Merge tag 'debian/0.12-1'

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 533cfa96dd8b89be115d84e85c889753dcd9b96a..0cd7d82676723bcff3feaa52afd3678bc7c51465 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -126,6 +126,11 @@ indentation."
                 (const :tag "View interactively"
                        notmuch-show-interactively-view-part)))
 
                 (const :tag "View interactively"
                        notmuch-show-interactively-view-part)))
 

+(defcustom notmuch-show-only-matching-messages nil
+  "Only matching messages are shown by default."
+  :type 'boolean
+  :group 'notmuch-show)
+

 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)
 (put 'notmuch-show-thread-id 'permanent-local t)
 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)
 (put 'notmuch-show-thread-id 'permanent-local t)


@@ -150,6 +155,35 @@ indentation."
 (make-variable-buffer-local 'notmuch-show-indent-content)
 (put 'notmuch-show-indent-content 'permanent-local t)
 
 (make-variable-buffer-local 'notmuch-show-indent-content)
 (put 'notmuch-show-indent-content 'permanent-local t)
 

+(defcustom notmuch-show-stash-mlarchive-link-alist
+  '(("Gmane" . "http://mid.gmane.org/")
+    ("MARC" . "http://marc.info/?i=")
+    ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=")
+    ;; FIXME: can these services be searched by `Message-Id' ?
+    ;; ("MarkMail" . "http://markmail.org/")
+    ;; ("Nabble" . "http://nabble.com/")
+    ;; ("opensubscriber" . "http://opensubscriber.com/")
+    )
+  "List of Mailing List Archives to use when stashing links.
+
+These URIs are concatenated with the current message's
+Message-Id in `notmuch-show-stash-mlarchive-link'."
+  :type '(alist :key-type (string :tag "Name")
+               :value-type (string :tag "URL"))
+  :group 'notmuch-show)
+
+(defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
+  "Default Mailing List Archive to use when stashing links.
+
+This is used when `notmuch-show-stash-mlarchive-link' isn't
+provided with an MLA argument nor `completing-read' input."
+  :type `(choice
+         ,@(mapcar
+            (lambda (mla)
+              (list 'const :tag (car mla) :value (car mla)))
+            notmuch-show-stash-mlarchive-link-alist))
+  :group 'notmuch-show)
+

 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion


@@ -454,7 +488,7 @@ message at DEPTH in the current thread."
         (setq notmuch-show-process-crypto ,process-crypto)
         ;; Always acquires the part via `notmuch part', even if it is
         ;; available in the JSON output.
         (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))
+        (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))

         ,@body))))
 
 (defun notmuch-show-save-part (message-id nth &optional filename content-type)
         ,@body))))
 
 (defun notmuch-show-save-part (message-id nth &optional filename content-type)


@@ -502,36 +536,19 @@ current buffer, if possible."
        ;; test whether we are able to inline it (which includes both
        ;; capability and suitability tests).
        (when (mm-inlined-p handle)
        ;; 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))
+         (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))

          (when (mm-inlinable-p handle)
            (set-buffer display-buffer)
            (mm-display-part handle)
            t))))))
 
          (when (mm-inlinable-p handle)
            (set-buffer display-buffer)
            (mm-display-part handle)
            t))))))
 

-(defvar notmuch-show-multipart/alternative-discouraged
-  '(
-    ;; Avoid HTML parts.
-    "text/html"
-    ;; multipart/related usually contain a text/html part and some associated graphics.
-    "multipart/related"
-    ))
-

 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 
 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 

