(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-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.
(const :tag "View interactively"
notmuch-show-interactively-view-part)))
+(defcustom notmuch-show-only-matching-messages nil
+ "Only matching messages are shown by default."
+ :type 'boolean
+ :group 'notmuch-show)
+
+(defvar notmuch-show-thread-id nil)
+(make-variable-buffer-local 'notmuch-show-thread-id)
+(put 'notmuch-show-thread-id 'permanent-local t)
+
+(defvar notmuch-show-parent-buffer nil)
+(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(put 'notmuch-show-parent-buffer 'permanent-local t)
+
+(defvar notmuch-show-query-context nil)
+(make-variable-buffer-local 'notmuch-show-query-context)
+(put 'notmuch-show-query-context 'permanent-local t)
+
+(defvar notmuch-show-process-crypto nil)
+(make-variable-buffer-local 'notmuch-show-process-crypto)
+(put 'notmuch-show-process-crypto 'permanent-local t)
+
+(defvar notmuch-show-elide-non-matching-messages nil)
+(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
+(put 'notmuch-show-elide-non-matching-messages 'permanent-local t)
+
+(defvar notmuch-show-indent-content t)
+(make-variable-buffer-local 'notmuch-show-indent-content)
+(put 'notmuch-show-indent-content 'permanent-local t)
+
+(defcustom notmuch-show-stash-mlarchive-link-alist
+ '(("Gmane" . "http://mid.gmane.org/")
+ ("MARC" . "http://marc.info/?i=")
+ ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=")
+ ;; FIXME: can these services be searched by `Message-Id' ?
+ ;; ("MarkMail" . "http://markmail.org/")
+ ;; ("Nabble" . "http://nabble.com/")
+ ;; ("opensubscriber" . "http://opensubscriber.com/")
+ )
+ "List of Mailing List Archives to use when stashing links.
+
+These URIs are concatenated with the current message's
+Message-Id in `notmuch-show-stash-mlarchive-link'."
+ :type '(alist :key-type (string :tag "Name")
+ :value-type (string :tag "URL"))
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
+ "Default Mailing List Archive to use when stashing links.
+
+This is used when `notmuch-show-stash-mlarchive-link' isn't
+provided with an MLA argument nor `completing-read' input."
+ :type `(choice
+ ,@(mapcar
+ (lambda (mla)
+ (list 'const :tag (car mla) :value (car mla)))
+ notmuch-show-stash-mlarchive-link-alist))
+ :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
(all (buffer-substring (notmuch-show-message-top)
(notmuch-show-message-bottom)))
- (props (notmuch-show-get-message-properties)))
+ (props (notmuch-show-get-message-properties))
+ (indenting notmuch-show-indent-content))
(with-temp-buffer
(insert all)
- (indent-rigidly (point-min) (point-max) (- depth))
+ (if indenting
+ (indent-rigidly (point-min) (point-max) (- depth)))
;; Remove the original header.
(goto-char (point-min))
(re-search-forward "^$" (point-max) nil)
(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
- ;; 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.
- (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'.
(sigstatus (car (plist-get part :sigstatus))))
(notmuch-crypto-insert-sigstatus-button sigstatus from))
;; if we're not adding sigstatus, tell the user how they can get it
- (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts.")))
+ (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
(let ((inner-parts (plist-get part :content))
(start (point)))
(sigstatus (car (plist-get part :sigstatus))))
(notmuch-crypto-insert-sigstatus-button sigstatus from))))
;; if we're not adding encstatus, tell the user how they can get it
- (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts.")))
+ (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
(let ((inner-parts (plist-get part :content))
(start (point)))
(run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
t)
-(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
(notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
(insert (with-temp-buffer
(insert (notmuch-show-get-bodypart-content msg part nth))
result)))
t)
+;; For backwards compatibility.
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+ (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
+
(defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
;; If we can deduce a MIME type from the filename of the attachment,
;; do so and pass it on to the handler for that type.
;; Helper for parts which are generally not included in the default
;; JSON output.
-;; Uses the buffer-local variable notmuch-show-process-crypto to
-;; determine if parts should be decrypted first.
(defun notmuch-show-get-bodypart-internal (message-id part-number)
(let ((args '("show" "--format=raw"))
(part-arg (format "--part=%s" part-number)))
;; 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
(setq notmuch-show-previous-subject bare-subject)
(setq body-start (point-marker))
- (notmuch-show-insert-body msg (plist-get msg :body) depth)
+ ;; A blank line between the headers and the body.
+ (insert "\n")
+ (notmuch-show-insert-body msg (plist-get msg :body)
+ (if notmuch-show-indent-content depth 0))
;; Ensure that the body ends with a newline.
(unless (bolp)
(insert "\n"))
(setq content-end (point-marker))
;; Indent according to the depth in the thread.
- (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))
+ (if notmuch-show-indent-content
+ (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)))
(setq message-end (point-max-marker))
;; criteria.
(notmuch-show-message-visible msg (plist-get msg :match))))
+(defun notmuch-show-toggle-process-crypto ()
+ "Toggle the processing of cryptographic MIME parts."
+ (interactive)
+ (setq notmuch-show-process-crypto (not notmuch-show-process-crypto))
+ (message (if notmuch-show-process-crypto
+ "Processing cryptographic MIME parts."
+ "Not processing cryptographic MIME parts."))
+ (notmuch-show-refresh-view t))
+
+(defun notmuch-show-toggle-elide-non-matching ()
+ "Toggle the display of non-matching messages."
+ (interactive)
+ (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages))
+ (message (if notmuch-show-elide-non-matching-messages
+ "Showing matching messages only."
+ "Showing all messages."))
+ (notmuch-show-refresh-view t))
+
+(defun notmuch-show-toggle-thread-indentation ()
+ "Toggle the indentation of threads."
+ (interactive)
+ (setq notmuch-show-indent-content (not notmuch-show-indent-content))
+ (message (if notmuch-show-indent-content
+ "Content is indented."
+ "Content is not indented."))
+ (notmuch-show-refresh-view t))
+
(defun notmuch-show-insert-tree (tree depth)
"Insert the message tree TREE at depth DEPTH in the current thread."
(let ((msg (car tree))
(replies (cadr tree)))
- (notmuch-show-insert-msg msg depth)
+ (if (or (not notmuch-show-elide-non-matching-messages)
+ (plist-get msg :match))
+ (notmuch-show-insert-msg msg depth))
(notmuch-show-insert-thread replies (1+ depth))))
(defun notmuch-show-insert-thread (thread depth)
"Insert the forest of threads FOREST."
(mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
-(defvar notmuch-show-thread-id nil)
-(make-variable-buffer-local 'notmuch-show-thread-id)
-(defvar notmuch-show-parent-buffer nil)
-(make-variable-buffer-local 'notmuch-show-parent-buffer)
-(defvar notmuch-show-query-context nil)
-(make-variable-buffer-local 'notmuch-show-query-context)
-(defvar notmuch-show-buffer-name nil)
-(make-variable-buffer-local 'notmuch-show-buffer-name)
-
(defun notmuch-show-buttonise-links (start end)
"Buttonise URLs and mail addresses between START and END.
'face goto-address-mail-face))))
;;;###autoload
-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
+(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
"Run \"notmuch show\" with the given thread ID and display results.
The optional PARENT-BUFFER is the notmuch-search buffer from
The optional BUFFER-NAME provides the name of the buffer in
which the message thread is shown. If it is nil (which occurs
when the command is called interactively) the argument to the
-function is used.
-
-The optional CRYPTO-SWITCH toggles the value of the
-notmuch-crypto-process-mime customization variable for this show
-buffer."
+function is used."
(interactive "sNotmuch show: ")
- (let* ((process-crypto (if crypto-switch
- (not notmuch-crypto-process-mime)
- notmuch-crypto-process-mime)))
- (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
-
-(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto)
- (let* ((buffer-name (generate-new-buffer-name
- (or buffer-name
- (concat "*notmuch-" thread-id "*"))))
- (buffer (get-buffer-create buffer-name))
- (inhibit-read-only t))
- (switch-to-buffer buffer)
+ (let ((buffer-name (generate-new-buffer-name
+ (or buffer-name
+ (concat "*notmuch-" thread-id "*")))))
+ (switch-to-buffer (get-buffer-create buffer-name))
+ ;; Set the default value for `notmuch-show-process-crypto' in this
+ ;; buffer.
+ (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
+ ;; Set the default value for
+ ;; `notmuch-show-elide-non-matching-messages' in this buffer. If
+ ;; there is a prefix argument, invert the default.
+ (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
+ (if current-prefix-arg
+ (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))
+
+ (setq notmuch-show-thread-id thread-id
+ notmuch-show-parent-buffer parent-buffer
+ notmuch-show-query-context query-context)
+ (notmuch-show-worker)))
+
+(defun notmuch-show-worker ()
+ (let ((inhibit-read-only t))
+
(notmuch-show-mode)
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
- (setq notmuch-show-thread-id thread-id)
- (setq notmuch-show-parent-buffer parent-buffer)
- (setq notmuch-show-query-context query-context)
- (setq notmuch-show-buffer-name buffer-name)
- (setq notmuch-show-process-crypto process-crypto)
-
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (let* ((basic-args (list thread-id))
- (args (if query-context
- (append (list "\'") basic-args (list "and (" query-context ")\'"))
+ (let* ((basic-args (list notmuch-show-thread-id))
+ (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))
;; If the query context reduced the results to nothing, run
;; the basic query.
(when (and (eq (buffer-size) 0)
- query-context)
+ notmuch-show-query-context)
(notmuch-show-insert-forest
(notmuch-query-get-threads basic-args))))
(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)))
-(defun notmuch-show-refresh-view (&optional crypto-switch)
- "Refresh the current view (with crypto switch if prefix given).
+(defun notmuch-show-capture-state ()
+ "Capture the state of the current buffer.
+
+This includes:
+ - the list of open messages,
+ - the current message."
+ (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages)))
+
+(defun notmuch-show-apply-state (state)
+ "Apply STATE to the current buffer.
+
+This includes:
+ - opening the messages previously opened,
+ - closing all other messages,
+ - moving to the correct current message."
+ (let ((current (car state))
+ (open (cadr state)))
+
+ ;; Open those that were open.
+ (goto-char (point-min))
+ (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
+ (member (notmuch-show-get-message-id) open))
+ until (not (notmuch-show-goto-message-next)))
+
+ ;; Go to the previously open message.
+ (goto-char (point-min))
+ (unless (loop if (string= current (notmuch-show-get-message-id))
+ return t
+ until (not (notmuch-show-goto-message-next)))
+ (goto-char (point-min))
+ (message "Previously current message not found."))
+ (notmuch-show-message-adjust)))
+
+(defun notmuch-show-refresh-view (&optional retain-state)
+ "Refresh the current view.
-Kills the current buffer and reruns notmuch show with the same
-thread id. If a prefix is given, crypto processing is toggled."
+Refreshes the current view, observing changes in display
+preferences. If RETAIN-STATE is non-nil then the state of the
+buffer is stored and re-applied after the refresh."
(interactive "P")
- (let ((thread-id notmuch-show-thread-id)
- (parent-buffer notmuch-show-parent-buffer)
- (query-context notmuch-show-query-context)
- (buffer-name notmuch-show-buffer-name)
- (process-crypto (if crypto-switch
- (not notmuch-show-process-crypto)
- notmuch-show-process-crypto)))
- (notmuch-kill-this-buffer)
- (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
+ (let ((inhibit-read-only t)
+ state)
+ (if retain-state
+ (setq state (notmuch-show-capture-state)))
+ (erase-buffer)
+ (notmuch-show-worker)
+ (if state
+ (notmuch-show-apply-state state))))
(defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "s" 'notmuch-show-stash-subject)
(define-key map "T" 'notmuch-show-stash-tags)
(define-key map "t" 'notmuch-show-stash-to)
+ (define-key map "l" 'notmuch-show-stash-mlarchive-link)
+ (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
map)
"Submap for stash commands")
(fset 'notmuch-show-stash-map notmuch-show-stash-map)
(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 "a" 'notmuch-show-archive-thread-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-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 (kbd "M-RET") 'notmuch-show-open-or-close-all)
(define-key map (kbd "RET") 'notmuch-show-toggle-message)
(define-key map "#" 'notmuch-show-print-message)
+ (define-key map "!" 'notmuch-show-toggle-elide-non-matching)
+ (define-key map "$" 'notmuch-show-toggle-process-crypto)
+ (define-key map "<" 'notmuch-show-toggle-thread-indentation)
+ (define-key map "t" 'toggle-truncate-lines)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
(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.
(notmuch-show-get-message-properties))))
(plist-get props prop)))
-(defun notmuch-show-get-message-id ()
- "Return the message id of the current message."
- (concat "id:\"" (notmuch-show-get-prop :id) "\""))
+(defun notmuch-show-get-message-id (&optional bare)
+ "Return the Message-Id of the current message.
+
+If optional argument BARE is non-nil, return
+the Message-Id without prefix and quotes."
+ (if bare
+ (notmuch-show-get-prop :id)
+ (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-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-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.
;; 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
(with-current-notmuch-show-message
(notmuch-mua-new-forward-message prompt-for-sender)))
-(defun notmuch-show-next-message ()
- "Show the next message."
- (interactive)
+(defun notmuch-show-next-message (&optional pop-at-end)
+ "Show the next message.
+
+If a prefix argument is given and this is the last message in the
+thread, navigate to the next thread in the parent search buffer."
+ (interactive "P")
(if (notmuch-show-goto-message-next)
(progn
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
- (goto-char (point-max))))
+ (if pop-at-end
+ (notmuch-show-next-thread)
+ (goto-char (point-max)))))
(defun notmuch-show-previous-message ()
"Show the previous message."
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
-(defun notmuch-show-next-open-message ()
- "Show the next message."
- (interactive)
+(defun notmuch-show-next-open-message (&optional pop-at-end)
+ "Show the next open message.
+
+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. 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))
(not (notmuch-show-message-visible-p))))
(progn
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
- (goto-char (point-max)))))
+ (if pop-at-end
+ (notmuch-show-next-thread)
+ (goto-char (point-max))))
+ r))
(defun notmuch-show-previous-open-message ()
- "Show the previous message."
+ "Show the previous open message."
(interactive)
(while (and (notmuch-show-goto-message-previous)
(not (notmuch-show-message-visible-p))))
(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))
- (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)
- (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))))
-(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."
(interactive)
(backward-button 1))
-(defun notmuch-show-tag-thread-internal (tag &optional remove)
- "Add tag to the current set of messages.
-
-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)
- until (not (notmuch-show-goto-message-next)))))
-
-(defun notmuch-show-add-tag-thread (tag)
- "Add tag to all messages in the current thread."
- (interactive)
- (notmuch-show-tag-thread-internal tag))
-
-(defun notmuch-show-remove-tag-thread (tag)
- "Remove tag from all messages in the current thread."
- (interactive)
- (notmuch-show-tag-thread-internal tag t))
-
(defun notmuch-show-next-thread (&optional show-next)
"Move to the next item in the search results, if any."
(interactive "P")
(let ((parent-buffer notmuch-show-parent-buffer))
(notmuch-kill-this-buffer)
- (when parent-buffer
+ (when (buffer-live-p parent-buffer)
(switch-to-buffer parent-buffer)
(notmuch-search-next-thread)
(if show-next
entire thread, but only the messages shown in the current
buffer."
(interactive "P")
- (if unarchive
- (notmuch-show-add-tag-thread "inbox")
- (notmuch-show-remove-tag-thread "inbox")))
+ (let ((op (if unarchive "+" "-")))
+ (notmuch-show-tag-all (concat op "inbox"))))
(defun notmuch-show-archive-thread-then-next ()
"Archive each message in thread, then show next thread from search."
\"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-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))
-(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-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)
- (notmuch-show-next-open-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."
(defun notmuch-show-stash-message-id-stripped ()
"Copy message ID of current message (sans `id:' prefix) to kill-ring."
(interactive)
- (notmuch-common-do-stash (substring (notmuch-show-get-message-id) 4 -1)))
+ (notmuch-common-do-stash (notmuch-show-get-message-id t)))
(defun notmuch-show-stash-subject ()
"Copy Subject field of current message to kill-ring."
(interactive)
(notmuch-common-do-stash (notmuch-show-get-to)))
+(defun notmuch-show-stash-mlarchive-link (&optional mla)
+ "Copy an ML Archive URI for the current message to the kill-ring.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+ (interactive)
+ (notmuch-common-do-stash
+ (concat (cdr (assoc
+ (or mla
+ (let ((completion-ignore-case t))
+ (completing-read
+ "Mailing List Archive: "
+ notmuch-show-stash-mlarchive-link-alist
+ nil t nil nil notmuch-show-stash-mlarchive-link-default)))
+ notmuch-show-stash-mlarchive-link-alist))
+ (notmuch-show-get-message-id t))))
+
+(defun notmuch-show-stash-mlarchive-link-and-go (&optional mla)
+ "Copy an ML Archive URI for the current message to the kill-ring and visit it.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+ (interactive)
+ (notmuch-show-stash-mlarchive-link mla)
+ (browse-url (current-kill 0 t)))
+
;; Commands typically bound to buttons.
(defun notmuch-show-part-button-default (&optional button)
projects / notmuch / blobdiff