emacs: with prefix argument, notmuch-show-stash-date stashes timestamp

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 5d9b7b45c557b42c0ad540ebdc103b9e006d7394..e7c22da0f54c35f128b70721128dbe6c87393b26 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -16,7 +16,7 @@
 ;; General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License

-;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;; along with Notmuch.  If not, see <https://www.gnu.org/licenses/>.

 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          David Edmondson <dme@dme.org>
 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          David Edmondson <dme@dme.org>


@@ -38,6 +38,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)


@@ -50,6 +51,7 @@
                  (&optional query query-context target buffer-name open-target))
 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
 (declare-function notmuch-read-query "notmuch" (prompt))
                  (&optional query query-context target buffer-name open-target))
 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
 (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.


@@ -182,9 +184,9 @@ each attachment handler is logged in buffers with names beginning
 
 (defcustom notmuch-show-stash-mlarchive-link-alist
   '(("Gmane" . "http://mid.gmane.org/")
 
 (defcustom notmuch-show-stash-mlarchive-link-alist
   '(("Gmane" . "http://mid.gmane.org/")

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

     ;; FIXME: can these services be searched by `Message-Id' ?
     ;; ("MarkMail" . "http://markmail.org/")
     ;; ("Nabble" . "http://nabble.com/")
     ;; FIXME: can these services be searched by `Message-Id' ?
     ;; ("MarkMail" . "http://markmail.org/")
     ;; ("Nabble" . "http://nabble.com/")


@@ -682,6 +684,9 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
       (indent-rigidly start (point) 1)))
   t)
 

