]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: add support for custom tag changes on message/thread archive
[notmuch] / emacs / notmuch-show.el
index 6d3fe62abf0a3a076af9568875b229f4cecfb054..e701aec39ccbec8fc8afdf661d2a47443cad1a75 100644 (file)
@@ -30,6 +30,7 @@
 (require 'goto-addr)
 
 (require 'notmuch-lib)
+(require 'notmuch-tag)
 (require 'notmuch-query)
 (require 'notmuch-wash)
 (require 'notmuch-mua)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)
-(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
 (declare-function notmuch-search-next-thread "notmuch" nil)
 (declare-function notmuch-search-show-thread "notmuch" nil)
-(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
@@ -184,6 +183,13 @@ provided with an MLA argument nor `completing-read' input."
             notmuch-show-stash-mlarchive-link-alist))
   :group 'notmuch-show)
 
+(defcustom notmuch-show-mark-read-tags '("-unread")
+  "List of tags to apply when message is read, ie. shown in notmuch-show
+buffer."
+  :type '(repeat string)
+  :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
@@ -454,6 +460,7 @@ message at DEPTH in the current thread."
     (define-key map "s" 'notmuch-show-part-button-save)
     (define-key map "v" 'notmuch-show-part-button-view)
     (define-key map "o" 'notmuch-show-part-button-interactively-view)
+    (define-key map "|" 'notmuch-show-part-button-pipe)
     map)
   "Submap for button commands")
 (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
@@ -525,22 +532,10 @@ message at DEPTH in the current thread."
     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
       (mm-interactively-view-part handle))))
 
-(defun notmuch-show-mm-display-part-inline (msg part nth content-type)
-  "Use the mm-decode/mm-view functions to display a part in the
-current buffer, if possible."
-  (let ((display-buffer (current-buffer)))
-    (with-temp-buffer
-      (let* ((charset (plist-get part :content-charset))
-            (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
-       ;; If the user wants the part inlined, insert the content and
-       ;; test whether we are able to inline it (which includes both
-       ;; capability and suitability tests).
-       (when (mm-inlined-p handle)
-         (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
-         (when (mm-inlinable-p handle)
-           (set-buffer display-buffer)
-           (mm-display-part handle)
-           t))))))
+(defun notmuch-show-pipe-part (message-id nth &optional filename content-type)
+  (notmuch-with-temp-part-buffer message-id nth
+    (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+      (mm-pipe-part handle))))
 
 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
@@ -786,7 +781,7 @@ current buffer, if possible."
 (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))
-  (notmuch-show-mm-display-part-inline msg part nth content-type)
+  (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
   t)
 
 ;; Functions for determining how to handle MIME parts.
@@ -837,7 +832,7 @@ current buffer, if possible."
   (make-symbol (concat "notmuch-show-" type)))
 
 (defun notmuch-show-strip-re (string)
-  (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+  (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
 
 (defvar notmuch-show-previous-subject "")
 (make-variable-buffer-local 'notmuch-show-previous-subject)
@@ -976,9 +971,9 @@ current buffer, if possible."
   "Insert the message tree TREE at depth DEPTH in the current thread."
   (let ((msg (car tree))
        (replies (cadr tree)))
-    (if (or (not notmuch-show-elide-non-matching-messages)
-           (plist-get msg :match))
-       (notmuch-show-insert-msg msg depth))
+    ;; We test whether there is a message or just some replies.
+    (when msg
+      (notmuch-show-insert-msg msg depth))
     (notmuch-show-insert-thread replies (1+ depth))))
 
 (defun notmuch-show-insert-thread (thread depth)
@@ -1043,7 +1038,8 @@ function is used."
          notmuch-show-parent-buffer parent-buffer
          notmuch-show-query-context query-context)
     (notmuch-show-build-buffer)
-    (notmuch-show-goto-first-wanted-message)))
+    (notmuch-show-goto-first-wanted-message)
+    (current-buffer)))
 
 (defun notmuch-show-build-buffer ()
   (let ((inhibit-read-only t))
@@ -1059,21 +1055,25 @@ function is used."
             (args (if notmuch-show-query-context
                       (append (list "\'") basic-args
                               (list "and (" notmuch-show-query-context ")\'"))
-                    (append (list "\'") basic-args (list "\'")))))
-       (notmuch-show-insert-forest (notmuch-query-get-threads args))
+                    (append (list "\'") basic-args (list "\'"))))
+            (cli-args (cons "--exclude=false"
+                            (when notmuch-show-elide-non-matching-messages
+                              (list "--entire-thread=false")))))
+
+       (notmuch-show-insert-forest (notmuch-query-get-threads (append cli-args args)))
        ;; If the query context reduced the results to nothing, run
        ;; the basic query.
        (when (and (eq (buffer-size) 0)
                   notmuch-show-query-context)
          (notmuch-show-insert-forest
-          (notmuch-query-get-threads basic-args))))
+          (notmuch-query-get-threads (append cli-args basic-args)))))
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
       (run-hooks 'notmuch-show-hook))
 
     ;; Set the header line to the subject of the first message.
-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))))
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))))
 
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
@@ -1373,9 +1373,6 @@ current thread."
 (defun notmuch-show-get-depth ()
   (notmuch-show-get-prop :depth))
 
-(defun notmuch-show-get-pretty-subject ()
-  (notmuch-prettify-subject (notmuch-show-get-subject)))
-
 (defun notmuch-show-set-tags (tags)
   "Set the tags of the current message."
   (notmuch-show-set-prop :tags tags)
@@ -1394,8 +1391,9 @@ current thread."
   (notmuch-show-get-prop :headers-visible))
 
 (defun notmuch-show-mark-read ()
-  "Mark the current message as read."
-  (notmuch-show-tag-message "-unread"))
+  "Apply `notmuch-show-mark-read-tags' to the message."
+  (when notmuch-show-mark-read-tags
+    (apply 'notmuch-show-tag-message notmuch-show-mark-read-tags)))
 
 ;; Functions for getting attributes of several messages in the current
 ;; thread.
@@ -1445,6 +1443,11 @@ current window), advance to the next open message."
       ;; This is not the last message - move to the next visible one.
       (notmuch-show-next-open-message))
 
+     ((not (= (point) (point-max)))
+      ;; This is the last message, but the cursor is not at the end of
+      ;; the buffer. Move it there.
+      (goto-char (point-max)))
+
      (t
       ;; This is the last message - change the return value
       (setq ret t)))
@@ -1531,9 +1534,11 @@ thread, navigate to the next thread in the parent search buffer."
       (goto-char (point-max)))))
 
 (defun notmuch-show-previous-message ()
-  "Show the previous message."
+  "Show the previous message or the start of the current message."
   (interactive)
-  (notmuch-show-goto-message-previous)
+  (if (= (point) (notmuch-show-message-top))
+      (notmuch-show-goto-message-previous)
+    (notmuch-show-move-to-message-top))
   (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
 
@@ -1569,6 +1574,11 @@ to show, nil otherwise."
          (notmuch-show-message-adjust))
       (goto-char (point-max)))))
 
+(defun notmuch-show-open-if-matched ()
+  "Open a message if it is matched (whether or not excluded)."
+  (let ((props (notmuch-show-get-message-properties)))
+    (notmuch-show-message-visible props (plist-get props :match))))
+
 (defun notmuch-show-goto-first-wanted-message ()
   "Move to the first open message and mark it read"
   (goto-char (point-min))
@@ -1576,14 +1586,21 @@ to show, nil otherwise."
       (notmuch-show-mark-read)
     (notmuch-show-next-open-message))
   (when (eobp)
+    ;; There are no matched non-excluded messages so open all matched
+    ;; (necessarily excluded) messages and go to the first.
+    (notmuch-show-mapc 'notmuch-show-open-if-matched)
+    (force-window-update)
     (goto-char (point-min))
-    (unless (notmuch-show-get-prop :match)
-      (notmuch-show-next-matching-message))))
+    (if (notmuch-show-message-visible-p)
+       (notmuch-show-mark-read)
+      (notmuch-show-next-open-message))))
 
 (defun notmuch-show-previous-open-message ()
   "Show the previous open message."
   (interactive)
-  (while (and (notmuch-show-goto-message-previous)
+  (while (and (if (= (point) (notmuch-show-message-top))
+                 (notmuch-show-goto-message-previous)
+               (notmuch-show-move-to-message-top))
              (not (notmuch-show-message-visible-p))))
   (notmuch-show-mark-read)
   (notmuch-show-message-adjust))
@@ -1613,7 +1630,7 @@ than only the current message."
   (let (shell-command)
     (if entire-thread
        (setq shell-command
-             (concat notmuch-command " show --format=mbox "
+             (concat notmuch-command " show --format=mbox --exclude=false "
                      (shell-quote-argument
                       (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
                      " | " command))
@@ -1640,22 +1657,26 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'."
   (let* ((current-tags (notmuch-show-get-tags))
         (new-tags (notmuch-update-tags current-tags tag-changes)))
     (unless (equal current-tags new-tags)
-      (apply 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
+      (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
       (notmuch-show-set-tags new-tags))))
 
-(defun notmuch-show-tag (&optional initial-input)
-  "Change tags for the current message, read input from the minibuffer."
+(defun notmuch-show-tag (&optional tag-changes)
+  "Change tags for the current message.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES."
   (interactive)
-  (let ((tag-changes (notmuch-read-tag-changes
-                     initial-input (notmuch-show-get-message-id))))
-    (apply 'notmuch-show-tag-message tag-changes)))
+  (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes))
+  (let* ((current-tags (notmuch-show-get-tags))
+        (new-tags (notmuch-update-tags current-tags tag-changes)))
+    (unless (equal current-tags new-tags)
+      (notmuch-show-set-tags new-tags))))
 
-(defun notmuch-show-tag-all (&rest tag-changes)
-  "Change tags for all messages in the current buffer.
+(defun notmuch-show-tag-all (&optional tag-changes)
+  "Change tags for all messages in the current show buffer.
 
-TAG-CHANGES is a list of tag operations for `notmuch-tag'."
-  (interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))
-  (apply 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)
+See `notmuch-tag' for information on the format of TAG-CHANGES."
+  (interactive)
+  (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes))
   (notmuch-show-mapc
    (lambda ()
      (let* ((current-tags (notmuch-show-get-tags))
@@ -1727,21 +1748,20 @@ argument, hide all of the messages."
 (defun notmuch-show-archive-thread (&optional unarchive)
   "Archive each message in thread.
 
-If a prefix argument is given, the messages will be
-\"unarchived\" (ie. the \"inbox\" tag will be added instead of
-removed).
-
-Archive each message currently shown by removing the \"inbox\"
-tag from each. Then kill this buffer and show the next thread
-from the search from which this thread was originally shown.
+Archive each message currently shown by applying the tag changes
+in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
+default). If a prefix argument is given, the messages will be
+\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
+will be reversed.
 
 Note: This command is safe from any race condition of new messages
 being delivered to the same thread. It does not archive the
 entire thread, but only the messages shown in the current
 buffer."
   (interactive "P")
-  (let ((op (if unarchive "+" "-")))
-    (notmuch-show-tag-all (concat op "inbox"))))
+  (when notmuch-archive-tags
+    (notmuch-show-tag-all
+     (notmuch-tag-change-list notmuch-archive-tags unarchive))))
 
 (defun notmuch-show-archive-thread-then-next ()
   "Archive all messages in the current buffer, then show next thread from search."
@@ -1758,12 +1778,15 @@ buffer."
 (defun notmuch-show-archive-message (&optional unarchive)
   "Archive the current message.
 
-If a prefix argument is given, the message will be
-\"unarchived\" (ie. the \"inbox\" tag will be added instead of
-removed)."
+Archive the current message by applying the tag changes in
+`notmuch-archive-tags' to it (remove the \"inbox\" tag by
+default). If a prefix argument is given, the message will be
+\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
+will be reversed."
   (interactive "P")
-  (let ((op (if unarchive "+" "-")))
-    (notmuch-show-tag-message (concat op "inbox"))))
+  (when notmuch-archive-tags
+    (apply 'notmuch-show-tag-message
+          (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.
@@ -1877,6 +1900,10 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
   (interactive)
   (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))
 
+(defun notmuch-show-part-button-pipe (&optional button)
+  (interactive)
+  (notmuch-show-part-button-internal button #'notmuch-show-pipe-part))
+
 (defun notmuch-show-part-button-internal (button handler)
   (let ((button (or button (button-at (point)))))
     (if button