]> git.notmuchmail.org Git - notmuch/blobdiff - contrib/notmuch-pick/notmuch-pick.el
contrib: pick: archive message updated
[notmuch] / contrib / notmuch-pick / notmuch-pick.el
index 5f9e456354f05be143ffdf201e40d84ac69a5e13..9d3999bf0f0cc2ee7258e6f393791a21494fbb70 100644 (file)
@@ -35,7 +35,6 @@
 (declare-function notmuch-show "notmuch-show" (&rest args))
 (declare-function notmuch-tag "notmuch" (query &rest tags))
 (declare-function notmuch-show-strip-re "notmuch-show" (subject))
-(declare-function notmuch-show-clean-address "notmuch-show" (parsed-address))
 (declare-function notmuch-show-spaces-n "notmuch-show" (n))
 (declare-function notmuch-read-query "notmuch" (prompt))
 (declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
     (define-key map "q" 'notmuch-pick-quit)
     (define-key map "x" 'notmuch-pick-quit)
     (define-key map "?" 'notmuch-help)
-    (define-key map "a" 'notmuch-pick-archive-message)
+    (define-key map "a" 'notmuch-pick-archive-message-then-next)
     (define-key map "=" 'notmuch-pick-refresh-view)
     (define-key map "s" 'notmuch-search)
     (define-key map "z" 'notmuch-pick)
@@ -340,8 +339,8 @@ Does NOT change the database."
       (with-selected-window notmuch-pick-message-window
        (setq current-prefix-arg '(4))
        (setq buffer (notmuch-show id nil nil nil)))
-      (notmuch-pick-tag-update-display (list "-unread")))
-    (setq notmuch-pick-message-buffer buffer)))
+      (notmuch-pick-tag-update-display (list "-unread"))
+      (setq notmuch-pick-message-buffer buffer))))
 
 (defun notmuch-pick-show-message-out ()
   "Show the current message (in whole window)."
@@ -394,10 +393,23 @@ Does NOT change the database."
       (kill-buffer notmuch-pick-message-buffer))
     t))
 
-(defun notmuch-pick-archive-message ()
+(defun notmuch-pick-archive-message (&optional unarchive)
+  "Archive the current message.
+
+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")
+  (when notmuch-archive-tags
+    (apply 'notmuch-pick-tag
+          (notmuch-tag-change-list notmuch-archive-tags unarchive))))
+
+(defun notmuch-pick-archive-message-then-next (&optional unarchive)
   "Archive the current message and move to next matching message."
-  (interactive)
-  (notmuch-pick-tag "-inbox")
+  (interactive "P")
+  (notmuch-pick-archive-message unarchive)
   (notmuch-pick-next-matching-message))
 
 (defun notmuch-pick-next-message ()
@@ -521,62 +533,16 @@ than only the current message."
          (message (format "Command '%s' exited abnormally with code %d"
                           shell-command exit-code)))))))
 
-;; Shamelessly stolen from notmuch-show.el: should be unified.
 (defun notmuch-pick-clean-address (address)
-  "Try to clean a single email ADDRESS for display.  Return
+  "Try to clean a single email ADDRESS for display. Return
+AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
 unchanged ADDRESS if parsing fails."
-  (condition-case nil
-    (let (p-name p-address)
-      ;; It would be convenient to use `mail-header-parse-address',
-      ;; but that expects un-decoded mailbox parts, whereas our
-      ;; mailbox parts are already decoded (and hence may contain
-      ;; UTF-8). Given that notmuch should handle most of the awkward
-      ;; cases, some simple string deconstruction should be sufficient
-      ;; here.
-      (cond
-       ;; "User <user@dom.ain>" style.
-       ((string-match "\\(.*\\) <\\(.*\\)>" address)
-       (setq p-name (match-string 1 address)
-             p-address (match-string 2 address)))
-
-       ;; "<user@dom.ain>" style.
-       ((string-match "<\\(.*\\)>" address)
-       (setq p-address (match-string 1 address)))
-
-       ;; Everything else.
-       (t
-       (setq p-address address)))
-
-      (when p-name
-       ;; Remove elements of the mailbox part that are not relevant for
-       ;; display, even if they are required during transport:
-       ;;
-       ;; Backslashes.
-       (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'.
-      (when (string= p-name p-address)
-       (setq p-name nil))
-
-      ;; If we have a name return that otherwise return the address.
-      (if (not p-name)
-         p-address
-       p-name))
-    (error address)))
+  (let* ((clean-address (notmuch-clean-address address))
+        (p-address (car clean-address))
+        (p-name (cdr clean-address)))
+
+    ;; If we have a name return that otherwise return the address.
+    (or p-name p-address)))
 
 (defun notmuch-pick-insert-field (field format-string msg)
   (let* ((headers (plist-get msg :headers))