NEWS: document Emacs UI tagging operations changes

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index de9421e80879edb544a949d801719b412bb10c92..faa9f9b43b77ad34ec5f5b8beaa901e5fa34be5f 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)


@@ -1018,7 +1029,7 @@ buffer."
       (notmuch-show-next-open-message))
 
     ;; Set the header line to the subject of the first open message.
       (notmuch-show-next-open-message))
 
     ;; Set the header line to the subject of the first open message.

-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))

 
     (notmuch-show-mark-read)))
 
 
     (notmuch-show-mark-read)))
 


@@ -1073,6 +1084,7 @@ 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 "x" 'notmuch-show-archive-thread-then-exit)
        (define-key map "-" 'notmuch-show-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)
        (define-key map "x" 'notmuch-show-archive-thread-then-exit)


@@ -1170,6 +1182,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 +1243,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 ()


@@ -1250,6 +1283,9 @@ Some useful entries are:
 (defun notmuch-show-get-depth ()
   (notmuch-show-get-prop :depth))
 
 (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)
 (defun notmuch-show-set-tags (tags)
   "Set the tags of the current message."
   (notmuch-show-set-prop :tags tags)


@@ -1269,7 +1305,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.


@@ -1364,11 +1400,10 @@ any effects from previous calls to
       ;; If a small number of lines from the previous message are
       ;; visible, realign so that the top of the current message is at
       ;; the top of the screen.
       ;; If a small number of lines from the previous message are
       ;; visible, realign so that the top of the current message is at
       ;; the top of the screen.

-      (if (<= (count-screen-lines (window-start) start-of-message)
-             next-screen-context-lines)
-         (progn
-           (goto-char (notmuch-show-message-top))
-           (notmuch-show-message-adjust)))
+      (when (<= (count-screen-lines (window-start) start-of-message)
+               next-screen-context-lines)
+       (goto-char (notmuch-show-message-top))
+       (notmuch-show-message-adjust))

       ;; Move to the top left of the window.
       (goto-char (window-start)))
      (t
       ;; Move to the top left of the window.
       (goto-char (window-start)))
      (t


@@ -1483,51 +1518,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."


@@ -1575,10 +1604,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)


@@ -1641,9 +1668,8 @@ 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 ()
   "Archive the current message, then show the next open message in the current thread."