X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=6ec70c906bc3e65d90cd28b649c720b575fd968b;hp=83bb9ad5d02af91496f4fdfd28dc84b84c5cf5c9;hb=055f7621d649021b354fabea90f55136b55bf6ef;hpb=109a0355d681b82715cf6fd6ca051c6b5b2c6714 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 83bb9ad5..6ec70c90 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -482,7 +482,8 @@ message at DEPTH in the current thread." (insert-button (concat "[ " base-label " ]") :base-label base-label - :type 'notmuch-show-part-button-type)) + :type 'notmuch-show-part-button-type + :notmuch-part-hidden nil)) (insert "\n") ;; return button button)) @@ -493,20 +494,22 @@ message at DEPTH in the current thread." (let* ((button (or button (button-at (point)))) (overlay (button-get button 'overlay))) (when overlay - (let* ((show (overlay-get overlay 'invisible)) + (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)))) + (overlay-put overlay 'invisible (not show)))))) ;; MIME part renderers @@ -514,8 +517,7 @@ message at DEPTH in the current thread." (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))) @@ -592,8 +594,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))) @@ -612,16 +613,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))) @@ -634,20 +634,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))) @@ -660,8 +659,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. @@ -673,8 +671,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))) @@ -695,12 +692,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 @@ -708,8 +706,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 @@ -732,8 +729,8 @@ 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-get-mime-type-of-application/octet-stream (part) ;; If we can deduce a MIME type from the filename of the attachment, @@ -751,11 +748,7 @@ message at DEPTH in the current thread." 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 content-type nth depth declared-type)) - -(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 @@ -763,11 +756,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) @@ -790,13 +782,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)) @@ -804,26 +796,43 @@ 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-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))) (mime-type (or (and (string= content-type "application/octet-stream") (notmuch-show-get-mime-type-of-application/octet-stream part)) @@ -831,33 +840,24 @@ If HIDE is non-nil then initially hide this part." "text/x-diff") content-type)) (nth (plist-get part :id)) - (beg (point))) + (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))) - (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type) + (notmuch-show-insert-bodypart-internal 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) - ;; Record part information. Since we already inserted subparts, - ;; don't override existing :notmuch-part properties. - (notmuch-map-text-property beg (point) :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 (point) 'front-sticky - (lambda (v) (if (listp v) - (pushnew :notmuch-part v) - v))) - (notmuch-map-text-property beg (point) 'rear-nonsticky - (lambda (v) (if (listp v) - (pushnew :notmuch-part v) - v))))) + (notmuch-show-create-part-overlays button content-beg (point)) + (when hide + (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."