X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=079281c341f0ea433d569d441f592ccea8058db6;hp=245114b719dac78726c2d47dc49e92679c79f30c;hb=e083987338ab058fff826242c0a7b533f5a453ba;hpb=dc13fcbf8755506b2681ef3c44da98737ddab8e8 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 245114b7..079281c3 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -1,4 +1,4 @@ -;; notmuch-show.el --- displaying notmuch forests. +;;; notmuch-show.el --- displaying notmuch forests. ;; ;; Copyright © Carl Worth ;; Copyright © David Edmondson @@ -16,11 +16,13 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with Notmuch. If not, see . +;; along with Notmuch. If not, see . ;; ;; Authors: Carl Worth ;; David Edmondson +;;; Code: + (eval-when-compile (require 'cl)) (require 'mm-view) (require 'message) @@ -36,6 +38,7 @@ (require 'notmuch-mua) (require 'notmuch-crypto) (require 'notmuch-print) +(require 'notmuch-draft) (declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) (declare-function notmuch-search-next-thread "notmuch" nil) @@ -45,9 +48,12 @@ (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. @@ -179,10 +185,10 @@ each attachment handler is logged in buffers with names beginning 24.3 to work.") (defcustom notmuch-show-stash-mlarchive-link-alist - '(("Gmane" . "http://mid.gmane.org/") - ("MARC" . "http://marc.info/?i=") - ("Mail Archive, The" . "http://mid.mail-archive.com/") - ("LKML" . "http://lkml.kernel.org/r/") + '(("Gmane" . "https://mid.gmane.org/") + ("MARC" . "https://marc.info/?i=") + ("Mail Archive, The" . "https://mid.mail-archive.com/") + ("LKML" . "https://lkml.kernel.org/r/") ;; FIXME: can these services be searched by `Message-Id' ? ;; ("MarkMail" . "http://markmail.org/") ;; ("Nabble" . "http://nabble.com/") @@ -243,6 +249,19 @@ every user interaction with notmuch." :type 'function :group 'notmuch-show) +(defcustom notmuch-show-imenu-indent nil + "Should Imenu display messages indented. + +By default, Imenu (see Info node `(emacs) Imenu') in a +notmuch-show buffer displays all messages straight. This is +because the default Emacs frontend for Imenu makes it difficult +to select an Imenu entry with spaces in front. Other imenu +frontends such as counsel-imenu does not have this limitation. +In these cases, Imenu entries can be indented to reflect the +position of the message in the thread." + :type 'boolean + :group 'notmuch-show) + (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" `(save-excursion @@ -326,7 +345,7 @@ operation on the contents of the current buffer." (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) @@ -587,7 +606,7 @@ will return nil if the CID is unknown or cannot be retrieved." (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) @@ -607,7 +626,7 @@ will return nil if the CID is unknown or cannot be retrieved." (plist-get part :content))) (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button) - (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) + (let ((chosen-type (car (notmuch-multipart/alternative-choose msg (notmuch-show-multipart/*-to-list part)))) (inner-parts (plist-get part :content)) (start (point))) ;; This inserts all parts of the chosen type rather than just one, @@ -642,15 +661,10 @@ will return nil if the CID is unknown or cannot be retrieved." (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button) (when 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 the signature status, tell the user how - ;; they can get it. - (when button - (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))) + + ;; 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))) @@ -666,19 +680,13 @@ will return nil if the CID is unknown or cannot be retrieved." (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button) (when button (button-put button 'face 'notmuch-crypto-part-header)) - ;; Add encryption status button if encryption status is specified. - (if (plist-member part :encstatus) - (let ((encstatus (car (plist-get part :encstatus)))) - (notmuch-crypto-insert-encstatus-button encstatus) - ;; Add signature status button if signature status is - ;; 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 the encryption status, tell the user how - ;; they can get it. - (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")) + + ;; 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))) @@ -691,6 +699,9 @@ will return nil if the CID is unknown or cannot be retrieved." (indent-rigidly start (point) 1))) t) +(defun notmuch-show-insert-part-application/pgp-encrypted (msg part content-type nth depth button) + t) + (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button) (let ((inner-parts (plist-get part :content)) (start (point))) @@ -764,6 +775,20 @@ will return nil if the CID is unknown or cannot be retrieved." (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button) (notmuch-show-insert-part-text/calendar msg part content-type nth depth button)) +(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) + (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. @@ -847,21 +872,16 @@ will return nil if the CID is unknown or cannot be retrieved." ;; (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button) - (let ((handlers (notmuch-show-handlers-for content-type))) - ;; Run the content handlers until one of them returns a non-nil - ;; value. - (while (and handlers - (not (condition-case err - (funcall (car handlers) msg part content-type nth depth button) - ;; Specifying `debug' here lets the debugger - ;; run if `debug-on-error' is non-nil. - ((debug error) - (progn - (insert "!!! Bodypart insert error: ") - (insert (error-message-string err)) - (insert " !!!\n") nil))))) - (setq handlers (cdr handlers)))) - t) + ;; Run the handlers until one of them succeeds. + (loop for handler in (notmuch-show-handlers-for content-type) + until (condition-case err + (funcall handler msg part content-type nth depth button) + ;; Specifying `debug' here lets the debugger run if + ;; `debug-on-error' is non-nil. + ((debug error) + (insert "!!! Bodypart handler `" (prin1-to-string handler) "' threw an error:\n" + "!!! " (error-message-string err) "\n") + nil)))) (defun notmuch-show-create-part-overlays (button beg end) "Add an overlay to the part between BEG and END" @@ -918,7 +938,7 @@ will return nil if the CID is unknown or cannot be retrieved." (narrow-to-region part-beg part-end) (delete-region part-beg part-end) (apply #'notmuch-show-insert-bodypart-internal part-args) - (indent-rigidly part-beg part-end depth)) + (indent-rigidly part-beg part-end (* notmuch-show-indent-messages-width depth))) (goto-char part-end) (delete-char 1) (notmuch-show-record-part-information (second part-args) @@ -1185,13 +1205,15 @@ This also turns id:\"\"-parts and mid: links into buttons for a corresponding notmuch search." (goto-address-fontify-region start end) (save-excursion - (let (links) - (goto-char start) - (while (re-search-forward notmuch-id-regexp end t) + (let (links + (beg-line (progn (goto-char start) (line-beginning-position))) + (end-line (progn (goto-char end) (line-end-position)))) + (goto-char beg-line) + (while (re-search-forward notmuch-id-regexp end-line t) (push (list (match-beginning 0) (match-end 0) (match-string-no-properties 0)) links)) - (goto-char start) - (while (re-search-forward notmuch-mid-regexp end t) + (goto-char beg-line) + (while (re-search-forward notmuch-mid-regexp end-line t) (let* ((mid-cid (match-string-no-properties 1)) (mid (save-match-data (string-match "^[^/]*" mid-cid) @@ -1234,7 +1256,15 @@ 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)) ;; No need to track undo information for this buffer. (setq buffer-undo-list t) @@ -1246,7 +1276,9 @@ matched." ;; 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-query-context (if (or (string= query-context "") + (string= query-context "*")) + nil query-context) notmuch-show-process-crypto notmuch-crypto-process-mime ;; If `elide-toggle', invert the default value. @@ -1272,6 +1304,18 @@ matched." (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. @@ -1279,25 +1323,20 @@ Apply the previously saved STATE if supplied, otherwise show the first relevant message. If no messages match the query return NIL." - (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" + (let* ((cli-args (cons "--exclude=false" (when notmuch-show-elide-non-matching-messages (list "--entire-thread=false")))) - - (forest (or (notmuch-query-get-threads (append cli-args args)) - ;; If a query context reduced the number of - ;; results to zero, try again without it. - (and notmuch-show-query-context - (notmuch-query-get-threads (append cli-args basic-args))))) - + (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) @@ -1328,8 +1367,13 @@ If no messages match the query return NIL." 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" @@ -1356,8 +1400,8 @@ This includes: This includes: - opening the messages previously opened, - closing all other messages, - - moving to the correct current message." - (let ((current (car state)) + - moving to the correct current message in every displayed window." + (let ((win-msg-alist (car state)) (open (cadr state))) ;; Open those that were open. @@ -1366,8 +1410,10 @@ This includes: (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. @@ -1417,6 +1463,7 @@ reset based on the original query." (define-key map "v" 'notmuch-show-view-part) (define-key map "o" 'notmuch-show-interactively-view-part) (define-key map "|" 'notmuch-show-pipe-part) + (define-key map "m" 'notmuch-show-choose-mime-of-part) (define-key map "?" 'notmuch-subkeymap-help) map) "Submap for part commands") @@ -1426,20 +1473,24 @@ reset based on the original query." (let ((map (make-sparse-keymap))) (set-keymap-parent map notmuch-common-keymap) (define-key map "Z" 'notmuch-tree-from-show-current-query) + (define-key map "U" 'notmuch-unthreaded-from-show-current-query) (define-key map (kbd "") 'widget-backward) (define-key map (kbd "M-TAB") 'notmuch-show-previous-button) (define-key map (kbd "") 'notmuch-show-previous-button) (define-key map (kbd "TAB") 'notmuch-show-next-button) (define-key map "f" 'notmuch-show-forward-message) (define-key map "F" 'notmuch-show-forward-open-messages) + (define-key map "b" 'notmuch-show-resend-message) (define-key map "l" 'notmuch-show-filter-thread) (define-key map "r" 'notmuch-show-reply-sender) (define-key map "R" 'notmuch-show-reply) (define-key map "|" 'notmuch-show-pipe-message) (define-key map "w" 'notmuch-show-save-attachments) (define-key map "V" 'notmuch-show-view-raw-message) + (define-key map "e" 'notmuch-show-resume-message) (define-key map "c" 'notmuch-show-stash-map) (define-key map "h" 'notmuch-show-toggle-visibility-headers) + (define-key map "k" 'notmuch-tag-jump) (define-key map "*" 'notmuch-show-tag-all) (define-key map "-" 'notmuch-show-remove-tag) (define-key map "+" 'notmuch-show-add-tag) @@ -1463,11 +1514,12 @@ reset based on the original query." (define-key map "<" 'notmuch-show-toggle-thread-indentation) (define-key map "t" 'toggle-truncate-lines) (define-key map "." 'notmuch-show-part-map) + (define-key map "B" 'notmuch-show-browse-urls) map) "Keymap for \"notmuch show\" buffers.") (fset 'notmuch-show-mode-map notmuch-show-mode-map) -(defun notmuch-show-mode () +(define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show" "Major mode for viewing a thread with notmuch. This buffer contains the results of the \"notmuch show\" command @@ -1495,14 +1547,13 @@ You can add or remove arbitrary tags from the current message with All currently available key bindings: \\{notmuch-show-mode-map}" - (interactive) - (kill-all-local-variables) (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view) - (use-local-map notmuch-show-mode-map) - (setq major-mode 'notmuch-show-mode - mode-name "notmuch-show") (setq buffer-read-only t - truncate-lines t)) + 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" @@ -1511,6 +1562,13 @@ All currently available key bindings: 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))) @@ -1526,6 +1584,8 @@ All currently available key bindings: ;; region a->b is not found when point is at b. We walk backwards ;; until finding the property. (defun notmuch-show-message-extent () + "Return a cons cell containing the start and end buffer offset +of the current message." (let (r) (save-excursion (while (not (setq r (get-text-property (point) :notmuch-message-extent))) @@ -1646,9 +1706,10 @@ current thread." ;; dme: Would it make sense to use a macro for many of these? +;; XXX TODO figure out what to do about multiple filenames (defun notmuch-show-get-filename () "Return the filename of the current message." - (notmuch-show-get-prop :filename)) + (car (notmuch-show-get-prop :filename))) (defun notmuch-show-get-header (header &optional props) "Return the named header of the current message, if any." @@ -1660,6 +1721,9 @@ current thread." (defun notmuch-show-get-date () (notmuch-show-get-header :Date)) +(defun notmuch-show-get-timestamp () + (notmuch-show-get-prop :timestamp)) + (defun notmuch-show-get-from () (notmuch-show-get-header :From)) @@ -1714,12 +1778,23 @@ user decision and we should not override it." (notmuch-show-mark-read) (notmuch-show-set-prop :seen t))) +(defvar notmuch-show--seen-has-errored nil) +(make-variable-buffer-local 'notmuch-show--seen-has-errored) + (defun notmuch-show-command-hook () (when (eq major-mode 'notmuch-show-mode) ;; We need to redisplay to get window-start and window-end correct. (redisplay) (save-excursion - (funcall notmuch-show-mark-read-function (window-start) (window-end))))) + (condition-case err + (funcall notmuch-show-mark-read-function (window-start) (window-end)) + ((debug error) + (unless notmuch-show--seen-has-errored + (setq notmuch-show--seen-has-errored 't) + (setq header-line-format + (concat header-line-format + (propertize " [some mark read tag changes may have failed]" + 'face font-lock-warning-face))))))))) (defun notmuch-show-filter-thread (query) "Filter or LIMIT the current thread based on a new query string. @@ -1869,6 +1944,14 @@ any effects from previous calls to (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. @@ -1960,6 +2043,11 @@ to show, nil otherwise." (setq buffer-read-only t) (view-buffer buf 'kill-buffer-if-not-modified))) +(defun notmuch-show-resume-message () + "Resume EDITING the current draft message." + (interactive) + (notmuch-draft-resume (notmuch-show-get-message-id))) + (put 'notmuch-show-pipe-message 'notmuch-doc "Pipe the contents of the current message to a command.") (put 'notmuch-show-pipe-message 'notmuch-prefix-doc @@ -2178,7 +2266,7 @@ message will be \"unarchived\", i.e. the tag changes in (notmuch-tag-change-list notmuch-archive-tags unarchive)))) (defun notmuch-show-archive-message-then-next-or-exit () - "Archive the current message, then show the next open message in the current thread. + "Archive current message, then show next open message in current thread. If at the last open message in the current thread, then exit back to search results." @@ -2187,7 +2275,7 @@ to search results." (notmuch-show-next-open-message t)) (defun notmuch-show-archive-message-then-next-or-next-thread () - "Archive the current message, then show the next open message in the current thread. + "Archive current message, then show next open message in current or next thread. If at the last open message in the current thread, then show next thread from search." @@ -2201,10 +2289,17 @@ thread from search." (interactive) (notmuch-common-do-stash (notmuch-show-get-cc))) -(defun notmuch-show-stash-date () - "Copy date of current message to kill-ring." - (interactive) - (notmuch-common-do-stash (notmuch-show-get-date))) +(put 'notmuch-show-stash-date 'notmuch-prefix-doc + "Copy timestamp of current message to kill-ring.") +(defun notmuch-show-stash-date (&optional stash-timestamp) + "Copy date of current message to kill-ring. + +If invoked with a prefix argument, copy timestamp of current +message to kill-ring." + (interactive "P") + (if stash-timestamp + (notmuch-common-do-stash (format "%d" (notmuch-show-get-timestamp))) + (notmuch-common-do-stash (notmuch-show-get-date)))) (defun notmuch-show-stash-filename () "Copy filename of current message to kill-ring." @@ -2331,25 +2426,27 @@ omit --in-reply-to=." (insert (notmuch-get-bodypart-binary msg part process-crypto))) buf)) -(defun notmuch-show-current-part-handle () +(defun notmuch-show-current-part-handle (&optional mime-type) "Return an mm-handle for the part containing point. This creates a temporary buffer for the part's content; the -caller is responsible for killing this buffer as appropriate." +caller is responsible for killing this buffer as appropriate. If +MIME-TYPE is given then set the handle's mime-type to MIME-TYPE." (let* ((msg (notmuch-show-get-message-properties)) (part (notmuch-show-get-part-properties)) (buf (notmuch-show-generate-part-buffer msg part)) - (computed-type (plist-get part :computed-type)) + (computed-type (or mime-type (plist-get part :computed-type))) (filename (plist-get part :filename)) (disposition (if filename `(attachment (filename . ,filename))))) (mm-make-handle buf (list computed-type) nil nil disposition))) -(defun notmuch-show-apply-to-current-part-handle (fn) +(defun notmuch-show-apply-to-current-part-handle (fn &optional mime-type) "Apply FN to an mm-handle for the part containing point. This ensures that the temporary buffer created for the mm-handle -is destroyed when FN returns." - (let ((handle (notmuch-show-current-part-handle))) +is destroyed when FN returns. If MIME-TYPE is given then force +part to be treated as if it had that mime-type." + (let ((handle (notmuch-show-current-part-handle mime-type))) ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we ;; call it from a temp-buffer, unless ;; notmuch-show-attachment-debug is non-nil in which case we put @@ -2394,4 +2491,77 @@ is destroyed when FN returns." (notmuch-show-apply-to-current-part-handle #'mm-pipe-part)) +(defun notmuch-show--mm-display-part (handle) + "Use mm-display-part to display HANDLE in a new buffer. + +If the part is displayed in an external application then close +the new buffer." + (let ((buf (get-buffer-create (generate-new-buffer-name + (concat " *notmuch-internal-part*"))))) + (switch-to-buffer buf) + (if (eq (mm-display-part handle) 'external) + (kill-buffer buf) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (view-buffer buf 'kill-buffer-if-not-modified)))) + +(defun notmuch-show-choose-mime-of-part (mime-type) + "Choose the mime type to use for displaying part" + (interactive + (list (completing-read "Mime type to use (default text/plain): " + (mailcap-mime-types) nil nil nil nil "text/plain"))) + (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part mime-type)) + +(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