;; Authors: Carl Worth <cworth@cworth.org>
;; David Edmondson <dme@dme.org>
-(require 'cl)
+(eval-when-compile (require 'cl))
(require 'mm-view)
(require 'message)
(require 'mm-decode)
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
`(save-excursion
- (let ((filename (notmuch-show-get-filename)))
- (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
+ (let ((id (notmuch-show-get-message-id)))
+ (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
(with-current-buffer buf
- (insert-file-contents filename nil nil nil t)
+ (call-process notmuch-command nil t nil "show" "--format=raw" id)
,@body)
(kill-buffer buf)))))
(defun notmuch-show-make-symbol (type)
(make-symbol (concat "notmuch-show-" type)))
+(defun notmuch-show-strip-re (string)
+ (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+
+(defvar notmuch-show-previous-subject "")
+(make-variable-buffer-local 'notmuch-show-previous-subject)
+
(defun notmuch-show-insert-msg (msg depth)
"Insert the message MSG at depth DEPTH in the current thread."
- (let ((headers (plist-get msg :headers))
- ;; Indentation causes the buffer offset of the start/end
- ;; points to move, so we must use markers.
- message-start message-end
- content-start content-end
- headers-start headers-end
- body-start body-end
- (headers-invis-spec (notmuch-show-make-symbol "header"))
- (message-invis-spec (notmuch-show-make-symbol "message")))
+ (let* ((headers (plist-get msg :headers))
+ ;; Indentation causes the buffer offset of the start/end
+ ;; points to move, so we must use markers.
+ message-start message-end
+ content-start content-end
+ headers-start headers-end
+ body-start body-end
+ (headers-invis-spec (notmuch-show-make-symbol "header"))
+ (message-invis-spec (notmuch-show-make-symbol "message"))
+ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
;; removing items from `buffer-invisibility-spec' (which is what
(insert "\n")
(save-excursion
(goto-char content-start)
- (forward-line 1)
+ ;; If the subject of this message is the same as that of the
+ ;; previous message, don't display it when this message is
+ ;; collapsed.
+ (when (not (string= notmuch-show-previous-subject
+ bare-subject))
+ (forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
+ (setq notmuch-show-previous-subject bare-subject)
+
(setq body-start (point-marker))
(notmuch-show-insert-body msg (plist-get msg :body) depth)
;; Ensure that the body ends with a newline.
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "?" 'notmuch-help)
- (define-key map "q" 'kill-this-buffer)
+ (define-key map "q" 'notmuch-kill-this-buffer)
(define-key map (kbd "<C-tab>") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
(define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
-;;;###autoload
(defun notmuch-show-mode ()
"Major mode for viewing a thread with notmuch.
(defun notmuch-show-get-message-id ()
"Return the message id of the current message."
- (concat "id:" (notmuch-show-get-prop :id)))
+ (concat "id:\"" (notmuch-show-get-prop :id) "\""))
;; dme: Would it make sense to use a macro for many of these?
(defun notmuch-show-view-raw-message ()
"View the file holding the current message."
(interactive)
- (view-file (notmuch-show-get-filename)))
+ (let ((id (notmuch-show-get-message-id)))
+ (let ((buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
+ (switch-to-buffer buf)
+ (save-excursion
+ (call-process notmuch-command nil t nil "show" "--format=raw" id)))))
(defun notmuch-show-pipe-message (entire-thread command)
"Pipe the contents of the current message (or thread) to the given command.
(let (shell-command)
(if entire-thread
(setq shell-command
- (concat "notmuch show --format=mbox "
+ (concat notmuch-command " show --format=mbox "
(shell-quote-argument
(mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
" | " command))
(setq shell-command
- (concat command " < " (shell-quote-argument (notmuch-show-get-filename)))))
+ (concat notmuch-command " show --format=raw "
+ (shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
(start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
+(defun notmuch-show-add-tags-worker (current-tags add-tags)
+ "Add to `current-tags' with any tags from `add-tags' not
+currently present and return the result."
+ (let ((result-tags (copy-sequence current-tags)))
+ (mapc (lambda (add-tag)
+ (unless (member add-tag current-tags)
+ (setq result-tags (push add-tag result-tags))))
+ add-tags)
+ (sort result-tags 'string<)))
+
+(defun notmuch-show-del-tags-worker (current-tags del-tags)
+ "Remove any tags in `del-tags' from `current-tags' and return
+the result."
+ (let ((result-tags (copy-sequence current-tags)))
+ (mapc (lambda (del-tag)
+ (setq result-tags (delete del-tag result-tags)))
+ del-tags)
+ result-tags))
+
(defun notmuch-show-add-tag (&rest toadd)
"Add a tag to the current message."
(interactive
(list (notmuch-select-tag-with-completion "Tag to add: ")))
- (apply 'notmuch-call-notmuch-process
- (append (cons "tag"
- (mapcar (lambda (s) (concat "+" s)) toadd))
- (cons (notmuch-show-get-message-id) nil)))
- (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
+
+ (let* ((current-tags (notmuch-show-get-tags))
+ (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
+
+ (unless (equal current-tags new-tags)
+ (apply 'notmuch-call-notmuch-process
+ (append (cons "tag"
+ (mapcar (lambda (s) (concat "+" s)) toadd))
+ (cons (notmuch-show-get-message-id) nil)))
+ (notmuch-show-set-tags new-tags))))
(defun notmuch-show-remove-tag (&rest toremove)
"Remove a tag from the current message."
(interactive
(list (notmuch-select-tag-with-completion
"Tag to remove: " (notmuch-show-get-message-id))))
- (let ((tags (notmuch-show-get-tags)))
- (if (intersection tags toremove :test 'string=)
- (progn
- (apply 'notmuch-call-notmuch-process
- (append (cons "tag"
- (mapcar (lambda (s) (concat "-" s)) toremove))
- (cons (notmuch-show-get-message-id) nil)))
- (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
+
+ (let* ((current-tags (notmuch-show-get-tags))
+ (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
+
+ (unless (equal current-tags new-tags)
+ (apply 'notmuch-call-notmuch-process
+ (append (cons "tag"
+ (mapcar (lambda (s) (concat "-" s)) toremove))
+ (cons (notmuch-show-get-message-id) nil)))
+ (notmuch-show-set-tags new-tags))))
(defun notmuch-show-toggle-headers ()
"Toggle the visibility of the current message headers."
until (not (notmuch-show-goto-message-next)))
;; Move to the next item in the search results, if any.
(let ((parent-buffer notmuch-show-parent-buffer))
- (kill-this-buffer)
+ (notmuch-kill-this-buffer)
(if parent-buffer
(progn
(switch-to-buffer parent-buffer)
projects / notmuch / blobdiff