emacs: Ensure that gnupg output goes at the end of the buffer.

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 7469e2eb8feb6ee8f9ffe0afc8a94a74541e7257..24fde0520060443cd6d0d07d0d404eca95f74da4 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -38,9 +38,10 @@
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)

-(declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
+(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-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.
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.


@@ -1083,11 +1084,13 @@ thread id.  If a prefix is given, crypto processing is toggled."
        (define-key map "c" 'notmuch-show-stash-map)
        (define-key map "=" 'notmuch-show-refresh-view)
        (define-key map "h" 'notmuch-show-toggle-headers)
        (define-key map "c" 'notmuch-show-stash-map)
        (define-key map "=" 'notmuch-show-refresh-view)
        (define-key map "h" 'notmuch-show-toggle-headers)

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

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

-       (define-key map "x" 'notmuch-show-archive-thread-then-exit)
-       (define-key map "a" 'notmuch-show-archive-message-then-next)
+       (define-key map "X" 'notmuch-show-archive-thread-then-exit)
+       (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit)

        (define-key map "A" 'notmuch-show-archive-thread-then-next)
        (define-key map "A" 'notmuch-show-archive-thread-then-next)

+       (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread)

        (define-key map "N" 'notmuch-show-next-message)
        (define-key map "P" 'notmuch-show-previous-message)
        (define-key map "n" 'notmuch-show-next-open-message)
        (define-key map "N" 'notmuch-show-next-message)
        (define-key map "P" 'notmuch-show-previous-message)
        (define-key map "n" 'notmuch-show-next-open-message)


@@ -1180,6 +1183,15 @@ All currently available key bindings:
     (notmuch-show-move-to-message-top)
     t))
 
     (notmuch-show-move-to-message-top)
     t))
 

+(defun notmuch-show-mapc (function)
+  "Iterate through all messages in the current thread with
+`notmuch-show-goto-message-next' and call FUNCTION for side
+effects."
+  (save-excursion
+    (goto-char (point-min))
+    (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.
 


@@ -1232,6 +1244,18 @@ Some useful entries are:
   "Return the message id of the current message."
   (concat "id:\"" (notmuch-show-get-prop :id) "\""))
 
   "Return the message id of the current message."
   (concat "id:\"" (notmuch-show-get-prop :id) "\""))
 

+(defun notmuch-show-get-messages-ids ()
+  "Return all message ids of messages in the current thread."
+  (let ((message-ids))
+    (notmuch-show-mapc
+     (lambda () (push (notmuch-show-get-message-id) message-ids)))
+    message-ids))
+
+(defun notmuch-show-get-messages-ids-search ()
+  "Return a search string for all message ids of messages in the
+current thread."
+  (mapconcat 'identity (notmuch-show-get-messages-ids) " or "))
+

 ;; dme: Would it make sense to use a macro for many of these?
 
 (defun notmuch-show-get-filename ()
 ;; dme: Would it make sense to use a macro for many of these?
 
 (defun notmuch-show-get-filename ()


@@ -1282,7 +1306,7 @@ Some useful entries are:
 
 (defun notmuch-show-mark-read ()
   "Mark the current message as read."
 
 (defun notmuch-show-mark-read ()
   "Mark the current message as read."

-  (notmuch-show-remove-tag "unread"))
+  (notmuch-show-tag-message "-unread"))

 
 ;; Functions for getting attributes of several messages in the current
 ;; thread.
 
 ;; Functions for getting attributes of several messages in the current
 ;; thread.


@@ -1429,7 +1453,8 @@ thread, navigate to the next thread in the parent search buffer."
 
 If a prefix argument is given and this is the last open message
 in the thread, navigate to the next thread in the parent search
 
 If a prefix argument is given and this is the last open message
 in the thread, navigate to the next thread in the parent search

-buffer."
+buffer. Return t if there was a next open message in the thread
+to show, nil otherwise."

   (interactive "P")
   (let (r)
     (while (and (setq r (notmuch-show-goto-message-next))
   (interactive "P")
   (let (r)
     (while (and (setq r (notmuch-show-goto-message-next))


@@ -1440,7 +1465,8 @@ buffer."
          (notmuch-show-message-adjust))
       (if pop-at-end
          (notmuch-show-next-thread)
          (notmuch-show-message-adjust))
       (if pop-at-end
          (notmuch-show-next-thread)

-       (goto-char (point-max))))))
+       (goto-char (point-max))))
+    r))

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


@@ -1495,51 +1521,45 @@ than only the current message."
            (message (format "Command '%s' exited abnormally with code %d"
                             shell-command exit-code))))))))
 
            (message (format "Command '%s' exited abnormally with code %d"
                             shell-command exit-code))))))))
 

-(defun notmuch-show-add-tags-worker (current-tags add-tags)
-  "Add to `current-tags' with any tags from `add-tags' not
-currently present and return the result."
-  (let ((result-tags (copy-sequence current-tags)))
-    (mapc (lambda (add-tag)
-           (unless (member add-tag current-tags)
-             (setq result-tags (push add-tag result-tags))))
-           add-tags)
-    (sort result-tags 'string<)))
-
-(defun notmuch-show-del-tags-worker (current-tags del-tags)
-  "Remove any tags in `del-tags' from `current-tags' and return
-the result."
-  (let ((result-tags (copy-sequence current-tags)))
-    (mapc (lambda (del-tag)
-           (setq result-tags (delete del-tag result-tags)))
-         del-tags)
-    result-tags))
-
-(defun notmuch-show-add-tag (&rest toadd)
-  "Add a tag to the current message."
-  (interactive
-   (list (notmuch-select-tag-with-completion "Tag to add: ")))
+(defun notmuch-show-tag-message (&rest tag-changes)
+  "Change tags for the current message.

 
 

+TAG-CHANGES is a list of tag operations for `notmuch-tag'."

   (let* ((current-tags (notmuch-show-get-tags))
   (let* ((current-tags (notmuch-show-get-tags))

-        (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
-
+        (new-tags (notmuch-update-tags current-tags tag-changes)))

     (unless (equal current-tags new-tags)
     (unless (equal current-tags new-tags)

-      (apply 'notmuch-tag (notmuch-show-get-message-id)
-            (mapcar (lambda (s) (concat "+" s)) toadd))
+      (apply 'notmuch-tag (notmuch-show-get-message-id) tag-changes)

       (notmuch-show-set-tags new-tags))))
 
       (notmuch-show-set-tags new-tags))))
 

-(defun notmuch-show-remove-tag (&rest toremove)
-  "Remove a tag from the current message."
-  (interactive
-   (list (notmuch-select-tag-with-completion
-         "Tag to remove: " (notmuch-show-get-message-id))))
-
-  (let* ((current-tags (notmuch-show-get-tags))
-        (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
+(defun notmuch-show-tag (&optional initial-input)
+  "Change tags for the current message, read input from the minibuffer."
+  (interactive)
+  (let ((tag-changes (notmuch-read-tag-changes
+                     initial-input (notmuch-show-get-message-id))))
+    (apply 'notmuch-show-tag-message tag-changes)))
+
+(defun notmuch-show-tag-all (&rest tag-changes)
+  "Change tags for all messages in the current thread.
+
+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)
+  (notmuch-show-mapc
+   (lambda ()
+     (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-add-tag ()
+  "Same as `notmuch-show-tag' but sets initial input to '+'."
+  (interactive)
+  (notmuch-show-tag "+"))

 
 

-    (unless (equal current-tags new-tags)
-      (apply 'notmuch-tag (notmuch-show-get-message-id)
-            (mapcar (lambda (s) (concat "-" s)) toremove))
-      (notmuch-show-set-tags new-tags))))
+(defun notmuch-show-remove-tag ()
+  "Same as `notmuch-show-tag' but sets initial input to '-'."
+  (interactive)
+  (notmuch-show-tag "-"))

 
 (defun notmuch-show-toggle-headers ()
   "Toggle the visibility of the current message headers."
 
 (defun notmuch-show-toggle-headers ()
   "Toggle the visibility of the current message headers."


@@ -1587,10 +1607,8 @@ argument, hide all of the messages."
 If the remove switch is given, tags will be removed instead of
 added."
   (goto-char (point-min))
 If the remove switch is given, tags will be removed instead of
 added."
   (goto-char (point-min))

-  (let ((tag-function (if remove
-                         'notmuch-show-remove-tag
-                       'notmuch-show-add-tag)))
-    (loop do (funcall tag-function tag)
+  (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)
          until (not (notmuch-show-goto-message-next)))))
 
 (defun notmuch-show-add-tag-thread (tag)


@@ -1653,16 +1671,28 @@ If a prefix argument is given, the message will be
 \"unarchived\" (ie. the \"inbox\" tag will be added instead of
 removed)."
   (interactive "P")
 \"unarchived\" (ie. the \"inbox\" tag will be added instead of
 removed)."
   (interactive "P")

-  (if unarchive
-      (notmuch-show-add-tag "inbox")
-    (notmuch-show-remove-tag "inbox")))
+  (let ((op (if unarchive "+" "-")))
+    (notmuch-show-tag-message (concat op "inbox"))))

 
 

-(defun notmuch-show-archive-message-then-next ()
-  "Archive the current message, then show the next open message in the current thread."
+(defun notmuch-show-archive-message-then-next-or-exit ()
+  "Archive the current message, then show the next open message in the current thread.
+
+If at the last open message in the current thread, then exit back
+to search results."

   (interactive)
   (notmuch-show-archive-message)
   (notmuch-show-next-open-message t))
 
   (interactive)
   (notmuch-show-archive-message)
   (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.
+
+If at the last open message in the current thread, then show next
+thread from search."
+  (interactive)
+  (notmuch-show-archive-message)
+  (unless (notmuch-show-next-open-message)
+    (notmuch-show-next-thread t)))
+

 (defun notmuch-show-stash-cc ()
   "Copy CC field of current message to kill-ring."
   (interactive)
 (defun notmuch-show-stash-cc ()
   "Copy CC field of current message to kill-ring."
   (interactive)