(require 'goto-addr)
(require 'notmuch-lib)
+(require 'notmuch-tag)
(require 'notmuch-query)
(require 'notmuch-wash)
(require 'notmuch-mua)
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-fontify-headers "notmuch" nil)
-(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.
For an open message, all of these headers will be made visible
according to `notmuch-message-headers-visible' or can be toggled
-with `notmuch-show-toggle-headers'. For a closed message, only
-the first header in the list will be visible."
+with `notmuch-show-toggle-visibility-headers'. For a closed message,
+only the first header in the list will be visible."
:type '(repeat string)
:group 'notmuch-show)
If this value is non-nil, then all of the headers defined in
`notmuch-message-headers' will be visible by default in the display
of each message. Otherwise, these headers will be hidden and
-`notmuch-show-toggle-headers' can be used to make the visible for
-any given message."
+`notmuch-show-toggle-visibility-headers' can be used to make them
+visible for any given message."
:type 'boolean
:group 'notmuch-show)
notmuch-show-stash-mlarchive-link-alist))
:group 'notmuch-show)
+(defcustom notmuch-show-mark-read-tags '("-unread")
+ "List of tag changes to apply to a message when it is marked as read.
+
+Tags starting with \"+\" (or not starting with either \"+\" or
+\"-\") in the list will be added, and tags starting with \"-\"
+will be removed from the message being marked as read.
+
+For example, if you wanted to remove an \"unread\" tag and add a
+\"read\" tag (which would make little sense), you would set:
+ (\"-unread\" \"+read\")"
+ :type '(repeat string)
+ :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
(let ((id (notmuch-show-get-message-id)))
(let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
(with-current-buffer buf
- (call-process notmuch-command nil t nil "show" "--format=raw" id)
- ,@body)
- (kill-buffer buf)))))
+ (let ((coding-system-for-read 'no-conversion))
+ (call-process notmuch-command nil t nil "show" "--format=raw" id)
+ ,@body)
+ (kill-buffer buf))))))
(defun notmuch-show-turn-on-visual-line-mode ()
"Enable Visual Line mode."
'face 'notmuch-tag-face)
")"))))))
-(defun notmuch-show-clean-address (address)
- "Try to clean a single email ADDRESS for display. Return
-unchanged ADDRESS if parsing fails."
+(defun notmuch-clean-address (address)
+ "Try to clean a single email ADDRESS for display. Return a cons
+cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
+parsing fails."
(condition-case nil
(let (p-name p-address)
;; It would be convenient to use `mail-header-parse-address',
(when (string= p-name p-address)
(setq p-name nil))
- ;; If no name results, return just the address.
- (if (not p-name)
- p-address
- ;; Otherwise format the name and address together.
- (concat p-name " <" p-address ">")))
- (error address)))
+ (cons p-address p-name))
+ (error (cons address nil))))
+
+(defun notmuch-show-clean-address (address)
+ "Try to clean a single email ADDRESS for display. Return
+unchanged ADDRESS if parsing fails."
+ (let* ((clean-address (notmuch-clean-address address))
+ (p-address (car clean-address))
+ (p-name (cdr clean-address)))
+ ;; If no name, return just the address.
+ (if (not p-name)
+ p-address
+ ;; Otherwise format the name and address together.
+ (concat p-name " <" p-address ">"))))
(defun notmuch-show-insert-headerline (headers date tags depth)
"Insert a notmuch style headerline based on HEADERS for a
(define-key map "s" 'notmuch-show-part-button-save)
(define-key map "v" 'notmuch-show-part-button-view)
(define-key map "o" 'notmuch-show-part-button-interactively-view)
+ (define-key map "|" 'notmuch-show-part-button-pipe)
map)
"Submap for button commands")
(fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
- (let ((button))
+ (let ((button)
+ (base-label (concat (when name (concat name ": "))
+ declared-type
+ (unless (string-equal declared-type content-type)
+ (concat " (as " content-type ")"))
+ comment)))
+
(setq button
(insert-button
- (concat "[ "
- (if name (concat name ": ") "")
- declared-type
- (if (not (string-equal declared-type content-type))
- (concat " (as " content-type ")")
- "")
- (or comment "")
- " ]")
+ (concat "[ " base-label " ]")
+ :base-label base-label
:type 'notmuch-show-part-button-type
:notmuch-part nth
:notmuch-filename name
(setq notmuch-show-process-crypto ,process-crypto)
;; Always acquires the part via `notmuch part', even if it is
;; available in the JSON output.
- (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))
+ (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))
,@body))))
(defun notmuch-show-save-part (message-id nth &optional filename content-type)
(let ((handle (mm-make-handle (current-buffer) (list content-type))))
(mm-interactively-view-part handle))))
-(defun notmuch-show-mm-display-part-inline (msg part nth content-type)
- "Use the mm-decode/mm-view functions to display a part in the
-current buffer, if possible."
- (let ((display-buffer (current-buffer)))
- (with-temp-buffer
- (let* ((charset (plist-get part :content-charset))
- (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
- ;; If the user wants the part inlined, insert the content and
- ;; test whether we are able to inline it (which includes both
- ;; capability and suitability tests).
- (when (mm-inlined-p handle)
- (insert (notmuch-show-get-bodypart-content msg part nth))
- (when (mm-inlinable-p handle)
- (set-buffer display-buffer)
- (mm-display-part handle)
- t))))))
-
-(defvar notmuch-show-multipart/alternative-discouraged
- '(
- ;; Avoid HTML parts.
- "text/html"
- ;; multipart/related usually contain a text/html part and some associated graphics.
- "multipart/related"
- ))
+(defun notmuch-show-pipe-part (message-id nth &optional filename content-type)
+ (notmuch-with-temp-part-buffer message-id nth
+ (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+ (mm-pipe-part handle))))
(defun notmuch-show-multipart/*-to-list (part)
(mapcar (lambda (inner-part) (plist-get inner-part :content-type))
(plist-get part :content)))
-(defun notmuch-show-multipart/alternative-choose (types)
- ;; Based on `mm-preferred-alternative-precedence'.
- (let ((seq types))
- (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
- (dolist (elem (copy-sequence seq))
- (when (string-match pref elem)
- (setq seq (nconc (delete elem seq) (list elem))))))
- seq))
-
(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
(notmuch-show-insert-part-header nth declared-type content-type nil)
- (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+ (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
(inner-parts (plist-get part :content))
(start (point)))
;; This inserts all parts of the chosen type rather than just one,
;; but it's not clear that this is the wrong thing to do - which
;; should be chosen if there are more than one that match?
(mapc (lambda (inner-part)
- (let ((inner-type (plist-get inner-part :content-type)))
- (if (or notmuch-show-all-multipart/alternative-parts
- (string= chosen-type inner-type))
- (notmuch-show-insert-bodypart msg inner-part depth)
- (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
+ (let* ((inner-type (plist-get inner-part :content-type))
+ (hide (not (or notmuch-show-all-multipart/alternative-parts
+ (string= chosen-type inner-type)))))
+ (notmuch-show-insert-bodypart msg inner-part depth hide)))
inner-parts)
(when notmuch-show-indent-multipart
;; times (hundreds!), which results in many calls to
;; `notmuch part'.
(unless content
- (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
- part-number))
+ (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
+ part-number notmuch-show-process-crypto))
(with-current-buffer w3m-current-buffer
(notmuch-show-w3m-cid-store-internal url
message-id
;; insert a header to make this clear.
(if (> nth 1)
(notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
- (insert (notmuch-show-get-bodypart-content msg part nth))
+ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
(save-excursion
(save-restriction
(narrow-to-region start (point-max))
(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))
+ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
+ ;; notmuch-get-bodypart-content provides "raw", non-converted
+ ;; data. Replace CRLF with LF before icalendar can use it.
(goto-char (point-min))
+ (while (re-search-forward "\r\n" nil t)
+ (replace-match "\n" nil nil))
(let ((file (make-temp-file "notmuch-ical"))
result)
- (icalendar--convert-ical-to-diary
- (icalendar--read-element nil nil)
- file t)
- (set-buffer (get-file-buffer file))
- (setq result (buffer-substring (point-min) (point-max)))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer))
- (delete-file file)
+ (unwind-protect
+ (progn
+ (unless (icalendar-import-buffer file t)
+ (error "Icalendar import error. See *icalendar-errors* for more information"))
+ (set-buffer (get-file-buffer file))
+ (setq result (buffer-substring (point-min) (point-max)))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (delete-file file))
result)))
t)
(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
;; This handler _must_ succeed - it is the handler of last resort.
(notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
- (notmuch-show-mm-display-part-inline msg part nth content-type)
+ (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
t)
;; Functions for determining how to handle MIME parts.
-(defun notmuch-show-split-content-type (content-type)
- (split-string content-type "/"))
-
(defun notmuch-show-handlers-for (content-type)
"Return a list of content handlers for a part of type CONTENT-TYPE."
(let (result)
(list (intern (concat "notmuch-show-insert-part-*/*"))
(intern (concat
"notmuch-show-insert-part-"
- (car (notmuch-show-split-content-type content-type))
+ (car (notmuch-split-content-type content-type))
"/*"))
(intern (concat "notmuch-show-insert-part-" content-type))))
result))
-;; Helper for parts which are generally not included in the default
-;; JSON output.
-(defun notmuch-show-get-bodypart-internal (message-id part-number)
- (let ((args '("show" "--format=raw"))
- (part-arg (format "--part=%s" part-number)))
- (setq args (append args (list part-arg)))
- (if notmuch-show-process-crypto
- (setq args (append args '("--decrypt"))))
- (setq args (append args (list message-id)))
- (with-temp-buffer
- (let ((coding-system-for-read 'no-conversion))
- (progn
- (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
- (buffer-string))))))
-
-(defun notmuch-show-get-bodypart-content (msg part nth)
- (or (plist-get part :content)
- (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
-
;; \f
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
;; Run the content handlers until one of them returns a non-nil
;; value.
(while (and handlers
- (not (funcall (car handlers) msg part content-type nth depth declared-type)))
+ (not (condition-case err
+ (funcall (car handlers) msg part content-type nth depth declared-type)
+ (error (progn
+ (insert "!!! Bodypart insert error: ")
+ (insert (error-message-string err))
+ (insert " !!!\n") nil)))))
(setq handlers (cdr handlers))))
t)
-(defun notmuch-show-insert-bodypart (msg part depth)
- "Insert the body part PART at depth DEPTH in the current thread."
+(defun notmuch-show-create-part-overlays (msg beg end hide)
+ "Add an overlay to the part between BEG and END"
+ (let* ((button (button-at beg))
+ (part-beg (and button (1+ (button-end button)))))
+
+ ;; If the part contains no text we do not make it toggleable. We
+ ;; also need to check that the button is a genuine part button not
+ ;; a notmuch-wash button.
+ (when (and button (/= part-beg end) (button-get button :base-label))
+ (button-put button 'overlay (make-overlay part-beg end)))))
+
+(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
+ "Insert the body part PART at depth DEPTH in the current thread.
+
+If HIDE is non-nil then initially hide this part."
(let ((content-type (downcase (plist-get part :content-type)))
- (nth (plist-get part :id)))
- (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
- ;; Some of the body part handlers leave point somewhere up in the
- ;; part, so we make sure that we're down at the end.
- (goto-char (point-max))
- ;; Ensure that the part ends with a carriage return.
- (unless (bolp)
- (insert "\n")))
+ (nth (plist-get part :id))
+ (beg (point)))
+
+ (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)
+ ;; Some of the body part handlers leave point somewhere up in the
+ ;; part, so we make sure that we're down at the end.
+ (goto-char (point-max))
+ ;; Ensure that the part ends with a carriage return.
+ (unless (bolp)
+ (insert "\n"))
+ (notmuch-show-create-part-overlays msg beg (point) hide)))
(defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread."
(make-symbol (concat "notmuch-show-" type)))
(defun notmuch-show-strip-re (string)
- (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+ (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
(defvar notmuch-show-previous-subject "")
(make-variable-buffer-local 'notmuch-show-previous-subject)
message-start message-end
content-start content-end
headers-start headers-end
- body-start body-end
- (headers-invis-spec (notmuch-show-make-symbol "header"))
- (message-invis-spec (notmuch-show-make-symbol "message"))
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
- ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
- ;; removing items from `buffer-invisibility-spec' (which is what
- ;; `notmuch-show-headers-visible' and
- ;; `notmuch-show-message-visible' do) is a no-op and has no
- ;; effect. This caused threads with only matching messages to have
- ;; those messages hidden initially because
- ;; `buffer-invisibility-spec' stayed `t'.
- ;;
- ;; This needs to be set here (rather than just above the call to
- ;; `notmuch-show-headers-visible') because some of the part
- ;; rendering or body washing functions
- ;; (e.g. `notmuch-wash-text/plain-citations') manipulate
- ;; `buffer-invisibility-spec').
- (when (eq buffer-invisibility-spec t)
- (setq buffer-invisibility-spec nil))
-
(setq message-start (point-marker))
(notmuch-show-insert-headerline headers
(setq content-start (point-marker))
- (plist-put msg :headers-invis-spec headers-invis-spec)
- (plist-put msg :message-invis-spec message-invis-spec)
-
;; Set `headers-start' to point after the 'Subject:' header to be
;; compatible with the existing implementation. This just sets it
;; to after the first header.
(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)
;; Ensure that the body ends with a newline.
(unless (bolp)
(insert "\n"))
- (setq body-end (point-marker))
(setq content-end (point-marker))
;; Indent according to the depth in the thread.
;; message.
(put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
- (let ((headers-overlay (make-overlay headers-start headers-end))
- (invis-specs (list headers-invis-spec message-invis-spec)))
- (overlay-put headers-overlay 'invisible invis-specs)
- (overlay-put headers-overlay 'priority 10))
- (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
+ ;; Create overlays used to control visibility
+ (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
+ (plist-put msg :message-overlay (make-overlay headers-start content-end))
(plist-put msg :depth depth)
;; Message visibility depends on whether it matched the search
;; criteria.
- (notmuch-show-message-visible msg (plist-get msg :match))))
+ (notmuch-show-message-visible msg (and (plist-get msg :match)
+ (not (plist-get msg :excluded))))))
(defun notmuch-show-toggle-process-crypto ()
"Toggle the processing of cryptographic MIME parts."
(message (if notmuch-show-process-crypto
"Processing cryptographic MIME parts."
"Not processing cryptographic MIME parts."))
- (notmuch-show-refresh-view t))
+ (notmuch-show-refresh-view))
(defun notmuch-show-toggle-elide-non-matching ()
"Toggle the display of non-matching messages."
(message (if notmuch-show-elide-non-matching-messages
"Showing matching messages only."
"Showing all messages."))
- (notmuch-show-refresh-view t))
+ (notmuch-show-refresh-view))
(defun notmuch-show-toggle-thread-indentation ()
"Toggle the indentation of threads."
(message (if notmuch-show-indent-content
"Content is indented."
"Content is not indented."))
- (notmuch-show-refresh-view t))
+ (notmuch-show-refresh-view))
(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)))
- (if (or (not notmuch-show-elide-non-matching-messages)
- (plist-get msg :match))
- (notmuch-show-insert-msg msg depth))
+ ;; We test whether there is a message or just some replies.
+ (when msg
+ (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-id-regexp
+ (concat
+ ;; Match the id: prefix only if it begins a word (to disallow, for
+ ;; example, matching cid:).
+ "\\<id:\\("
+ ;; If the term starts with a ", then parse Xapian's quoted boolean
+ ;; term syntax, which allows for anything as long as embedded
+ ;; double quotes escaped by doubling them. We also disallow
+ ;; newlines (which Xapian allows) to prevent runaway terms.
+ "\"\\([^\"\n]\\|\"\"\\)*\""
+ ;; Otherwise, parse Xapian's unquoted syntax, which goes up to the
+ ;; next space or ). We disallow [.,;] as the last character
+ ;; because these are probably part of the surrounding text, and not
+ ;; part of the id. This doesn't match single character ids; meh.
+ "\\|[^\"[:space:])][^[:space:])]*[^])[:space:].,:;?!]"
+ "\\)")
+ "The regexp used to match id: links in messages.")
+
+(defvar notmuch-mid-regexp
+ ;; goto-address-url-regexp matched cid: links, which have the same
+ ;; grammar as the message ID part of a mid: link. Construct the
+ ;; regexp using the same technique as goto-address-url-regexp.
+ (concat "\\<mid:\\(" thing-at-point-url-path-regexp "\\)")
+ "The regexp used to match mid: links in messages.
+
+See RFC 2392.")
+
(defun notmuch-show-buttonise-links (start end)
"Buttonise URLs and mail addresses between START and END.
-This also turns id:\"<message id>\"-parts into buttons for
-a corresponding notmuch search."
+This also turns id:\"<message id>\"-parts and mid: links into
+buttons for a corresponding notmuch search."
(goto-address-fontify-region start end)
(save-excursion
- (goto-char start)
- (while (re-search-forward "id:\\(\"?\\)[^[:space:]\"]+\\1" end t)
- ;; remove the overlay created by goto-address-mode
- (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
- (make-text-button (match-beginning 0) (match-end 0)
- 'action `(lambda (arg)
- (notmuch-show ,(match-string-no-properties 0)))
- 'follow-link t
- 'help-echo "Mouse-1, RET: search for this message"
- 'face goto-address-mail-face))))
+ (let (links)
+ (goto-char start)
+ (while (re-search-forward notmuch-id-regexp end t)
+ (push (list (match-beginning 0) (match-end 0)
+ (match-string-no-properties 0)) links))
+ (goto-char start)
+ (while (re-search-forward notmuch-mid-regexp end t)
+ (let* ((mid-cid (match-string-no-properties 1))
+ (mid (save-match-data
+ (string-match "^[^/]*" mid-cid)
+ (url-unhex-string (match-string 0 mid-cid)))))
+ (push (list (match-beginning 0) (match-end 0)
+ (notmuch-id-to-query mid)) links)))
+ (dolist (link links)
+ ;; Remove the overlay created by goto-address-mode
+ (remove-overlays (first link) (second link) 'goto-address t)
+ (make-text-button (first link) (second link)
+ 'action `(lambda (arg)
+ (notmuch-show ,(third link)))
+ 'follow-link t
+ 'help-echo "Mouse-1, RET: search for this message"
+ 'face goto-address-mail-face)))))
;;;###autoload
(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
notmuch-show-parent-buffer parent-buffer
notmuch-show-query-context query-context)
(notmuch-show-build-buffer)
-
- ;; Move to the first open message and mark it read
- (if (notmuch-show-message-visible-p)
- (notmuch-show-mark-read)
- (notmuch-show-next-open-message))))
+ (notmuch-show-goto-first-wanted-message)
+ (current-buffer)))
(defun notmuch-show-build-buffer ()
(let ((inhibit-read-only t))
(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))
+ (append (list "\'") basic-args (list "\'"))))
+ (cli-args (cons "--exclude=false"
+ (when notmuch-show-elide-non-matching-messages
+ (list "--entire-thread=false")))))
+
+ (notmuch-show-insert-forest (notmuch-query-get-threads (append cli-args args)))
;; If the query context reduced the results to nothing, run
;; the basic query.
(when (and (eq (buffer-size) 0)
notmuch-show-query-context)
(notmuch-show-insert-forest
- (notmuch-query-get-threads basic-args))))
+ (notmuch-query-get-threads (append cli-args basic-args)))))
(jit-lock-register #'notmuch-show-buttonise-links)
- (run-hooks 'notmuch-show-hook))
+ ;; Set the header line to the subject of the first message.
+ (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
- ;; Set the header line to the subject of the first open message.
- (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))))
+ (run-hooks 'notmuch-show-hook))))
(defun notmuch-show-capture-state ()
"Capture the state of the current buffer.
(message "Previously current message not found."))
(notmuch-show-message-adjust)))
-(defun notmuch-show-refresh-view (&optional retain-state)
+(defun notmuch-show-refresh-view (&optional reset-state)
"Refresh the current view.
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."
+preferences. If invoked with a prefix argument (or RESET-STATE is
+non-nil) then the state of the buffer (open/closed messages) is
+reset based on the original query."
(interactive "P")
(let ((inhibit-read-only t)
- state)
- (if retain-state
- (setq state (notmuch-show-capture-state)))
+ (state (unless reset-state
+ (notmuch-show-capture-state))))
+ ;; erase-buffer does not seem to remove overlays, which can lead
+ ;; to weird effects such as remaining images, so remove them
+ ;; manually.
+ (remove-overlays)
(erase-buffer)
(notmuch-show-build-buffer)
(if state
(notmuch-show-apply-state state)
;; We're resetting state, so navigate to the first open message
;; and mark it read, just like opening a new show buffer.
- (if (notmuch-show-message-visible-p)
- (notmuch-show-mark-read)
- (notmuch-show-next-open-message)))))
+ (notmuch-show-goto-first-wanted-message))))
(defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "v" 'notmuch-show-view-all-mime-parts)
(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 "h" 'notmuch-show-toggle-visibility-headers)
(define-key map "*" 'notmuch-show-tag-all)
(define-key map "-" 'notmuch-show-remove-tag)
(define-key map "+" 'notmuch-show-add-tag)
;; Functions relating to the visibility of messages and their
;; components.
-(defun notmuch-show-element-visible (props visible-p spec-property)
- (let ((spec (plist-get props spec-property)))
- (if visible-p
- (remove-from-invisibility-spec spec)
- (add-to-invisibility-spec spec))))
-
(defun notmuch-show-message-visible (props visible-p)
- (notmuch-show-element-visible props visible-p :message-invis-spec)
+ (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
(notmuch-show-set-prop :message-visible visible-p props))
(defun notmuch-show-headers-visible (props visible-p)
- (notmuch-show-element-visible props visible-p :headers-invis-spec)
+ (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
(notmuch-show-set-prop :headers-visible visible-p props))
;; Functions for setting and getting attributes of the current
(plist-get props prop)))
(defun notmuch-show-get-message-id (&optional bare)
- "Return the Message-Id of the current message.
+ "Return an id: query for the Message-Id of the current message.
If optional argument BARE is non-nil, return
-the Message-Id without prefix and quotes."
+the Message-Id without id: prefix and escaping."
(if bare
(notmuch-show-get-prop :id)
- (concat "id:\"" (notmuch-show-get-prop :id) "\"")))
+ (notmuch-id-to-query (notmuch-show-get-prop :id))))
(defun notmuch-show-get-messages-ids ()
- "Return all message ids of messages in the current thread."
+ "Return all id: queries of messages in the current thread."
(let ((message-ids))
(notmuch-show-mapc
(lambda () (push (notmuch-show-get-message-id) message-ids)))
(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)
"Are the headers of the current message visible?"
(notmuch-show-get-prop :headers-visible))
-(defun notmuch-show-mark-read ()
- "Mark the current message as read."
- (notmuch-show-tag-message "-unread"))
+(defun notmuch-show-mark-read (&optional unread)
+ "Mark the current message as read.
+
+Mark the current message as read by applying the tag changes in
+`notmuch-show-mark-read-tags' to it (remove the \"unread\" tag by
+default). If a prefix argument is given, the message will be
+marked as unread, i.e. the tag changes in
+`notmuch-show-mark-read-tags' will be reversed."
+ (interactive "P")
+ (when notmuch-show-mark-read-tags
+ (apply 'notmuch-show-tag-message
+ (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
;; Functions for getting attributes of several messages in the current
;; thread.
(defun notmuch-show-get-message-ids-for-open-messages ()
- "Return a list of all message IDs for open messages in the current thread."
+ "Return a list of all id: queries for open messages in the current thread."
(save-excursion
(let (message-ids done)
(goto-char (point-min))
;; This is not the last message - move to the next visible one.
(notmuch-show-next-open-message))
+ ((not (= (point) (point-max)))
+ ;; This is the last message, but the cursor is not at the end of
+ ;; the buffer. Move it there.
+ (goto-char (point-max)))
+
(t
;; This is the last message - change the return value
(setq ret t)))
(goto-char (point-max)))))
(defun notmuch-show-previous-message ()
- "Show the previous message."
+ "Show the previous message or the start of the current message."
(interactive)
- (notmuch-show-goto-message-previous)
+ (if (= (point) (notmuch-show-message-top))
+ (notmuch-show-goto-message-previous)
+ (notmuch-show-move-to-message-top))
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
(goto-char (point-max))))
r))
+(defun notmuch-show-next-matching-message ()
+ "Show the next matching message."
+ (interactive)
+ (let (r)
+ (while (and (setq r (notmuch-show-goto-message-next))
+ (not (notmuch-show-get-prop :match))))
+ (if r
+ (progn
+ (notmuch-show-mark-read)
+ (notmuch-show-message-adjust))
+ (goto-char (point-max)))))
+
+(defun notmuch-show-open-if-matched ()
+ "Open a message if it is matched (whether or not excluded)."
+ (let ((props (notmuch-show-get-message-properties)))
+ (notmuch-show-message-visible props (plist-get props :match))))
+
+(defun notmuch-show-goto-first-wanted-message ()
+ "Move to the first open message and mark it read"
+ (goto-char (point-min))
+ (if (notmuch-show-message-visible-p)
+ (notmuch-show-mark-read)
+ (notmuch-show-next-open-message))
+ (when (eobp)
+ ;; There are no matched non-excluded messages so open all matched
+ ;; (necessarily excluded) messages and go to the first.
+ (notmuch-show-mapc 'notmuch-show-open-if-matched)
+ (force-window-update)
+ (goto-char (point-min))
+ (if (notmuch-show-message-visible-p)
+ (notmuch-show-mark-read)
+ (notmuch-show-next-open-message))))
+
(defun notmuch-show-previous-open-message ()
"Show the previous open message."
(interactive)
- (while (and (notmuch-show-goto-message-previous)
+ (while (and (if (= (point) (notmuch-show-message-top))
+ (notmuch-show-goto-message-previous)
+ (notmuch-show-move-to-message-top))
(not (notmuch-show-message-visible-p))))
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
(let (shell-command)
(if entire-thread
(setq shell-command
- (concat notmuch-command " show --format=mbox "
+ (concat notmuch-command " show --format=mbox --exclude=false "
(shell-quote-argument
(mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
" | " command))
(let* ((current-tags (notmuch-show-get-tags))
(new-tags (notmuch-update-tags current-tags tag-changes)))
(unless (equal current-tags new-tags)
- (apply 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
+ (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
(notmuch-show-set-tags new-tags))))
-(defun notmuch-show-tag (&optional initial-input)
- "Change tags for the current message, read input from the minibuffer."
+(defun notmuch-show-tag (&optional tag-changes)
+ "Change tags for the current message.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES."
(interactive)
- (let ((tag-changes (notmuch-read-tag-changes
- initial-input (notmuch-show-get-message-id))))
- (apply 'notmuch-show-tag-message tag-changes)))
+ (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes))
+ (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-tag-all (&rest tag-changes)
- "Change tags for all messages in the current thread.
+(defun notmuch-show-tag-all (&optional tag-changes)
+ "Change tags for all messages in the current show buffer.
-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)
+See `notmuch-tag' for information on the format of TAG-CHANGES."
+ (interactive)
+ (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes))
(notmuch-show-mapc
(lambda ()
(let* ((current-tags (notmuch-show-get-tags))
(interactive)
(notmuch-show-tag "-"))
-(defun notmuch-show-toggle-headers ()
+(defun notmuch-show-toggle-visibility-headers ()
"Toggle the visibility of the current message headers."
(interactive)
(let ((props (notmuch-show-get-message-properties)))
(defun notmuch-show-archive-thread (&optional unarchive)
"Archive each message in thread.
-If a prefix argument is given, the messages will be
-\"unarchived\" (ie. the \"inbox\" tag will be added instead of
-removed).
-
-Archive each message currently shown by removing the \"inbox\"
-tag from each. Then kill this buffer and show the next thread
-from the search from which this thread was originally shown.
+Archive each message currently shown by applying the tag changes
+in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
+default). If a prefix argument is given, the messages will be
+\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
+will be reversed.
Note: This command is safe from any race condition of new messages
being delivered to the same thread. It does not archive the
entire thread, but only the messages shown in the current
buffer."
(interactive "P")
- (let ((op (if unarchive "+" "-")))
- (notmuch-show-tag-all (concat op "inbox"))))
+ (when notmuch-archive-tags
+ (notmuch-show-tag-all
+ (notmuch-tag-change-list notmuch-archive-tags unarchive))))
(defun notmuch-show-archive-thread-then-next ()
- "Archive each message in thread, then show next thread from search."
+ "Archive all messages in the current buffer, then show next thread from search."
(interactive)
(notmuch-show-archive-thread)
(notmuch-show-next-thread t))
(defun notmuch-show-archive-thread-then-exit ()
- "Archive each message in thread, then exit back to search results."
+ "Archive all messages in the current buffer, then exit back to search results."
(interactive)
(notmuch-show-archive-thread)
(notmuch-show-next-thread))
(defun notmuch-show-archive-message (&optional unarchive)
"Archive the current message.
-If a prefix argument is given, the message will be
-\"unarchived\" (ie. the \"inbox\" tag will be added instead of
-removed)."
+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")
- (let ((op (if unarchive "+" "-")))
- (notmuch-show-tag-message (concat op "inbox"))))
+ (when notmuch-archive-tags
+ (apply 'notmuch-show-tag-message
+ (notmuch-tag-change-list notmuch-archive-tags unarchive))))
(defun notmuch-show-archive-message-then-next-or-exit ()
"Archive the current message, then show the next open message in the current thread.
(interactive)
(notmuch-common-do-stash (notmuch-show-get-from)))
-(defun notmuch-show-stash-message-id ()
- "Copy message ID of current message to kill-ring."
- (interactive)
- (notmuch-common-do-stash (notmuch-show-get-message-id)))
+(defun notmuch-show-stash-message-id (&optional stash-thread-id)
+ "Copy id: query matching the current message to kill-ring.
+
+If invoked with a prefix argument (or STASH-THREAD-ID is
+non-nil), copy thread: query matching the current thread to
+kill-ring."
+ (interactive "P")
+ (if stash-thread-id
+ (notmuch-common-do-stash notmuch-show-thread-id)
+ (notmuch-common-do-stash (notmuch-show-get-message-id))))
(defun notmuch-show-stash-message-id-stripped ()
"Copy message ID of current message (sans `id:' prefix) to kill-ring."
(interactive)
(notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))
+(defun notmuch-show-part-button-pipe (&optional button)
+ (interactive)
+ (notmuch-show-part-button-internal button #'notmuch-show-pipe-part))
+
(defun notmuch-show-part-button-internal (button handler)
(let ((button (or button (button-at (point)))))
(if button
projects / notmuch / blobdiff