(require 'mm-decode)
(require 'mailcap)
(require 'icalendar)
+(require 'goto-addr)
(require 'notmuch-lib)
(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
- :type 'boolean)
-
(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
"A list of functions called to decorate the headers listed in
`notmuch-message-headers'.")
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)
"Use external viewers to view all attachments from the current message."
(interactive)
(with-current-notmuch-show-message
- ; We ovverride the mm-inline-media-tests to indicate which message
+ ; We override the mm-inline-media-tests to indicate which message
; parts are already sufficiently handled by the original
; presentation of the message in notmuch-show mode. These parts
; will be inserted directly into the temporary buffer of
")"))))))
(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))
t)
(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
- (let* ((message-part (plist-get part :content))
- (inner-parts (plist-get message-part :content)))
- (notmuch-show-insert-part-header nth declared-type content-type nil)
+ (notmuch-show-insert-part-header nth declared-type content-type nil)
+ (let* ((message (car (plist-get part :content)))
+ (headers (plist-get message :headers))
+ (body (car (plist-get message :body)))
+ (start (point)))
+
;; Override `notmuch-message-headers' to force `From' to be
;; displayed.
(let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
- (notmuch-show-insert-headers (plist-get part :headers)))
+ (notmuch-show-insert-headers (plist-get message :headers)))
+
;; Blank line after headers to be compatible with the normal
;; message display.
(insert "\n")
- ;; Show all of the parts.
- (mapc (lambda (inner-part)
- (notmuch-show-insert-bodypart msg inner-part depth))
- inner-parts))
+ ;; Show the body
+ (notmuch-show-insert-bodypart msg body depth)
+
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1)))
t)
(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
(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.
;; 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 (and notmuch-show-elide-same-subject
- (not (string= notmuch-show-previous-subject
- bare-subject)))
+ (when (not (string= notmuch-show-previous-subject
+ bare-subject))
(forward-line 1))
(setq headers-start (point-marker)))
(setq headers-end (point-marker))
;; 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
"Insert the forest of threads FOREST."
(mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
+(defvar notmuch-show-thread-id nil)
+(make-variable-buffer-local 'notmuch-show-thread-id)
(defvar notmuch-show-parent-buffer nil)
+(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(defvar notmuch-show-query-context nil)
+(make-variable-buffer-local 'notmuch-show-query-context)
+(defvar notmuch-show-buffer-name nil)
+(make-variable-buffer-local 'notmuch-show-buffer-name)
+
+(defun notmuch-show-buttonise-links (start end)
+ "Buttonise URLs and mail addresses between START and END.
+
+This also turns id:\"<message id>\"-parts into buttons for
+a corresponding notmuch search."
+ (goto-address-fontify-region start end)
+ (save-excursion
+ (goto-char start)
+ (while (re-search-forward "id:\\(\"?\\)[^[:space:]\"]+\\1" end t)
+ ;; remove the overlay created by goto-address-mode
+ (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
+ (make-text-button (match-beginning 0) (match-end 0)
+ 'action `(lambda (arg)
+ (notmuch-search ,(match-string-no-properties 0)))
+ 'follow-link t
+ 'help-echo "Mouse-1, RET: search for this message"
+ 'face goto-address-mail-face))))
;;;###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
messages from the thread matching this search term are shown if
non-nil.
-The optional BUFFER-NAME provides the neame of the buffer in
+The optional BUFFER-NAME provides the name of the buffer in
which the message thread is shown. If it is nil (which occurs
when the command is called interactively) the argument to the
function is used. "
(interactive "sNotmuch show: ")
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- (or buffer-name
- (concat "*notmuch-" thread-id "*")))))
- (inhibit-read-only t))
+ (let* ((buffer-name (generate-new-buffer-name
+ (or buffer-name
+ (concat "*notmuch-" thread-id "*"))))
+ (buffer (get-buffer-create buffer-name))
+ (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-thread-id thread-id)
+ (setq notmuch-show-parent-buffer parent-buffer)
+ (setq notmuch-show-query-context query-context)
+ (setq notmuch-show-buffer-name buffer-name)
+ (setq notmuch-show-process-crypto process-crypto)
+
(erase-buffer)
(goto-char (point-min))
(save-excursion
(notmuch-show-insert-forest
(notmuch-query-get-threads basic-args))))
- ;; Enable buttonisation of URLs and email addresses in the
- ;; buffer.
- (goto-address-mode t)
+ (jit-lock-register #'notmuch-show-buttonise-links)
+
;; Act on visual lines rather than logical lines.
(visual-line-mode t)
(notmuch-show-mark-read)))
+(defun notmuch-show-refresh-view (&optional crypto-switch)
+ "Refresh the current view (with crypto switch if prefix given).
+
+Kills the current buffer and reruns notmuch show with the same
+thread id. If a prefix is given, the current thread is
+redisplayed with the crypto switch activated, which switch the
+logic of the notmuch-crypto-process-mime customization variable."
+ (interactive "P")
+ (let ((thread-id notmuch-show-thread-id)
+ (parent-buffer notmuch-show-parent-buffer)
+ (query-context notmuch-show-query-context)
+ (buffer-name notmuch-show-buffer-name))
+ (notmuch-kill-this-buffer)
+ (notmuch-show thread-id parent-buffer query-context buffer-name crypto-switch)))
+
(defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'notmuch-show-stash-cc)
(define-key map "V" 'notmuch-show-view-raw-message)
(define-key map "v" 'notmuch-show-view-all-mime-parts)
(define-key map "c" 'notmuch-show-stash-map)
+ (define-key map "=" 'notmuch-show-refresh-view)
(define-key map "h" 'notmuch-show-toggle-headers)
(define-key map "-" 'notmuch-show-remove-tag)
(define-key map "+" 'notmuch-show-add-tag)
without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread
without scrolling through with \\[notmuch-show-advance-and-archive]).
-You can add or remove arbitary tags from the current message with
+You can add or remove arbitrary tags from the current message with
'\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
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
this buffer, and display the next thread from the search from
which this thread was originally shown."
(interactive)
- (let ((end-of-this-message (notmuch-show-message-bottom)))
+ (let* ((end-of-this-message (notmuch-show-message-bottom))
+ (visible-end-of-this-message (1- end-of-this-message)))
+ (while (invisible-p visible-end-of-this-message)
+ (setq visible-end-of-this-message
+ (previous-single-char-property-change visible-end-of-this-message
+ 'invisible)))
(cond
;; Ideally we would test `end-of-this-message' against the result
;; of `window-end', but that doesn't account for the fact that
- ;; the end of the message might be hidden, so we have to actually
- ;; go to the end, walk back over invisible text and then see if
- ;; point is visible.
- ((save-excursion
- (goto-char (- end-of-this-message 1))
- (notmuch-show-move-past-invisible-backward)
- (> (point) (window-end)))
+ ;; the end of the message might be hidden.
+ ((and visible-end-of-this-message
+ (> visible-end-of-this-message (window-end)))
;; The bottom of this message is not visible - scroll.
(scroll-up nil))
projects / notmuch / blobdiff