(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)
:group 'notmuch
:type 'boolean)
+(defcustom notmuch-show-elide-same-subject nil
+ "Do not show the subject of a collapsed message if it is the
+same as that of the previous message."
+ :group 'notmuch
+ :type 'boolean)
+
(defcustom notmuch-show-always-show-subject t
"Should a collapsed message show the `Subject:' line?"
:group 'notmuch
'face 'notmuch-tag-face)
")"))))))
+(defun notmuch-show-clean-address (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
message at DEPTH in the current thread."
(let ((start (point)))
(insert (notmuch-show-spaces-n depth)
- (plist-get headers :From)
+ (notmuch-show-clean-address (plist-get headers :From))
" ("
date
") ("
'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))
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
- "part" (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)
;; If the subject of this message is the same as that of the
;; previous message, don't display it when this message is
;; collapsed.
- (when (or notmuch-show-always-show-subject
- (not (string= notmuch-show-previous-subject
- bare-subject)))
+ (when (and notmuch-show-elide-same-subject
+ (not (string= notmuch-show-previous-subject
+ bare-subject)))
(forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
(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
(define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
(define-key map (kbd "TAB") 'notmuch-show-next-button)
(define-key map "s" 'notmuch-search)
- (define-key map "m" 'notmuch-mua-mail)
+ (define-key map "m" 'notmuch-mua-new-mail)
(define-key map "f" 'notmuch-show-forward-message)
(define-key map "r" 'notmuch-show-reply)
(define-key map "|" 'notmuch-show-pipe-message)
;; 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."
(new-tags (notmuch-show-add-tags-worker current-tags toadd)))
(unless (equal current-tags new-tags)
- (apply 'notmuch-call-notmuch-process
- (append (cons "tag"
- (mapcar (lambda (s) (concat "+" s)) toadd))
- (cons (notmuch-show-get-message-id) nil)))
+ (apply 'notmuch-tag (notmuch-show-get-message-id)
+ (mapcar (lambda (s) (concat "+" s)) toadd))
(notmuch-show-set-tags new-tags))))
(defun notmuch-show-remove-tag (&rest toremove)
(new-tags (notmuch-show-del-tags-worker current-tags toremove)))
(unless (equal current-tags new-tags)
- (apply 'notmuch-call-notmuch-process
- (append (cons "tag"
- (mapcar (lambda (s) (concat "-" s)) toremove))
- (cons (notmuch-show-get-message-id) nil)))
+ (apply 'notmuch-tag (notmuch-show-get-message-id)
+ (mapcar (lambda (s) (concat "-" s)) toremove))
(notmuch-show-set-tags new-tags))))
(defun notmuch-show-toggle-headers ()
projects / notmuch / blobdiff