+(defun notmuch-show-insert-part-application/pgp-encrypted (msg part content-type nth depth button)
+  t)
+

 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button)
   (let ((inner-parts (plist-get part :content))
        (start (point)))
 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button)
   (let ((inner-parts (plist-get part :content))
        (start (point)))


@@ -1171,13 +1176,15 @@ 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)
        (let* ((mid-cid (match-string-no-properties 1))
               (mid (save-match-data
                      (string-match "^[^/]*" mid-cid)


@@ -1220,7 +1227,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)


@@ -1258,6 +1273,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.
 


@@ -1265,25 +1292,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)
 


@@ -1314,8 +1336,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"


@@ -1342,8 +1369,8 @@ 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.
        (open (cadr state)))
 
     ;; Open those that were open.


@@ -1352,8 +1379,10 @@ This includes:
                                           (member (notmuch-show-get-message-id) open))
          until (not (notmuch-show-goto-message-next)))
 
                                           (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.


@@ -1403,6 +1432,7 @@ reset based on the original query."
     (define-key map "v" 'notmuch-show-view-part)
     (define-key map "o" 'notmuch-show-interactively-view-part)
     (define-key map "|" 'notmuch-show-pipe-part)
     (define-key map "v" 'notmuch-show-view-part)
     (define-key map "o" 'notmuch-show-interactively-view-part)
     (define-key map "|" 'notmuch-show-pipe-part)

+    (define-key map "m" 'notmuch-show-choose-mime-of-part)

     (define-key map "?" 'notmuch-subkeymap-help)
     map)
   "Submap for part commands")
     (define-key map "?" 'notmuch-subkeymap-help)
     map)
   "Submap for part commands")


@@ -1418,14 +1448,17 @@ reset based on the original query."
     (define-key map (kbd "TAB") 'notmuch-show-next-button)
     (define-key map "f" 'notmuch-show-forward-message)
     (define-key map "F" 'notmuch-show-forward-open-messages)
     (define-key map (kbd "TAB") 'notmuch-show-next-button)
     (define-key map "f" 'notmuch-show-forward-message)
     (define-key map "F" 'notmuch-show-forward-open-messages)

+    (define-key map "b" 'notmuch-show-resend-message)

     (define-key map "l" 'notmuch-show-filter-thread)
     (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)
     (define-key map "l" 'notmuch-show-filter-thread)
     (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)

+    (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 "c" 'notmuch-show-stash-map)
     (define-key map "h" 'notmuch-show-toggle-visibility-headers)

+    (define-key map "k" 'notmuch-tag-jump)

     (define-key map "*" 'notmuch-show-tag-all)
     (define-key map "-" 'notmuch-show-remove-tag)
     (define-key map "+" 'notmuch-show-add-tag)
     (define-key map "*" 'notmuch-show-tag-all)
     (define-key map "-" 'notmuch-show-remove-tag)
     (define-key map "+" 'notmuch-show-add-tag)


@@ -1453,7 +1486,7 @@ reset based on the original query."
   "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
 
   "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
 

-(defun notmuch-show-mode ()
+(define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show"

   "Major mode for viewing a thread with notmuch.
 
 This buffer contains the results of the \"notmuch show\" command
   "Major mode for viewing a thread with notmuch.
 
 This buffer contains the results of the \"notmuch show\" command


@@ -1481,12 +1514,7 @@ You can add or remove arbitrary tags from the current message with
 All currently available key bindings:
 
 \\{notmuch-show-mode-map}"
 All currently available key bindings:
 
 \\{notmuch-show-mode-map}"

-  (interactive)
-  (kill-all-local-variables)

   (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
   (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)

-  (use-local-map notmuch-show-mode-map)
-  (setq major-mode 'notmuch-show-mode
-       mode-name "notmuch-show")

   (setq buffer-read-only t
        truncate-lines t))
 
   (setq buffer-read-only t
        truncate-lines t))
 


@@ -1646,6 +1674,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))
 


@@ -1700,12 +1731,23 @@ user decision and we should not override it."
        (notmuch-show-mark-read)
        (notmuch-show-set-prop :seen t)))
 
        (notmuch-show-mark-read)
        (notmuch-show-set-prop :seen t)))
 

+(defvar notmuch-show--seen-has-errored nil)
+(make-variable-buffer-local 'notmuch-show--seen-has-errored)
+

 (defun notmuch-show-command-hook ()
   (when (eq major-mode 'notmuch-show-mode)
     ;; We need to redisplay to get window-start and window-end correct.
     (redisplay)
     (save-excursion
 (defun notmuch-show-command-hook ()
   (when (eq major-mode 'notmuch-show-mode)
     ;; We need to redisplay to get window-start and window-end correct.
     (redisplay)
     (save-excursion

-      (funcall notmuch-show-mark-read-function (window-start) (window-end)))))
+      (condition-case err
+         (funcall notmuch-show-mark-read-function (window-start) (window-end))
+       ((debug error)
+        (unless notmuch-show--seen-has-errored
+          (setq notmuch-show--seen-has-errored 't)
+          (setq header-line-format
+                (concat header-line-format
+                        (propertize "  [some mark read tag changes may have failed]"
+                                    'face font-lock-warning-face)))))))))

 
 (defun notmuch-show-filter-thread (query)
   "Filter or LIMIT the current thread based on a new query string.
 
 (defun notmuch-show-filter-thread (query)
   "Filter or LIMIT the current thread based on a new query string.


@@ -1855,6 +1897,14 @@ any effects from previous calls to
       (error "No open messages to forward."))
     (notmuch-mua-new-forward-messages open-messages prompt-for-sender)))
 
       (error "No open messages to forward."))
     (notmuch-mua-new-forward-messages open-messages prompt-for-sender)))
 

+(defun notmuch-show-resend-message (addresses)
+  "Resend the current message."
+  (interactive (list (notmuch-address-from-minibuffer "Resend to: ")))
+  (when (y-or-n-p (concat "Confirm resend to " addresses " "))
+    (notmuch-show-view-raw-message)
+    (message-resend addresses)
+    (notmuch-bury-or-kill-this-buffer)))
+

 (defun notmuch-show-next-message (&optional pop-at-end)
   "Show the next message.
 
 (defun notmuch-show-next-message (&optional pop-at-end)
   "Show the next message.
 


@@ -1946,6 +1996,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


@@ -2187,10 +2242,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."


@@ -2317,25 +2379,27 @@ omit --in-reply-to=<Message-Id>."
       (insert (notmuch-get-bodypart-binary msg part process-crypto)))
     buf))
 
       (insert (notmuch-get-bodypart-binary msg part process-crypto)))
     buf))
 

-(defun notmuch-show-current-part-handle ()
+(defun notmuch-show-current-part-handle (&optional mime-type)

   "Return an mm-handle for the part containing point.
 
 This creates a temporary buffer for the part's content; the
   "Return an mm-handle for the part containing point.
 
 This creates a temporary buffer for the part's content; the

-caller is responsible for killing this buffer as appropriate."
+caller is responsible for killing this buffer as appropriate.  If
+MIME-TYPE is given then set the handle's mime-type to MIME-TYPE."

   (let* ((msg (notmuch-show-get-message-properties))
         (part (notmuch-show-get-part-properties))
         (buf (notmuch-show-generate-part-buffer msg part))
   (let* ((msg (notmuch-show-get-message-properties))
         (part (notmuch-show-get-part-properties))
         (buf (notmuch-show-generate-part-buffer msg part))

-        (computed-type (plist-get part :computed-type))
+        (computed-type (or mime-type (plist-get part :computed-type)))

         (filename (plist-get part :filename))
         (disposition (if filename `(attachment (filename . ,filename)))))
     (mm-make-handle buf (list computed-type) nil nil disposition)))
 
         (filename (plist-get part :filename))
         (disposition (if filename `(attachment (filename . ,filename)))))
     (mm-make-handle buf (list computed-type) nil nil disposition)))
 

-(defun notmuch-show-apply-to-current-part-handle (fn)
+(defun notmuch-show-apply-to-current-part-handle (fn &optional mime-type)

   "Apply FN to an mm-handle for the part containing point.
 
 This ensures that the temporary buffer created for the mm-handle
   "Apply FN to an mm-handle for the part containing point.
 
 This ensures that the temporary buffer created for the mm-handle

-is destroyed when FN returns."
-  (let ((handle (notmuch-show-current-part-handle)))
+is destroyed when FN returns. If MIME-TYPE is given then force
+part to be treated as if it had that mime-type."
+  (let ((handle (notmuch-show-current-part-handle mime-type)))

     ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
     ;; call it from a temp-buffer, unless
     ;; notmuch-show-attachment-debug is non-nil in which case we put
     ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
     ;; call it from a temp-buffer, unless
     ;; notmuch-show-attachment-debug is non-nil in which case we put


@@ -2380,6 +2444,27 @@ is destroyed when FN returns."
   (notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
 
 
   (notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
 
 

+(defun notmuch-show--mm-display-part (handle)
+  "Use mm-display-part to display HANDLE in a new buffer.
+
+If the part is displayed in an external application then close
+the new buffer."
+  (let ((buf (get-buffer-create (generate-new-buffer-name
+                                (concat " *notmuch-internal-part*")))))
+    (switch-to-buffer buf)
+    (if (eq (mm-display-part handle) 'external)
+       (kill-buffer buf)
+      (goto-char (point-min))
+      (set-buffer-modified-p nil)
+      (view-buffer buf 'kill-buffer-if-not-modified))))
+
+(defun notmuch-show-choose-mime-of-part (mime-type)
+  "Choose the mime type to use for displaying part"
+  (interactive
+   (list (completing-read "Mime type to use (default text/plain): "
+                         (mailcap-mime-types) nil nil nil nil "text/plain")))
+  (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part mime-type))
+

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