X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=eb07e450f34e0c80935becac89131daac9e0ff77;hb=73b8f0b8d71af395667022395b6d6bb692c3aaf2;hp=3345878f513caac3c2e58e89905eacd64976e784;hpb=bfb709851406255d87e1427b7c94f3204d9ea743;p=notmuch
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 3345878f..eb07e450 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1,4 +1,4 @@
-;; notmuch-show.el --- displaying notmuch forests.
+;;; notmuch-show.el --- displaying notmuch forests.
;;
;; Copyright © Carl Worth
;; Copyright © David Edmondson
@@ -16,12 +16,17 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see .
+;; along with Notmuch. If not, see .
;;
;; Authors: Carl Worth
;; David Edmondson
-(eval-when-compile (require 'cl))
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'pcase))
+
(require 'mm-view)
(require 'message)
(require 'mm-decode)
@@ -36,6 +41,7 @@
(require 'notmuch-mua)
(require 'notmuch-crypto)
(require 'notmuch-print)
+(require 'notmuch-draft)
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-search-next-thread "notmuch" nil)
@@ -45,9 +51,13 @@
(declare-function notmuch-count-attachments "notmuch" (mm-handle))
(declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
(declare-function notmuch-tree "notmuch-tree"
- (&optional query query-context target buffer-name open-target))
+ (&optional query query-context target buffer-name
+ open-target unthreaded))
(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
+(declare-function notmuch-unthreaded
+ (&optional query query-context target buffer-name open-target))
(declare-function notmuch-read-query "notmuch" (prompt))
+(declare-function notmuch-draft-resume "notmuch-draft" (id))
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order.
@@ -86,10 +96,11 @@ visible for any given message."
:group 'notmuch-show
:group 'notmuch-hooks)
-(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
- notmuch-wash-tidy-citations
- notmuch-wash-elide-blank-lines
- notmuch-wash-excerpt-citations)
+(defcustom notmuch-show-insert-text/plain-hook
+ '(notmuch-wash-wrap-long-lines
+ notmuch-wash-tidy-citations
+ notmuch-wash-elide-blank-lines
+ notmuch-wash-excerpt-citations)
"Functions used to improve the display of text/plain parts."
:type 'hook
:options '(notmuch-wash-convert-inline-patch-to-part
@@ -153,30 +164,24 @@ indentation."
(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)
(defvar notmuch-show-attachment-debug nil
- "If t log stdout and stderr from attachment handlers
+ "If t log stdout and stderr from attachment handlers.
When set to nil (the default) stdout and stderr from attachment
handlers is discarded. When set to t the stdout and stderr from
@@ -185,10 +190,10 @@ each attachment handler is logged in buffers with names beginning
24.3 to work.")
(defcustom notmuch-show-stash-mlarchive-link-alist
- '(("Gmane" . "http://mid.gmane.org/")
- ("MARC" . "http://marc.info/?i=")
- ("Mail Archive, The" . "http://mid.mail-archive.com/")
- ("LKML" . "http://lkml.kernel.org/r/")
+ '(("Gmane" . "https://mid.gmane.org/")
+ ("MARC" . "https://marc.info/?i=")
+ ("Mail Archive, The" . "https://mid.mail-archive.com/")
+ ("LKML" . "https://lkml.kernel.org/r/")
;; FIXME: can these services be searched by `Message-Id' ?
;; ("MarkMail" . "http://markmail.org/")
;; ("Nabble" . "http://nabble.com/")
@@ -249,12 +254,25 @@ every user interaction with notmuch."
:type 'function
:group 'notmuch-show)
+(defcustom notmuch-show-imenu-indent nil
+ "Should Imenu display messages indented.
+
+By default, Imenu (see Info node `(emacs) Imenu') in a
+notmuch-show buffer displays all messages straight. This is
+because the default Emacs frontend for Imenu makes it difficult
+to select an Imenu entry with spaces in front. Other imenu
+frontends such as counsel-imenu does not have this limitation.
+In these cases, Imenu entries can be indented to reflect the
+position of the message in the thread."
+ :type 'boolean
+ :group 'notmuch-show)
+
(defmacro with-current-notmuch-show-message (&rest body)
- "Evaluate body with current buffer set to the text of current message"
+ "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
+ (with-current-buffer buf
(let ((coding-system-for-read 'no-conversion))
(call-process notmuch-command nil t nil "show" "--format=raw" id))
,@body)
@@ -279,13 +297,12 @@ every user interaction with notmuch."
;;
;; Any MIME part not explicitly mentioned here will be handled by an
;; external viewer as configured in the various mailcap files.
- (let ((mm-inline-media-tests '(
- ("text/.*" ignore identity)
- ("application/pgp-signature" ignore identity)
- ("multipart/alternative" ignore identity)
- ("multipart/mixed" ignore identity)
- ("multipart/related" ignore identity)
- )))
+ (let ((mm-inline-media-tests
+ '(("text/.*" ignore identity)
+ ("application/pgp-signature" ignore identity)
+ ("multipart/alternative" ignore identity)
+ ("multipart/mixed" ignore identity)
+ ("multipart/related" ignore identity))))
(mm-display-parts (mm-dissect-buffer)))))
(defun notmuch-show-save-attachments ()
@@ -302,7 +319,6 @@ every user interaction with notmuch."
FN is called with one argument, the message properties. It should
operation on the contents of the current buffer."
-
;; Remake the header to ensure that all information is available.
(let* ((to (notmuch-show-get-to))
(cc (notmuch-show-get-cc))
@@ -311,7 +327,6 @@ operation on the contents of the current buffer."
(date (notmuch-show-get-date))
(tags (notmuch-show-get-tags))
(depth (notmuch-show-get-depth))
-
(header (concat
"Subject: " subject "\n"
"To: " to "\n"
@@ -331,8 +346,10 @@ operation on the contents of the current buffer."
(indenting notmuch-show-indent-content))
(with-temp-buffer
(insert all)
- (if indenting
- (indent-rigidly (point-min) (point-max) (- depth)))
+ (when indenting
+ (indent-rigidly (point-min)
+ (point-max)
+ (- (* notmuch-show-indent-messages-width depth))))
;; Remove the original header.
(goto-char (point-min))
(re-search-forward "^$" (point-max) nil)
@@ -355,7 +372,6 @@ operation on the contents of the current buffer."
'message-header-subject)
(t
'message-header-other))))
-
(overlay-put (make-overlay (point) (re-search-forward ":"))
'face 'message-header-name)
(overlay-put (make-overlay (point) (re-search-forward ".*$"))
@@ -376,69 +392,62 @@ operation on the contents of the current buffer."
"Update the displayed tags of the current message."
(save-excursion
(goto-char (notmuch-show-message-top))
- (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
- (let ((inhibit-read-only t))
- (replace-match (concat "("
- (notmuch-tag-format-tags tags (notmuch-show-get-prop :orig-tags))
- ")"))))))
+ (when (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
+ (let ((inhibit-read-only t))
+ (replace-match (concat "("
+ (notmuch-tag-format-tags
+ tags
+ (notmuch-show-get-prop :orig-tags))
+ ")"))))))
(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',
- ;; 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 " style.
- ((string-match "\\(.*\\) <\\(.*\\)>" address)
- (setq p-name (match-string 1 address)
- p-address (match-string 2 address)))
-
- ;; "" 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 ' then show just
- ;; 'foo@bar.com'.
- (when (string= p-name p-address)
- (setq p-name nil))
-
- (cons p-address p-name))
+ (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 " style.
+ ((string-match "\\(.*\\) <\\(.*\\)>" address)
+ (setq p-name (match-string 1 address))
+ (setq p-address (match-string 2 address)))
+
+ ;; "" 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.
+ (cl-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 ' then show just
+ ;; 'foo@bar.com'.
+ (when (string= p-name p-address)
+ (setq p-name nil))
+ (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."
+ "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)))
@@ -451,16 +460,23 @@ unchanged ADDRESS if parsing fails."
(defun notmuch-show-insert-headerline (headers date tags depth)
"Insert a notmuch style headerline based on HEADERS for a
message at DEPTH in the current thread."
- (let ((start (point)))
+ (let ((start (point))
+ (from (notmuch-sanitize
+ (notmuch-show-clean-address (plist-get headers :From)))))
+ (when (string-match "\\cR" from)
+ ;; If the From header has a right-to-left character add
+ ;; invisible U+200E LEFT-TO-RIGHT MARK character which forces
+ ;; the header paragraph as left-to-right text.
+ (insert (propertize (string ?\x200e) 'invisible t)))
(insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
- (notmuch-sanitize
- (notmuch-show-clean-address (plist-get headers :From)))
+ from
" ("
date
") ("
(notmuch-tag-format-tags tags tags)
")\n")
- (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
+ (overlay-put (make-overlay start (point))
+ 'face 'notmuch-message-summary-face)))
(defun notmuch-show-insert-header (header header-value)
"Insert a single header."
@@ -472,9 +488,9 @@ message at DEPTH in the current thread."
(mapc (lambda (header)
(let* ((header-symbol (intern (concat ":" header)))
(header-value (plist-get headers header-symbol)))
- (if (and header-value
- (not (string-equal "" header-value)))
- (notmuch-show-insert-header header header-value))))
+ (when (and header-value
+ (not (string-equal "" header-value)))
+ (notmuch-show-insert-header header header-value))))
notmuch-message-headers)
(save-excursion
(save-restriction
@@ -487,56 +503,54 @@ message at DEPTH in the current thread."
'face 'message-mml
:supertype 'notmuch-button-type)
-(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
- (let ((button)
- (base-label (concat (when name (concat name ": "))
+(defun notmuch-show-insert-part-header (nth content-type declared-type
+ &optional name comment)
+ (let ((base-label (concat (and name (concat name ": "))
declared-type
- (unless (string-equal declared-type content-type)
- (concat " (as " content-type ")"))
+ (and (not (string-equal declared-type content-type))
+ (concat " (as " content-type ")"))
comment)))
-
- (setq button
- (insert-button
- (concat "[ " base-label " ]")
- :base-label base-label
- :type 'notmuch-show-part-button-type
- :notmuch-part-hidden nil))
- (insert "\n")
- ;; return button
- button))
+ (prog1 (insert-button
+ (concat "[ " base-label " ]")
+ :base-label base-label
+ :type 'notmuch-show-part-button-type
+ :notmuch-part-hidden nil)
+ (insert "\n"))))
(defun notmuch-show-toggle-part-invisibility (&optional button)
(interactive)
- (let* ((button (or button (button-at (point))))
- (overlay (button-get button 'overlay))
- (lazy-part (button-get button :notmuch-lazy-part)))
- ;; We have a part to toggle if there is an overlay or if there is a lazy part.
- ;; If neither is present we cannot toggle the part so we just return nil.
- (when (or overlay lazy-part)
- (let* ((show (button-get button :notmuch-part-hidden))
- (new-start (button-start button))
- (button-label (button-get button :base-label))
- (old-point (point))
- (properties (text-properties-at (button-start button)))
- (inhibit-read-only t))
- ;; Toggle the button itself.
- (button-put button :notmuch-part-hidden (not show))
- (goto-char new-start)
- (insert "[ " button-label (if show " ]" " (hidden) ]"))
- (set-text-properties new-start (point) properties)
- (let ((old-end (button-end button)))
- (move-overlay button new-start (point))
- (delete-region (point) old-end))
- (goto-char (min old-point (1- (button-end button))))
- ;; Return nil if there is a lazy-part, it is empty, and we are
- ;; trying to show it. In all other cases return t.
- (if lazy-part
- (when show
- (button-put button :notmuch-lazy-part nil)
- (notmuch-show-lazy-part lazy-part button))
- ;; else there must be an overlay.
- (overlay-put overlay 'invisible (not show))
- t)))))
+ (let ((button (or button (button-at (point)))))
+ (when button
+ (let ((overlay (button-get button 'overlay))
+ (lazy-part (button-get button :notmuch-lazy-part)))
+ ;; We have a part to toggle if there is an overlay or if there
+ ;; is a lazy part. If neither is present we cannot toggle the
+ ;; part so we just return nil.
+ (when (or overlay lazy-part)
+ (let* ((show (button-get button :notmuch-part-hidden))
+ (new-start (button-start button))
+ (button-label (button-get button :base-label))
+ (old-point (point))
+ (properties (text-properties-at (button-start button)))
+ (inhibit-read-only t))
+ ;; Toggle the button itself.
+ (button-put button :notmuch-part-hidden (not show))
+ (goto-char new-start)
+ (insert "[ " button-label (if show " ]" " (hidden) ]"))
+ (set-text-properties new-start (point) properties)
+ (let ((old-end (button-end button)))
+ (move-overlay button new-start (point))
+ (delete-region (point) old-end))
+ (goto-char (min old-point (1- (button-end button))))
+ ;; Return nil if there is a lazy-part, it is empty, and we are
+ ;; trying to show it. In all other cases return t.
+ (if lazy-part
+ (when show
+ (button-put button :notmuch-lazy-part nil)
+ (notmuch-show-lazy-part lazy-part button))
+ ;; else there must be an overlay.
+ (overlay-put overlay 'invisible (not show))
+ t)))))))
;; Part content ID handling
@@ -559,13 +573,13 @@ message at DEPTH in the current thread."
;; Recurse on sub-parts
(let ((ctype (notmuch-split-content-type
(downcase (plist-get part :content-type)))))
- (cond ((equal (first ctype) "multipart")
+ (cond ((equal (car ctype) "multipart")
(mapc (apply-partially #'notmuch-show--register-cids msg)
(plist-get part :content)))
((equal ctype '("message" "rfc822"))
(notmuch-show--register-cids
msg
- (first (plist-get (first (plist-get part :content)) :body)))))))
+ (car (plist-get (car (plist-get part :content)) :body)))))))
(defun notmuch-show--get-cid-content (cid)
"Return a list (CID-content content-type) or nil.
@@ -576,8 +590,8 @@ enclosing angle brackets, a cid: prefix, or URL encoding. This
will return nil if the CID is unknown or cannot be retrieved."
(let ((descriptor (cdr (assoc cid notmuch-show--cids))))
(when descriptor
- (let* ((msg (first descriptor))
- (part (second descriptor))
+ (let* ((msg (car descriptor))
+ (part (cadr descriptor))
;; Request caching for this content, as some messages
;; reference the same cid: part many times (hundreds!).
(content (notmuch-get-bodypart-binary
@@ -588,11 +602,11 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-setup-w3m ()
"Instruct w3m how to retrieve content from a \"related\" part of a message."
(interactive)
- (if (boundp 'w3m-cid-retrieve-function-alist)
- (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
- (push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
- w3m-cid-retrieve-function-alist)))
- (setq mm-inline-text-html-with-images t))
+ (when (and (boundp 'w3m-cid-retrieve-function-alist)
+ (not (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)))
+ (push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
+ w3m-cid-retrieve-function-alist))
+ (setq mm-html-inhibit-images nil))
(defvar w3m-current-buffer) ;; From `w3m.el'.
(defun notmuch-show--cid-w3m-retrieve (url &rest args)
@@ -602,8 +616,8 @@ will return nil if the CID is unknown or cannot be retrieved."
(with-current-buffer w3m-current-buffer
(notmuch-show--get-cid-content cid))))
(when content-and-type
- (insert (first content-and-type))
- (second content-and-type))))
+ (insert (car content-and-type))
+ (cadr content-and-type))))
;; MIME part renderers
@@ -612,7 +626,8 @@ will return nil if the CID is unknown or cannot be retrieved."
(plist-get part :content)))
(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)
- (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+ (let ((chosen-type (car (notmuch-multipart/alternative-choose
+ msg (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,
@@ -620,8 +635,8 @@ will return nil if the CID is unknown or cannot be retrieved."
;; should be chosen if there are more than one that match?
(mapc (lambda (inner-part)
(let* ((inner-type (plist-get inner-part :content-type))
- (hide (not (or notmuch-show-all-multipart/alternative-parts
- (string= chosen-type inner-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)
@@ -632,64 +647,53 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
(let ((inner-parts (plist-get part :content))
(start (point)))
-
;; Render the primary part. FIXME: Support RFC 2387 Start header.
(notmuch-show-insert-bodypart msg (car inner-parts) depth)
;; Add hidden buttons for the rest
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth t))
(cdr inner-parts))
-
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
- (button-put button 'face 'notmuch-crypto-part-header)
- ;; add signature status button if sigstatus provided
- (if (plist-member part :sigstatus)
- (let* ((from (notmuch-show-get-header :From msg))
- (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."))
-
+ (when button
+ (button-put button 'face 'notmuch-crypto-part-header))
+ ;; Insert a button detailing the signature status.
+ (notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
+ (notmuch-show-get-header :From msg))
(let ((inner-parts (plist-get part :content))
(start (point)))
;; Show all of the parts.
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth))
inner-parts)
-
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
- (button-put button 'face 'notmuch-crypto-part-header)
- ;; add encryption status button if encstatus specified
- (if (plist-member part :encstatus)
- (let ((encstatus (car (plist-get part :encstatus))))
- (notmuch-crypto-insert-encstatus-button encstatus)
- ;; add signature status button if sigstatus specified
- (if (plist-member part :sigstatus)
- (let* ((from (notmuch-show-get-header :From msg))
- (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."))
-
+ (when button
+ (button-put button 'face 'notmuch-crypto-part-header))
+ ;; Insert a button detailing the encryption status.
+ (notmuch-crypto-insert-encstatus-button (car (plist-get part :encstatus)))
+ ;; Insert a button detailing the signature status.
+ (notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
+ (notmuch-show-get-header :From msg))
(let ((inner-parts (plist-get part :content))
(start (point)))
;; Show all of the parts.
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth))
inner-parts)
-
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
+(defun notmuch-show-insert-part-application/pgp-encrypted (msg part content-type nth depth button)
+ t)
+
(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button)
(let ((inner-parts (plist-get part :content))
(start (point)))
@@ -697,7 +701,6 @@ will return nil if the CID is unknown or cannot be retrieved."
(mapc (lambda (inner-part)
(notmuch-show-insert-bodypart msg inner-part depth))
inner-parts)
-
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
@@ -706,19 +709,15 @@ will return nil if the CID is unknown or cannot be retrieved."
(let* ((message (car (plist-get part :content)))
(body (car (plist-get message :body)))
(start (point)))
-
;; Override `notmuch-message-headers' to force `From' to be
;; displayed.
(let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
(notmuch-show-insert-headers (plist-get message :headers)))
-
;; Blank line after headers to be compatible with the normal
;; message display.
(insert "\n")
-
;; Show the body
(notmuch-show-insert-bodypart msg body depth)
-
(when notmuch-show-indent-multipart
(indent-rigidly start (point) 1)))
t)
@@ -750,7 +749,8 @@ will return nil if the CID is unknown or cannot be retrieved."
(unwind-protect
(progn
(unless (icalendar-import-buffer file t)
- (error "Icalendar import error. See *icalendar-errors* for more information"))
+ (error "Icalendar import error. %s"
+ "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)
@@ -763,28 +763,41 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
(notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
+(when (version< emacs-version "25.3")
+ ;; https://bugs.gnu.org/28350
+ ;;
+ ;; For newer emacs, we fall back to notmuch-show-insert-part-*/*
+ ;; (see notmuch-show-handlers-for)
+ (defun notmuch-show-insert-part-text/enriched
+ (msg part content-type nth depth button)
+ ;; By requiring enriched below, we ensure that the function
+ ;; enriched-decode-display-prop is defined before it will be
+ ;; shadowed by the letf below. Otherwise the version in
+ ;; enriched.el may be loaded a bit later and used instead (for
+ ;; the first time).
+ (require 'enriched)
+ (cl-letf (((symbol-function 'enriched-decode-display-prop)
+ (lambda (start end &optional param) (list start end))))
+ (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
+
(defun notmuch-show-get-mime-type-of-application/octet-stream (part)
;; If we can deduce a MIME type from the filename of the attachment,
;; we return that.
- (if (plist-get part :filename)
- (let ((extension (file-name-extension (plist-get part :filename)))
- mime-type)
- (if extension
- (progn
- (mailcap-parse-mimetypes)
- (setq mime-type (mailcap-extension-to-mime extension))
- (if (and mime-type
- (not (string-equal mime-type "application/octet-stream")))
- mime-type
- nil))
- nil))))
+ (and (plist-get part :filename)
+ (let ((extension (file-name-extension (plist-get part :filename))))
+ (and extension
+ (progn
+ (mailcap-parse-mimetypes)
+ (let ((mime-type (mailcap-extension-to-mime extension)))
+ (and mime-type
+ (not (string-equal mime-type "application/octet-stream"))
+ mime-type)))))))
(defun notmuch-show-insert-part-text/html (msg part content-type nth depth button)
(if (eq mm-text-html-renderer 'shr)
;; It's easier to drive shr ourselves than to work around the
;; goofy things `mm-shr' does (like irreversibly taking over
;; content ID handling).
-
;; FIXME: If we block an image, offer a button to load external
;; images.
(let ((shr-blocked-images notmuch-show-text/html-blocked-images))
@@ -817,7 +830,7 @@ will return nil if the CID is unknown or cannot be retrieved."
;; shr strips the "cid:" part of URL, but doesn't
;; URL-decode it (see RFC 2392).
(let ((cid (url-unhex-string url)))
- (first (notmuch-show--get-cid-content cid))))))
+ (car (notmuch-show--get-cid-content cid))))))
(shr-insert-document dom)
t))
@@ -832,8 +845,8 @@ will return nil if the CID is unknown or cannot be retrieved."
"Return a list of content handlers for a part of type CONTENT-TYPE."
(let (result)
(mapc (lambda (func)
- (if (functionp func)
- (push func result)))
+ (when (functionp func)
+ (push func result)))
;; Reverse order of prefrence.
(list (intern (concat "notmuch-show-insert-part-*/*"))
(intern (concat
@@ -846,25 +859,20 @@ will return nil if the CID is unknown or cannot be retrieved."
;;
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
- (let ((handlers (notmuch-show-handlers-for content-type)))
- ;; Run the content handlers until one of them returns a non-nil
- ;; value.
- (while (and handlers
- (not (condition-case err
- (funcall (car handlers) msg part content-type nth depth button)
- ;; Specifying `debug' here lets the debugger
- ;; run if `debug-on-error' is non-nil.
- ((debug error)
- (progn
- (insert "!!! Bodypart insert error: ")
- (insert (error-message-string err))
- (insert " !!!\n") nil)))))
- (setq handlers (cdr handlers))))
- t)
+ ;; Run the handlers until one of them succeeds.
+ (cl-loop for handler in (notmuch-show-handlers-for content-type)
+ until (condition-case err
+ (funcall handler msg part content-type nth depth button)
+ ;; Specifying `debug' here lets the debugger run if
+ ;; `debug-on-error' is non-nil.
+ ((debug error)
+ (insert "!!! Bodypart handler `" (prin1-to-string handler)
+ "' threw an error:\n"
+ "!!! " (error-message-string err) "\n")
+ nil))))
(defun notmuch-show-create-part-overlays (button beg end)
- "Add an overlay to the part between BEG and END"
-
+ "Add an overlay to the part between BEG and END."
;; If there is no button (i.e., the part is text/plain and the first
;; part) or if the part has no content then we don't make the part
;; toggleable.
@@ -874,8 +882,7 @@ will return nil if the CID is unknown or cannot be retrieved."
t))
(defun notmuch-show-record-part-information (part beg end)
- "Store PART as a text property from BEG to END"
-
+ "Store PART as a text property from BEG to END."
;; Record part information. Since we already inserted subparts,
;; don't override existing :notmuch-part properties.
(notmuch-map-text-property beg end :notmuch-part
@@ -886,13 +893,15 @@ will return nil if the CID is unknown or cannot be retrieved."
;; watch out for sticky specs of t, which means all properties are
;; front-sticky/rear-nonsticky.
(notmuch-map-text-property beg end 'front-sticky
- (lambda (v) (if (listp v)
- (pushnew :notmuch-part v)
- v)))
+ (lambda (v)
+ (if (listp v)
+ (cl-pushnew :notmuch-part v)
+ v)))
(notmuch-map-text-property beg end 'rear-nonsticky
- (lambda (v) (if (listp v)
- (pushnew :notmuch-part v)
- v))))
+ (lambda (v)
+ (if (listp v)
+ (cl-pushnew :notmuch-part v)
+ v))))
(defun notmuch-show-lazy-part (part-args button)
;; Insert the lazy part after the button for the part. We would just
@@ -917,56 +926,86 @@ will return nil if the CID is unknown or cannot be retrieved."
(narrow-to-region part-beg part-end)
(delete-region part-beg part-end)
(apply #'notmuch-show-insert-bodypart-internal part-args)
- (indent-rigidly part-beg part-end depth))
+ (indent-rigidly part-beg
+ part-end
+ (* notmuch-show-indent-messages-width depth)))
(goto-char part-end)
(delete-char 1)
- (notmuch-show-record-part-information (second part-args)
+ (notmuch-show-record-part-information (cadr part-args)
(button-start button)
part-end)
;; Create the overlay. If the lazy-part turned out to be empty/not
;; showable this returns nil.
(notmuch-show-create-part-overlays button part-beg part-end))))
+(defun notmuch-show-mime-type (part)
+ "Return the correct mime-type to use for PART."
+ (let ((content-type (downcase (plist-get part :content-type))))
+ (or (and (string= content-type "application/octet-stream")
+ (notmuch-show-get-mime-type-of-application/octet-stream part))
+ (and (string= content-type "inline patch")
+ "text/x-diff")
+ content-type)))
+
+;; The following variable can be overridden by let bindings.
+(defvar notmuch-show-insert-header-p-function 'notmuch-show-insert-header-p
+ "Specify which function decides which part headers get inserted.
+
+The function should take two parameters, PART and HIDE, and
+should return non-NIL if a header button should be inserted for
+this part.")
+
+(defun notmuch-show-insert-header-p (part hide)
+ ;; Show all part buttons except for the first part if it is text/plain.
+ (let ((mime-type (notmuch-show-mime-type part)))
+ (not (and (string= mime-type "text/plain")
+ (<= (plist-get part :id) 1)))))
+
+(defun notmuch-show-reply-insert-header-p-never (part hide)
+ nil)
+
+(defun notmuch-show-reply-insert-header-p-trimmed (part hide)
+ (let ((mime-type (notmuch-show-mime-type part)))
+ (and (not (notmuch-match-content-type mime-type "multipart/*"))
+ (not hide))))
+
+(defun notmuch-show-reply-insert-header-p-minimal (part hide)
+ (let ((mime-type (notmuch-show-mime-type part)))
+ (and (notmuch-match-content-type mime-type "text/*")
+ (not hide))))
+
(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
"Insert the body part PART at depth DEPTH in the current thread.
HIDE determines whether to show or hide the part and the button
as follows: If HIDE is nil, show the part and the button. If HIDE
-is t, hide the part initially and show the button. If HIDE is
-'no-buttons, show the part but do not add any buttons (this is
-useful for quoting in replies)."
-
+is t, hide the part initially and show the button."
(let* ((content-type (downcase (plist-get part :content-type)))
- (mime-type (or (and (string= content-type "application/octet-stream")
- (notmuch-show-get-mime-type-of-application/octet-stream part))
- (and (string= content-type "inline patch")
- "text/x-diff")
- content-type))
+ (mime-type (notmuch-show-mime-type part))
(nth (plist-get part :id))
(long (and (notmuch-match-content-type mime-type "text/*")
(> notmuch-show-max-text-part-size 0)
- (> (length (plist-get part :content)) notmuch-show-max-text-part-size)))
+ (> (length (plist-get part :content))
+ notmuch-show-max-text-part-size)))
(beg (point))
- ;; We omit the part button for the first (or only) part if
- ;; this is text/plain, or HIDE is 'no-buttons.
- (button (unless (or (equal hide 'no-buttons)
- (and (string= mime-type "text/plain") (<= nth 1)))
- (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
+ ;; This default header-p function omits the part button for
+ ;; the first (or only) part if this is text/plain.
+ (button (and (funcall notmuch-show-insert-header-p-function part hide)
+ (notmuch-show-insert-part-header
+ nth mime-type content-type
+ (plist-get part :filename))))
;; Hide the part initially if HIDE is t, or if it is too long
- ;; and we have a button to allow toggling (thus reply which
- ;; uses 'no-buttons automatically includes long parts)
+ ;; and we have a button to allow toggling.
(show-part (not (or (equal hide t)
(and long button))))
(content-beg (point)))
-
;; Store the computed mime-type for later use (e.g. by attachment handlers).
(plist-put part :computed-type mime-type)
-
(if show-part
- (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
- (button-put button :notmuch-lazy-part
- (list msg part mime-type nth depth button)))
-
+ (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
+ (when button
+ (button-put button :notmuch-lazy-part
+ (list msg part mime-type nth depth button))))
;; 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))
@@ -983,12 +1022,10 @@ useful for quoting in replies)."
(defun notmuch-show-insert-body (msg body depth)
"Insert the body BODY at depth DEPTH in the current thread."
-
;; Register all content IDs for this message. According to RFC
;; 2392, content IDs are *global*, but it's okay if an MUA treats
;; them as only global within a message.
- (notmuch-show--register-cids msg (first body))
-
+ (notmuch-show--register-cids msg (car body))
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
(defun notmuch-show-make-symbol (type)
@@ -1009,18 +1046,13 @@ useful for quoting in replies)."
content-start content-end
headers-start headers-end
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
-
(setq message-start (point-marker))
-
(notmuch-show-insert-headerline headers
- (or (if notmuch-show-relative-dates
- (plist-get msg :date_relative)
- nil)
+ (or (and notmuch-show-relative-dates
+ (plist-get msg :date_relative))
(plist-get headers :Date))
(plist-get msg :tags) depth)
-
(setq content-start (point-marker))
-
;; 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.
@@ -1030,14 +1062,11 @@ useful for quoting in replies)."
;; If the subject of this message is the same as that of the
;; previous message, don't display it when this message is
;; collapsed.
- (when (not (string= notmuch-show-previous-subject
- bare-subject))
+ (unless (string= notmuch-show-previous-subject bare-subject)
(forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
-
(setq notmuch-show-previous-subject bare-subject)
-
;; A blank line between the headers and the body.
(insert "\n")
(notmuch-show-insert-body msg (plist-get msg :body)
@@ -1046,32 +1075,28 @@ useful for quoting in replies)."
(unless (bolp)
(insert "\n"))
(setq content-end (point-marker))
-
;; Indent according to the depth in the thread.
- (if notmuch-show-indent-content
- (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)))
-
+ (when notmuch-show-indent-content
+ (indent-rigidly content-start
+ content-end
+ (* notmuch-show-indent-messages-width depth)))
(setq message-end (point-max-marker))
-
;; Save the extents of this message over the whole text of the
;; message.
- (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
-
+ (put-text-property message-start message-end
+ :notmuch-message-extent
+ (cons message-start message-end))
;; 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)
-
;; Save the properties for this message. Currently this saves the
;; entire message (augmented it with other stuff), which seems
;; like overkill. We might save a reduced subset (for example, not
;; the content).
(notmuch-show-set-message-properties msg)
-
;; Set header visibility.
(notmuch-show-headers-visible msg notmuch-message-headers-visible)
-
;; Message visibility depends on whether it matched the search
;; criteria.
(notmuch-show-message-visible msg (and (plist-get msg :match)
@@ -1089,7 +1114,8 @@ useful for quoting in replies)."
(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))
+ (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."))
@@ -1155,26 +1181,28 @@ This also turns id:\"\"-parts and mid: links into
buttons for a corresponding notmuch search."
(goto-address-fontify-region start end)
(save-excursion
- (let (links)
- (goto-char start)
- (while (re-search-forward notmuch-id-regexp end t)
+ (let (links
+ (beg-line (progn (goto-char start) (line-beginning-position)))
+ (end-line (progn (goto-char end) (line-end-position))))
+ (goto-char beg-line)
+ (while (re-search-forward notmuch-id-regexp end-line 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)
+ (goto-char beg-line)
+ (while (re-search-forward notmuch-mid-regexp end-line 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)
+ (pcase-dolist (`(,beg ,end ,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)
+ (remove-overlays beg end 'goto-address t)
+ (make-text-button beg end
:type 'notmuch-button-type
'action `(lambda (arg)
- (notmuch-show ,(third link) current-prefix-arg))
+ (notmuch-show ,link current-prefix-arg))
'follow-link t
'help-echo "Mouse-1, RET: search for this message"
'face goto-address-mail-face)))))
@@ -1197,82 +1225,125 @@ non-nil.
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."
+function is used.
+
+Returns the buffer containing the messages, or NIL if no messages
+matched."
(interactive "sNotmuch show: \nP")
(let ((buffer-name (generate-new-buffer-name
(or buffer-name
- (concat "*notmuch-" thread-id "*")))))
+ (concat "*notmuch-" thread-id "*"))))
+ ;; We override mm-inline-override-types to stop application/*
+ ;; parts from being displayed unless the user has customized
+ ;; it themselves.
+ (mm-inline-override-types
+ (if (equal mm-inline-override-types
+ (eval (car (get 'mm-inline-override-types 'standard-value))))
+ (cons "application/*" mm-inline-override-types)
+ mm-inline-override-types)))
(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
- ;; elide-toggle is set, invert the default.
- (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
- (if elide-toggle
- (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-build-buffer)
- (notmuch-show-goto-first-wanted-message)
- (current-buffer)))
-
-(defun notmuch-show-build-buffer ()
- (let ((inhibit-read-only t))
-
+ ;; No need to track undo information for this buffer.
+ (setq buffer-undo-list t)
(notmuch-show-mode)
+ ;; Set various buffer local variables to their appropriate initial
+ ;; state. Do this after enabling `notmuch-show-mode' so that they
+ ;; aren't wiped out.
+ (setq notmuch-show-thread-id thread-id)
+ (setq notmuch-show-parent-buffer parent-buffer)
+ (setq notmuch-show-query-context
+ (if (or (string= query-context "")
+ (string= query-context "*"))
+ nil
+ query-context))
+ (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
+ ;; If `elide-toggle', invert the default value.
+ (setq notmuch-show-elide-non-matching-messages
+ (if elide-toggle
+ (not notmuch-show-only-matching-messages)
+ notmuch-show-only-matching-messages))
(add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
-
- ;; Don't track undo information for this buffer
- (set 'buffer-undo-list t)
-
+ (jit-lock-register #'notmuch-show-buttonise-links)
(notmuch-tag-clear-cache)
- (erase-buffer)
- (goto-char (point-min))
- (save-excursion
- (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 "\'"))))
- (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 (append cli-args basic-args)))))
-
- (jit-lock-register #'notmuch-show-buttonise-links)
-
- (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
-
+ (let ((inhibit-read-only t))
+ (if (notmuch-show--build-buffer)
+ ;; Messages were inserted into the buffer.
+ (current-buffer)
+ ;; No messages were inserted - presumably none matched the
+ ;; query.
+ (kill-buffer (current-buffer))
+ (ding)
+ (message "No messages matched the query!")
+ nil))))
+
+(defun notmuch-show--build-queries (thread context)
+ "Return a list of queries to try for this search.
+
+THREAD and CONTEXT are both strings, though CONTEXT may be nil.
+When CONTEXT is not nil, the first query is the conjunction of it
+and THREAD. The next query is THREAD alone, and serves as a
+fallback if the prior matches no messages."
+ (let (queries)
+ (push (list thread) queries)
+ (when context
+ (push (list thread "and (" context ")") queries))
+ queries))
+
+(defun notmuch-show--build-buffer (&optional state)
+ "Display messages matching the current buffer context.
+
+Apply the previously saved STATE if supplied, otherwise show the
+first relevant message.
+
+If no messages match the query return NIL."
+ (let* ((cli-args (cons "--exclude=false"
+ (and notmuch-show-elide-non-matching-messages
+ (list "--entire-thread=false"))))
+ (queries (notmuch-show--build-queries
+ notmuch-show-thread-id notmuch-show-query-context))
+ (forest nil)
+ ;; Must be reset every time we are going to start inserting
+ ;; messages into the buffer.
+ (notmuch-show-previous-subject ""))
+ ;; Use results from the first query that returns some.
+ (while (and (not forest) queries)
+ (setq forest (notmuch-query-get-threads
+ (append cli-args (list "'") (car queries) (list "'"))))
+ (setq queries (cdr queries)))
+ (when forest
+ (notmuch-show-insert-forest forest)
+ ;; Store the original tags for each message so that we can
+ ;; display changes.
+ (notmuch-show-mapc
+ (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
;; Set the header line to the subject of the first message.
(setq header-line-format
(replace-regexp-in-string "%" "%%"
- (notmuch-sanitize
- (notmuch-show-strip-re
- (notmuch-show-get-subject)))))
-
- (run-hooks 'notmuch-show-hook))))
+ (notmuch-sanitize
+ (notmuch-show-strip-re
+ (notmuch-show-get-subject)))))
+ (run-hooks 'notmuch-show-hook)
+ (if state
+ (notmuch-show-apply-state state)
+ ;; With no state to apply, just go to the first message.
+ (notmuch-show-goto-first-wanted-message)))
+ ;; Report back to the caller whether any messages matched.
+ forest))
(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)))
+ - the combination of current message id with/for each visible window."
+ (let* ((win-list (get-buffer-window-list (current-buffer) nil t))
+ (win-id-combo (mapcar (lambda (win)
+ (with-selected-window win
+ (list win (notmuch-show-get-message-id))))
+ win-list)))
+ (list win-id-combo (notmuch-show-get-message-ids-for-open-messages))))
(defun notmuch-show-get-query ()
- "Return the current query in this show buffer"
+ "Return the current query in this show buffer."
(if notmuch-show-query-context
(concat notmuch-show-thread-id
" and ("
@@ -1283,9 +1354,9 @@ This includes:
(defun notmuch-show-goto-message (msg-id)
"Go to message with msg-id."
(goto-char (point-min))
- (unless (loop if (string= msg-id (notmuch-show-get-message-id))
- return t
- until (not (notmuch-show-goto-message-next)))
+ (unless (cl-loop if (string= msg-id (notmuch-show-get-message-id))
+ return t
+ until (not (notmuch-show-goto-message-next)))
(goto-char (point-min))
(message "Message-id not found."))
(notmuch-show-message-adjust))
@@ -1296,18 +1367,19 @@ This includes:
This includes:
- opening the messages previously opened,
- closing all other messages,
- - moving to the correct current message."
- (let ((current (car state))
+ - moving to the correct current message in every displayed window."
+ (let ((win-msg-alist (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.
- (notmuch-show-goto-message current)))
+ (cl-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)))
+ (dolist (win-msg-pair win-msg-alist)
+ (with-selected-window (car win-msg-pair)
+ ;; Go to the previously open message in this window
+ (notmuch-show-goto-message (cadr win-msg-pair))))))
(defun notmuch-show-refresh-view (&optional reset-state)
"Refresh the current view.
@@ -1320,17 +1392,16 @@ reset based on the original query."
(let ((inhibit-read-only t)
(state (unless reset-state
(notmuch-show-capture-state))))
- ;; erase-buffer does not seem to remove overlays, which can lead
+ ;; `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.
- (notmuch-show-goto-first-wanted-message))))
+ (unless (notmuch-show--build-buffer state)
+ ;; No messages were inserted.
+ (kill-buffer (current-buffer))
+ (ding)
+ (message "Refreshing the buffer resulted in no messages!"))))
(defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap)))
@@ -1348,7 +1419,7 @@ reset based on the original query."
(define-key map "G" 'notmuch-show-stash-git-send-email)
(define-key map "?" 'notmuch-subkeymap-help)
map)
- "Submap for stash commands")
+ "Submap for stash commands.")
(fset 'notmuch-show-stash-map notmuch-show-stash-map)
(defvar notmuch-show-part-map
@@ -1357,28 +1428,34 @@ reset based on the original query."
(define-key map "v" 'notmuch-show-view-part)
(define-key map "o" 'notmuch-show-interactively-view-part)
(define-key map "|" 'notmuch-show-pipe-part)
+ (define-key map "m" 'notmuch-show-choose-mime-of-part)
(define-key map "?" 'notmuch-subkeymap-help)
map)
- "Submap for part commands")
+ "Submap for part commands.")
(fset 'notmuch-show-part-map notmuch-show-part-map)
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map notmuch-common-keymap)
(define-key map "Z" 'notmuch-tree-from-show-current-query)
+ (define-key map "U" 'notmuch-unthreaded-from-show-current-query)
(define-key map (kbd "") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
(define-key map (kbd "") 'notmuch-show-previous-button)
(define-key map (kbd "TAB") 'notmuch-show-next-button)
(define-key map "f" 'notmuch-show-forward-message)
+ (define-key map "F" 'notmuch-show-forward-open-messages)
+ (define-key map "b" 'notmuch-show-resend-message)
(define-key map "l" 'notmuch-show-filter-thread)
(define-key map "r" 'notmuch-show-reply-sender)
(define-key map "R" 'notmuch-show-reply)
(define-key map "|" 'notmuch-show-pipe-message)
(define-key map "w" 'notmuch-show-save-attachments)
(define-key map "V" 'notmuch-show-view-raw-message)
+ (define-key map "e" 'notmuch-show-resume-message)
(define-key map "c" 'notmuch-show-stash-map)
(define-key map "h" 'notmuch-show-toggle-visibility-headers)
+ (define-key map "k" 'notmuch-tag-jump)
(define-key map "*" 'notmuch-show-tag-all)
(define-key map "-" 'notmuch-show-remove-tag)
(define-key map "+" 'notmuch-show-add-tag)
@@ -1402,11 +1479,12 @@ reset based on the original query."
(define-key map "<" 'notmuch-show-toggle-thread-indentation)
(define-key map "t" 'toggle-truncate-lines)
(define-key map "." 'notmuch-show-part-map)
+ (define-key map "B" 'notmuch-show-browse-urls)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
-(defun notmuch-show-mode ()
+(define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show"
"Major mode for viewing a thread with notmuch.
This buffer contains the results of the \"notmuch show\" command
@@ -1434,22 +1512,28 @@ You can add or remove arbitrary tags from the current message with
All currently available key bindings:
\\{notmuch-show-mode-map}"
- (interactive)
- (kill-all-local-variables)
(setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
- (use-local-map notmuch-show-mode-map)
- (setq major-mode 'notmuch-show-mode
- mode-name "notmuch-show")
- (setq buffer-read-only t
- truncate-lines t))
+ (setq buffer-read-only t)
+ (setq truncate-lines t)
+ (setq imenu-prev-index-position-function
+ #'notmuch-show-imenu-prev-index-position-function)
+ (setq imenu-extract-index-name-function
+ #'notmuch-show-imenu-extract-index-name-function))
(defun notmuch-tree-from-show-current-query ()
- "Call notmuch tree with the current query"
+ "Call notmuch tree with the current query."
(interactive)
(notmuch-tree notmuch-show-thread-id
notmuch-show-query-context
(notmuch-show-get-message-id)))
+(defun notmuch-unthreaded-from-show-current-query ()
+ "Call notmuch unthreaded with the current query."
+ (interactive)
+ (notmuch-unthreaded notmuch-show-thread-id
+ notmuch-show-query-context
+ (notmuch-show-get-message-id)))
+
(defun notmuch-show-move-to-message-top ()
(goto-char (notmuch-show-message-top)))
@@ -1465,6 +1549,8 @@ All currently available key bindings:
;; region a->b is not found when point is at b. We walk backwards
;; until finding the property.
(defun notmuch-show-message-extent ()
+ "Return a cons cell containing the start and end buffer offset
+of the current message."
(let (r)
(save-excursion
(while (not (setq r (get-text-property (point) :notmuch-message-extent)))
@@ -1499,8 +1585,8 @@ All currently available key bindings:
effects."
(save-excursion
(goto-char (point-min))
- (loop do (funcall function)
- while (notmuch-show-goto-message-next))))
+ (cl-loop do (funcall function)
+ while (notmuch-show-goto-message-next))))
;; Functions relating to the visibility of messages and their
;; components.
@@ -1519,7 +1605,8 @@ effects."
(defun notmuch-show-set-message-properties (props)
(save-excursion
(notmuch-show-move-to-message-top)
- (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
+ (put-text-property (point) (+ (point) 1)
+ :notmuch-message-properties props)))
(defun notmuch-show-get-message-properties ()
"Return the properties of the current message as a plist.
@@ -1585,9 +1672,10 @@ current thread."
;; dme: Would it make sense to use a macro for many of these?
+;; XXX TODO figure out what to do about multiple filenames
(defun notmuch-show-get-filename ()
"Return the filename of the current message."
- (notmuch-show-get-prop :filename))
+ (car (notmuch-show-get-prop :filename)))
(defun notmuch-show-get-header (header &optional props)
"Return the named header of the current message, if any."
@@ -1599,6 +1687,9 @@ current thread."
(defun notmuch-show-get-date ()
(notmuch-show-get-header :Date))
+(defun notmuch-show-get-timestamp ()
+ (notmuch-show-get-prop :timestamp))
+
(defun notmuch-show-get-from ()
(notmuch-show-get-header :From))
@@ -1650,15 +1741,27 @@ We only mark it read once: if it is changed back then that is a
user decision and we should not override it."
(when (and (notmuch-show-message-visible-p)
(not (notmuch-show-get-prop :seen)))
- (notmuch-show-mark-read)
- (notmuch-show-set-prop :seen t)))
+ (notmuch-show-mark-read)
+ (notmuch-show-set-prop :seen t)))
+
+(defvar notmuch-show--seen-has-errored nil)
+(make-variable-buffer-local 'notmuch-show--seen-has-errored)
(defun notmuch-show-command-hook ()
(when (eq major-mode 'notmuch-show-mode)
;; We need to redisplay to get window-start and window-end correct.
(redisplay)
(save-excursion
- (funcall notmuch-show-mark-read-function (window-start) (window-end)))))
+ (condition-case err
+ (funcall notmuch-show-mark-read-function (window-start) (window-end))
+ ((debug error)
+ (unless notmuch-show--seen-has-errored
+ (setq notmuch-show--seen-has-errored 't)
+ (setq header-line-format
+ (concat header-line-format
+ (propertize
+ " [some mark read tag changes may have failed]"
+ 'face font-lock-warning-face)))))))))
(defun notmuch-show-filter-thread (query)
"Filter or LIMIT the current thread based on a new query string.
@@ -1679,12 +1782,11 @@ Reshows the current thread with matches defined by the new query-string."
(let (message-ids done)
(goto-char (point-min))
(while (not done)
- (if (notmuch-show-message-visible-p)
- (setq message-ids (append message-ids (list (notmuch-show-get-message-id)))))
- (setq done (not (notmuch-show-goto-message-next)))
- )
- message-ids
- )))
+ (when (notmuch-show-message-visible-p)
+ (setq message-ids
+ (append message-ids (list (notmuch-show-get-message-id)))))
+ (setq done (not (notmuch-show-goto-message-next))))
+ message-ids)))
;; Commands typically bound to keys.
@@ -1713,16 +1815,13 @@ current window), advance to the next open message."
(> visible-end-of-this-message (window-end)))
;; The bottom of this message is not visible - scroll.
(scroll-up nil))
-
((not (= end-of-this-message (point-max)))
;; 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)))
@@ -1740,11 +1839,12 @@ archives the entire current thread, (apply changes in
thread from the search from which this thread was originally
shown."
(interactive)
- (if (notmuch-show-advance)
- (notmuch-show-archive-thread-then-next)))
+ (when (notmuch-show-advance)
+ (notmuch-show-archive-thread-then-next)))
(defun notmuch-show-rewind ()
- "Backup through the thread (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
+ "Backup through the thread (reverse scrolling compared to \
+\\[notmuch-show-advance-and-archive]).
Specifically, if the beginning of the previous email is fewer
than `window-height' lines from the current point, move to it
@@ -1759,9 +1859,9 @@ any effects from previous calls to
(let ((start-of-message (notmuch-show-message-top))
(start-of-window (window-start)))
(cond
- ;; Either this message is properly aligned with the start of the
- ;; window or the start of this message is not visible on the
- ;; screen - scroll.
+ ;; Either this message is properly aligned with the start of the
+ ;; window or the start of this message is not visible on the
+ ;; screen - scroll.
((or (= start-of-message start-of-window)
(< start-of-message start-of-window))
(scroll-down)
@@ -1795,8 +1895,26 @@ any effects from previous calls to
(defun notmuch-show-forward-message (&optional prompt-for-sender)
"Forward the current message."
(interactive "P")
- (with-current-notmuch-show-message
- (notmuch-mua-new-forward-message prompt-for-sender)))
+ (notmuch-mua-new-forward-messages (list (notmuch-show-get-message-id))
+ prompt-for-sender))
+
+(put 'notmuch-show-forward-open-messages 'notmuch-prefix-doc
+ "... and prompt for sender")
+(defun notmuch-show-forward-open-messages (&optional prompt-for-sender)
+ "Forward the currently open messages."
+ (interactive "P")
+ (let ((open-messages (notmuch-show-get-message-ids-for-open-messages)))
+ (unless open-messages
+ (error "No open messages to forward."))
+ (notmuch-mua-new-forward-messages open-messages prompt-for-sender)))
+
+(defun notmuch-show-resend-message (addresses)
+ "Resend the current message."
+ (interactive (list (notmuch-address-from-minibuffer "Resend to: ")))
+ (when (y-or-n-p (concat "Confirm resend to " addresses " "))
+ (notmuch-show-view-raw-message)
+ (message-resend addresses)
+ (notmuch-bury-or-kill-this-buffer)))
(defun notmuch-show-next-message (&optional pop-at-end)
"Show the next message.
@@ -1852,7 +1970,7 @@ to show, nil otherwise."
(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"
+ "Move to the first open message and mark it read."
(goto-char (point-min))
(unless (notmuch-show-message-visible-p)
(notmuch-show-next-open-message))
@@ -1889,6 +2007,11 @@ to show, nil otherwise."
(setq buffer-read-only t)
(view-buffer buf 'kill-buffer-if-not-modified)))
+(defun notmuch-show-resume-message ()
+ "Resume EDITING the current draft message."
+ (interactive)
+ (notmuch-draft-resume (notmuch-show-get-message-id)))
+
(put 'notmuch-show-pipe-message 'notmuch-doc
"Pipe the contents of the current message to a command.")
(put 'notmuch-show-pipe-message 'notmuch-prefix-doc
@@ -1913,11 +2036,14 @@ message."
(setq shell-command
(concat notmuch-command " show --format=mbox --exclude=false "
(shell-quote-argument
- (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
+ (mapconcat 'identity
+ (notmuch-show-get-message-ids-for-open-messages)
+ " OR "))
" | " command))
(setq shell-command
(concat notmuch-command " show --format=raw "
- (shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
+ (shell-quote-argument (notmuch-show-get-message-id))
+ " | " command)))
(let ((cwd default-directory)
(buf (get-buffer-create (concat "*notmuch-pipe*"))))
(with-current-buffer buf
@@ -2018,9 +2144,10 @@ argument, hide all of the messages."
(interactive)
(save-excursion
(goto-char (point-min))
- (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
- (not current-prefix-arg))
- until (not (notmuch-show-goto-message-next))))
+ (cl-loop do (notmuch-show-message-visible
+ (notmuch-show-get-message-properties)
+ (not current-prefix-arg))
+ until (not (notmuch-show-goto-message-next))))
(force-window-update))
(defun notmuch-show-next-button ()
@@ -2107,7 +2234,7 @@ message will be \"unarchived\", i.e. the tag changes in
(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.
+ "Archive current message, then show next open message in current thread.
If at the last open message in the current thread, then exit back
to search results."
@@ -2116,7 +2243,7 @@ to search results."
(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.
+ "Archive current message, then show next open message in current or next thread.
If at the last open message in the current thread, then show next
thread from search."
@@ -2130,10 +2257,17 @@ thread from search."
(interactive)
(notmuch-common-do-stash (notmuch-show-get-cc)))
-(defun notmuch-show-stash-date ()
- "Copy date of current message to kill-ring."
- (interactive)
- (notmuch-common-do-stash (notmuch-show-get-date)))
+(put 'notmuch-show-stash-date 'notmuch-prefix-doc
+ "Copy timestamp of current message to kill-ring.")
+(defun notmuch-show-stash-date (&optional stash-timestamp)
+ "Copy date of current message to kill-ring.
+
+If invoked with a prefix argument, copy timestamp of current
+message to kill-ring."
+ (interactive "P")
+ (if stash-timestamp
+ (notmuch-common-do-stash (format "%d" (notmuch-show-get-timestamp)))
+ (notmuch-common-do-stash (notmuch-show-get-date))))
(defun notmuch-show-stash-filename ()
"Copy filename of current message to kill-ring."
@@ -2260,25 +2394,27 @@ omit --in-reply-to=."
(insert (notmuch-get-bodypart-binary msg part process-crypto)))
buf))
-(defun notmuch-show-current-part-handle ()
+(defun notmuch-show-current-part-handle (&optional mime-type)
"Return an mm-handle for the part containing point.
This creates a temporary buffer for the part's content; the
-caller is responsible for killing this buffer as appropriate."
+caller is responsible for killing this buffer as appropriate. If
+MIME-TYPE is given then set the handle's mime-type to MIME-TYPE."
(let* ((msg (notmuch-show-get-message-properties))
(part (notmuch-show-get-part-properties))
(buf (notmuch-show-generate-part-buffer msg part))
- (computed-type (plist-get part :computed-type))
+ (computed-type (or mime-type (plist-get part :computed-type)))
(filename (plist-get part :filename))
- (disposition (if filename `(attachment (filename . ,filename)))))
+ (disposition (and filename `(attachment (filename . ,filename)))))
(mm-make-handle buf (list computed-type) nil nil disposition)))
-(defun notmuch-show-apply-to-current-part-handle (fn)
+(defun notmuch-show-apply-to-current-part-handle (fn &optional mime-type)
"Apply FN to an mm-handle for the part containing point.
This ensures that the temporary buffer created for the mm-handle
-is destroyed when FN returns."
- (let ((handle (notmuch-show-current-part-handle)))
+is destroyed when FN returns. If MIME-TYPE is given then force
+part to be treated as if it had that mime-type."
+ (let ((handle (notmuch-show-current-part-handle mime-type)))
;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
;; call it from a temp-buffer, unless
;; notmuch-show-attachment-debug is non-nil in which case we put
@@ -2322,5 +2458,78 @@ is destroyed when FN returns."
(interactive)
(notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
+(defun notmuch-show--mm-display-part (handle)
+ "Use mm-display-part to display HANDLE in a new buffer.
+
+If the part is displayed in an external application then close
+the new buffer."
+ (let ((buf (get-buffer-create (generate-new-buffer-name
+ (concat " *notmuch-internal-part*")))))
+ (switch-to-buffer buf)
+ (if (eq (mm-display-part handle) 'external)
+ (kill-buffer buf)
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (view-buffer buf 'kill-buffer-if-not-modified))))
+
+(defun notmuch-show-choose-mime-of-part (mime-type)
+ "Choose the mime type to use for displaying part."
+ (interactive
+ (list (completing-read "Mime type to use (default text/plain): "
+ (mailcap-mime-types) nil nil nil nil "text/plain")))
+ (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part
+ mime-type))
+
+(defun notmuch-show-imenu-prev-index-position-function ()
+ "Move point to previous message in notmuch-show buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+ (if (bobp)
+ nil
+ (notmuch-show-previous-message)
+ t))
+
+(defun notmuch-show-imenu-extract-index-name-function ()
+ "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'. Point should be at the
+beginning of the line."
+ (back-to-indentation)
+ (buffer-substring-no-properties (if notmuch-show-imenu-indent
+ (line-beginning-position)
+ (point))
+ (line-end-position)))
+
+(defmacro notmuch-show--with-currently-shown-message (&rest body)
+ "Evaluate BODY with display restricted to the currently shown
+message."
+ `(save-excursion
+ (save-restriction
+ (let ((extent (notmuch-show-message-extent)))
+ (narrow-to-region (car extent) (cdr extent))
+ ,@body))))
+
+(defun notmuch-show--gather-urls ()
+ "Gather any URLs in the current message."
+ (notmuch-show--with-currently-shown-message
+ (let (urls)
+ (goto-char (point-min))
+ (while (re-search-forward goto-address-url-regexp (point-max) t)
+ (push (match-string-no-properties 0) urls))
+ (reverse urls))))
+
+(defun notmuch-show-browse-urls (&optional kill)
+ "Offer to browse any URLs in the current message.
+With a prefix argument, copy the URL to the kill ring rather than
+browsing."
+ (interactive "P")
+ (let ((urls (notmuch-show--gather-urls))
+ (prompt (if kill "Copy URL to kill ring: " "Browse URL: "))
+ (fn (if kill #'kill-new #'browse-url)))
+ (if urls
+ (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
+ (message "No URLs found."))))
(provide 'notmuch-show)
+
+;;; notmuch-show.el ends here