X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=4b8c66fdb2a1feefeacbee711acceef752f7c3a3;hp=8222f0d1e784821a4bae3345cdf732a07f7f731c;hb=c13ff402c42143941010cd03bd57658d42f0df7d;hpb=c802d12a1e43fe69f2fcf7a2f7d44018a55bfb65 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 8222f0d1..4b8c66fd 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 @@ -21,6 +21,8 @@ ;; Authors: Carl Worth ;; David Edmondson +;;; Code: + (eval-when-compile (require 'cl)) (require 'mm-view) (require 'message) @@ -607,7 +609,7 @@ will return nil if the CID is unknown or cannot be retrieved." (plist-get part :content))) (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button) - (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) + (let ((chosen-type (car (notmuch-multipart/alternative-choose msg (notmuch-show-multipart/*-to-list part)))) (inner-parts (plist-get part :content)) (start (point))) ;; This inserts all parts of the chosen type rather than just one, @@ -642,15 +644,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 +663,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))) @@ -847,21 +838,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" @@ -954,14 +940,22 @@ this part.") (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 (notmuch-show-mime-type part)) @@ -972,12 +966,10 @@ useful for quoting in replies)." (beg (point)) ;; This default header-p function omits the part button for ;; the first (or only) part if this is text/plain. - (button (when (and (not (equal hide 'no-buttons)) - (funcall notmuch-show-insert-header-p-function part hide)) + (button (when (funcall notmuch-show-insert-header-p-function part hide) (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename)))) ;; Hide the part initially if HIDE is t, or if it is too long - ;; and we have a button to allow toggling (thus reply which - ;; uses 'no-buttons automatically includes long parts) + ;; and we have a button to allow toggling. (show-part (not (or (equal hide t) (and long button)))) (content-beg (point))) @@ -1425,6 +1417,7 @@ reset based on the original query." (define-key map (kbd "") 'notmuch-show-previous-button) (define-key map (kbd "TAB") 'notmuch-show-next-button) (define-key map "f" 'notmuch-show-forward-message) + (define-key map "F" 'notmuch-show-forward-open-messages) (define-key map "l" 'notmuch-show-filter-thread) (define-key map "r" 'notmuch-show-reply-sender) (define-key map "R" 'notmuch-show-reply) @@ -1849,8 +1842,26 @@ any effects from previous calls to (defun notmuch-show-forward-message (&optional prompt-for-sender) "Forward the current message." (interactive "P") - (with-current-notmuch-show-message - (notmuch-mua-new-forward-message prompt-for-sender))) + (notmuch-mua-new-forward-messages (list (notmuch-show-get-message-id)) + prompt-for-sender)) + +(put 'notmuch-show-forward-open-messages 'notmuch-prefix-doc + "... and prompt for sender") +(defun notmuch-show-forward-open-messages (&optional prompt-for-sender) + "Forward the currently open messages." + (interactive "P") + (let ((open-messages (notmuch-show-get-message-ids-for-open-messages))) + (unless open-messages + (error "No open messages to forward.")) + (notmuch-mua-new-forward-messages open-messages prompt-for-sender))) + +(defun notmuch-show-resend-message (addresses) + "Resend the current message." + (interactive (list (notmuch-address-from-minibuffer "Resend to: "))) + (when (y-or-n-p (concat "Confirm resend to " addresses " ")) + (notmuch-show-view-raw-message) + (message-resend addresses) + (notmuch-bury-or-kill-this-buffer))) (defun notmuch-show-next-message (&optional pop-at-end) "Show the next message. @@ -2378,3 +2389,5 @@ is destroyed when FN returns." (provide 'notmuch-show) + +;;; notmuch-show.el ends here