-;; notmuch-show.el --- displaying notmuch forests.
+;;; notmuch-show.el --- displaying notmuch forests.
;;
;; Copyright © Carl Worth
;; Copyright © David Edmondson
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
+;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>.
;;
;; Authors: Carl Worth <cworth@cworth.org>
;; David Edmondson <dme@dme.org>
-(eval-when-compile (require 'cl))
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'pcase))
+
(require 'mm-view)
(require 'message)
(require 'mm-decode)
(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)
(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.
(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
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/")
: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"
`(save-excursion
(with-temp-buffer
(insert all)
(if indenting
- (indent-rigidly (point-min) (point-max) (- depth)))
+ (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)
(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)
+ (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))
- 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)))
+ until (string= start-of-loop p-name)))
;; If the address is 'foo@bar.com <foo@bar.com>' then show just
;; 'foo@bar.com'.
(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
;; 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.
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
(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))
+ (setq mm-html-inhibit-images nil))
(defvar w3m-current-buffer) ;; From `w3m.el'.
(defun notmuch-show--cid-w3m-retrieve (url &rest args)
(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
(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,
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)))
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)))
(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)))
(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))
+(if (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.
;; 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))
;; \f
(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"
;; 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
(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)))
(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)))
+ ;; 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 (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)))
(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.
;; 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))
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)))))
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)))
+ ;; 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 (if (or (string= query-context "")
+ (string= query-context "*"))
+ nil 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"
(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))
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)))
+ (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)))
- ;; Go to the previously open message.
- (notmuch-show-goto-message current)))
+ (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.
(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)))
(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")
(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 "<C-tab>") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
(define-key map (kbd "<backtab>") '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)
(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
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))
+ 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"
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)))
;; 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)))
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.
;; 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."
(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))
(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.
(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.
"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)))
+(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
(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 ()
(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."
(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."
(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."
(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
(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
projects / notmuch / blobdiff