]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
Merge branch 'release'
[notmuch] / emacs / notmuch-show.el
index 90f9af7f2d9d4b5a6b8a78d706b6e6025634a1d8..2806879e53cfff412e07c4b175478f8ed728998e 100644 (file)
@@ -27,6 +27,7 @@
 (require 'mm-decode)
 (require 'mailcap)
 (require 'icalendar)
 (require 'mm-decode)
 (require 'mailcap)
 (require 'icalendar)
+(require 'goto-addr)
 
 (require 'notmuch-lib)
 (require 'notmuch-query)
 
 (require 'notmuch-lib)
 (require 'notmuch-query)
@@ -74,7 +75,10 @@ any given message."
   :group 'notmuch
   :type 'hook)
 
   :group 'notmuch
   :type 'hook)
 
-(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)
+(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
   "Functions used to improve the display of text/plain parts."
   :group 'notmuch
   :type 'hook
@@ -90,6 +94,16 @@ any given message."
   :group 'notmuch
   :type 'boolean)
 
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-show-indent-messages-width 1
+  "Width of message indentation in threads.
+
+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)
+
 (defcustom notmuch-show-indent-multipart nil
   "Should the sub-parts of a multipart/* part be indented?"
   ;; dme: Not sure which is a good default.
 (defcustom notmuch-show-indent-multipart nil
   "Should the sub-parts of a multipart/* part be indented?"
   ;; dme: Not sure which is a good default.
@@ -237,7 +251,7 @@ unchanged ADDRESS if parsing fails."
   "Insert a notmuch style headerline based on HEADERS for a
 message at DEPTH in the current thread."
   (let ((start (point)))
   "Insert a notmuch style headerline based on HEADERS for a
 message at DEPTH in the current thread."
   (let ((start (point)))
-    (insert (notmuch-show-spaces-n depth)
+    (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
            (notmuch-show-clean-address (plist-get headers :From))
            " ("
            date
            (notmuch-show-clean-address (plist-get headers :From))
            " ("
            date
@@ -254,12 +268,12 @@ message at DEPTH in the current thread."
 (defun notmuch-show-insert-headers (headers)
   "Insert the headers of the current message."
   (let ((start (point)))
 (defun notmuch-show-insert-headers (headers)
   "Insert the headers of the current message."
   (let ((start (point)))
-    (mapc '(lambda (header)
-            (let* ((header-symbol (intern (concat ":" header)))
-                   (header-value (plist-get headers header-symbol)))
-              (if (and header-value
-                       (not (string-equal "" header-value)))
-                  (notmuch-show-insert-header header header-value))))
+    (mapc (lambda (header)
+           (let* ((header-symbol (intern (concat ":" header)))
+                  (header-value (plist-get headers header-symbol)))
+             (if (and header-value
+                      (not (string-equal "" header-value)))
+                 (notmuch-show-insert-header header header-value))))
          notmuch-message-headers)
     (save-excursion
       (save-restriction
          notmuch-message-headers)
     (save-excursion
       (save-restriction
@@ -309,17 +323,17 @@ message at DEPTH in the current thread."
        ;; ange-ftp, which is reasonable to use here.
        (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))))
 
        ;; 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-mm-display-part-inline (msg part content-type content)
+(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
   "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
-      (insert content)
       (let ((handle (mm-make-handle (current-buffer) (list content-type))))
       (let ((handle (mm-make-handle (current-buffer) (list content-type))))
-       (set-buffer display-buffer)
        (if (and (mm-inlinable-p handle)
                 (mm-inlined-p handle))
        (if (and (mm-inlinable-p handle)
                 (mm-inlined-p handle))
-           (progn
+           (let ((content (notmuch-show-get-bodypart-content msg part nth)))
+             (insert content)
+             (set-buffer display-buffer)
              (mm-display-part handle)
              t)
          nil)))))
              (mm-display-part handle)
              t)
          nil)))))
@@ -333,7 +347,7 @@ current buffer, if possible."
     ))
 
 (defun notmuch-show-multipart/*-to-list (part)
     ))
 
 (defun notmuch-show-multipart/*-to-list (part)
-  (mapcar '(lambda (inner-part) (plist-get inner-part :content-type))
+  (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 
 (defun notmuch-show-multipart/alternative-choose (types)
          (plist-get part :content)))
 
 (defun notmuch-show-multipart/alternative-choose (types)
@@ -446,11 +460,10 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
 
 (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
-    (button-put button 'face '(:foreground "blue"))
+    (button-put button 'face 'notmuch-crypto-part-header)
     ;; add signature status button if sigstatus provided
     (if (plist-member part :sigstatus)
     ;; add signature status button if sigstatus provided
     (if (plist-member part :sigstatus)
-       (let* ((headers (plist-get msg :headers))
-              (from (plist-get headers :From))
+       (let* ((from (notmuch-show-get-header :From msg))
               (sigstatus (car (plist-get part :sigstatus))))
          (notmuch-crypto-insert-sigstatus-button sigstatus from))
       ;; if we're not adding sigstatus, tell the user how they can get it
               (sigstatus (car (plist-get part :sigstatus))))
          (notmuch-crypto-insert-sigstatus-button sigstatus from))
       ;; if we're not adding sigstatus, tell the user how they can get it
@@ -469,15 +482,14 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
 
 (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
-    (button-put button 'face '(:foreground "blue"))
+    (button-put button 'face 'notmuch-crypto-part-header)
     ;; add encryption status button if encstatus specified
     (if (plist-member part :encstatus)
        (let ((encstatus (car (plist-get part :encstatus))))
          (notmuch-crypto-insert-encstatus-button encstatus)
          ;; add signature status button if sigstatus specified
          (if (plist-member part :sigstatus)
     ;; add encryption status button if encstatus specified
     (if (plist-member part :encstatus)
        (let ((encstatus (car (plist-get part :encstatus))))
          (notmuch-crypto-insert-encstatus-button encstatus)
          ;; add signature status button if sigstatus specified
          (if (plist-member part :sigstatus)
-             (let* ((headers (plist-get msg :headers))
-                    (from (plist-get headers :From))
+             (let* ((from (notmuch-show-get-header :From msg))
                     (sigstatus (car (plist-get part :sigstatus))))
                (notmuch-crypto-insert-sigstatus-button sigstatus from))))
       ;; if we're not adding encstatus, tell the user how they can get it
                     (sigstatus (car (plist-get part :sigstatus))))
                (notmuch-crypto-insert-sigstatus-button sigstatus from))))
       ;; if we're not adding encstatus, tell the user how they can get it
@@ -510,7 +522,6 @@ current buffer, if possible."
 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
   (let* ((message (car (plist-get part :content)))
 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
   (let* ((message (car (plist-get part :content)))
-        (headers (plist-get message :headers))
         (body (car (plist-get message :body)))
         (start (point)))
 
         (body (car (plist-get message :body)))
         (start (point)))
 
@@ -577,17 +588,14 @@ current buffer, if possible."
                nil))
          nil))))
 
                nil))
          nil))))
 
-(defun notmuch-show-insert-part-application/* (msg part content-type nth depth declared-type
-)
-  ;; do not render random "application" parts
-  (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)))
+;; 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))
 
 (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))
-  (let ((content (notmuch-show-get-bodypart-content msg part nth)))
-    (if content
-       (notmuch-show-mm-display-part-inline msg part content-type content)))
+  (notmuch-show-mm-display-part-inline msg part nth content-type)
   t)
 
 ;; Functions for determining how to handle MIME parts.
   t)
 
 ;; Functions for determining how to handle MIME parts.
@@ -656,7 +664,7 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
-  (mapc '(lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
+  (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
 
 (defun notmuch-show-make-symbol (type)
   (make-symbol (concat "notmuch-show-" type)))
 
 (defun notmuch-show-make-symbol (type)
   (make-symbol (concat "notmuch-show-" type)))
@@ -738,7 +746,7 @@ current buffer, if possible."
     (setq content-end (point-marker))
 
     ;; Indent according to the depth in the thread.
     (setq content-end (point-marker))
 
     ;; Indent according to the depth in the thread.
-    (indent-rigidly content-start content-end depth)
+    (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))
 
     (setq message-end (point-max-marker))
 
 
     (setq message-end (point-max-marker))
 
@@ -774,14 +782,38 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-thread (thread depth)
   "Insert the thread THREAD at depth DEPTH in the current forest."
 
 (defun notmuch-show-insert-thread (thread depth)
   "Insert the thread THREAD at depth DEPTH in the current forest."
-  (mapc '(lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
+  (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
 
 (defun notmuch-show-insert-forest (forest)
   "Insert the forest of threads FOREST."
 
 (defun notmuch-show-insert-forest (forest)
   "Insert the forest of threads FOREST."
-  (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
+  (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
 
+(defvar notmuch-show-thread-id nil)
+(make-variable-buffer-local 'notmuch-show-thread-id)
 (defvar notmuch-show-parent-buffer nil)
 (make-variable-buffer-local 'notmuch-show-parent-buffer)
 (defvar notmuch-show-parent-buffer nil)
 (make-variable-buffer-local 'notmuch-show-parent-buffer)
+(defvar notmuch-show-query-context nil)
+(make-variable-buffer-local 'notmuch-show-query-context)
+(defvar notmuch-show-buffer-name nil)
+(make-variable-buffer-local 'notmuch-show-buffer-name)
+
+(defun notmuch-show-buttonise-links (start end)
+  "Buttonise URLs and mail addresses between START and END.
+
+This also turns id:\"<message id>\"-parts into buttons for
+a corresponding notmuch search."
+  (goto-address-fontify-region start end)
+  (save-excursion
+    (goto-char start)
+    (while (re-search-forward "id:\\(\"?\\)[^[:space:]\"]+\\1" end t)
+      ;; remove the overlay created by goto-address-mode
+      (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
+      (make-text-button (match-beginning 0) (match-end 0)
+                       'action `(lambda (arg)
+                                  (notmuch-show ,(match-string-no-properties 0)))
+                       'follow-link t
+                       'help-echo "Mouse-1, RET: search for this message"
+                       'face goto-address-mail-face))))
 
 ;;;###autoload
 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
 
 ;;;###autoload
 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
@@ -799,19 +831,34 @@ non-nil.
 The optional BUFFER-NAME provides the name of the buffer in
 which the message thread is shown. If it is nil (which occurs
 when the command is called interactively) the argument to the
 The optional BUFFER-NAME provides the name of the buffer in
 which the message thread is shown. If it is nil (which occurs
 when the command is called interactively) the argument to the
-function is used. "
+function is used.
+
+The optional CRYPTO-SWITCH toggles the value of the
+notmuch-crypto-process-mime customization variable for this show
+buffer."
   (interactive "sNotmuch show: ")
   (interactive "sNotmuch show: ")
-  (let ((buffer (get-buffer-create (generate-new-buffer-name
-                                   (or buffer-name
-                                       (concat "*notmuch-" thread-id "*")))))
-       (process-crypto (if crypto-switch
-                           (not notmuch-crypto-process-mime)
-                         notmuch-crypto-process-mime))
-       (inhibit-read-only t))
+  (let* ((process-crypto (if crypto-switch
+                            (not notmuch-crypto-process-mime)
+                          notmuch-crypto-process-mime)))
+    (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
+
+(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto)
+  (let* ((buffer-name (generate-new-buffer-name
+                      (or buffer-name
+                          (concat "*notmuch-" thread-id "*"))))
+        (buffer (get-buffer-create buffer-name))
+        (inhibit-read-only t))
     (switch-to-buffer buffer)
     (notmuch-show-mode)
     (switch-to-buffer buffer)
     (notmuch-show-mode)
+    ;; Don't track undo information for this buffer
+    (set 'buffer-undo-list t)
+
+    (setq notmuch-show-thread-id thread-id)
     (setq notmuch-show-parent-buffer parent-buffer)
     (setq notmuch-show-parent-buffer parent-buffer)
+    (setq notmuch-show-query-context query-context)
+    (setq notmuch-show-buffer-name buffer-name)
     (setq notmuch-show-process-crypto process-crypto)
     (setq notmuch-show-process-crypto process-crypto)
+
     (erase-buffer)
     (goto-char (point-min))
     (save-excursion
     (erase-buffer)
     (goto-char (point-min))
     (save-excursion
@@ -827,9 +874,8 @@ function is used. "
          (notmuch-show-insert-forest
           (notmuch-query-get-threads basic-args))))
 
          (notmuch-show-insert-forest
           (notmuch-query-get-threads basic-args))))
 
-      ;; Enable buttonisation of URLs and email addresses in the
-      ;; buffer.
-      (goto-address-mode t)
+      (jit-lock-register #'notmuch-show-buttonise-links)
+
       ;; Act on visual lines rather than logical lines.
       (visual-line-mode t)
 
       ;; Act on visual lines rather than logical lines.
       (visual-line-mode t)
 
@@ -844,6 +890,22 @@ function is used. "
 
     (notmuch-show-mark-read)))
 
 
     (notmuch-show-mark-read)))
 
+(defun notmuch-show-refresh-view (&optional crypto-switch)
+  "Refresh the current view (with crypto switch if prefix given).
+
+Kills the current buffer and reruns notmuch show with the same
+thread id.  If a prefix is given, crypto processing is toggled."
+  (interactive "P")
+  (let ((thread-id notmuch-show-thread-id)
+       (parent-buffer notmuch-show-parent-buffer)
+       (query-context notmuch-show-query-context)
+       (buffer-name notmuch-show-buffer-name)
+       (process-crypto (if crypto-switch
+                           (not notmuch-show-process-crypto)
+                         notmuch-show-process-crypto)))
+    (notmuch-kill-this-buffer)
+    (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
+
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)
@@ -851,6 +913,7 @@ function is used. "
     (define-key map "F" 'notmuch-show-stash-filename)
     (define-key map "f" 'notmuch-show-stash-from)
     (define-key map "i" 'notmuch-show-stash-message-id)
     (define-key map "F" 'notmuch-show-stash-filename)
     (define-key map "f" 'notmuch-show-stash-from)
     (define-key map "i" 'notmuch-show-stash-message-id)
+    (define-key map "I" 'notmuch-show-stash-message-id-stripped)
     (define-key map "s" 'notmuch-show-stash-subject)
     (define-key map "T" 'notmuch-show-stash-tags)
     (define-key map "t" 'notmuch-show-stash-to)
     (define-key map "s" 'notmuch-show-stash-subject)
     (define-key map "T" 'notmuch-show-stash-tags)
     (define-key map "t" 'notmuch-show-stash-to)
@@ -875,6 +938,7 @@ function is used. "
        (define-key map "V" 'notmuch-show-view-raw-message)
        (define-key map "v" 'notmuch-show-view-all-mime-parts)
        (define-key map "c" 'notmuch-show-stash-map)
        (define-key map "V" 'notmuch-show-view-raw-message)
        (define-key map "v" 'notmuch-show-view-all-mime-parts)
        (define-key map "c" 'notmuch-show-stash-map)
+       (define-key map "=" 'notmuch-show-refresh-view)
        (define-key map "h" 'notmuch-show-toggle-headers)
        (define-key map "-" 'notmuch-show-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)
        (define-key map "h" 'notmuch-show-toggle-headers)
        (define-key map "-" 'notmuch-show-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)
@@ -970,14 +1034,6 @@ All currently available key bindings:
     (notmuch-show-move-to-message-top)
     t))
 
     (notmuch-show-move-to-message-top)
     t))
 
-(defun notmuch-show-move-past-invisible-forward ()
-  (while (point-invisible-p)
-    (forward-char)))
-
-(defun notmuch-show-move-past-invisible-backward ()
-  (while (point-invisible-p)
-    (backward-char)))
-
 ;; Functions relating to the visibility of messages and their
 ;; components.
 
 ;; Functions relating to the visibility of messages and their
 ;; components.
 
@@ -1004,6 +1060,12 @@ All currently available key bindings:
     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
 
 (defun notmuch-show-get-message-properties ()
     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
 
 (defun notmuch-show-get-message-properties ()
+  "Return the properties of the current message as a plist.
+
+Some useful entries are:
+:headers - Property list containing the headers :Date, :Subject, :From, etc.
+:body - Body of the message
+:tags - Tags for this message"
   (save-excursion
     (notmuch-show-move-to-message-top)
     (get-text-property (point) :notmuch-message-properties)))
   (save-excursion
     (notmuch-show-move-to-message-top)
     (get-text-property (point) :notmuch-message-properties)))
@@ -1030,9 +1092,9 @@ All currently available key bindings:
   "Return the filename of the current message."
   (notmuch-show-get-prop :filename))
 
   "Return the filename of the current message."
   (notmuch-show-get-prop :filename))
 
-(defun notmuch-show-get-header (header)
+(defun notmuch-show-get-header (header &optional props)
   "Return the named header of the current message, if any."
   "Return the named header of the current message, if any."
-  (plist-get (notmuch-show-get-prop :headers) header))
+  (plist-get (notmuch-show-get-prop :headers props) header))
 
 (defun notmuch-show-get-cc ()
   (notmuch-show-get-header :Cc))
 
 (defun notmuch-show-get-cc ()
   (notmuch-show-get-header :Cc))
@@ -1088,35 +1150,29 @@ All currently available key bindings:
 
 ;; Commands typically bound to keys.
 
 
 ;; Commands typically bound to keys.
 
-(defun notmuch-show-advance-and-archive ()
-  "Advance through thread and archive.
-
-This command is intended to be one of the simplest ways to
-process a thread of email. It does the following:
+(defun notmuch-show-advance ()
+  "Advance through thread.
 
 If the current message in the thread is not yet fully visible,
 scroll by a near screenful to read more of the message.
 
 Otherwise, (the end of the current message is already within the
 
 If the current message in the thread is not yet fully visible,
 scroll by a near screenful to read more of the message.
 
 Otherwise, (the end of the current message is already within the
-current window), advance to the next open message.
-
-Finally, if there is no further message to advance to, and this
-last message is already read, then archive the entire current
-thread, (remove the \"inbox\" tag from each message). Also kill
-this buffer, and display the next thread from the search from
-which this thread was originally shown."
+current window), advance to the next open message."
   (interactive)
   (interactive)
-  (let ((end-of-this-message (notmuch-show-message-bottom)))
+  (let* ((end-of-this-message (notmuch-show-message-bottom))
+        (visible-end-of-this-message (1- end-of-this-message))
+        (ret nil))
+    (while (invisible-p visible-end-of-this-message)
+      (setq visible-end-of-this-message
+           (max (point-min)
+                (1- (previous-single-char-property-change
+                     visible-end-of-this-message 'invisible)))))
     (cond
      ;; Ideally we would test `end-of-this-message' against the result
      ;; of `window-end', but that doesn't account for the fact that
     (cond
      ;; Ideally we would test `end-of-this-message' against the result
      ;; of `window-end', but that doesn't account for the fact that
-     ;; the end of the message might be hidden, so we have to actually
-     ;; go to the end, walk back over invisible text and then see if
-     ;; point is visible.
-     ((save-excursion
-       (goto-char (- end-of-this-message 1))
-       (notmuch-show-move-past-invisible-backward)
-       (> (point) (window-end)))
+     ;; the end of the message might be hidden.
+     ((and visible-end-of-this-message
+          (> visible-end-of-this-message (window-end)))
       ;; The bottom of this message is not visible - scroll.
       (scroll-up nil))
 
       ;; The bottom of this message is not visible - scroll.
       (scroll-up nil))
 
@@ -1125,8 +1181,24 @@ which this thread was originally shown."
       (notmuch-show-next-open-message))
 
      (t
       (notmuch-show-next-open-message))
 
      (t
-      ;; This is the last message - archive the thread.
-      (notmuch-show-archive-thread)))))
+      ;; This is the last message - change the return value
+      (setq ret t)))
+    ret))
+
+(defun notmuch-show-advance-and-archive ()
+  "Advance through thread and archive.
+
+This command is intended to be one of the simplest ways to
+process a thread of email. It works exactly like
+notmuch-show-advance, in that it scrolls through messages in a
+show buffer, except that when it gets to the end of the buffer it
+archives the entire current thread, (remove the \"inbox\" tag
+from each message), kills the buffer, and displays the next
+thread from the search from which this thread was originally
+shown."
+  (interactive)
+  (if (notmuch-show-advance)
+      (notmuch-show-archive-thread)))
 
 (defun notmuch-show-rewind ()
   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
 
 (defun notmuch-show-rewind ()
   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
@@ -1401,6 +1473,11 @@ buffer."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
+(defun notmuch-show-stash-message-id-stripped ()
+  "Copy message ID of current message (sans `id:' prefix) to kill-ring."
+  (interactive)
+  (notmuch-common-do-stash (substring (notmuch-show-get-message-id) 4 -1)))
+
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
   (interactive)
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
   (interactive)