X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=af1d44b67fafce58a669b76eccb299d8139c5d2a;hb=2ba880d59ecdff754b84ad495c0f803cbf8e1b56;hp=2f6be597b410eb61cf34764f31b82509d0d204d8;hpb=45fe3547458e0c403f7501bad89860afe2fa534a;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 2f6be597..af1d44b6 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -96,7 +96,7 @@ same as that of the previous message." notmuch-wash-excerpt-citations)) ;; Mostly useful for debugging. -(defcustom notmuch-show-all-multipart/alternative-parts nil +(defcustom notmuch-show-all-multipart/alternative-parts t "Should all parts of multipart/alternative parts be shown?" :group 'notmuch :type 'boolean) @@ -224,22 +224,25 @@ same as that of the previous message." ")")))))) (defun notmuch-show-clean-address (address) - "Clean a single email address for display." - (let* ((parsed (mail-header-parse-address address)) - (address (car parsed)) - (name (cdr parsed))) - ;; Remove double quotes. They might be required during transport, - ;; but we don't need to see them. - (when name - (setq name (replace-regexp-in-string "\"" "" name))) - ;; If the address is 'foo@bar.com ' then show just - ;; 'foo@bar.com'. - (when (string= name address) - (setq name nil)) - - (if (not name) - address - (concat name " <" address ">")))) + "Try to clean a single email ADDRESS for display. Return +unchanged ADDRESS if parsing fails." + (condition-case nil + (let* ((parsed (mail-header-parse-address address)) + (address (car parsed)) + (name (cdr parsed))) + ;; Remove double quotes. They might be required during transport, + ;; but we don't need to see them. + (when name + (setq name (replace-regexp-in-string "\"" "" name))) + ;; If the address is 'foo@bar.com ' then show just + ;; 'foo@bar.com'. + (when (string= name address) + (setq name nil)) + + (if (not name) + address + (concat name " <" address ">"))) + (error address))) (defun notmuch-show-insert-headerline (headers date tags depth) "Insert a notmuch style headerline based on HEADERS for a @@ -280,18 +283,23 @@ message at DEPTH in the current thread." 'face 'message-mml) (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment) - (insert-button - (concat "[ " - (if name (concat name ": ") "") - declared-type - (if (not (string-equal declared-type content-type)) - (concat " (as " content-type ")") - "") - (or comment "") - " ]\n") - :type 'notmuch-show-part-button-type - :notmuch-part nth - :notmuch-filename name)) + (let ((button)) + (setq button + (insert-button + (concat "[ " + (if name (concat name ": ") "") + declared-type + (if (not (string-equal declared-type content-type)) + (concat " (as " content-type ")") + "") + (or comment "") + " ]") + :type 'notmuch-show-part-button-type + :notmuch-part nth + :notmuch-filename name)) + (insert "\n") + ;; return button + button)) ;; Functions handling particular MIME parts. @@ -306,10 +314,11 @@ message at DEPTH in the current thread." "Filename to save as: " (or mailcap-download-directory "~/") nil nil - filename)) - (require-final-newline nil) - (coding-system-for-write 'no-conversion)) - (write-region (point-min) (point-max) file))))) + 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-mm-display-part-inline (msg part content-type content) "Use the mm-decode/mm-view functions to display a part in the @@ -446,6 +455,56 @@ current buffer, if possible." (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 '(:foreground "blue")) + ;; add signature status button if sigstatus provided + (if (plist-member part :sigstatus) + (let* ((headers (plist-get msg :headers)) + (from (plist-get headers :From)) + (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))) + ;; Show all of the parts. + (mapc (lambda (inner-part) + (notmuch-show-insert-bodypart msg inner-part depth)) + inner-parts) + + (when notmuch-show-indent-multipart + (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 '(:foreground "blue")) + ;; 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* ((headers (plist-get msg :headers)) + (from (plist-get headers :From)) + (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))) + ;; Show all of the parts. + (mapc (lambda (inner-part) + (notmuch-show-insert-bodypart msg inner-part depth)) + inner-parts) + + (when notmuch-show-indent-multipart + (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) (let ((inner-parts (plist-get part :content)) @@ -487,7 +546,7 @@ current buffer, if possible." (save-excursion (save-restriction (narrow-to-region start (point-max)) - (run-hook-with-args 'notmuch-show-insert-text/plain-hook depth)))) + (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth)))) t) (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type) @@ -524,6 +583,11 @@ current buffer, if possible." nil)) nil)))) +(defun notmuch-show-insert-part-application/* (msg part content-type nth depth declared-type +) + ;; do not render random "application" parts + (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))) + (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) ;; 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)) @@ -588,16 +652,6 @@ current buffer, if possible." "Insert the body part PART at depth DEPTH in the current thread." (let ((content-type (downcase (plist-get part :content-type))) (nth (plist-get part :id))) - ;; 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* ((headers (plist-get msg :headers)) - (from (plist-get headers :From)) - (sigstatus (car (plist-get part :sigstatus)))) - (notmuch-crypto-insert-sigstatus-button sigstatus from))) (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)) ;; Some of the body part handlers leave point somewhere up in the ;; part, so we make sure that we're down at the end. @@ -659,6 +713,9 @@ current buffer, if possible." (setq content-start (point-marker)) + (plist-put msg :headers-invis-spec headers-invis-spec) + (plist-put msg :message-invis-spec message-invis-spec) + ;; Set `headers-start' to point after the 'Subject:' header to be ;; compatible with the existing implementation. This just sets it ;; to after the first header. @@ -696,10 +753,10 @@ current buffer, if possible." ;; message. (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) - (plist-put msg :headers-invis-spec headers-invis-spec) - (overlay-put (make-overlay headers-start headers-end) 'invisible headers-invis-spec) - - (plist-put msg :message-invis-spec message-invis-spec) + (let ((headers-overlay (make-overlay headers-start headers-end)) + (invis-specs (list headers-invis-spec message-invis-spec))) + (overlay-put headers-overlay 'invisible invis-specs) + (overlay-put headers-overlay 'priority 10)) (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec) ;; Save the properties for this message. Currently this saves the @@ -938,20 +995,11 @@ All currently available key bindings: (add-to-invisibility-spec spec)))) (defun notmuch-show-message-visible (props visible-p) - (if visible-p - ;; When making the message visible, the headers may or not be - ;; visible. So we check that property separately. - (let ((headers-visible (plist-get props :headers-visible))) - (notmuch-show-element-visible props headers-visible :headers-invis-spec) - (notmuch-show-element-visible props t :message-invis-spec)) - (notmuch-show-element-visible props nil :headers-invis-spec) - (notmuch-show-element-visible props nil :message-invis-spec)) - + (notmuch-show-element-visible props visible-p :message-invis-spec) (notmuch-show-set-prop :message-visible visible-p props)) (defun notmuch-show-headers-visible (props visible-p) - (if (plist-get props :message-visible) - (notmuch-show-element-visible props visible-p :headers-invis-spec)) + (notmuch-show-element-visible props visible-p :headers-invis-spec) (notmuch-show-set-prop :headers-visible visible-p props)) ;; Functions for setting and getting attributes of the current