-(defun notmuch-show-multipart/alternative-choose (types)
-  ;; Based on `mm-preferred-alternative-precedence'.
-  (let ((seq types))
-    (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
-      (dolist (elem (copy-sequence seq))
-       (when (string-match pref elem)
-         (setq seq (nconc (delete elem seq) (list elem))))))
-    seq))
-

 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)

-  (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+  (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))

        (inner-parts (plist-get part :content))
        (start (point)))
     ;; This inserts all parts of the chosen type rather than just one,
        (inner-parts (plist-get part :content))
        (start (point)))
     ;; This inserts all parts of the chosen type rather than just one,


@@ -596,8 +613,8 @@ current buffer, if possible."
          ;; times (hundreds!), which results in many calls to
          ;; `notmuch part'.
          (unless content
          ;; times (hundreds!), which results in many calls to
          ;; `notmuch part'.
          (unless content

-           (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
-                                                             part-number))
+           (setq content (notmuch-get-bodypart-internal (concat "id:" message-id)
+                                                             part-number notmuch-show-process-crypto))

            (with-current-buffer w3m-current-buffer
              (notmuch-show-w3m-cid-store-internal url
                                                   message-id
            (with-current-buffer w3m-current-buffer
              (notmuch-show-w3m-cid-store-internal url
                                                   message-id


@@ -717,17 +734,17 @@ current buffer, if possible."
     ;; insert a header to make this clear.
     (if (> nth 1)
        (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
     ;; insert a header to make this clear.
     (if (> nth 1)
        (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))

-    (insert (notmuch-show-get-bodypart-content msg part nth))
+    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))

     (save-excursion
       (save-restriction
        (narrow-to-region start (point-max))
        (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
   t)
 
     (save-excursion
       (save-restriction
        (narrow-to-region start (point-max))
        (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
   t)
 

-(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)

   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
   (insert (with-temp-buffer
   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
   (insert (with-temp-buffer

-           (insert (notmuch-show-get-bodypart-content msg part nth))
+           (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))

            (goto-char (point-min))
            (let ((file (make-temp-file "notmuch-ical"))
                  result)
            (goto-char (point-min))
            (let ((file (make-temp-file "notmuch-ical"))
                  result)


@@ -742,6 +759,10 @@ current buffer, if possible."
              result)))
   t)
 
              result)))
   t)
 

+;; For backwards compatibility.
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
+

 (defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
   ;; If we can deduce a MIME type from the filename of the attachment,
   ;; do so and pass it on to the handler for that type.
 (defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
   ;; If we can deduce a MIME type from the filename of the attachment,
   ;; do so and pass it on to the handler for that type.


@@ -770,9 +791,6 @@ current buffer, if possible."
 
 ;; Functions for determining how to handle MIME parts.
 
 
 ;; Functions for determining how to handle MIME parts.
 

-(defun notmuch-show-split-content-type (content-type)
-  (split-string content-type "/"))
-

 (defun notmuch-show-handlers-for (content-type)
   "Return a list of content handlers for a part of type CONTENT-TYPE."
   (let (result)
 (defun notmuch-show-handlers-for (content-type)
   "Return a list of content handlers for a part of type CONTENT-TYPE."
   (let (result)


@@ -783,30 +801,11 @@ current buffer, if possible."
          (list (intern (concat "notmuch-show-insert-part-*/*"))
                (intern (concat
                         "notmuch-show-insert-part-"
          (list (intern (concat "notmuch-show-insert-part-*/*"))
                (intern (concat
                         "notmuch-show-insert-part-"

-                        (car (notmuch-show-split-content-type content-type))
+                        (car (notmuch-split-content-type content-type))

                         "/*"))
                (intern (concat "notmuch-show-insert-part-" content-type))))
     result))
 
                         "/*"))
                (intern (concat "notmuch-show-insert-part-" content-type))))
     result))
 

-;; Helper for parts which are generally not included in the default
-;; JSON output.
-(defun notmuch-show-get-bodypart-internal (message-id part-number)
-  (let ((args '("show" "--format=raw"))
-       (part-arg (format "--part=%s" part-number)))
-    (setq args (append args (list part-arg)))
-    (if notmuch-show-process-crypto
-       (setq args (append args '("--decrypt"))))
-    (setq args (append args (list message-id)))
-    (with-temp-buffer
-      (let ((coding-system-for-read 'no-conversion))
-       (progn
-         (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
-         (buffer-string))))))
-
-(defun notmuch-show-get-bodypart-content (msg part nth)
-  (or (plist-get part :content)
-      (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
-

 ;; \f
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
 ;; \f
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)


@@ -943,7 +942,8 @@ current buffer, if possible."
 
     ;; Message visibility depends on whether it matched the search
     ;; criteria.
 
     ;; Message visibility depends on whether it matched the search
     ;; criteria.

-    (notmuch-show-message-visible msg (plist-get msg :match))))
+    (notmuch-show-message-visible msg (and (plist-get msg :match)
+                                          (not (plist-get msg :excluded))))))

 
 (defun notmuch-show-toggle-process-crypto ()
   "Toggle the processing of cryptographic MIME parts."
 
 (defun notmuch-show-toggle-process-crypto ()
   "Toggle the processing of cryptographic MIME parts."


@@ -1032,13 +1032,20 @@ function is used."
     ;; Set the default value for `notmuch-show-process-crypto' in this
     ;; buffer.
     (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
     ;; Set the default value for `notmuch-show-process-crypto' in this
     ;; buffer.
     (setq notmuch-show-process-crypto notmuch-crypto-process-mime)

+    ;; Set the default value for
+    ;; `notmuch-show-elide-non-matching-messages' in this buffer. If
+    ;; there is a prefix argument, invert the default.
+    (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
+    (if current-prefix-arg
+       (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))

 
     (setq notmuch-show-thread-id thread-id
          notmuch-show-parent-buffer parent-buffer
          notmuch-show-query-context query-context)
 
     (setq notmuch-show-thread-id thread-id
          notmuch-show-parent-buffer parent-buffer
          notmuch-show-query-context query-context)

-    (notmuch-show-worker)))
+    (notmuch-show-build-buffer)
+    (notmuch-show-goto-first-wanted-message)))

 
 

