]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: fix show-previous-message doc string
[notmuch] / emacs / notmuch-show.el
index 82d11c925bab4b5ecc6b225579e430514b8fce44..de9421e80879edb544a949d801719b412bb10c92 100644 (file)
 (require 'notmuch-wash)
 (require 'notmuch-mua)
 (require 'notmuch-crypto)
+(require 'notmuch-print)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)
 (declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
+(declare-function notmuch-search-next-thread "notmuch" nil)
 (declare-function notmuch-search-show-thread "notmuch" nil)
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
@@ -47,8 +49,8 @@ For an open message, all of these headers will be made visible
 according to `notmuch-message-headers-visible' or can be toggled
 with `notmuch-show-toggle-headers'. For a closed message, only
 the first header in the list will be visible."
-  :group 'notmuch
-  :type '(repeat string))
+  :type '(repeat string)
+  :group 'notmuch-show)
 
 (defcustom notmuch-message-headers-visible t
   "Should the headers be visible by default?
@@ -58,38 +60,44 @@ If this value is non-nil, then all of the headers defined in
 of each message. Otherwise, these headers will be hidden and
 `notmuch-show-toggle-headers' can be used to make the visible for
 any given message."
-  :group 'notmuch
-  :type 'boolean)
+  :type 'boolean
+  :group 'notmuch-show)
 
 (defcustom notmuch-show-relative-dates t
   "Display relative dates in the message summary line."
-  :group 'notmuch
-  :type 'boolean)
+  :type 'boolean
+  :group 'notmuch-show)
 
 (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
   "A list of functions called to decorate the headers listed in
 `notmuch-message-headers'.")
 
-(defcustom notmuch-show-hook nil
+(defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
   "Functions called after populating a `notmuch-show' buffer."
-  :group 'notmuch
-  :type 'hook)
-
-(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)
+  :type 'hook
+  :options '(notmuch-show-turn-on-visual-line-mode)
+  :group 'notmuch-show
+  :group 'notmuch-hooks)
+
+(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
+                                                notmuch-wash-tidy-citations
+                                                notmuch-wash-elide-blank-lines
+                                                notmuch-wash-excerpt-citations)
   "Functions used to improve the display of text/plain parts."
-  :group 'notmuch
   :type 'hook
   :options '(notmuch-wash-convert-inline-patch-to-part
             notmuch-wash-wrap-long-lines
             notmuch-wash-tidy-citations
             notmuch-wash-elide-blank-lines
-            notmuch-wash-excerpt-citations))
+            notmuch-wash-excerpt-citations)
+  :group 'notmuch-show
+  :group 'notmuch-hooks)
 
 ;; Mostly useful for debugging.
 (defcustom notmuch-show-all-multipart/alternative-parts t
   "Should all parts of multipart/alternative parts be shown?"
-  :group 'notmuch
-  :type 'boolean)
+  :type 'boolean
+  :group 'notmuch-show)
 
 (defcustom notmuch-show-indent-messages-width 1
   "Width of message indentation in threads.
@@ -98,14 +106,24 @@ Messages are shown indented according to their depth in a thread.
 This variable determines the width of this indentation measured
 in number of blanks.  Defaults to `1', choose `0' to disable
 indentation."
-  :group 'notmuch
-  :type 'integer)
+  :type 'integer
+  :group 'notmuch-show)
 
 (defcustom notmuch-show-indent-multipart nil
   "Should the sub-parts of a multipart/* part be indented?"
   ;; dme: Not sure which is a good default.
-  :group 'notmuch
-  :type 'boolean)
+  :type 'boolean
+  :group 'notmuch-show)
+
+(defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part
+  "Default part header button action (on ENTER or mouse click)."
+  :group 'notmuch-show
+  :type '(choice (const :tag "Save part"
+                       notmuch-show-save-part)
+                (const :tag "View part"
+                       notmuch-show-view-part)
+                (const :tag "View interactively"
+                       notmuch-show-interactively-view-part)))
 
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
@@ -117,18 +135,22 @@ indentation."
            ,@body)
         (kill-buffer buf)))))
 
+(defun notmuch-show-turn-on-visual-line-mode ()
+  "Enable Visual Line mode."
+  (visual-line-mode t))
+
 (defun notmuch-show-view-all-mime-parts ()
   "Use external viewers to view all attachments from the current message."
   (interactive)
   (with-current-notmuch-show-message
-   ; We override the mm-inline-media-tests to indicate which message
-   ; parts are already sufficiently handled by the original
-   ; presentation of the message in notmuch-show mode. These parts
-   ; will be inserted directly into the temporary buffer of
-   ; with-current-notmuch-show-message and silently discarded.
-   ;
-   ; Any MIME part not explicitly mentioned here will be handled by an
-   ; external viewer as configured in the various mailcap files.
+   ;; We override the mm-inline-media-tests to indicate which message
+   ;; parts are already sufficiently handled by the original
+   ;; presentation of the message in notmuch-show mode. These parts
+   ;; will be inserted directly into the temporary buffer of
+   ;; with-current-notmuch-show-message and silently discarded.
+   ;;
+   ;; Any MIME part not explicitly mentioned here will be handled by an
+   ;; external viewer as configured in the various mailcap files.
    (let ((mm-inline-media-tests '(
                                  ("text/.*" ignore identity)
                                  ("application/pgp-signature" ignore identity)
@@ -183,6 +205,52 @@ indentation."
       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
   (message "Done"))
 
+(defun notmuch-show-with-message-as-text (fn)
+  "Apply FN to a text representation of the current message.
+
+FN is called with one argument, the message properties. It should
+operation on the contents of the current buffer."
+
+  ;; Remake the header to ensure that all information is available.
+  (let* ((to (notmuch-show-get-to))
+        (cc (notmuch-show-get-cc))
+        (from (notmuch-show-get-from))
+        (subject (notmuch-show-get-subject))
+        (date (notmuch-show-get-date))
+        (tags (notmuch-show-get-tags))
+        (depth (notmuch-show-get-depth))
+
+        (header (concat
+                 "Subject: " subject "\n"
+                 "To: " to "\n"
+                 (if (not (string= cc ""))
+                     (concat "Cc: " cc "\n")
+                   "")
+                 "From: " from "\n"
+                 "Date: " date "\n"
+                 (if tags
+                     (concat "Tags: "
+                             (mapconcat #'identity tags ", ") "\n")
+                   "")))
+        (all (buffer-substring (notmuch-show-message-top)
+                               (notmuch-show-message-bottom)))
+
+        (props (notmuch-show-get-message-properties)))
+    (with-temp-buffer
+      (insert all)
+      (indent-rigidly (point-min) (point-max) (- depth))
+      ;; Remove the original header.
+      (goto-char (point-min))
+      (re-search-forward "^$" (point-max) nil)
+      (delete-region (point-min) (point))
+      (insert header)
+      (funcall fn props))))
+
+(defun notmuch-show-print-message ()
+  "Print the current message."
+  (interactive)
+  (notmuch-show-with-message-as-text 'notmuch-print-message))
+
 (defun notmuch-show-fontify-header ()
   (let ((face (cond
               ((looking-at "[Tt]o:")
@@ -227,21 +295,47 @@ indentation."
   "Try to clean a single email ADDRESS for display.  Return
 unchanged ADDRESS if parsing fails."
   (condition-case nil
-    (let* ((parsed (mail-header-parse-address address))
-          (address (car parsed))
-          (name (cdr parsed)))
-      ;; Remove double quotes. They might be required during transport,
-      ;; but we don't need to see them.
-      (when name
-        (setq name (replace-regexp-in-string "\"" "" name)))
+    (let (p-name p-address)
+      ;; It would be convenient to use `mail-header-parse-address',
+      ;; but that expects un-decoded mailbox parts, whereas our
+      ;; mailbox parts are already decoded (and hence may contain
+      ;; UTF-8). Given that notmuch should handle most of the awkward
+      ;; cases, some simple string deconstruction should be sufficient
+      ;; here.
+      (cond
+       ;; "User <user@dom.ain>" style.
+       ((string-match "\\(.*\\) <\\(.*\\)>" address)
+       (setq p-name (match-string 1 address)
+             p-address (match-string 2 address)))
+
+       ;; "<user@dom.ain>" style.
+       ((string-match "<\\(.*\\)>" address)
+       (setq p-address (match-string 1 address)))
+
+       ;; Everything else.
+       (t
+       (setq p-address address)))
+
+      ;; Remove elements of the mailbox part that are not relevant for
+      ;; display, even if they are required during transport.
+      (when p-name
+       ;; Outer double quotes.
+       (when (string-match "^\"\\(.*\\)\"$" p-name)
+         (setq p-name (match-string 1 p-name)))
+
+       ;; Backslashes.
+       (setq p-name (replace-regexp-in-string "\\\\" "" p-name)))
+
       ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
       ;; 'foo@bar.com'.
-      (when (string= name address)
-        (setq name nil))
-
-      (if (not name)
-        address
-        (concat name " <" address ">")))
+      (when (string= p-name p-address)
+       (setq p-name nil))
+
+      ;; If no name results, return just the address.
+      (if (not p-name)
+         p-address
+       ;; Otherwise format the name and address together.
+       (concat p-name " <" p-address ">")))
     (error address)))
 
 (defun notmuch-show-insert-headerline (headers date tags depth)
@@ -278,10 +372,21 @@ message at DEPTH in the current thread."
        (run-hooks 'notmuch-show-markup-headers-hook)))))
 
 (define-button-type 'notmuch-show-part-button-type
-  'action 'notmuch-show-part-button-action
+  'action 'notmuch-show-part-button-default
+  'keymap 'notmuch-show-part-button-map
   'follow-link t
   'face 'message-mml)
 
+(defvar notmuch-show-part-button-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map button-map)
+    (define-key map "s" 'notmuch-show-part-button-save)
+    (define-key map "v" 'notmuch-show-part-button-view)
+    (define-key map "o" 'notmuch-show-part-button-interactively-view)
+    map)
+  "Submap for button commands")
+(fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
+
 (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
   (let ((button))
     (setq button
@@ -296,44 +401,75 @@ message at DEPTH in the current thread."
                   " ]")
           :type 'notmuch-show-part-button-type
           :notmuch-part nth
-          :notmuch-filename name))
+          :notmuch-filename name
+          :notmuch-content-type content-type))
     (insert "\n")
     ;; return button
     button))
 
 ;; Functions handling particular MIME parts.
 
-(defun notmuch-show-save-part (message-id nth &optional filename)
-  (let ((process-crypto notmuch-show-process-crypto))
-    (with-temp-buffer
-      (setq notmuch-show-process-crypto process-crypto)
-      ;; Always acquires the part via `notmuch part', even if it is
-      ;; available in the JSON output.
-      (insert (notmuch-show-get-bodypart-internal message-id nth))
-      (let ((file (read-file-name
-                  "Filename to save as: "
-                  (or mailcap-download-directory "~/")
-                  nil nil
-                  filename)))
-       ;; Don't re-compress .gz & al.  Arguably we should make
-       ;; `file-name-handler-alist' nil, but that would chop
-       ;; ange-ftp, which is reasonable to use here.
-       (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))))
+(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)
+  (declare (indent 2))
+  (let ((process-crypto (make-symbol "process-crypto")))
+    `(let ((,process-crypto notmuch-show-process-crypto))
+       (with-temp-buffer
+        (setq notmuch-show-process-crypto ,process-crypto)
+        ;; Always acquires the part via `notmuch part', even if it is
+        ;; available in the JSON output.
+        (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))
+        ,@body))))
+
+(defun notmuch-show-save-part (message-id nth &optional filename content-type)
+  (notmuch-with-temp-part-buffer message-id nth
+    (let ((file (read-file-name
+                "Filename to save as: "
+                (or mailcap-download-directory "~/")
+                nil nil
+                filename)))
+      ;; Don't re-compress .gz & al.  Arguably we should make
+      ;; `file-name-handler-alist' nil, but that would chop
+      ;; ange-ftp, which is reasonable to use here.
+      (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t))))
+
+(defun notmuch-show-view-part (message-id nth &optional filename content-type )
+  (notmuch-with-temp-part-buffer message-id nth
+    ;; set mm-inlined-types to nil to force an external viewer
+    (let ((handle (mm-make-handle (current-buffer) (list content-type)))
+         (mm-inlined-types nil))
+      ;; We override mm-save-part as notmuch-show-save-part is better
+      ;; since it offers the filename. We need to lexically bind
+      ;; everything we need for notmuch-show-save-part to prevent
+      ;; potential dynamic shadowing.
+      (lexical-let ((message-id message-id)
+                   (nth nth)
+                   (filename filename)
+                   (content-type content-type))
+       (flet ((mm-save-part (&rest args) (notmuch-show-save-part
+                                          message-id nth filename content-type)))
+         (mm-display-part handle))))))
+
+(defun notmuch-show-interactively-view-part (message-id nth &optional filename content-type)
+  (notmuch-with-temp-part-buffer message-id nth
+    (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+      (mm-interactively-view-part handle))))
 
 (defun notmuch-show-mm-display-part-inline (msg part nth content-type)
   "Use the mm-decode/mm-view functions to display a part in the
 current buffer, if possible."
   (let ((display-buffer (current-buffer)))
     (with-temp-buffer
-      (let ((handle (mm-make-handle (current-buffer) (list content-type))))
-       (if (and (mm-inlinable-p handle)
-                (mm-inlined-p handle))
-           (let ((content (notmuch-show-get-bodypart-content msg part nth)))
-             (insert content)
-             (set-buffer display-buffer)
-             (mm-display-part handle)
-             t)
-         nil)))))
+      (let* ((charset (plist-get part :content-charset))
+            (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
+       ;; If the user wants the part inlined, insert the content and
+       ;; test whether we are able to inline it (which includes both
+       ;; capability and suitability tests).
+       (when (mm-inlined-p handle)
+         (insert (notmuch-show-get-bodypart-content msg part nth))
+         (when (mm-inlinable-p handle)
+           (set-buffer display-buffer)
+           (mm-display-part handle)
+           t))))))
 
 (defvar notmuch-show-multipart/alternative-discouraged
   '(
@@ -585,6 +721,10 @@ current buffer, if possible."
                nil))
          nil))))
 
+;; Handler for wash generated inline patch fake parts.
+(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-*/* msg part "text/x-diff" nth depth "inline patch"))
+
 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
   ;; This handler _must_ succeed - it is the handler of last resort.
   (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
@@ -652,8 +792,8 @@ current buffer, if possible."
   ;; part, so we make sure that we're down at the end.
   (goto-char (point-max))
   ;; Ensure that the part ends with a carriage return.
-  (if (not (bolp))
-      (insert "\n")))
+  (unless (bolp)
+    (insert "\n")))
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
@@ -733,8 +873,8 @@ current buffer, if possible."
     (setq body-start (point-marker))
     (notmuch-show-insert-body msg (plist-get msg :body) depth)
     ;; Ensure that the body ends with a newline.
-    (if (not (bolp))
-       (insert "\n"))
+    (unless (bolp)
+      (insert "\n"))
     (setq body-end (point-marker))
     (setq content-end (point-marker))
 
@@ -753,6 +893,8 @@ current buffer, if possible."
       (overlay-put headers-overlay 'priority 10))
     (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
 
+    (plist-put msg :depth depth)
+
     ;; Save the properties for this message. Currently this saves the
     ;; entire message (augmented it with other stuff), which seems
     ;; like overkill. We might save a reduced subset (for example, not
@@ -869,14 +1011,11 @@ buffer."
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
-      ;; Act on visual lines rather than logical lines.
-      (visual-line-mode t)
-
       (run-hooks 'notmuch-show-hook))
 
     ;; Move straight to the first open message
-    (if (not (notmuch-show-message-visible-p))
-       (notmuch-show-next-open-message))
+    (unless (notmuch-show-message-visible-p)
+      (notmuch-show-next-open-message))
 
     ;; Set the header line to the subject of the first open message.
     (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
@@ -925,7 +1064,8 @@ thread id.  If a prefix is given, crypto processing is toggled."
        (define-key map "s" 'notmuch-search)
        (define-key map "m" 'notmuch-mua-new-mail)
        (define-key map "f" 'notmuch-show-forward-message)
-       (define-key map "r" 'notmuch-show-reply)
+       (define-key map "r" 'notmuch-show-reply-sender)
+       (define-key map "R" 'notmuch-show-reply)
        (define-key map "|" 'notmuch-show-pipe-message)
        (define-key map "w" 'notmuch-show-save-attachments)
        (define-key map "V" 'notmuch-show-view-raw-message)
@@ -936,7 +1076,8 @@ thread id.  If a prefix is given, crypto processing is toggled."
        (define-key map "-" 'notmuch-show-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)
        (define-key map "x" 'notmuch-show-archive-thread-then-exit)
-       (define-key map "a" 'notmuch-show-archive-thread)
+       (define-key map "a" 'notmuch-show-archive-message-then-next)
+       (define-key map "A" 'notmuch-show-archive-thread-then-next)
        (define-key map "N" 'notmuch-show-next-message)
        (define-key map "P" 'notmuch-show-previous-message)
        (define-key map "n" 'notmuch-show-next-open-message)
@@ -945,6 +1086,7 @@ thread id.  If a prefix is given, crypto processing is toggled."
        (define-key map " " 'notmuch-show-advance-and-archive)
        (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
        (define-key map (kbd "RET") 'notmuch-show-toggle-message)
+       (define-key map "#" 'notmuch-show-print-message)
        map)
       "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
@@ -982,7 +1124,8 @@ All currently available key bindings:
   (use-local-map notmuch-show-mode-map)
   (setq major-mode 'notmuch-show-mode
        mode-name "notmuch-show")
-  (setq buffer-read-only t))
+  (setq buffer-read-only t
+       truncate-lines t))
 
 (defun notmuch-show-move-to-message-top ()
   (goto-char (notmuch-show-message-top)))
@@ -1104,6 +1247,9 @@ Some useful entries are:
 (defun notmuch-show-get-to ()
   (notmuch-show-get-header :To))
 
+(defun notmuch-show-get-depth ()
+  (notmuch-show-get-prop :depth))
+
 (defun notmuch-show-set-tags (tags)
   "Set the tags of the current message."
   (notmuch-show-set-prop :tags tags)
@@ -1191,7 +1337,7 @@ thread from the search from which this thread was originally
 shown."
   (interactive)
   (if (notmuch-show-advance)
-      (notmuch-show-archive-thread)))
+      (notmuch-show-archive-thread-then-next)))
 
 (defun notmuch-show-rewind ()
   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
@@ -1230,9 +1376,14 @@ any effects from previous calls to
       (notmuch-show-previous-message)))))
 
 (defun notmuch-show-reply (&optional prompt-for-sender)
-  "Reply to the current message."
+  "Reply to the sender and all recipients of the current message."
+  (interactive "P")
+  (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t))
+
+(defun notmuch-show-reply-sender (&optional prompt-for-sender)
+  "Reply to the sender of the current message."
   (interactive "P")
-  (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender))
+  (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil))
 
 (defun notmuch-show-forward-message (&optional prompt-for-sender)
   "Forward the current message."
@@ -1240,14 +1391,19 @@ any effects from previous calls to
   (with-current-notmuch-show-message
    (notmuch-mua-new-forward-message prompt-for-sender)))
 
-(defun notmuch-show-next-message ()
-  "Show the next message."
-  (interactive)
+(defun notmuch-show-next-message (&optional pop-at-end)
+  "Show the next message.
+
+If a prefix argument is given and this is the last message in the
+thread, navigate to the next thread in the parent search buffer."
+  (interactive "P")
   (if (notmuch-show-goto-message-next)
       (progn
        (notmuch-show-mark-read)
        (notmuch-show-message-adjust))
-    (goto-char (point-max))))
+    (if pop-at-end
+       (notmuch-show-next-thread)
+      (goto-char (point-max)))))
 
 (defun notmuch-show-previous-message ()
   "Show the previous message."
@@ -1256,9 +1412,13 @@ any effects from previous calls to
   (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
 
-(defun notmuch-show-next-open-message ()
-  "Show the next message."
-  (interactive)
+(defun notmuch-show-next-open-message (&optional pop-at-end)
+  "Show the next open message.
+
+If a prefix argument is given and this is the last open message
+in the thread, navigate to the next thread in the parent search
+buffer."
+  (interactive "P")
   (let (r)
     (while (and (setq r (notmuch-show-goto-message-next))
                (not (notmuch-show-message-visible-p))))
@@ -1266,10 +1426,12 @@ any effects from previous calls to
        (progn
          (notmuch-show-mark-read)
          (notmuch-show-message-adjust))
-      (goto-char (point-max)))))
+      (if pop-at-end
+         (notmuch-show-next-thread)
+       (goto-char (point-max))))))
 
 (defun notmuch-show-previous-open-message ()
-  "Show the previous message."
+  "Show the previous open message."
   (interactive)
   (while (and (notmuch-show-goto-message-previous)
              (not (notmuch-show-message-visible-p))))
@@ -1300,7 +1462,7 @@ than only the current message."
   (interactive "P\nsPipe message to command: ")
   (let (shell-command)
     (if entire-thread
-       (setq shell-command 
+       (setq shell-command
              (concat notmuch-command " show --format=mbox "
                      (shell-quote-argument
                       (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
@@ -1407,23 +1569,45 @@ argument, hide all of the messages."
   (interactive)
   (backward-button 1))
 
-(defun notmuch-show-archive-thread-internal (show-next)
-  ;; Remove the tag from the current set of messages.
+(defun notmuch-show-tag-thread-internal (tag &optional remove)
+  "Add tag to the current set of messages.
+
+If the remove switch is given, tags will be removed instead of
+added."
   (goto-char (point-min))
-  (loop do (notmuch-show-remove-tag "inbox")
-       until (not (notmuch-show-goto-message-next)))
-  ;; Move to the next item in the search results, if any.
+  (let ((tag-function (if remove
+                         'notmuch-show-remove-tag
+                       'notmuch-show-add-tag)))
+    (loop do (funcall tag-function tag)
+         until (not (notmuch-show-goto-message-next)))))
+
+(defun notmuch-show-add-tag-thread (tag)
+  "Add tag to all messages in the current thread."
+  (interactive)
+  (notmuch-show-tag-thread-internal tag))
+
+(defun notmuch-show-remove-tag-thread (tag)
+  "Remove tag from all messages in the current thread."
+  (interactive)
+  (notmuch-show-tag-thread-internal tag t))
+
+(defun notmuch-show-next-thread (&optional show-next)
+  "Move to the next item in the search results, if any."
+  (interactive "P")
   (let ((parent-buffer notmuch-show-parent-buffer))
     (notmuch-kill-this-buffer)
-    (if parent-buffer
-       (progn
-         (switch-to-buffer parent-buffer)
-         (forward-line)
-         (if show-next
-             (notmuch-search-show-thread))))))
+    (when parent-buffer
+      (switch-to-buffer parent-buffer)
+      (notmuch-search-next-thread)
+      (if show-next
+         (notmuch-search-show-thread)))))
+
+(defun notmuch-show-archive-thread (&optional unarchive)
+  "Archive each message in thread.
 
-(defun notmuch-show-archive-thread ()
-  "Archive each message in thread, then show next thread from search.
+If a prefix argument is given, the messages will be
+\"unarchived\" (ie. the \"inbox\" tag will be added instead of
+removed).
 
 Archive each message currently shown by removing the \"inbox\"
 tag from each. Then kill this buffer and show the next thread
@@ -1433,13 +1617,39 @@ Note: This command is safe from any race condition of new messages
 being delivered to the same thread. It does not archive the
 entire thread, but only the messages shown in the current
 buffer."
+  (interactive "P")
+  (if unarchive
+      (notmuch-show-add-tag-thread "inbox")
+    (notmuch-show-remove-tag-thread "inbox")))
+
+(defun notmuch-show-archive-thread-then-next ()
+  "Archive each message in thread, then show next thread from search."
   (interactive)
-  (notmuch-show-archive-thread-internal t))
+  (notmuch-show-archive-thread)
+  (notmuch-show-next-thread t))
 
 (defun notmuch-show-archive-thread-then-exit ()
   "Archive each message in thread, then exit back to search results."
   (interactive)
-  (notmuch-show-archive-thread-internal nil))
+  (notmuch-show-archive-thread)
+  (notmuch-show-next-thread))
+
+(defun notmuch-show-archive-message (&optional unarchive)
+  "Archive the current message.
+
+If a prefix argument is given, the message will be
+\"unarchived\" (ie. the \"inbox\" tag will be added instead of
+removed)."
+  (interactive "P")
+  (if unarchive
+      (notmuch-show-add-tag "inbox")
+    (notmuch-show-remove-tag "inbox")))
+
+(defun notmuch-show-archive-message-then-next ()
+  "Archive the current message, then show the next open message in the current thread."
+  (interactive)
+  (notmuch-show-archive-message)
+  (notmuch-show-next-open-message t))
 
 (defun notmuch-show-stash-cc ()
   "Copy CC field of current message to kill-ring."
@@ -1488,12 +1698,30 @@ buffer."
 
 ;; Commands typically bound to buttons.
 
-(defun notmuch-show-part-button-action (button)
-  (let ((nth (button-get button :notmuch-part)))
-    (if nth
-       (notmuch-show-save-part (notmuch-show-get-message-id) nth
-                               (button-get button :notmuch-filename))
-      (message "Not a valid part (is it a fake part?)."))))
+(defun notmuch-show-part-button-default (&optional button)
+  (interactive)
+  (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))
+
+(defun notmuch-show-part-button-save (&optional button)
+  (interactive)
+  (notmuch-show-part-button-internal button #'notmuch-show-save-part))
+
+(defun notmuch-show-part-button-view (&optional button)
+  (interactive)
+  (notmuch-show-part-button-internal button #'notmuch-show-view-part))
+
+(defun notmuch-show-part-button-interactively-view (&optional button)
+  (interactive)
+  (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))
+
+(defun notmuch-show-part-button-internal (button handler)
+  (let ((button (or button (button-at (point)))))
+    (if button
+       (let ((nth (button-get button :notmuch-part)))
+         (if nth
+             (funcall handler (notmuch-show-get-message-id) nth
+                      (button-get button :notmuch-filename)
+                      (button-get button :notmuch-content-type)))))))
 
 ;;