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 3a1a8c89e0b76cdfaff40eb31b28fb77cb015dcf..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.


@@ -316,15 +317,25 @@ unchanged ADDRESS if parsing fails."
        (t
        (setq p-address address)))
 
        (t
        (setq p-address address)))
 

-      ;; Remove elements of the mailbox part that are not relevant for
-      ;; display, even if they are required during transport.

       (when p-name
       (when p-name

-       ;; Outer double quotes.
-       (when (string-match "^\"\\(.*\\)\"$" p-name)
-         (setq p-name (match-string 1 p-name)))
-
+       ;; Remove elements of the mailbox part that are not relevant for
+       ;; display, even if they are required during transport:
+       ;;

        ;; Backslashes.
        ;; Backslashes.

-       (setq p-name (replace-regexp-in-string "\\\\" "" p-name)))
+       (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)
+
+        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)))

 
       ;; 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'.


@@ -855,8 +866,6 @@ current buffer, if possible."
     ;; compatible with the existing implementation. This just sets it
     ;; to after the first header.
     (notmuch-show-insert-headers headers)
     ;; compatible with the existing implementation. This just sets it
     ;; to after the first header.
     (notmuch-show-insert-headers headers)

-    ;; Headers should include a blank line (backwards compatibility).
-    (insert "\n")

     (save-excursion
       (goto-char content-start)
       ;; If the subject of this message is the same as that of the
     (save-excursion
       (goto-char content-start)
       ;; If the subject of this message is the same as that of the


@@ -871,6 +880,8 @@ current buffer, if possible."
     (setq notmuch-show-previous-subject bare-subject)
 
     (setq body-start (point-marker))
     (setq notmuch-show-previous-subject bare-subject)
 
     (setq body-start (point-marker))

+    ;; A blank line between the headers and the body.
+    (insert "\n")

     (notmuch-show-insert-body msg (plist-get msg :body) depth)
     ;; Ensure that the body ends with a newline.
     (unless (bolp)
     (notmuch-show-insert-body msg (plist-get msg :body) depth)
     ;; Ensure that the body ends with a newline.
     (unless (bolp)


@@ -1073,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)


@@ -1170,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.
 


@@ -1222,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 ()


@@ -1272,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.


@@ -1419,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))


@@ -1430,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."


@@ -1485,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."


@@ -1577,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)


@@ -1643,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)