-(defun notmuch-show-worker ()
+(defun notmuch-show-build-buffer ()

   (let ((inhibit-read-only t))
 
     (notmuch-show-mode)
   (let ((inhibit-read-only t))
 
     (notmuch-show-mode)


@@ -1065,23 +1072,60 @@ function is used."
 
       (run-hooks 'notmuch-show-hook))
 
 
       (run-hooks 'notmuch-show-hook))
 

-    ;; Move straight to the first open message
-    (unless (notmuch-show-message-visible-p)
-      (notmuch-show-next-open-message))
+    ;; Set the header line to the subject of the first message.
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))))
+
+(defun notmuch-show-capture-state ()
+  "Capture the state of the current buffer.
+
+This includes:
+ - the list of open messages,
+ - the current message."
+  (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages)))
+
+(defun notmuch-show-apply-state (state)
+  "Apply STATE to the current buffer.

 
 

-    ;; Set the header line to the subject of the first open message.
-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))
+This includes:
+ - opening the messages previously opened,
+ - closing all other messages,
+ - moving to the correct current message."
+  (let ((current (car state))
+       (open (cadr state)))

 
 

-    (notmuch-show-mark-read)))
+    ;; Open those that were open.
+    (goto-char (point-min))
+    (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
+                                          (member (notmuch-show-get-message-id) open))
+         until (not (notmuch-show-goto-message-next)))

 
 

-(defun notmuch-show-refresh-view ()
+    ;; Go to the previously open message.
+    (goto-char (point-min))
+    (unless (loop if (string= current (notmuch-show-get-message-id))
+                 return t
+                 until (not (notmuch-show-goto-message-next)))
+      (goto-char (point-min))
+      (message "Previously current message not found."))
+    (notmuch-show-message-adjust)))
+
+(defun notmuch-show-refresh-view (&optional reset-state)

   "Refresh the current view.
 
   "Refresh the current view.
 

-Refreshes the current view, observing changes in cryptographic preferences."
-  (interactive)
-  (let ((inhibit-read-only t))
-    (erase-buffer))
-  (notmuch-show-worker))
+Refreshes the current view, observing changes in display
+preferences. If invoked with a prefix argument (or RESET-STATE is
+non-nil) then the state of the buffer (open/closed messages) is
+reset based on the original query."
+  (interactive "P")
+  (let ((inhibit-read-only t)
+       (state (unless reset-state
+                (notmuch-show-capture-state))))
+    (erase-buffer)
+    (notmuch-show-build-buffer)
+    (if state
+       (notmuch-show-apply-state state)
+      ;; We're resetting state, so navigate to the first open message
+      ;; and mark it read, just like opening a new show buffer.
+      (notmuch-show-goto-first-wanted-message))))

 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))


@@ -1094,6 +1138,8 @@ Refreshes the current view, observing changes in cryptographic preferences."
     (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)

+    (define-key map "l" 'notmuch-show-stash-mlarchive-link)
+    (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)

     map)
   "Submap for stash commands")
 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
     map)
   "Submap for stash commands")
 (fset 'notmuch-show-stash-map notmuch-show-stash-map)


@@ -1278,9 +1324,14 @@ Some useful entries are:
                   (notmuch-show-get-message-properties))))
     (plist-get props prop)))
 
                   (notmuch-show-get-message-properties))))
     (plist-get props prop)))
 

-(defun notmuch-show-get-message-id ()
-  "Return the message id of the current message."
-  (concat "id:\"" (notmuch-show-get-prop :id) "\""))
+(defun notmuch-show-get-message-id (&optional bare)
+  "Return the Message-Id of the current message.
+
+If optional argument BARE is non-nil, return
+the Message-Id without prefix and quotes."
+  (if bare
+      (notmuch-show-get-prop :id)
+    (concat "id:\"" (notmuch-show-get-prop :id) "\"")))

 
 (defun notmuch-show-get-messages-ids ()
   "Return all message ids of messages in the current thread."
 
 (defun notmuch-show-get-messages-ids ()
   "Return all message ids of messages in the current thread."


@@ -1506,6 +1557,29 @@ to show, nil otherwise."
        (goto-char (point-max))))
     r))
 
        (goto-char (point-max))))
     r))
 

