X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=82b70bafcd2bc35d4c67d1d827a602f812c4619c;hp=acaef8ef2afd3871b071e468025fec44ab9f124c;hb=15f5fc513d45cb6173c1a319e3c58b724c3da4db;hpb=3901bbca2eb3f24dd8ffa628a2c057ec1a28a1d0 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index acaef8ef..82b70baf 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -38,8 +38,8 @@ (require 'notmuch-print) (declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) -(declare-function notmuch-fontify-headers "notmuch" nil) (declare-function notmuch-search-next-thread "notmuch" nil) +(declare-function notmuch-search-previous-thread "notmuch" nil) (declare-function notmuch-search-show-thread "notmuch" nil) (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") @@ -158,6 +158,7 @@ indentation." '(("Gmane" . "http://mid.gmane.org/") ("MARC" . "http://marc.info/?i=") ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=") + ("LKML" . "http://lkml.kernel.org/r/") ;; FIXME: can these services be searched by `Message-Id' ? ;; ("MarkMail" . "http://markmail.org/") ;; ("Nabble" . "http://nabble.com/") @@ -212,6 +213,9 @@ For example, if you wanted to remove an \"unread\" tag and add a "Enable Visual Line mode." (visual-line-mode t)) +;; DEPRECATED in Notmuch 0.16 since we now have convenient part +;; commands. We'll keep the command around for a version or two in +;; case people want to bind it themselves. (defun notmuch-show-view-all-mime-parts () "Use external viewers to view all attachments from the current message." (interactive) @@ -362,8 +366,7 @@ operation on the contents of the current buffer." (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) (let ((inhibit-read-only t)) (replace-match (concat "(" - (propertize (mapconcat 'identity tags " ") - 'face 'notmuch-tag-face) + (notmuch-tag-format-tags tags) ")")))))) (defun notmuch-clean-address (address) @@ -441,8 +444,7 @@ message at DEPTH in the current thread." " (" date ") (" - (propertize (mapconcat 'identity tags " ") - 'face 'notmuch-tag-face) + (notmuch-tag-format-tags tags) ")\n") (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) @@ -467,22 +469,10 @@ message at DEPTH in the current thread." (define-button-type 'notmuch-show-part-button-type 'action 'notmuch-show-part-button-default - 'keymap 'notmuch-show-part-button-map 'follow-link t 'face 'message-mml :supertype 'notmuch-button-type) -(defvar notmuch-show-part-button-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map button-map) - (define-key map "s" 'notmuch-show-part-button-save) - (define-key map "v" 'notmuch-show-part-button-view) - (define-key map "o" 'notmuch-show-part-button-interactively-view) - (define-key map "|" 'notmuch-show-part-button-pipe) - map) - "Submap for button commands") -(fset 'notmuch-show-part-button-map notmuch-show-part-button-map) - (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment) (let ((button) (base-label (concat (when name (concat name ": ")) @@ -496,90 +486,51 @@ message at DEPTH in the current thread." (concat "[ " base-label " ]") :base-label base-label :type 'notmuch-show-part-button-type - :notmuch-part nth - :notmuch-filename name - :notmuch-content-type content-type)) + :notmuch-part-hidden nil)) (insert "\n") ;; return button button)) -;; Functions handling particular MIME parts. - -(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body) - (declare (indent 2)) - (let ((process-crypto (make-symbol "process-crypto"))) - `(let ((,process-crypto notmuch-show-process-crypto)) - (with-temp-buffer - (setq notmuch-show-process-crypto ,process-crypto) - ;; Always acquires the part via `notmuch part', even if it is - ;; available in the JSON output. - (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto)) - ,@body)))) - -(defun notmuch-show-save-part (message-id nth &optional filename content-type) - (notmuch-with-temp-part-buffer message-id nth - (let ((file (read-file-name - "Filename to save as: " - (or mailcap-download-directory "~/") - nil nil - filename))) - ;; Don't re-compress .gz & al. Arguably we should make - ;; `file-name-handler-alist' nil, but that would chop - ;; ange-ftp, which is reasonable to use here. - (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))) - -(defun notmuch-show-view-part (message-id nth &optional filename content-type ) - (notmuch-with-temp-part-buffer message-id nth - ;; set mm-inlined-types to nil to force an external viewer - (let ((handle (mm-make-handle (current-buffer) (list content-type))) - (mm-inlined-types nil)) - ;; We override mm-save-part as notmuch-show-save-part is better - ;; since it offers the filename. We need to lexically bind - ;; everything we need for notmuch-show-save-part to prevent - ;; potential dynamic shadowing. - (lexical-let ((message-id message-id) - (nth nth) - (filename filename) - (content-type content-type)) - (flet ((mm-save-part (&rest args) (notmuch-show-save-part - message-id nth filename content-type))) - (mm-display-part handle)))))) - -(defun notmuch-show-interactively-view-part (message-id nth &optional filename content-type) - (notmuch-with-temp-part-buffer message-id nth - (let ((handle (mm-make-handle (current-buffer) (list content-type)))) - (mm-interactively-view-part handle)))) - -(defun notmuch-show-pipe-part (message-id nth &optional filename content-type) - (notmuch-with-temp-part-buffer message-id nth - (let ((handle (mm-make-handle (current-buffer) (list content-type)))) - (mm-pipe-part handle)))) - -;; This is taken from notmuch-wash: maybe it should be unified? (defun notmuch-show-toggle-part-invisibility (&optional button) (interactive) (let* ((button (or button (button-at (point)))) - (overlay (button-get button 'overlay))) - (when overlay - (let* ((show (overlay-get overlay 'invisible)) + (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 (point))) (inhibit-read-only t)) - (overlay-put overlay 'invisible (not show)) + ;; 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)))))))) + (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))))) + +;; MIME part renderers (defun notmuch-show-multipart/*-to-list (part) (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) (plist-get part :content))) -(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-header nth declared-type content-type nil) +(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)))) (inner-parts (plist-get part :content)) (start (point))) @@ -656,8 +607,7 @@ message at DEPTH in the current thread." content-type) nil))) -(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-header nth declared-type 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))) @@ -676,16 +626,15 @@ message at DEPTH in the current thread." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type) - (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) - (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."))) +(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.")) (let ((inner-parts (plist-get part :content)) (start (point))) @@ -698,20 +647,19 @@ message at DEPTH in the current thread." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type) - (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) - (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."))) +(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.")) (let ((inner-parts (plist-get part :content)) (start (point))) @@ -724,8 +672,7 @@ message at DEPTH in the current thread." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-header nth declared-type content-type nil) +(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button) (let ((inner-parts (plist-get part :content)) (start (point))) ;; Show all of the parts. @@ -737,8 +684,7 @@ message at DEPTH in the current thread." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-header nth declared-type content-type nil) +(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth button) (let* ((message (car (plist-get part :content))) (body (car (plist-get message :body))) (start (point))) @@ -759,12 +705,13 @@ message at DEPTH in the current thread." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type) - (let ((start (point))) - ;; If this text/plain part is not the first part in the message, - ;; insert a header to make this clear. - (if (> nth 1) - (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))) +(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth button) + ;; For backward compatibility we want to apply the text/plain hook + ;; to the whole of the part including the part button if there is + ;; one. + (let ((start (if button + (button-start button) + (point)))) (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto)) (save-excursion (save-restriction @@ -772,8 +719,7 @@ message at DEPTH in the current thread." (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth)))) t) -(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)) +(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 @@ -796,12 +742,12 @@ message at DEPTH in the current thread." t) ;; For backwards compatibility. -(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type)) +(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)) -(defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type) +(defun notmuch-show-get-mime-type-of-application/octet-stream (part) ;; If we can deduce a MIME type from the filename of the attachment, - ;; do so and pass it on to the handler for that type. + ;; we return that. (if (plist-get part :filename) (let ((extension (file-name-extension (plist-get part :filename))) mime-type) @@ -811,15 +757,11 @@ message at DEPTH in the current thread." (setq mime-type (mailcap-extension-to-mime extension)) (if (and mime-type (not (string-equal mime-type "application/octet-stream"))) - (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type) + mime-type nil)) nil)))) -;; Handler for wash generated inline patch fake parts. -(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type) - (notmuch-show-insert-part-*/* msg part "text/x-diff" nth depth "inline patch")) - -(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type) +(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 @@ -827,11 +769,10 @@ message at DEPTH in the current thread." ;; 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 declared-type))) + (notmuch-show-insert-part-*/* msg part content-type nth depth button))) -(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) +(defun notmuch-show-insert-part-*/* (msg part content-type nth depth button) ;; This handler _must_ succeed - it is the handler of last resort. - (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)) (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto) t) @@ -854,13 +795,13 @@ message at DEPTH in the current thread." ;; -(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type) +(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 declared-type) + (funcall (car handlers) msg part content-type nth depth button) (error (progn (insert "!!! Bodypart insert error: ") (insert (error-message-string err)) @@ -868,38 +809,110 @@ message at DEPTH in the current thread." (setq handlers (cdr handlers)))) t) -(defun notmuch-show-create-part-overlays (msg beg end hide) +(defun notmuch-show-create-part-overlays (button beg end) "Add an overlay to the part between BEG and END" - (let* ((button (button-at beg)) - (part-beg (and button (1+ (button-end button))))) - - ;; If the part contains no text we do not make it toggleable. We - ;; also need to check that the button is a genuine part button not - ;; a notmuch-wash button. - (when (and button (/= part-beg end) (button-get button :base-label)) - (button-put button 'overlay (make-overlay part-beg end)) - ;; We toggle the button for hidden parts as that gets the - ;; button label right. - (save-excursion - (when hide - (notmuch-show-toggle-part-invisibility button)))))) + + ;; If there is no button (i.e., the part is text/plain and the first + ;; part) or if the part has no content then we don't make the part + ;; toggleable. + (when (and button (/= beg end)) + (button-put button 'overlay (make-overlay beg end)) + ;; Return true if we created an overlay. + t)) + +(defun notmuch-show-record-part-information (part beg end) + "Store PART as a text property from BEG to END" + + ;; Record part information. Since we already inserted subparts, + ;; don't override existing :notmuch-part properties. + (notmuch-map-text-property beg end :notmuch-part + (lambda (v) (or v part))) + ;; Make :notmuch-part front sticky and rear non-sticky so it stays + ;; applied to the beginning of each line when we indent the + ;; message. Since we're operating on arbitrary renderer output, + ;; 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))) + (notmuch-map-text-property beg end 'rear-nonsticky + (lambda (v) (if (listp v) + (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 + ;; move to the start of the new line following the button and insert + ;; the part but that point might have text properties (eg colours + ;; from a message header etc) so instead we start from the last + ;; character of the button by adding a newline and finish by + ;; removing the extra newline from the end of the part. + (save-excursion + (goto-char (button-end button)) + (insert "\n") + (let* ((inhibit-read-only t) + ;; We need to use markers for the start and end of the part + ;; because the part insertion functions do not guarantee + ;; to leave point at the end of the part. + (part-beg (copy-marker (point) nil)) + (part-end (copy-marker (point) t)) + ;; We have to save the depth as we can't find the depth + ;; when narrowed. + (depth (notmuch-show-get-depth))) + (save-restriction + (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)) + (goto-char part-end) + (delete-char 1) + (notmuch-show-record-part-information (second 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-insert-bodypart (msg part depth &optional hide) "Insert the body part PART at depth DEPTH in the current thread. If HIDE is non-nil then initially hide this part." - (let ((content-type (downcase (plist-get part :content-type))) - (nth (plist-get part :id)) - (beg (point))) - (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type) + (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)) + (nth (plist-get part :id)) + (beg (point)) + ;; We omit the part button for the first (or only) part if this is text/plain. + (button (unless (and (string= mime-type "text/plain") (<= nth 1)) + (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename)))) + (content-beg (point))) + + ;; Store the computed mime-type for later use (e.g. by attachment handlers). + (plist-put part :computed-type mime-type) + + (if (not hide) + (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))) + ;; Some of the body part handlers leave point somewhere up in the ;; part, so we make sure that we're down at the end. (goto-char (point-max)) ;; Ensure that the part ends with a carriage return. (unless (bolp) (insert "\n")) - (notmuch-show-create-part-overlays msg beg (point) hide))) + ;; We do not create the overlay for hidden (lazy) parts until + ;; they are inserted. + (if (not hide) + (notmuch-show-create-part-overlays button content-beg (point)) + (save-excursion + (notmuch-show-toggle-part-invisibility button))) + (notmuch-show-record-part-information part beg (point)))) (defun notmuch-show-insert-body (msg body depth) "Insert the body BODY at depth DEPTH in the current thread." @@ -1239,6 +1252,16 @@ reset based on the original query." "Submap for stash commands") (fset 'notmuch-show-stash-map notmuch-show-stash-map) +(defvar notmuch-show-part-map + (let ((map (make-sparse-keymap))) + (define-key map "s" 'notmuch-show-save-part) + (define-key map "v" 'notmuch-show-view-part) + (define-key map "o" 'notmuch-show-interactively-view-part) + (define-key map "|" 'notmuch-show-pipe-part) + map) + "Submap for part commands") +(fset 'notmuch-show-part-map notmuch-show-part-map) + (defvar notmuch-show-mode-map (let ((map (make-sparse-keymap))) (define-key map "?" 'notmuch-help) @@ -1255,7 +1278,6 @@ reset based on the original query." (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 "v" 'notmuch-show-view-all-mime-parts) (define-key map "c" 'notmuch-show-stash-map) (define-key map "=" 'notmuch-show-refresh-view) (define-key map "h" 'notmuch-show-toggle-visibility-headers) @@ -1270,6 +1292,8 @@ reset based on the original query." (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) @@ -1279,6 +1303,7 @@ reset based on the original query." (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) @@ -1401,6 +1426,14 @@ Some useful entries are: (notmuch-show-move-to-message-top) (get-text-property (point) :notmuch-message-properties))) +(defun notmuch-show-get-part-properties () + "Return the properties of the innermost part containing point. + +This is the part property list retrieved from the CLI. Signals +an error if there is no part containing point." + (or (get-text-property (point) :notmuch-part) + (error "No message part here"))) + (defun notmuch-show-set-prop (prop val &optional props) (let ((inhibit-read-only t) (props (or props @@ -1557,8 +1590,8 @@ This command is intended to be one of the simplest ways to process a thread of email. It works exactly like notmuch-show-advance, in that it scrolls through messages in a show buffer, except that when it gets to the end of the buffer it -archives the entire current thread, (remove the \"inbox\" tag -from each message), kills the buffer, and displays the next +archives the entire current thread, (apply changes in +`notmuch-archive-tags'), kills the buffer, and displays the next thread from the search from which this thread was originally shown." (interactive) @@ -1723,7 +1756,10 @@ to stdout or stderr will appear in the *notmuch-pipe* buffer. When invoked with a prefix argument, the command will receive all open messages in the current thread (formatted as an mbox) rather than only the current message." - (interactive "P\nsPipe message to command: ") + (interactive (let ((query-string (if current-prefix-arg + "Pipe all open messages to command: " + "Pipe message to command: "))) + (list current-prefix-arg (read-string query-string)))) (let (shell-command) (if entire-thread (setq shell-command @@ -1754,7 +1790,7 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'." (let* ((current-tags (notmuch-show-get-tags)) (new-tags (notmuch-update-tags current-tags tag-changes))) (unless (equal current-tags new-tags) - (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes) + (notmuch-tag (notmuch-show-get-message-id) tag-changes) (notmuch-show-set-tags new-tags)))) (defun notmuch-show-tag (&optional tag-changes) @@ -1762,8 +1798,8 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'." See `notmuch-tag' for information on the format of TAG-CHANGES." (interactive) - (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes)) - (let* ((current-tags (notmuch-show-get-tags)) + (let* ((tag-changes (notmuch-tag (notmuch-show-get-message-id) tag-changes)) + (current-tags (notmuch-show-get-tags)) (new-tags (notmuch-update-tags current-tags tag-changes))) (unless (equal current-tags new-tags) (notmuch-show-set-tags new-tags)))) @@ -1773,7 +1809,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." See `notmuch-tag' for information on the format of TAG-CHANGES." (interactive) - (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)) + (setq tag-changes (notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)) (notmuch-show-mapc (lambda () (let* ((current-tags (notmuch-show-get-tags)) @@ -1831,25 +1867,41 @@ argument, hide all of the messages." (interactive) (backward-button 1)) -(defun notmuch-show-next-thread (&optional show-next) - "Move to the next item in the search results, if any." +(defun notmuch-show-next-thread (&optional show previous) + "Move to the next item in the search results, if any. + +If SHOW is non-nil, open the next item in a show +buffer. Otherwise just highlight the next item in the search +buffer. If PREVIOUS is non-nil, move to the previous item in the +search results instead." (interactive "P") (let ((parent-buffer notmuch-show-parent-buffer)) (notmuch-kill-this-buffer) (when (buffer-live-p parent-buffer) (switch-to-buffer parent-buffer) - (notmuch-search-next-thread) - (if show-next - (notmuch-search-show-thread))))) + (and (if previous + (notmuch-search-previous-thread) + (notmuch-search-next-thread)) + show + (notmuch-search-show-thread))))) + +(defun notmuch-show-next-thread-show () + "Show the next thread in the search results, if any." + (interactive) + (notmuch-show-next-thread t)) + +(defun notmuch-show-previous-thread-show () + "Show the previous thread in the search results, if any." + (interactive) + (notmuch-show-next-thread t t)) (defun notmuch-show-archive-thread (&optional unarchive) "Archive each message in thread. Archive each message currently shown by applying the tag changes -in `notmuch-archive-tags' to each (remove the \"inbox\" tag by -default). If a prefix argument is given, the messages will be -\"unarchived\", i.e. the tag changes in `notmuch-archive-tags' -will be reversed. +in `notmuch-archive-tags' to each. If a prefix argument is given, +the messages will be \"unarchived\", i.e. the tag changes in +`notmuch-archive-tags' will be reversed. Note: This command is safe from any race condition of new messages being delivered to the same thread. It does not archive the @@ -1876,10 +1928,9 @@ buffer." "Archive the current message. Archive the current message by applying the tag changes in -`notmuch-archive-tags' to it (remove the \"inbox\" tag by -default). If a prefix argument is given, the message will be -\"unarchived\", i.e. the tag changes in `notmuch-archive-tags' -will be reversed." +`notmuch-archive-tags' to it. If a prefix argument is given, the +message will be \"unarchived\", i.e. the tag changes in +`notmuch-archive-tags' will be reversed." (interactive "P") (when notmuch-archive-tags (apply 'notmuch-show-tag-message @@ -1985,40 +2036,73 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')." (notmuch-show-stash-mlarchive-link mla) (browse-url (current-kill 0 t))) -;; Commands typically bound to buttons. +;; Interactive part functions and their helpers + +(defun notmuch-show-generate-part-buffer (message-id nth) + "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))) + buf)) + +(defun notmuch-show-current-part-handle () + "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)) + (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) + "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))) + (unwind-protect + (funcall fn handle) + (kill-buffer (mm-handle-buffer handle))))) (defun notmuch-show-part-button-default (&optional button) (interactive) (let ((button (or button (button-at (point))))) - (if (button-get button 'overlay) - (notmuch-show-toggle-part-invisibility button) - (notmuch-show-part-button-internal button notmuch-show-part-button-default-action)))) - -(defun notmuch-show-part-button-save (&optional button) + ;; Try to toggle the part, if that fails then call the default + ;; action. The toggle fails if the part has no emacs renderable + ;; content. + (unless (notmuch-show-toggle-part-invisibility button) + (call-interactively notmuch-show-part-button-default-action)))) + +(defun notmuch-show-save-part () + "Save the MIME part containing point to a file." (interactive) - (notmuch-show-part-button-internal button #'notmuch-show-save-part)) + (notmuch-show-apply-to-current-part-handle #'mm-save-part)) -(defun notmuch-show-part-button-view (&optional button) +(defun notmuch-show-view-part () + "View the MIME part containing point in an external viewer." (interactive) - (notmuch-show-part-button-internal button #'notmuch-show-view-part)) + ;; Set mm-inlined-types to nil to force an external viewer + (let ((mm-inlined-types nil)) + (notmuch-show-apply-to-current-part-handle #'mm-display-part))) -(defun notmuch-show-part-button-interactively-view (&optional button) +(defun notmuch-show-interactively-view-part () + "View the MIME part containing point, prompting for a viewer." (interactive) - (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part)) + (notmuch-show-apply-to-current-part-handle #'mm-interactively-view-part)) -(defun notmuch-show-part-button-pipe (&optional button) +(defun notmuch-show-pipe-part () + "Pipe the MIME part containing point to an external command." (interactive) - (notmuch-show-part-button-internal button #'notmuch-show-pipe-part)) + (notmuch-show-apply-to-current-part-handle #'mm-pipe-part)) -(defun notmuch-show-part-button-internal (button handler) - (let ((button (or button (button-at (point))))) - (if button - (let ((nth (button-get button :notmuch-part))) - (if nth - (funcall handler (notmuch-show-get-message-id) nth - (button-get button :notmuch-filename) - (button-get button :notmuch-content-type))))))) - -;; (provide 'notmuch-show)