(require 'notmuch-query)
(require 'notmuch-wash)
(require 'notmuch-mua)
+(require 'notmuch-crypto)
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-fontify-headers "notmuch" nil)
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)
")"))))))
(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 <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 <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
'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.
(defun notmuch-show-save-part (message-id nth &optional filename)
- (with-temp-buffer
- ;; Always acquires the part via `notmuch part', even if it is
- ;; available in the JSON output.
- (insert (notmuch-show-get-bodypart-internal message-id nth))
- (let ((file (read-file-name
- "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))))
+ (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-show-get-bodypart-internal 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-mm-display-part-inline (msg part content-type content)
"Use the mm-decode/mm-view functions to display a part in the
(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))
(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)
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))
;; Helper for parts which are generally not included in the default
;; JSON output.
-
+;; Uses the buffer-local variable notmuch-show-process-crypto to
+;; determine if parts should be decrypted first.
(defun notmuch-show-get-bodypart-internal (message-id part-number)
- (with-temp-buffer
- (let ((coding-system-for-read 'no-conversion))
- (call-process notmuch-command nil t nil
- "show" "--format=raw" (format "--part=%s" part-number) message-id)
- (buffer-string))))
+ (let ((args '("show" "--format=raw"))
+ (part-arg (format "--part=%s" part-number)))
+ (setq args (append args (list part-arg)))
+ (if notmuch-show-process-crypto
+ (setq args (append args '("--decrypt"))))
+ (setq args (append args (list message-id)))
+ (with-temp-buffer
+ (let ((coding-system-for-read 'no-conversion))
+ (progn
+ (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
+ (buffer-string))))))
(defun notmuch-show-get-bodypart-content (msg part nth)
(or (plist-get part :content)
(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.
;; 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
(mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
(defvar notmuch-show-parent-buffer nil)
+(make-variable-buffer-local 'notmuch-show-parent-buffer)
;;;###autoload
-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
+(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
"Run \"notmuch show\" with the given thread ID and display results.
The optional PARENT-BUFFER is the notmuch-search buffer from
(let ((buffer (get-buffer-create (generate-new-buffer-name
(or buffer-name
(concat "*notmuch-" thread-id "*")))))
+ (process-crypto (if crypto-switch
+ (not notmuch-crypto-process-mime)
+ notmuch-crypto-process-mime))
(inhibit-read-only t))
(switch-to-buffer buffer)
(notmuch-show-mode)
- (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
+ (setq notmuch-show-parent-buffer parent-buffer)
+ (setq notmuch-show-process-crypto process-crypto)
(erase-buffer)
(goto-char (point-min))
(save-excursion
(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
;; Move to the previous message.
(notmuch-show-previous-message)))))
-(defun notmuch-show-reply ()
+(defun notmuch-show-reply (&optional prompt-for-sender)
"Reply to the current message."
- (interactive)
- (notmuch-mua-reply (notmuch-show-get-message-id)))
+ (interactive "P")
+ (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender))
-(defun notmuch-show-forward-message ()
+(defun notmuch-show-forward-message (&optional prompt-for-sender)
"Forward the current message."
- (interactive)
+ (interactive "P")
(with-current-notmuch-show-message
- (notmuch-mua-forward-message)))
+ (notmuch-mua-new-forward-message prompt-for-sender)))
(defun notmuch-show-next-message ()
"Show the next message."