X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;ds=sidebyside;f=emacs%2Fnotmuch-show.el;h=fcf7e6ee00c845f7424560e9eeea651712baa042;hb=9be349c20faea4b119c69ec63a39476ec9570d85;hp=66350d436470ffa24d543370490c33980997293d;hpb=b74ed1cfad09f578e7c05ca5676d9d3d8c512a5e;p=notmuch
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 66350d43..fcf7e6ee 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,11 +16,13 @@
;; 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
+;;; Code:
+
(eval-when-compile (require 'cl))
(require 'mm-view)
(require 'message)
@@ -47,6 +49,7 @@
(declare-function notmuch-tree "notmuch-tree"
(&optional query query-context target buffer-name open-target))
(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
+(declare-function notmuch-read-query "notmuch" (prompt))
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order.
@@ -99,6 +102,13 @@ visible for any given message."
:group 'notmuch-show
:group 'notmuch-hooks)
+(defcustom notmuch-show-max-text-part-size 100000
+ "Maximum size of a text part to be shown by default in characters.
+
+Set to 0 to show the part regardless of size."
+ :type 'integer
+ :group 'notmuch-show)
+
;; Mostly useful for debugging.
(defcustom notmuch-show-all-multipart/alternative-parts nil
"Should all parts of multipart/alternative parts be shown?"
@@ -136,29 +146,30 @@ indentation."
:type 'boolean
:group 'notmuch-show)
+;; By default, block all external images to prevent privacy leaks and
+;; potential attacks.
+(defcustom notmuch-show-text/html-blocked-images "."
+ "Remote images that have URLs matching this regexp will be blocked."
+ :type '(choice (const nil) regexp)
+ :group 'notmuch-show)
+
(defvar notmuch-show-thread-id nil)
(make-variable-buffer-local 'notmuch-show-thread-id)
-(put 'notmuch-show-thread-id 'permanent-local t)
(defvar notmuch-show-parent-buffer nil)
(make-variable-buffer-local 'notmuch-show-parent-buffer)
-(put 'notmuch-show-parent-buffer 'permanent-local t)
(defvar notmuch-show-query-context nil)
(make-variable-buffer-local 'notmuch-show-query-context)
-(put 'notmuch-show-query-context 'permanent-local t)
(defvar notmuch-show-process-crypto nil)
(make-variable-buffer-local 'notmuch-show-process-crypto)
-(put 'notmuch-show-process-crypto 'permanent-local t)
(defvar notmuch-show-elide-non-matching-messages nil)
(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
-(put 'notmuch-show-elide-non-matching-messages 'permanent-local t)
(defvar notmuch-show-indent-content t)
(make-variable-buffer-local 'notmuch-show-indent-content)
-(put 'notmuch-show-indent-content 'permanent-local t)
(defvar notmuch-show-attachment-debug nil
"If t log stdout and stderr from attachment handlers
@@ -171,9 +182,9 @@ each attachment handler is logged in buffers with names beginning
(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/")
+ ("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/")
@@ -338,8 +349,6 @@ operation on the contents of the current buffer."
'message-header-cc)
((looking-at "[Ss]ubject:")
'message-header-subject)
- ((looking-at "[Ff]rom:")
- 'message-header-from)
(t
'message-header-other))))
@@ -494,36 +503,37 @@ message at DEPTH in the current thread."
(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
@@ -599,7 +609,7 @@ 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,
@@ -632,14 +642,12 @@ will return nil if the CID is unknown or cannot be retrieved."
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)))
@@ -653,18 +661,15 @@ will return nil if the CID is unknown or cannot be retrieved."
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)))
@@ -677,6 +682,9 @@ will return nil if the CID is unknown or cannot be retrieved."
(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)))
@@ -771,14 +779,21 @@ will return nil if the CID is unknown or cannot be retrieved."
;; It's easier to drive shr ourselves than to work around the
;; goofy things `mm-shr' does (like irreversibly taking over
;; content ID handling).
- (notmuch-show--insert-part-text/html-shr msg part)
+
+ ;; FIXME: If we block an image, offer a button to load external
+ ;; images.
+ (let ((shr-blocked-images notmuch-show-text/html-blocked-images))
+ (notmuch-show--insert-part-text/html-shr msg part))
;; Otherwise, let message-mode do the heavy lifting
;;
;; w3m sets up a keymap which "leaks" outside the invisible region
;; and causes strange effects in notmuch. We set
;; mm-inline-text-html-with-w3m-keymap to nil to tell w3m not to
;; set a keymap (so the normal notmuch-show-mode-map remains).
- (let ((mm-inline-text-html-with-w3m-keymap nil))
+ (let ((mm-inline-text-html-with-w3m-keymap nil)
+ ;; FIXME: If we block an image, offer a button to load external
+ ;; images.
+ (gnus-blocked-images notmuch-show-text/html-blocked-images))
(notmuch-show-insert-part-*/* msg part content-type nth depth button))))
;; These functions are used by notmuch-show--insert-part-text/html-shr
@@ -797,11 +812,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)))))
- ;; Block all external images to prevent privacy leaks and
- ;; potential attacks. FIXME: If we block an image, offer a
- ;; button to load external images.
- (shr-blocked-images "."))
+ (first (notmuch-show--get-cid-content cid))))))
(shr-insert-document dom)
t))
@@ -830,21 +841,16 @@ 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.
+ (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"
@@ -911,30 +917,64 @@ will return nil if the CID is unknown or cannot be retrieved."
;; 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)))
(beg (point))
- ;; Hide the part initially if HIDE is t.
- (show-part (not (equal hide t)))
- ;; 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)))
+ ;; This default header-p function omits the part button for
+ ;; the first (or only) part if this is text/plain.
+ (button (when (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.
+ (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).
@@ -942,8 +982,9 @@ useful for quoting in replies)."
(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)))
+ (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.
@@ -1133,13 +1174,15 @@ 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)
@@ -1175,79 +1218,121 @@ 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 "*")))))
(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)))
+ ;; 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
notmuch-show-parent-buffer parent-buffer
- notmuch-show-query-context query-context)
- (notmuch-show-build-buffer)
- (notmuch-show-goto-first-wanted-message)
- (current-buffer)))
+ notmuch-show-query-context query-context
-(defun notmuch-show-build-buffer ()
- (let ((inhibit-read-only t))
+ notmuch-show-process-crypto notmuch-crypto-process-mime
+ ;; If `elide-toggle', invert the default value.
+ notmuch-show-elide-non-matching-messages
+ (if elide-toggle
+ (not notmuch-show-only-matching-messages)
+ notmuch-show-only-matching-messages))
- (notmuch-show-mode)
(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)
+ (if 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"
+ (when 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)))))
+ (notmuch-sanitize
+ (notmuch-show-strip-re
+ (notmuch-show-get-subject)))))
+
+ (run-hooks 'notmuch-show-hook)
- (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"
@@ -1258,14 +1343,24 @@ This includes:
")")
notmuch-show-thread-id))
+(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)))
+ (goto-char (point-min))
+ (message "Message-id not found."))
+ (notmuch-show-message-adjust))
+
(defun notmuch-show-apply-state (state)
"Apply STATE to the current buffer.
This includes:
- opening the messages previously opened,
- closing all other messages,
- - moving to the correct current message."
- (let ((current (car state))
+ - moving to the correct current message in every displayed window."
+ (let ((win-msg-alist (car state))
(open (cadr state)))
;; Open those that were open.
@@ -1274,14 +1369,10 @@ This includes:
(member (notmuch-show-get-message-id) open))
until (not (notmuch-show-goto-message-next)))
- ;; Go to the previously open message.
- (goto-char (point-min))
- (unless (loop if (string= current (notmuch-show-get-message-id))
- return t
- until (not (notmuch-show-goto-message-next)))
- (goto-char (point-min))
- (message "Previously current message not found."))
- (notmuch-show-message-adjust)))
+ (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.
@@ -1294,17 +1385,17 @@ 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)))
@@ -1331,6 +1422,7 @@ 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")
@@ -1345,6 +1437,9 @@ reset based on the original query."
(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)
@@ -1352,6 +1447,7 @@ reset based on the original query."
(define-key map "V" 'notmuch-show-view-raw-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)
@@ -1379,7 +1475,7 @@ reset based on the original query."
"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
@@ -1407,12 +1503,7 @@ 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))
@@ -1626,12 +1717,33 @@ user decision and we should not override it."
(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.
+
+Reshows the current thread with matches defined by the new query-string."
+ (interactive (list (notmuch-read-query "Filter thread: ")))
+ (let ((msg-id (notmuch-show-get-message-id)))
+ (setq notmuch-show-query-context (if (string= query "") nil query))
+ (notmuch-show-refresh-view t)
+ (notmuch-show-goto-message msg-id)))
;; Functions for getting attributes of several messages in the current
;; thread.
@@ -1758,8 +1870,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.
@@ -1841,12 +1971,15 @@ to show, nil otherwise."
"View the original source of the current message."
(interactive)
(let* ((id (notmuch-show-get-message-id))
- (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
- (let ((coding-system-for-read 'no-conversion))
- (call-process notmuch-command nil buf nil "show" "--format=raw" id))
+ (buf (get-buffer-create (concat "*notmuch-raw-" id "*")))
+ (inhibit-read-only t))
(switch-to-buffer buf)
+ (erase-buffer)
+ (let ((coding-system-for-read 'no-conversion))
+ (call-process notmuch-command nil t nil "show" "--format=raw" id))
(goto-char (point-min))
(set-buffer-modified-p nil)
+ (setq buffer-read-only t)
(view-buffer buf 'kill-buffer-if-not-modified)))
(put 'notmuch-show-pipe-message 'notmuch-doc
@@ -2220,25 +2353,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)))))
(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
@@ -2283,4 +2418,27 @@ is destroyed when FN returns."
(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))
+
(provide 'notmuch-show)
+
+;;; notmuch-show.el ends here