emacs: Use `cl-lib' instead of deprecated `cl'

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index f2487abf5ccf983eae438c01cc06e388dc1fa693..59931453a018a4b7a5a58749e7d6447d696f2606 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -23,7 +23,10 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl-lib)
+  (require 'pcase))
+

 (require 'mm-view)
 (require 'message)
 (require 'mm-decode)
 (require 'mm-view)
 (require 'message)
 (require 'mm-decode)


@@ -38,6 +41,7 @@
 (require 'notmuch-mua)
 (require 'notmuch-crypto)
 (require 'notmuch-print)
 (require 'notmuch-mua)
 (require 'notmuch-crypto)
 (require 'notmuch-print)

+(require 'notmuch-draft)

 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-search-next-thread "notmuch" nil)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-search-next-thread "notmuch" nil)


@@ -47,9 +51,12 @@
 (declare-function notmuch-count-attachments "notmuch" (mm-handle))
 (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
 (declare-function notmuch-tree "notmuch-tree"
 (declare-function notmuch-count-attachments "notmuch" (mm-handle))
 (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
 (declare-function notmuch-tree "notmuch-tree"

-                 (&optional query query-context target buffer-name open-target))
+                 (&optional query query-context target buffer-name open-target unthreaded))

 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)

+(declare-function notmuch-unthreaded
+                 (&optional query query-context target buffer-name open-target))

 (declare-function notmuch-read-query "notmuch" (prompt))
 (declare-function notmuch-read-query "notmuch" (prompt))

+(declare-function notmuch-draft-resume "notmuch-draft" (id))

 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.


@@ -181,7 +188,7 @@ each attachment handler is logged in buffers with names beginning
 24.3 to work.")
 
 (defcustom notmuch-show-stash-mlarchive-link-alist
 24.3 to work.")
 
 (defcustom notmuch-show-stash-mlarchive-link-alist

-  '(("Gmane" . "http://mid.gmane.org/")
+  '(("Gmane" . "https://mid.gmane.org/")

     ("MARC" . "https://marc.info/?i=")
     ("Mail Archive, The" . "https://mid.mail-archive.com/")
     ("LKML" . "https://lkml.kernel.org/r/")
     ("MARC" . "https://marc.info/?i=")
     ("Mail Archive, The" . "https://mid.mail-archive.com/")
     ("LKML" . "https://lkml.kernel.org/r/")


@@ -245,6 +252,19 @@ every user interaction with notmuch."
   :type 'function
   :group 'notmuch-show)
 
   :type 'function
   :group 'notmuch-show)
 

+(defcustom notmuch-show-imenu-indent nil
+  "Should Imenu display messages indented.
+
+By default, Imenu (see Info node `(emacs) Imenu') in a
+notmuch-show buffer displays all messages straight.  This is
+because the default Emacs frontend for Imenu makes it difficult
+to select an Imenu entry with spaces in front.  Other imenu
+frontends such as counsel-imenu does not have this limitation.
+In these cases, Imenu entries can be indented to reflect the
+position of the message in the thread."
+  :type 'boolean
+  :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


@@ -328,7 +348,7 @@ operation on the contents of the current buffer."
     (with-temp-buffer
       (insert all)
       (if indenting
     (with-temp-buffer
       (insert all)
       (if indenting

-         (indent-rigidly (point-min) (point-max) (- depth)))
+         (indent-rigidly (point-min) (point-max) (- (* notmuch-show-indent-messages-width depth))))

       ;; Remove the original header.
       (goto-char (point-min))
       (re-search-forward "^$" (point-max) nil)
       ;; Remove the original header.
       (goto-char (point-min))
       (re-search-forward "^$" (point-max) nil)


@@ -412,17 +432,16 @@ parsing fails."
        (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
 
        ;; Outer single and double quotes, which might be nested.
        (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
 
        ;; Outer single and double quotes, which might be nested.

-       (loop
-        with start-of-loop
-        do (setq start-of-loop p-name)
+       (cl-loop with start-of-loop
+                do (setq start-of-loop p-name)

 
 

-        when (string-match "^\"\\(.*\\)\"$" p-name)
-        do (setq p-name (match-string 1 p-name))
+                when (string-match "^\"\\(.*\\)\"$" p-name)
+                do (setq p-name (match-string 1 p-name))

 
 

-        when (string-match "^'\\(.*\\)'$" p-name)
-        do (setq p-name (match-string 1 p-name))
+                when (string-match "^'\\(.*\\)'$" p-name)
+                do (setq p-name (match-string 1 p-name))

 
 

-        until (string= start-of-loop p-name)))
+                until (string= start-of-loop p-name)))

 
       ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
       ;; 'foo@bar.com'.
 
       ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
       ;; 'foo@bar.com'.


@@ -556,13 +575,13 @@ message at DEPTH in the current thread."
   ;; Recurse on sub-parts
   (let ((ctype (notmuch-split-content-type
                (downcase (plist-get part :content-type)))))
   ;; Recurse on sub-parts
   (let ((ctype (notmuch-split-content-type
                (downcase (plist-get part :content-type)))))

-    (cond ((equal (first ctype) "multipart")
+    (cond ((equal (car ctype) "multipart")

           (mapc (apply-partially #'notmuch-show--register-cids msg)
                 (plist-get part :content)))
          ((equal ctype '("message" "rfc822"))
           (notmuch-show--register-cids
            msg
           (mapc (apply-partially #'notmuch-show--register-cids msg)
                 (plist-get part :content)))
          ((equal ctype '("message" "rfc822"))
           (notmuch-show--register-cids
            msg

-           (first (plist-get (first (plist-get part :content)) :body)))))))
+           (car (plist-get (car (plist-get part :content)) :body)))))))

 
 (defun notmuch-show--get-cid-content (cid)
   "Return a list (CID-content content-type) or nil.
 
 (defun notmuch-show--get-cid-content (cid)
   "Return a list (CID-content content-type) or nil.


@@ -573,8 +592,8 @@ enclosing angle brackets, a cid: prefix, or URL encoding.  This
 will return nil if the CID is unknown or cannot be retrieved."
   (let ((descriptor (cdr (assoc cid notmuch-show--cids))))
     (when descriptor
 will return nil if the CID is unknown or cannot be retrieved."
   (let ((descriptor (cdr (assoc cid notmuch-show--cids))))
     (when descriptor

-      (let* ((msg (first descriptor))
-            (part (second descriptor))
+      (let* ((msg (car descriptor))
+            (part (cadr descriptor))

             ;; Request caching for this content, as some messages
             ;; reference the same cid: part many times (hundreds!).
             (content (notmuch-get-bodypart-binary
             ;; Request caching for this content, as some messages
             ;; reference the same cid: part many times (hundreds!).
             (content (notmuch-get-bodypart-binary


@@ -589,7 +608,7 @@ will return nil if the CID is unknown or cannot be retrieved."
     (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
       (push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
            w3m-cid-retrieve-function-alist)))
     (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
       (push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
            w3m-cid-retrieve-function-alist)))

-  (setq mm-inline-text-html-with-images t))
+  (setq mm-html-inhibit-images nil))

 
 (defvar w3m-current-buffer) ;; From `w3m.el'.
 (defun notmuch-show--cid-w3m-retrieve (url &rest args)
 
 (defvar w3m-current-buffer) ;; From `w3m.el'.
 (defun notmuch-show--cid-w3m-retrieve (url &rest args)


@@ -599,8 +618,8 @@ will return nil if the CID is unknown or cannot be retrieved."
          (with-current-buffer w3m-current-buffer
            (notmuch-show--get-cid-content cid))))
     (when content-and-type
          (with-current-buffer w3m-current-buffer
            (notmuch-show--get-cid-content cid))))
     (when content-and-type

-      (insert (first content-and-type))
-      (second content-and-type))))
+      (insert (car content-and-type))
+      (cadr content-and-type))))

 
 ;; MIME part renderers
 
 
 ;; MIME part renderers
 


@@ -758,6 +777,20 @@ will return nil if the CID is unknown or cannot be retrieved."
 (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
   (notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
 
 (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
   (notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
 

+(if (version< emacs-version "25.3")
+    ;; https://bugs.gnu.org/28350
+    ;;
+    ;; For newer emacs, we fall back to notmuch-show-insert-part-*/*
+    ;; (see notmuch-show-handlers-for)
+    (defun notmuch-show-insert-part-text/enriched (msg part content-type nth depth button)
+      ;; By requiring enriched below, we ensure that the function enriched-decode-display-prop
+      ;; is defined before it will be shadowed by the letf below. Otherwise the version
+      ;; in enriched.el may be loaded a bit later and used instead (for the first time).
+      (require 'enriched)
+      (cl-letf (((symbol-function 'enriched-decode-display-prop)
+                (lambda (start end &optional param) (list start end))))
+       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
+

 (defun notmuch-show-get-mime-type-of-application/octet-stream (part)
   ;; If we can deduce a MIME type from the filename of the attachment,
   ;; we return that.
 (defun notmuch-show-get-mime-type-of-application/octet-stream (part)
   ;; If we can deduce a MIME type from the filename of the attachment,
   ;; we return that.


@@ -812,7 +845,7 @@ will return nil if the CID is unknown or cannot be retrieved."
           ;; shr strips the "cid:" part of URL, but doesn't
           ;; URL-decode it (see RFC 2392).
           (let ((cid (url-unhex-string url)))
           ;; shr strips the "cid:" part of URL, but doesn't
           ;; URL-decode it (see RFC 2392).
           (let ((cid (url-unhex-string url)))

-            (first (notmuch-show--get-cid-content cid))))))
+            (car (notmuch-show--get-cid-content cid))))))

     (shr-insert-document dom)
     t))
 
     (shr-insert-document dom)
     t))
 


@@ -842,15 +875,16 @@ will return nil if the CID is unknown or cannot be retrieved."
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
   ;; Run the handlers until one of them succeeds.
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
   ;; Run the handlers until one of them succeeds.

-  (loop for handler in (notmuch-show-handlers-for content-type)
-       until (condition-case err
-                 (funcall handler msg part content-type nth depth button)
-               ;; Specifying `debug' here lets the debugger run if
-               ;; `debug-on-error' is non-nil.
-               ((debug error)
-                (insert "!!! Bodypart handler `" (prin1-to-string handler) "' threw an error:\n"
-                        "!!! " (error-message-string err) "\n")
-                nil))))
+  (cl-loop for handler in (notmuch-show-handlers-for content-type)
+          until (condition-case err
+                    (funcall handler msg part content-type nth depth button)
+                  ;; Specifying `debug' here lets the debugger run if
+                  ;; `debug-on-error' is non-nil.
+                  ((debug error)
+                   (insert "!!! Bodypart handler `" (prin1-to-string handler)
+                           "' threw an error:\n"
+                           "!!! " (error-message-string err) "\n")
+                   nil))))

 
 (defun notmuch-show-create-part-overlays (button beg end)
   "Add an overlay to the part between BEG and END"
 
 (defun notmuch-show-create-part-overlays (button beg end)
   "Add an overlay to the part between BEG and END"


@@ -876,13 +910,15 @@ will return nil if the CID is unknown or cannot be retrieved."
   ;; watch out for sticky specs of t, which means all properties are
   ;; front-sticky/rear-nonsticky.
   (notmuch-map-text-property beg end 'front-sticky
   ;; watch out for sticky specs of t, which means all properties are
   ;; front-sticky/rear-nonsticky.
   (notmuch-map-text-property beg end 'front-sticky

-                            (lambda (v) (if (listp v)
-                                            (pushnew :notmuch-part v)
-                                          v)))
+                            (lambda (v)
+                              (if (listp v)
+                                  (cl-pushnew :notmuch-part v)
+                                v)))

   (notmuch-map-text-property beg end 'rear-nonsticky
   (notmuch-map-text-property beg end 'rear-nonsticky

-                            (lambda (v) (if (listp v)
-                                            (pushnew :notmuch-part v)
-                                          v))))
+                            (lambda (v)
+                              (if (listp v)
+                                  (cl-pushnew :notmuch-part v)
+                                v))))

 
 (defun notmuch-show-lazy-part (part-args button)
   ;; Insert the lazy part after the button for the part. We would just
 
 (defun notmuch-show-lazy-part (part-args button)
   ;; Insert the lazy part after the button for the part. We would just


@@ -907,10 +943,10 @@ will return nil if the CID is unknown or cannot be retrieved."
        (narrow-to-region part-beg part-end)
        (delete-region part-beg part-end)
        (apply #'notmuch-show-insert-bodypart-internal part-args)
        (narrow-to-region part-beg part-end)
        (delete-region part-beg part-end)
        (apply #'notmuch-show-insert-bodypart-internal part-args)

-       (indent-rigidly part-beg part-end depth))
+       (indent-rigidly part-beg part-end (* notmuch-show-indent-messages-width depth)))

       (goto-char part-end)
       (delete-char 1)
       (goto-char part-end)
       (delete-char 1)

-      (notmuch-show-record-part-information (second part-args)
+      (notmuch-show-record-part-information (cadr part-args)

                                            (button-start button)
                                            part-end)
       ;; Create the overlay. If the lazy-part turned out to be empty/not
                                            (button-start button)
                                            part-end)
       ;; Create the overlay. If the lazy-part turned out to be empty/not


@@ -1006,7 +1042,7 @@ is t, hide the part initially and show the button."
   ;; Register all content IDs for this message.  According to RFC
   ;; 2392, content IDs are *global*, but it's okay if an MUA treats
   ;; them as only global within a message.
   ;; Register all content IDs for this message.  According to RFC
   ;; 2392, content IDs are *global*, but it's okay if an MUA treats
   ;; them as only global within a message.

-  (notmuch-show--register-cids msg (first body))
+  (notmuch-show--register-cids msg (car body))

 
   (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
 
 
   (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
 


@@ -1174,26 +1210,28 @@ This also turns id:\"<message id>\"-parts and mid: links into
 buttons for a corresponding notmuch search."
   (goto-address-fontify-region start end)
   (save-excursion
 buttons for a corresponding notmuch search."
   (goto-address-fontify-region start end)
   (save-excursion

-    (let (links)
-      (goto-char start)
-      (while (re-search-forward notmuch-id-regexp end t)
+    (let (links
+         (beg-line (progn (goto-char start) (line-beginning-position)))
+         (end-line (progn (goto-char end) (line-end-position))))
+      (goto-char beg-line)
+      (while (re-search-forward notmuch-id-regexp end-line t)

        (push (list (match-beginning 0) (match-end 0)
                    (match-string-no-properties 0)) links))
        (push (list (match-beginning 0) (match-end 0)
                    (match-string-no-properties 0)) links))

-      (goto-char start)
-      (while (re-search-forward notmuch-mid-regexp end t)
+      (goto-char beg-line)
+      (while (re-search-forward notmuch-mid-regexp end-line t)

        (let* ((mid-cid (match-string-no-properties 1))
               (mid (save-match-data
                      (string-match "^[^/]*" mid-cid)
                      (url-unhex-string (match-string 0 mid-cid)))))
          (push (list (match-beginning 0) (match-end 0)
                      (notmuch-id-to-query mid)) links)))
        (let* ((mid-cid (match-string-no-properties 1))
               (mid (save-match-data
                      (string-match "^[^/]*" mid-cid)
                      (url-unhex-string (match-string 0 mid-cid)))))
          (push (list (match-beginning 0) (match-end 0)
                      (notmuch-id-to-query mid)) links)))

-      (dolist (link links)
+      (pcase-dolist (`(,beg ,end ,link) links)

        ;; Remove the overlay created by goto-address-mode
        ;; Remove the overlay created by goto-address-mode

-       (remove-overlays (first link) (second link) 'goto-address t)
-       (make-text-button (first link) (second link)
+       (remove-overlays beg end 'goto-address t)
+       (make-text-button beg end

                          :type 'notmuch-button-type
                          'action `(lambda (arg)
                          :type 'notmuch-button-type
                          'action `(lambda (arg)

-                                    (notmuch-show ,(third link) current-prefix-arg))
+                                    (notmuch-show ,link current-prefix-arg))

                          'follow-link t
                          'help-echo "Mouse-1, RET: search for this message"
                          'face goto-address-mail-face)))))
                          'follow-link t
                          'help-echo "Mouse-1, RET: search for this message"
                          'face goto-address-mail-face)))))


@@ -1223,7 +1261,15 @@ matched."
   (interactive "sNotmuch show: \nP")
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name
   (interactive "sNotmuch show: \nP")
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name

-                         (concat "*notmuch-" thread-id "*")))))
+                         (concat "*notmuch-" thread-id "*"))))
+       ;; We override mm-inline-override-types to stop application/*
+       ;; parts from being displayed unless the user has customized
+       ;; it themselves.
+       (mm-inline-override-types
+        (if (equal mm-inline-override-types
+                   (eval (car (get 'mm-inline-override-types 'standard-value))))
+            (cons "application/*" mm-inline-override-types)
+          mm-inline-override-types)))

     (switch-to-buffer (get-buffer-create buffer-name))
     ;; No need to track undo information for this buffer.
     (setq buffer-undo-list t)
     (switch-to-buffer (get-buffer-create buffer-name))
     ;; No need to track undo information for this buffer.
     (setq buffer-undo-list t)


@@ -1235,7 +1281,9 @@ matched."
     ;; aren't wiped out.
     (setq notmuch-show-thread-id thread-id
          notmuch-show-parent-buffer parent-buffer
     ;; aren't wiped out.
     (setq notmuch-show-thread-id thread-id
          notmuch-show-parent-buffer parent-buffer

-         notmuch-show-query-context query-context
+         notmuch-show-query-context (if (or (string= query-context "")
+                                            (string= query-context "*"))
+                                        nil query-context)

 
          notmuch-show-process-crypto notmuch-crypto-process-mime
          ;; If `elide-toggle', invert the default value.
 
          notmuch-show-process-crypto notmuch-crypto-process-mime
          ;; If `elide-toggle', invert the default value.


@@ -1261,6 +1309,18 @@ matched."
        (message "No messages matched the query!")
        nil))))
 
        (message "No messages matched the query!")
        nil))))
 

+(defun notmuch-show--build-queries (thread context)
+  "Return a list of queries to try for this search.
+
+THREAD and CONTEXT are both strings, though CONTEXT may be nil.
+When CONTEXT is not nil, the first query is the conjunction of it
+and THREAD.  The next query is THREAD alone, and serves as a
+fallback if the prior matches no messages."
+  (let (queries)
+    (push (list thread) queries)
+    (if context (push (list thread "and (" context ")") queries))
+    queries))
+

 (defun notmuch-show--build-buffer (&optional state)
   "Display messages matching the current buffer context.
 
 (defun notmuch-show--build-buffer (&optional state)
   "Display messages matching the current buffer context.
 


@@ -1268,25 +1328,20 @@ Apply the previously saved STATE if supplied, otherwise show the
 first relevant message.
 
 If no messages match the query return NIL."
 first relevant message.
 
 If no messages match the query return NIL."

-  (let* ((basic-args (list notmuch-show-thread-id))
-        (args (if notmuch-show-query-context
-                  (append (list "\'") basic-args
-                          (list "and (" notmuch-show-query-context ")\'"))
-                (append (list "\'") basic-args (list "\'"))))
-        (cli-args (cons "--exclude=false"
+  (let* ((cli-args (cons "--exclude=false"

                         (when notmuch-show-elide-non-matching-messages
                           (list "--entire-thread=false"))))
                         (when notmuch-show-elide-non-matching-messages
                           (list "--entire-thread=false"))))

-
-        (forest (or (notmuch-query-get-threads (append cli-args args))
-                    ;; If a query context reduced the number of
-                    ;; results to zero, try again without it.
-                    (and notmuch-show-query-context
-                         (notmuch-query-get-threads (append cli-args basic-args)))))
-
+        (queries (notmuch-show--build-queries
+                  notmuch-show-thread-id notmuch-show-query-context))
+        (forest nil)

         ;; Must be reset every time we are going to start inserting
         ;; messages into the buffer.
         (notmuch-show-previous-subject ""))
         ;; Must be reset every time we are going to start inserting
         ;; messages into the buffer.
         (notmuch-show-previous-subject ""))

-
+    ;; Use results from the first query that returns some.
+    (while (and (not forest) queries)
+      (setq forest (notmuch-query-get-threads
+                   (append cli-args (list "'") (car queries) (list "'"))))
+      (setq queries (cdr queries)))

     (when forest
       (notmuch-show-insert-forest forest)
 
     (when forest
       (notmuch-show-insert-forest forest)
 


@@ -1317,8 +1372,13 @@ If no messages match the query return NIL."
 
 This includes:
  - the list of open messages,
 
 This includes:
  - the list of open messages,

- - the current message."
-  (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages)))
+ - the combination of current message id with/for each visible window."
+  (let* ((win-list (get-buffer-window-list (current-buffer) nil t))
+        (win-id-combo (mapcar (lambda (win)
+                                (with-selected-window win
+                                  (list win (notmuch-show-get-message-id))))
+                              win-list)))
+    (list win-id-combo (notmuch-show-get-message-ids-for-open-messages))))

 
 (defun notmuch-show-get-query ()
   "Return the current query in this show buffer"
 
 (defun notmuch-show-get-query ()
   "Return the current query in this show buffer"


@@ -1332,9 +1392,9 @@ This includes:
 (defun notmuch-show-goto-message (msg-id)
   "Go to message with msg-id."
   (goto-char (point-min))
 (defun notmuch-show-goto-message (msg-id)
   "Go to message with msg-id."
   (goto-char (point-min))

-  (unless (loop if (string= msg-id (notmuch-show-get-message-id))
-               return t
-               until (not (notmuch-show-goto-message-next)))
+  (unless (cl-loop if (string= msg-id (notmuch-show-get-message-id))
+                  return t
+                  until (not (notmuch-show-goto-message-next)))

     (goto-char (point-min))
     (message "Message-id not found."))
   (notmuch-show-message-adjust))
     (goto-char (point-min))
     (message "Message-id not found."))
   (notmuch-show-message-adjust))


@@ -1345,18 +1405,20 @@ This includes:
 This includes:
  - opening the messages previously opened,
  - closing all other messages,
 This includes:
  - opening the messages previously opened,
  - closing all other messages,

- - moving to the correct current message."
-  (let ((current (car state))
+ - moving to the correct current message in every displayed window."
+  (let ((win-msg-alist (car state))

        (open (cadr state)))
 
     ;; Open those that were open.
     (goto-char (point-min))
        (open (cadr state)))
 
     ;; 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)))
+    (cl-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)))

 
 

-    ;; Go to the previously open message.
-    (notmuch-show-goto-message current)))
+    (dolist (win-msg-pair win-msg-alist)
+      (with-selected-window (car win-msg-pair)
+       ;; Go to the previously open message in this window
+       (notmuch-show-goto-message (cadr win-msg-pair))))))

 
 (defun notmuch-show-refresh-view (&optional reset-state)
   "Refresh the current view.
 
 (defun notmuch-show-refresh-view (&optional reset-state)
   "Refresh the current view.


@@ -1416,6 +1478,7 @@ reset based on the original query."
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map notmuch-common-keymap)
     (define-key map "Z" 'notmuch-tree-from-show-current-query)
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map notmuch-common-keymap)
     (define-key map "Z" 'notmuch-tree-from-show-current-query)

+    (define-key map "U" 'notmuch-unthreaded-from-show-current-query)

     (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)
     (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)


@@ -1429,6 +1492,7 @@ reset based on the original query."
     (define-key map "|" 'notmuch-show-pipe-message)
     (define-key map "w" 'notmuch-show-save-attachments)
     (define-key map "V" 'notmuch-show-view-raw-message)
     (define-key map "|" 'notmuch-show-pipe-message)
     (define-key map "w" 'notmuch-show-save-attachments)
     (define-key map "V" 'notmuch-show-view-raw-message)

+    (define-key map "e" 'notmuch-show-resume-message)

     (define-key map "c" 'notmuch-show-stash-map)
     (define-key map "h" 'notmuch-show-toggle-visibility-headers)
     (define-key map "k" 'notmuch-tag-jump)
     (define-key map "c" 'notmuch-show-stash-map)
     (define-key map "h" 'notmuch-show-toggle-visibility-headers)
     (define-key map "k" 'notmuch-tag-jump)


@@ -1455,6 +1519,7 @@ reset based on the original query."
     (define-key map "<" 'notmuch-show-toggle-thread-indentation)
     (define-key map "t" 'toggle-truncate-lines)
     (define-key map "." 'notmuch-show-part-map)
     (define-key map "<" 'notmuch-show-toggle-thread-indentation)
     (define-key map "t" 'toggle-truncate-lines)
     (define-key map "." 'notmuch-show-part-map)

+    (define-key map "B" 'notmuch-show-browse-urls)

     map)
   "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
     map)
   "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)


@@ -1489,7 +1554,11 @@ All currently available key bindings:
 \\{notmuch-show-mode-map}"
   (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
   (setq buffer-read-only t
 \\{notmuch-show-mode-map}"
   (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
   (setq buffer-read-only t

-       truncate-lines t))
+       truncate-lines t)
+  (setq imenu-prev-index-position-function
+        #'notmuch-show-imenu-prev-index-position-function)
+  (setq imenu-extract-index-name-function
+        #'notmuch-show-imenu-extract-index-name-function))

 
 (defun notmuch-tree-from-show-current-query ()
   "Call notmuch tree with the current query"
 
 (defun notmuch-tree-from-show-current-query ()
   "Call notmuch tree with the current query"


@@ -1498,6 +1567,13 @@ All currently available key bindings:
                notmuch-show-query-context
                (notmuch-show-get-message-id)))
 
                notmuch-show-query-context
                (notmuch-show-get-message-id)))
 

+(defun notmuch-unthreaded-from-show-current-query ()
+  "Call notmuch unthreaded with the current query"
+  (interactive)
+  (notmuch-unthreaded notmuch-show-thread-id
+                     notmuch-show-query-context
+                     (notmuch-show-get-message-id)))
+

 (defun notmuch-show-move-to-message-top ()
   (goto-char (notmuch-show-message-top)))
 
 (defun notmuch-show-move-to-message-top ()
   (goto-char (notmuch-show-message-top)))
 


@@ -1513,6 +1589,8 @@ All currently available key bindings:
 ;; region a->b is not found when point is at b. We walk backwards
 ;; until finding the property.
 (defun notmuch-show-message-extent ()
 ;; region a->b is not found when point is at b. We walk backwards
 ;; until finding the property.
 (defun notmuch-show-message-extent ()

+  "Return a cons cell containing the start and end buffer offset
+of the current message."

   (let (r)
     (save-excursion
       (while (not (setq r (get-text-property (point) :notmuch-message-extent)))
   (let (r)
     (save-excursion
       (while (not (setq r (get-text-property (point) :notmuch-message-extent)))


@@ -1547,8 +1625,8 @@ All currently available key bindings:
 effects."
   (save-excursion
     (goto-char (point-min))
 effects."
   (save-excursion
     (goto-char (point-min))

-    (loop do (funcall function)
-         while (notmuch-show-goto-message-next))))
+    (cl-loop do (funcall function)
+            while (notmuch-show-goto-message-next))))

 
 ;; Functions relating to the visibility of messages and their
 ;; components.
 
 ;; Functions relating to the visibility of messages and their
 ;; components.


@@ -1633,9 +1711,10 @@ current thread."
 
 ;; dme: Would it make sense to use a macro for many of these?
 
 
 ;; dme: Would it make sense to use a macro for many of these?
 

+;; XXX TODO figure out what to do about multiple filenames

 (defun notmuch-show-get-filename ()
   "Return the filename of the current message."
 (defun notmuch-show-get-filename ()
   "Return the filename of the current message."

-  (notmuch-show-get-prop :filename))
+  (car (notmuch-show-get-prop :filename)))

 
 (defun notmuch-show-get-header (header &optional props)
   "Return the named header of the current message, if any."
 
 (defun notmuch-show-get-header (header &optional props)
   "Return the named header of the current message, if any."


@@ -1647,6 +1726,9 @@ current thread."
 (defun notmuch-show-get-date ()
   (notmuch-show-get-header :Date))
 
 (defun notmuch-show-get-date ()
   (notmuch-show-get-header :Date))
 

+(defun notmuch-show-get-timestamp ()
+  (notmuch-show-get-prop :timestamp))
+

 (defun notmuch-show-get-from ()
   (notmuch-show-get-header :From))
 
 (defun notmuch-show-get-from ()
   (notmuch-show-get-header :From))
 


@@ -1966,6 +2048,11 @@ to show, nil otherwise."
     (setq buffer-read-only t)
     (view-buffer buf 'kill-buffer-if-not-modified)))
 
     (setq buffer-read-only t)
     (view-buffer buf 'kill-buffer-if-not-modified)))
 

+(defun notmuch-show-resume-message ()
+  "Resume EDITING the current draft message."
+  (interactive)
+  (notmuch-draft-resume (notmuch-show-get-message-id)))
+

 (put 'notmuch-show-pipe-message 'notmuch-doc
      "Pipe the contents of the current message to a command.")
 (put 'notmuch-show-pipe-message 'notmuch-prefix-doc
 (put 'notmuch-show-pipe-message 'notmuch-doc
      "Pipe the contents of the current message to a command.")
 (put 'notmuch-show-pipe-message 'notmuch-prefix-doc


@@ -2095,9 +2182,9 @@ argument, hide all of the messages."
   (interactive)
   (save-excursion
     (goto-char (point-min))
   (interactive)
   (save-excursion
     (goto-char (point-min))

-    (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
-                                          (not current-prefix-arg))
-         until (not (notmuch-show-goto-message-next))))
+    (cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
+                                             (not current-prefix-arg))
+            until (not (notmuch-show-goto-message-next))))

   (force-window-update))
 
 (defun notmuch-show-next-button ()
   (force-window-update))
 
 (defun notmuch-show-next-button ()


@@ -2184,7 +2271,7 @@ message will be \"unarchived\", i.e. the tag changes in
           (notmuch-tag-change-list notmuch-archive-tags unarchive))))
 
 (defun notmuch-show-archive-message-then-next-or-exit ()
           (notmuch-tag-change-list notmuch-archive-tags unarchive))))
 
 (defun notmuch-show-archive-message-then-next-or-exit ()

-  "Archive the current message, then show the next open message in the current thread.
+  "Archive current message, then show next open message in current thread.

 
 If at the last open message in the current thread, then exit back
 to search results."
 
 If at the last open message in the current thread, then exit back
 to search results."


@@ -2193,7 +2280,7 @@ to search results."
   (notmuch-show-next-open-message t))
 
 (defun notmuch-show-archive-message-then-next-or-next-thread ()
   (notmuch-show-next-open-message t))
 
 (defun notmuch-show-archive-message-then-next-or-next-thread ()

-  "Archive the current message, then show the next open message in the current thread.
+  "Archive current message, then show next open message in current or next thread.

 
 If at the last open message in the current thread, then show next
 thread from search."
 
 If at the last open message in the current thread, then show next
 thread from search."


@@ -2207,10 +2294,17 @@ thread from search."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-cc)))
 
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-cc)))
 

-(defun notmuch-show-stash-date ()
-  "Copy date of current message to kill-ring."
-  (interactive)
-  (notmuch-common-do-stash (notmuch-show-get-date)))
+(put 'notmuch-show-stash-date 'notmuch-prefix-doc
+     "Copy timestamp of current message to kill-ring.")
+(defun notmuch-show-stash-date (&optional stash-timestamp)
+  "Copy date of current message to kill-ring.
+
+If invoked with a prefix argument, copy timestamp of current
+message to kill-ring."
+  (interactive "P")
+  (if stash-timestamp
+      (notmuch-common-do-stash (format "%d" (notmuch-show-get-timestamp)))
+    (notmuch-common-do-stash (notmuch-show-get-date))))

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


@@ -2423,6 +2517,56 @@ the new buffer."
                          (mailcap-mime-types) nil nil nil nil "text/plain")))
   (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part mime-type))
 
                          (mailcap-mime-types) nil nil nil nil "text/plain")))
   (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part mime-type))
 

+(defun notmuch-show-imenu-prev-index-position-function ()
+  "Move point to previous message in notmuch-show buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+  (if (bobp)
+      nil
+    (notmuch-show-previous-message)
+    t))
+
+(defun notmuch-show-imenu-extract-index-name-function ()
+  "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'.  Point should be at the
+beginning of the line."
+  (back-to-indentation)
+  (buffer-substring-no-properties (if notmuch-show-imenu-indent
+                                     (line-beginning-position)
+                                   (point))
+                                 (line-end-position)))
+
+(defmacro notmuch-show--with-currently-shown-message (&rest body)
+  "Evaluate BODY with display restricted to the currently shown
+message."
+  `(save-excursion
+     (save-restriction
+      (let ((extent (notmuch-show-message-extent)))
+       (narrow-to-region (car extent) (cdr extent))
+       ,@body))))
+
+(defun notmuch-show--gather-urls ()
+  "Gather any URLs in the current message."
+  (notmuch-show--with-currently-shown-message
+   (let (urls)
+     (goto-char (point-min))
+     (while (re-search-forward goto-address-url-regexp (point-max) t)
+       (push (match-string-no-properties 0) urls))
+     (reverse urls))))
+
+(defun notmuch-show-browse-urls (&optional kill)
+  "Offer to browse any URLs in the current message.
+With a prefix argument, copy the URL to the kill ring rather than
+browsing."
+  (interactive "P")
+  (let ((urls (notmuch-show--gather-urls))
+       (prompt (if kill "Copy URL to kill ring: " "Browse URL: "))
+       (fn (if kill #'kill-new #'browse-url)))
+    (if urls
+       (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
+      (message "No URLs found."))))
+

 (provide 'notmuch-show)
 
 ;;; notmuch-show.el ends here
 (provide 'notmuch-show)
 
 ;;; notmuch-show.el ends here