-;; 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>
+;;; Code:
+
(eval-when-compile (require 'cl))
(require 'mm-view)
(require 'message)
(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-save-attachments "notmuch" (mm-handle &optional queryp))
(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))
+(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.
: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?"
: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
(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/")
:type '(repeat string)
:group 'notmuch-show)
+(defcustom notmuch-show-mark-read-function #'notmuch-show-seen-current-message
+ "Function to control which messages are marked read.
+
+The function should take two arguments START and END which will
+be the start and end of the visible portion of the buffer and
+should mark the appropriate messages read by applying
+`notmuch-show-mark-read'. This function will be called after
+every user interaction with notmuch."
+ :type 'function
+ :group 'notmuch-show)
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
(let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
(with-current-buffer buf
(let ((coding-system-for-read 'no-conversion))
- (call-process notmuch-command nil t nil "show" "--format=raw" id)
- ,@body)
- (kill-buffer buf))))))
+ (call-process notmuch-command nil t nil "show" "--format=raw" id))
+ ,@body)
+ (kill-buffer buf)))))
(defun notmuch-show-turn-on-visual-line-mode ()
"Enable Visual Line mode."
'message-header-cc)
((looking-at "[Ss]ubject:")
'message-header-subject)
- ((looking-at "[Ff]rom:")
- 'message-header-from)
(t
'message-header-other))))
(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
+
+(defvar notmuch-show--cids nil
+ "Alist from raw content ID to (MSG PART).")
+(make-variable-buffer-local 'notmuch-show--cids)
+
+(defun notmuch-show--register-cids (msg part)
+ "Register content-IDs in PART and all of PART's sub-parts."
+ (let ((content-id (plist-get part :content-id)))
+ (when content-id
+ ;; Note that content-IDs are globally unique, except when they
+ ;; aren't: RFC 2046 section 5.1.4 permits children of a
+ ;; multipart/alternative to have the same content-ID, in which
+ ;; case the MUA is supposed to pick the best one it can render.
+ ;; We simply add the content-ID to the beginning of our alist;
+ ;; so if this happens, we'll take the last (and "best")
+ ;; alternative (even if we can't render it).
+ (push (list content-id msg part) notmuch-show--cids)))
+ ;; Recurse on sub-parts
+ (let ((ctype (notmuch-split-content-type
+ (downcase (plist-get part :content-type)))))
+ (cond ((equal (first 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)))))))
+
+(defun notmuch-show--get-cid-content (cid)
+ "Return a list (CID-content content-type) or nil.
+
+This will only find parts from messages that have been inserted
+into the current buffer. CID must be a raw content ID, without
+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))
+ ;; Request caching for this content, as some messages
+ ;; reference the same cid: part many times (hundreds!).
+ (content (notmuch-get-bodypart-binary
+ msg part notmuch-show-process-crypto 'cache))
+ (content-type (plist-get part :content-type)))
+ (list content content-type)))))
+
+(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))
+
+(defvar w3m-current-buffer) ;; From `w3m.el'.
+(defun notmuch-show--cid-w3m-retrieve (url &rest args)
+ ;; url includes the cid: prefix and is URL encoded (see RFC 2392).
+ (let* ((cid (url-unhex-string (substring url 4)))
+ (content-and-type
+ (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))))
;; 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,
(indent-rigidly start (point) 1)))
t)
-(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-w3m-cid-retrieve)
- w3m-cid-retrieve-function-alist)))
- (setq mm-inline-text-html-with-images t))
-
-(defvar w3m-current-buffer) ;; From `w3m.el'.
-(defvar notmuch-show-w3m-cid-store nil)
-(make-variable-buffer-local 'notmuch-show-w3m-cid-store)
-
-(defun notmuch-show-w3m-cid-store-internal (content-id
- message-id
- part-number
- content-type
- content)
- (push (list content-id
- message-id
- part-number
- content-type
- content)
- notmuch-show-w3m-cid-store))
-
-(defun notmuch-show-w3m-cid-store (msg part)
- (let ((content-id (plist-get part :content-id)))
- (when content-id
- (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
- (plist-get msg :id)
- (plist-get part :id)
- (plist-get part :content-type)
- nil))))
-
-(defun notmuch-show-w3m-cid-retrieve (url &rest args)
- (let ((matching-part (with-current-buffer w3m-current-buffer
- (assoc url notmuch-show-w3m-cid-store))))
- (if matching-part
- (let ((message-id (nth 1 matching-part))
- (part-number (nth 2 matching-part))
- (content-type (nth 3 matching-part))
- (content (nth 4 matching-part)))
- ;; If we don't already have the content, get it and cache
- ;; it, as some messages reference the same cid: part many
- ;; times (hundreds!), which results in many calls to
- ;; `notmuch part'.
- (unless content
- (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
- part-number notmuch-show-process-crypto))
- (with-current-buffer w3m-current-buffer
- (notmuch-show-w3m-cid-store-internal url
- message-id
- part-number
- content-type
- content)))
- (insert content)
- content-type)
- nil)))
-
(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
(let ((inner-parts (plist-get part :content))
(start (point)))
- ;; We assume that the first part is text/html and the remainder
- ;; things that it references.
-
- ;; Stash the non-primary parts.
- (mapc (lambda (part)
- (notmuch-show-w3m-cid-store msg part))
- (cdr inner-parts))
-
- ;; Render the primary part.
+ ;; 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)
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)))
(let ((start (if button
(button-start button)
(point))))
- (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
+ (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto))
(save-excursion
(save-restriction
(narrow-to-region start (point-max))
(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth button)
(insert (with-temp-buffer
- (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
- ;; notmuch-get-bodypart-content provides "raw", non-converted
- ;; data. Replace CRLF with LF before icalendar can use it.
+ (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto))
+ ;; notmuch-get-bodypart-text does no newline conversion.
+ ;; Replace CRLF with LF before icalendar can use it.
(goto-char (point-min))
(while (re-search-forward "\r\n" nil t)
(replace-match "\n" nil nil))
nil))))
(defun notmuch-show-insert-part-text/html (msg part content-type nth depth button)
- ;; text/html handler to work around bugs in renderers and our
- ;; invisibile parts code. In particular 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))
- (notmuch-show-insert-part-*/* 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))
+ (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)
+ ;; 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
+(declare-function libxml-parse-html-region "xml.c")
+(declare-function shr-insert-document "shr")
+
+(defun notmuch-show--insert-part-text/html-shr (msg part)
+ ;; Make sure shr is loaded before we start let-binding its globals
+ (require 'shr)
+ (let ((dom (let ((process-crypto notmuch-show-process-crypto))
+ (with-temp-buffer
+ (insert (notmuch-get-bodypart-text msg part process-crypto))
+ (libxml-parse-html-region (point-min) (point-max)))))
+ (shr-content-function
+ (lambda (url)
+ ;; 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))))))
+ (shr-insert-document dom)
+ t))
(defun notmuch-show-insert-part-*/* (msg part content-type nth depth button)
;; This handler _must_ succeed - it is the handler of last resort.
- (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
+ (notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto)
t)
;; Functions for determining how to handle MIME parts.
;; \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.
+ (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"
;; 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).
(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.
(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))
+
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
(defun notmuch-show-make-symbol (type)
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)
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 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)
- ;; Don't track undo information for this buffer
- (set 'buffer-undo-list t)
+ (add-hook 'post-command-hook #'notmuch-show-command-hook nil 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 (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject))))
+ (setq header-line-format
+ (replace-regexp-in-string "%" "%%"
+ (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"
+ (if notmuch-show-query-context
+ (concat notmuch-show-thread-id
+ " and ("
+ notmuch-show-query-context
+ ")")
+ 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.
(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.
(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 "t" 'notmuch-show-stash-to)
(define-key map "l" 'notmuch-show-stash-mlarchive-link)
(define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
+ (define-key map "G" 'notmuch-show-stash-git-send-email)
(define-key map "?" 'notmuch-subkeymap-help)
map)
"Submap for stash commands")
(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")
(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 (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 "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 "c" 'notmuch-show-stash-map)
- (define-key map "h" 'notmuch-show-toggle-visibility-headers)
- (define-key map "*" 'notmuch-show-tag-all)
- (define-key map "-" 'notmuch-show-remove-tag)
- (define-key map "+" 'notmuch-show-add-tag)
- (define-key map "X" 'notmuch-show-archive-thread-then-exit)
- (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit)
- (define-key map "A" 'notmuch-show-archive-thread-then-next)
- (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread)
- (define-key map "N" 'notmuch-show-next-message)
- (define-key map "P" 'notmuch-show-previous-message)
- (define-key map "n" 'notmuch-show-next-open-message)
- (define-key map "p" 'notmuch-show-previous-open-message)
- (define-key map (kbd "M-n") 'notmuch-show-next-thread-show)
- (define-key map (kbd "M-p") 'notmuch-show-previous-thread-show)
- (define-key map (kbd "DEL") 'notmuch-show-rewind)
- (define-key map " " 'notmuch-show-advance-and-archive)
- (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
- (define-key map (kbd "RET") 'notmuch-show-toggle-message)
- (define-key map "#" 'notmuch-show-print-message)
- (define-key map "!" 'notmuch-show-toggle-elide-non-matching)
- (define-key map "$" 'notmuch-show-toggle-process-crypto)
- (define-key map "<" 'notmuch-show-toggle-thread-indentation)
- (define-key map "t" 'toggle-truncate-lines)
- (define-key map "." 'notmuch-show-part-map)
- map)
- "Keymap for \"notmuch show\" buffers.")
+ (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 (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 "X" 'notmuch-show-archive-thread-then-exit)
+ (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit)
+ (define-key map "A" 'notmuch-show-archive-thread-then-next)
+ (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread)
+ (define-key map "N" 'notmuch-show-next-message)
+ (define-key map "P" 'notmuch-show-previous-message)
+ (define-key map "n" 'notmuch-show-next-open-message)
+ (define-key map "p" 'notmuch-show-previous-open-message)
+ (define-key map (kbd "M-n") 'notmuch-show-next-thread-show)
+ (define-key map (kbd "M-p") 'notmuch-show-previous-thread-show)
+ (define-key map (kbd "DEL") 'notmuch-show-rewind)
+ (define-key map " " 'notmuch-show-advance-and-archive)
+ (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
+ (define-key map (kbd "RET") 'notmuch-show-toggle-message)
+ (define-key map "#" 'notmuch-show-print-message)
+ (define-key map "!" 'notmuch-show-toggle-elide-non-matching)
+ (define-key map "$" 'notmuch-show-toggle-process-crypto)
+ (define-key map "<" 'notmuch-show-toggle-thread-indentation)
+ (define-key map "t" 'toggle-truncate-lines)
+ (define-key map "." 'notmuch-show-part-map)
+ 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))
(notmuch-show-set-message-properties props)))
(defun notmuch-show-get-prop (prop &optional props)
+ "Get property PROP from current message in show or tree mode.
+
+It gets property PROP from PROPS or, if PROPS is nil, the current
+message in either tree or show. This means that several utility
+functions in notmuch-show can be used directly by notmuch-tree as
+they just need the correct message properties."
(let ((props (or props
- (notmuch-show-get-message-properties))))
+ (cond ((eq major-mode 'notmuch-show-mode)
+ (notmuch-show-get-message-properties))
+ ((eq major-mode 'notmuch-tree-mode)
+ (notmuch-tree-get-message-properties))
+ (t nil)))))
(plist-get props prop)))
(defun notmuch-show-get-message-id (&optional bare)
(apply 'notmuch-show-tag-message
(notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
+(defun notmuch-show-seen-current-message (start end)
+ "Mark the current message read if it is open.
+
+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)))
+
+(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
+ (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.
(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.
thread, navigate to the next thread in the parent search buffer."
(interactive "P")
(if (notmuch-show-goto-message-next)
- (progn
- (notmuch-show-mark-read)
- (notmuch-show-message-adjust))
+ (notmuch-show-message-adjust)
(if pop-at-end
(notmuch-show-next-thread)
(goto-char (point-max)))))
(if (= (point) (notmuch-show-message-top))
(notmuch-show-goto-message-previous)
(notmuch-show-move-to-message-top))
- (notmuch-show-mark-read)
(notmuch-show-message-adjust))
(defun notmuch-show-next-open-message (&optional pop-at-end)
(while (and (setq r (notmuch-show-goto-message-next))
(not (notmuch-show-message-visible-p))))
(if r
- (progn
- (notmuch-show-mark-read)
- (notmuch-show-message-adjust))
+ (notmuch-show-message-adjust)
(if pop-at-end
(notmuch-show-next-thread)
(goto-char (point-max))))
(while (and (setq r (notmuch-show-goto-message-next))
(not (notmuch-show-get-prop :match))))
(if r
- (progn
- (notmuch-show-mark-read)
- (notmuch-show-message-adjust))
+ (notmuch-show-message-adjust)
(goto-char (point-max)))))
(defun notmuch-show-open-if-matched ()
(defun notmuch-show-goto-first-wanted-message ()
"Move to the first open message and mark it read"
(goto-char (point-min))
- (if (notmuch-show-message-visible-p)
- (notmuch-show-mark-read)
+ (unless (notmuch-show-message-visible-p)
(notmuch-show-next-open-message))
(when (eobp)
;; There are no matched non-excluded messages so open all matched
(notmuch-show-mapc 'notmuch-show-open-if-matched)
(force-window-update)
(goto-char (point-min))
- (if (notmuch-show-message-visible-p)
- (notmuch-show-mark-read)
+ (unless (notmuch-show-message-visible-p)
(notmuch-show-next-open-message))))
(defun notmuch-show-previous-open-message ()
(notmuch-show-goto-message-previous)
(notmuch-show-move-to-message-top))
(not (notmuch-show-message-visible-p))))
- (notmuch-show-mark-read)
(notmuch-show-message-adjust))
(defun notmuch-show-view-raw-message ()
- "View the file holding the current 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 "*"))))
- (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
search results instead."
(interactive "P")
(let ((parent-buffer notmuch-show-parent-buffer))
- (notmuch-kill-this-buffer)
+ (notmuch-bury-or-kill-this-buffer)
(when (buffer-live-p parent-buffer)
(switch-to-buffer parent-buffer)
(and (if previous
(notmuch-show-stash-mlarchive-link mla)
(browse-url (current-kill 0 t)))
+(defun notmuch-show-stash-git-helper (addresses prefix)
+ "Escape, trim, quote, and add PREFIX to each address in list of ADDRESSES, and return the result as a single string."
+ (mapconcat (lambda (x)
+ (concat prefix "\""
+ ;; escape double-quotes
+ (replace-regexp-in-string
+ "\"" "\\\\\""
+ ;; trim leading and trailing spaces
+ (replace-regexp-in-string
+ "\\(^ *\\| *$\\)" ""
+ x)) "\""))
+ addresses " "))
+
+(put 'notmuch-show-stash-git-send-email 'notmuch-prefix-doc
+ "Copy From/To/Cc of current message to kill-ring in a form suitable for pasting to git send-email command line.")
+
+(defun notmuch-show-stash-git-send-email (&optional no-in-reply-to)
+ "Copy From/To/Cc/Message-Id of current message to kill-ring in a form suitable for pasting to git send-email command line.
+
+If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil),
+omit --in-reply-to=<Message-Id>."
+ (interactive "P")
+ (notmuch-common-do-stash
+ (mapconcat 'identity
+ (remove ""
+ (list
+ (notmuch-show-stash-git-helper
+ (message-tokenize-header (notmuch-show-get-from)) "--to=")
+ (notmuch-show-stash-git-helper
+ (message-tokenize-header (notmuch-show-get-to)) "--to=")
+ (notmuch-show-stash-git-helper
+ (message-tokenize-header (notmuch-show-get-cc)) "--cc=")
+ (unless no-in-reply-to
+ (notmuch-show-stash-git-helper
+ (list (notmuch-show-get-message-id t)) "--in-reply-to="))))
+ " ")))
+
;; Interactive part functions and their helpers
-(defun notmuch-show-generate-part-buffer (message-id nth)
+(defun notmuch-show-generate-part-buffer (msg part)
"Return a temporary buffer containing the specified part's content."
(let ((buf (generate-new-buffer " *notmuch-part*"))
(process-crypto notmuch-show-process-crypto))
(with-current-buffer buf
- (setq notmuch-show-process-crypto process-crypto)
- ;; Always acquires the part via `notmuch part', even if it is
- ;; available in the SEXP output.
- (insert (notmuch-get-bodypart-internal message-id nth notmuch-show-process-crypto)))
+ ;; This is always used in the content of mm handles, which
+ ;; expect undecoded, binary part content.
+ (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."
- (let* ((part (notmuch-show-get-part-properties))
- (message-id (notmuch-show-get-message-id))
- (nth (plist-get part :id))
- (buf (notmuch-show-generate-part-buffer message-id nth))
- (computed-type (plist-get part :computed-type))
+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 (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))
+
(provide 'notmuch-show)
+
+;;; notmuch-show.el ends here
projects / notmuch / blobdiff