+(defun notmuch-show-next-matching-message ()
+  "Show the next matching message."
+  (interactive)
+  (let (r)
+    (while (and (setq r (notmuch-show-goto-message-next))
+               (not (notmuch-show-get-prop :match))))
+    (if r
+       (progn
+         (notmuch-show-mark-read)
+         (notmuch-show-message-adjust))
+      (goto-char (point-max)))))
+
+(defun notmuch-show-goto-first-wanted-message ()
+  "Move to the first open message and mark it read"
+  (goto-char (point-min))
+  (if (notmuch-show-message-visible-p)
+      (notmuch-show-mark-read)
+    (notmuch-show-next-open-message))
+  (when (eobp)
+    (goto-char (point-min))
+    (unless (notmuch-show-get-prop :match)
+      (notmuch-show-next-matching-message))))
+

 (defun notmuch-show-previous-open-message ()
   "Show the previous open message."
   (interactive)
 (defun notmuch-show-previous-open-message ()
   "Show the previous open message."
   (interactive)


@@ -1577,7 +1651,7 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'."
     (apply 'notmuch-show-tag-message tag-changes)))
 
 (defun notmuch-show-tag-all (&rest tag-changes)
     (apply 'notmuch-show-tag-message tag-changes)))
 
 (defun notmuch-show-tag-all (&rest tag-changes)

-  "Change tags for all messages in the current thread.
+  "Change tags for all messages in the current buffer.

 
 TAG-CHANGES is a list of tag operations for `notmuch-tag'."
   (interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))
 
 TAG-CHANGES is a list of tag operations for `notmuch-tag'."
   (interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))


@@ -1639,32 +1713,12 @@ argument, hide all of the messages."
   (interactive)
   (backward-button 1))
 
   (interactive)
   (backward-button 1))
 

-(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))
-  (let ((op (if remove "-" "+")))
-    (loop do (notmuch-show-tag-message (concat op 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)
 (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)

-    (when parent-buffer
+    (when (buffer-live-p parent-buffer)

       (switch-to-buffer parent-buffer)
       (notmuch-search-next-thread)
       (if show-next
       (switch-to-buffer parent-buffer)
       (notmuch-search-next-thread)
       (if show-next


@@ -1686,18 +1740,17 @@ being delivered to the same thread. It does not archive the
 entire thread, but only the messages shown in the current
 buffer."
   (interactive "P")
 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")))
+  (let ((op (if unarchive "+" "-")))
+    (notmuch-show-tag-all (concat op "inbox"))))

 
 (defun notmuch-show-archive-thread-then-next ()
 
 (defun notmuch-show-archive-thread-then-next ()

-  "Archive each message in thread, then show next thread from search."
+  "Archive all messages in the current buffer, then show next thread from search."

   (interactive)
   (notmuch-show-archive-thread)
   (notmuch-show-next-thread t))
 
 (defun notmuch-show-archive-thread-then-exit ()
   (interactive)
   (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."
+  "Archive all messages in the current buffer, then exit back to search results."

   (interactive)
   (notmuch-show-archive-thread)
   (notmuch-show-next-thread))
   (interactive)
   (notmuch-show-archive-thread)
   (notmuch-show-next-thread))


@@ -1759,7 +1812,7 @@ thread from search."
 (defun notmuch-show-stash-message-id-stripped ()
   "Copy message ID of current message (sans `id:' prefix) to kill-ring."
   (interactive)
 (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)))
+  (notmuch-common-do-stash (notmuch-show-get-message-id t)))

 
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
 
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."


@@ -1776,6 +1829,36 @@ thread from search."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-to)))
 
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-to)))
 

+(defun notmuch-show-stash-mlarchive-link (&optional mla)
+  "Copy an ML Archive URI for the current message to the kill-ring.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+  (interactive)
+  (notmuch-common-do-stash
+   (concat (cdr (assoc
+                (or mla
+                    (let ((completion-ignore-case t))
+                      (completing-read
+                       "Mailing List Archive: "
+                       notmuch-show-stash-mlarchive-link-alist
+                       nil t nil nil notmuch-show-stash-mlarchive-link-default)))
+                notmuch-show-stash-mlarchive-link-alist))
+          (notmuch-show-get-message-id t))))
+
+(defun notmuch-show-stash-mlarchive-link-and-go (&optional mla)
+  "Copy an ML Archive URI for the current message to the kill-ring and visit it.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+  (interactive)
+  (notmuch-show-stash-mlarchive-link mla)
+  (browse-url (current-kill 0 t)))
+

 ;; Commands typically bound to buttons.
 
 (defun notmuch-show-part-button-default (&optional button)
 ;; Commands typically bound to buttons.
 
 (defun notmuch-show-part-button-default (&optional button)