X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=939f8913f2508d5ff145bdbd6a1477fcf278fae4;hp=48374b38451ed67887c27595cd90a3710a6b12d8;hb=HEAD;hpb=0067a43ea2ee554eafed1e1300a71259cd6b6a6d diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 48374b38..4c0ad74d 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -23,10 +23,6 @@ ;;; Code: -(eval-when-compile - (require 'cl-lib) - (require 'pcase)) - (require 'mm-view) (require 'message) (require 'mm-decode) @@ -36,32 +32,33 @@ (require 'notmuch-lib) (require 'notmuch-tag) -(require 'notmuch-query) (require 'notmuch-wash) (require 'notmuch-mua) (require 'notmuch-crypto) (require 'notmuch-print) (require 'notmuch-draft) -(declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) +(declare-function notmuch-call-notmuch-process "notmuch-lib" (&rest args)) (declare-function notmuch-search-next-thread "notmuch" nil) (declare-function notmuch-search-previous-thread "notmuch" nil) -(declare-function notmuch-search-show-thread "notmuch" nil) +(declare-function notmuch-search-show-thread "notmuch") (declare-function notmuch-foreach-mime-part "notmuch" (function mm-handle)) (declare-function notmuch-count-attachments "notmuch" (mm-handle)) (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp)) (declare-function notmuch-tree "notmuch-tree" (&optional query query-context target buffer-name - open-target unthreaded)) + open-target unthreaded parent-buffer)) (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil) -(declare-function notmuch-unthreaded - (&optional query query-context target buffer-name open-target)) +(declare-function notmuch-unthreaded "notmuch-tree" + (&optional query query-context target buffer-name + open-target)) (declare-function notmuch-read-query "notmuch" (prompt)) (declare-function notmuch-draft-resume "notmuch-draft" (id)) (defvar shr-blocked-images) (defvar gnus-blocked-images) (defvar shr-content-function) +(defvar w3m-ignored-image-url-regexp) ;;; Options @@ -86,6 +83,59 @@ visible for any given message." :type 'boolean :group 'notmuch-show) +(defcustom notmuch-show-header-line t + "Show a header line in notmuch show buffers. + +If t (the default), the header line will contain the current +message's subject. + +If a string, this value is interpreted as a format string to be +passed to `format-spec` with `%s` as the substitution variable +for the message's subject. E.g., to display the subject trimmed +to a maximum of 80 columns, you could use \"%>-80s\" as format. + +If you assign to this variable a function, it will be called with +the subject as argument, and the return value will be used as the +header line format. Since the function is called with the +message buffer as the current buffer, it is also possible to +access any other properties of the message, using for instance +notmuch-show functions such as +`notmuch-show-get-message-properties'. + +Finally, if this variable is set to nil, no header is +displayed." + :type '(choice (const :tag "No header" ni) + (const :tag "Subject" t) + (string :tag "Format") + (function :tag "Function")) + :group 'notmuch-show) + +(defcustom notmuch-show-depth-limit nil + "Depth beyond which message bodies are displayed lazily. + +If bound to an integer, any message with tree depth greater than +this will have its body display lazily, initially +inserting only a button. + +If this variable is set to nil (the default) no such lazy +insertion is done." + :type '(choice (const :tag "No limit" nil) + (number :tag "Limit" 10)) + :group 'notmuch-show) + +(defcustom notmuch-show-height-limit nil + "Height (from leaves) beyond which message bodies are displayed lazily. + +If bound to an integer, any message with height in the message +tree greater than this will have its body displayed lazily, +initially only a button. + +If this variable is set to nil (the default) no such lazy +display is done." + :type '(choice (const :tag "No limit" nil) + (number :tag "Limit" 10)) + :group 'notmuch-show) + (defcustom notmuch-show-relative-dates t "Display relative dates in the message summary line." :type 'boolean @@ -182,6 +232,8 @@ indentation." (defvar-local notmuch-show-indent-content t) +(defvar-local notmuch-show-single-message nil) + (defvar notmuch-show-attachment-debug nil "If t log stdout and stderr from attachment handlers. @@ -193,10 +245,10 @@ each attachment handler is logged in buffers with names beginning ;;; Options (defcustom notmuch-show-stash-mlarchive-link-alist - '(("Gmane" . "https://mid.gmane.org/") - ("MARC" . "https://marc.info/?i=") + '(("MARC" . "https://marc.info/?i=") ("Mail Archive, The" . "https://mid.mail-archive.com/") - ("LKML" . "https://lkml.kernel.org/r/") + ("Lore" . "https://lore.kernel.org/r/") + ("Notmuch" . "https://nmbug.notmuchmail.org/nmweb/show/") ;; FIXME: can these services be searched by `Message-Id' ? ;; ("MarkMail" . "http://markmail.org/") ;; ("Nabble" . "http://nabble.com/") @@ -221,7 +273,7 @@ return the ML archive reference URI." (function :tag "Function returning the URL"))) :group 'notmuch-show) -(defcustom notmuch-show-stash-mlarchive-link-default "Gmane" +(defcustom notmuch-show-stash-mlarchive-link-default "MARC" "Default Mailing List Archive to use when stashing links. This is used when `notmuch-show-stash-mlarchive-link' isn't @@ -279,7 +331,7 @@ position of the message in the thread." (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*")))) (with-current-buffer buf (let ((coding-system-for-read 'no-conversion)) - (call-process notmuch-command nil t nil "show" "--format=raw" id)) + (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id)) ,@body) (kill-buffer buf))))) @@ -337,7 +389,7 @@ operation on the contents of the current buffer." (header (concat "Subject: " subject "\n" "To: " to "\n" - (if (not (string= cc "")) + (if (not (string-empty-p cc)) (concat "Cc: " cc "\n") "") "From: " from "\n" @@ -400,14 +452,19 @@ operation on the contents of the current buffer." (defun notmuch-show-update-tags (tags) "Update the displayed tags of the current message." (save-excursion - (goto-char (notmuch-show-message-top)) - (when (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) - (let ((inhibit-read-only t)) - (replace-match (concat "(" - (notmuch-tag-format-tags - tags - (notmuch-show-get-prop :orig-tags)) - ")")))))) + (let ((inhibit-read-only t) + (start (notmuch-show-message-top)) + (depth (notmuch-show-get-prop :depth)) + (orig-tags (notmuch-show-get-prop :orig-tags)) + (props (notmuch-show-get-message-properties)) + (extent (notmuch-show-message-extent))) + (goto-char start) + (notmuch-show-insert-headerline props depth tags orig-tags) + (put-text-property start (1+ start) + :notmuch-message-properties props) + (put-text-property (car extent) (cdr extent) :notmuch-message-extent extent) + ;; delete original headerline, but do not save to kill ring + (delete-region (point) (1+ (line-end-position)))))) (defun notmuch-clean-address (address) "Try to clean a single email ADDRESS for display. Return a cons @@ -466,11 +523,29 @@ Return unchanged ADDRESS if parsing fails." ;; Otherwise format the name and address together. (concat p-name " <" p-address ">")))) -(defun notmuch-show-insert-headerline (headers date tags depth) +(defun notmuch-show--mark-height (tree) + "Calculate and cache height (distance from deepest descendent)" + (let* ((msg (car tree)) + (children (cadr tree)) + (cached-height (plist-get msg :height))) + (or cached-height + (let ((height + (if (null children) 0 + (1+ (apply #'max (mapcar #'notmuch-show--mark-height children)))))) + (plist-put msg :height height) + height)))) + +(defun notmuch-show-insert-headerline (msg-plist depth tags &optional orig-tags) "Insert a notmuch style headerline based on HEADERS for a message at DEPTH in the current thread." - (let ((start (point)) - (from (notmuch-sanitize + (let* ((start (point)) + (headers (plist-get msg-plist :headers)) + (duplicate (or (plist-get msg-plist :duplicate) 0)) + (file-count (length (plist-get msg-plist :filename))) + (date (or (and notmuch-show-relative-dates + (plist-get msg-plist :date_relative)) + (plist-get headers :Date))) + (from (notmuch-sanitize (notmuch-show-clean-address (plist-get headers :From))))) (when (string-match "\\cR" from) ;; If the From header has a right-to-left character add @@ -485,8 +560,15 @@ message at DEPTH in the current thread." " (" date ") (" - (notmuch-tag-format-tags tags tags) - ")\n") + (notmuch-tag-format-tags tags (or orig-tags tags)) + ")") + (insert + (if (> file-count 1) + (let ((txt (format "%d/%d\n" duplicate file-count))) + (concat + (notmuch-show-spaces-n (max 0 (- (window-width) (+ (current-column) (length txt))))) + txt)) + "\n")) (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) @@ -562,8 +644,24 @@ message at DEPTH in the current thread." (when show (button-put button :notmuch-lazy-part nil) (notmuch-show-lazy-part lazy-part button)) - ;; else there must be an overlay. - (overlay-put overlay 'invisible (not show)) + (let* ((part (plist-get properties :notmuch-part)) + (undisplayer (plist-get part :undisplayer)) + (mime-type (plist-get part :computed-type)) + (redisplay-data (button-get button + :notmuch-redisplay-data)) + (imagep (string-match "^image/" mime-type))) + (cond + ((and imagep (not show) undisplayer) + ;; call undisplayer thunk created by gnus. + (funcall undisplayer) + ;; there is an extra newline left + (delete-region + (+ 1 (button-end button)) + (+ 2 (button-end button)))) + ((and imagep show redisplay-data) + (notmuch-show-lazy-part redisplay-data button)) + (t + (overlay-put overlay 'invisible (not show))))) t))))))) ;;; Part content ID handling @@ -585,16 +683,17 @@ message at DEPTH in the current thread." ;; alternative (even if we can't render it). (push (list content-id msg part) notmuch-show--cids))) ;; Recurse on sub-parts - (pcase-let ((`(,content ,type) - (split-string (downcase (plist-get part :content-type)) "/"))) - (cond ((equal content "multipart") - (mapc (apply-partially #'notmuch-show--register-cids msg) - (plist-get part :content))) - ((and (equal content "message") - (equal type "rfc822")) - (notmuch-show--register-cids - msg - (car (plist-get (car (plist-get part :content)) :body))))))) + (when-let ((type (plist-get part :content-type))) + (pcase-let ((`(,type ,subtype) + (split-string (downcase type) "/"))) + (cond ((equal type "multipart") + (mapc (apply-partially #'notmuch-show--register-cids msg) + (plist-get part :content))) + ((and (equal type "message") + (equal subtype "rfc822")) + (notmuch-show--register-cids + msg + (car (plist-get (car (plist-get part :content)) :body)))))))) (defun notmuch-show--get-cid-content (cid) "Return a list (CID-content content-type) or nil. @@ -603,16 +702,13 @@ This will only find parts from messages that have been inserted into the current buffer. CID must be a raw content ID, without enclosing angle brackets, a cid: prefix, or URL encoding. This will return nil if the CID is unknown or cannot be retrieved." - (let ((descriptor (cdr (assoc cid notmuch-show--cids)))) - (when descriptor - (let* ((msg (car descriptor)) - (part (cadr descriptor)) - ;; Request caching for this content, as some messages - ;; reference the same cid: part many times (hundreds!). - (content (notmuch-get-bodypart-binary - msg part notmuch-show-process-crypto 'cache)) - (content-type (plist-get part :content-type))) - (list content content-type))))) + (when-let ((descriptor (cdr (assoc cid notmuch-show--cids)))) + (pcase-let ((`(,msg ,part) descriptor)) + ;; Request caching for this content, as some messages + ;; reference the same cid: part many times (hundreds!). + (list (notmuch-get-bodypart-binary + msg part notmuch-show-process-crypto 'cache) + (plist-get part :content-type))))) (defun notmuch-show-setup-w3m () "Instruct w3m how to retrieve content from a \"related\" part of a message." @@ -721,21 +817,23 @@ will return nil if the CID is unknown or cannot be retrieved." t) (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))) - ;; 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 message :headers))) - ;; Blank line after headers to be compatible with the normal - ;; message display. - (insert "\n") - ;; Show the body - (notmuch-show-insert-bodypart msg body depth) - (when notmuch-show-indent-multipart - (indent-rigidly start (point) 1))) - t) + (let ((message (car (plist-get part :content)))) + (and + message + (let ((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 message :headers))) + ;; Blank line after headers to be compatible with the normal + ;; message display. + (insert "\n") + ;; 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 button) ;; For backward compatibility we want to apply the text/plain hook @@ -826,7 +924,8 @@ will return nil if the CID is unknown or cannot be retrieved." (let ((mm-inline-text-html-with-w3m-keymap nil) ;; FIXME: If we block an image, offer a button to load external ;; images. - (gnus-blocked-images notmuch-show-text/html-blocked-images)) + (gnus-blocked-images notmuch-show-text/html-blocked-images) + (w3m-ignored-image-url-regexp notmuch-show-text/html-blocked-images)) (notmuch-show-insert-part-*/* msg part content-type nth depth button)))) ;;; Functions used by notmuch-show--insert-part-text/html-shr @@ -936,10 +1035,13 @@ will return nil if the CID is unknown or cannot be retrieved." (part-end (copy-marker (point) t)) ;; We have to save the depth as we can't find the depth ;; when narrowed. - (depth (notmuch-show-get-depth))) + (depth (notmuch-show-get-depth)) + (mime-type (plist-get (cadr part-args) :computed-type))) (save-restriction (narrow-to-region part-beg part-end) (delete-region part-beg part-end) + (when (and mime-type (string-match "^image/" mime-type)) + (button-put button :notmuch-redisplay-data part-args)) (apply #'notmuch-show-insert-bodypart-internal part-args) (indent-rigidly part-beg part-end @@ -955,7 +1057,8 @@ will return nil if the CID is unknown or cannot be retrieved." (defun notmuch-show-mime-type (part) "Return the correct mime-type to use for PART." - (let ((content-type (downcase (plist-get part :content-type)))) + (when-let ((content-type (plist-get part :content-type))) + (setq content-type (downcase content-type)) (or (and (string= content-type "application/octet-stream") (notmuch-show-get-mime-type-of-application/octet-stream part)) (and (string= content-type "inline patch") @@ -995,32 +1098,45 @@ this part.") HIDE determines whether to show or hide the part and the button as follows: If HIDE is nil, show the part and the button. If HIDE is t, hide the part initially and show the button." - (let* ((content-type (downcase (plist-get part :content-type))) + (let* ((content-type (plist-get part :content-type)) (mime-type (notmuch-show-mime-type part)) (nth (plist-get part :id)) + (height (plist-get msg :height)) (long (and (notmuch-match-content-type mime-type "text/*") (> notmuch-show-max-text-part-size 0) (> (length (plist-get part :content)) notmuch-show-max-text-part-size))) + (deep (and notmuch-show-depth-limit + (> depth notmuch-show-depth-limit))) + (high (and notmuch-show-height-limit + (> height notmuch-show-height-limit))) (beg (point)) ;; This default header-p function omits the part button for ;; the first (or only) part if this is text/plain. - (button (and (funcall notmuch-show-insert-header-p-function part hide) + (button (and (or deep long high + (funcall notmuch-show-insert-header-p-function part hide)) (notmuch-show-insert-part-header - nth mime-type content-type + nth mime-type + (and content-type (downcase content-type)) (plist-get part :filename)))) - ;; Hide the part initially if HIDE is t, or if it is too long + ;; Hide the part initially if HIDE is t, or if it is too long/deep ;; and we have a button to allow toggling. (show-part (not (or (equal hide t) + (and deep button) + (and high button) (and long button)))) - (content-beg (point))) + (content-beg (point)) + (part-data (list msg part mime-type nth depth button))) ;; Store the computed mime-type for later use (e.g. by attachment handlers). (plist-put part :computed-type mime-type) - (if show-part - (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button) + (cond + (show-part + (apply #'notmuch-show-insert-bodypart-internal part-data) + (when (and button (string-match "^image/" mime-type)) + (button-put button :notmuch-redisplay-data part-data))) + (t (when button - (button-put button :notmuch-lazy-part - (list msg part mime-type nth depth button)))) + (button-put button :notmuch-lazy-part part-data)))) ;; 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)) @@ -1052,6 +1168,40 @@ is t, hide the part initially and show the button." (defvar notmuch-show-previous-subject "") (make-variable-buffer-local 'notmuch-show-previous-subject) +(defun notmuch-show-choose-duplicate (duplicate) + "Display message file with index DUPLICATE in place of the current one. + +Message file indices are based on the order the files are +discovered by `notmuch new' (and hence are somewhat arbitrary), +and correspond to those passed to the \"\\-\\-duplicate\" arguments +to the CLI. + +When called interactively, the function will prompt for the index +of the file to display. An error will be signaled if the index +is out of range." + (interactive "Nduplicate: ") + (let ((count (length (notmuch-show-get-prop :filename)))) + (when (or (> duplicate count) + (< duplicate 1)) + (error "Duplicate %d out of range [1,%d]" duplicate count))) + (notmuch-show-move-to-message-top) + (save-excursion + (let* ((extent (notmuch-show-message-extent)) + (id (notmuch-show-get-message-id)) + (depth (notmuch-show-get-depth)) + (inhibit-read-only t) + (new-msg (notmuch--run-show (list id) duplicate))) + ;; clean up existing overlays to avoid extending them. + (dolist (o (overlays-in (car extent) (cdr extent))) + (delete-overlay o)) + ;; pretend insertion is happening at end of buffer + (narrow-to-region (point-min) (car extent)) + ;; Insert first, then delete, to avoid marker for start of next + ;; message being in same place as the start of this one. + (notmuch-show-insert-msg new-msg depth) + (widen) + (delete-region (point) (cdr extent))))) + (defun notmuch-show-insert-msg (msg depth) "Insert the message MSG at depth DEPTH in the current thread." (let* ((headers (plist-get msg :headers)) @@ -1062,11 +1212,7 @@ is t, hide the part initially and show the button." headers-start headers-end (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))) (setq message-start (point-marker)) - (notmuch-show-insert-headerline headers - (or (and notmuch-show-relative-dates - (plist-get msg :date_relative)) - (plist-get headers :Date)) - (plist-get msg :tags) depth) + (notmuch-show-insert-headerline msg depth (plist-get msg :tags)) (setq content-start (point-marker)) ;; Set `headers-start' to point after the 'Subject:' header to be ;; compatible with the existing implementation. This just sets it @@ -1155,6 +1301,7 @@ is t, hide the part initially and show the button." (replies (cadr tree))) ;; We test whether there is a message or just some replies. (when msg + (notmuch-show--mark-height tree) (notmuch-show-insert-msg msg depth)) (notmuch-show-insert-thread replies (1+ depth)))) @@ -1256,14 +1403,8 @@ matched." (let ((buffer-name (generate-new-buffer-name (or buffer-name (concat "*notmuch-" thread-id "*")))) - ;; We override mm-inline-override-types to stop application/* - ;; parts from being displayed unless the user has customized - ;; it themselves. - (mm-inline-override-types - (if (equal mm-inline-override-types - (eval (car (get 'mm-inline-override-types 'standard-value)))) - (cons "application/*" mm-inline-override-types) - mm-inline-override-types))) + (mm-inline-override-types (notmuch--inline-override-types))) + (pop-to-buffer-same-window (get-buffer-create buffer-name)) ;; No need to track undo information for this buffer. (setq buffer-undo-list t) @@ -1311,6 +1452,18 @@ fallback if the prior matches no messages." (push (list thread "and (" context ")") queries)) queries)) +(defun notmuch-show--header-line-format () + "Compute the header line format of a notmuch-show buffer." + (when notmuch-show-header-line + (let* ((s (notmuch-sanitize + (notmuch-show-strip-re (notmuch-show-get-subject)))) + (subject (replace-regexp-in-string "%" "%%" s))) + (cond ((stringp notmuch-show-header-line) + (format-spec notmuch-show-header-line `((?s . ,subject)))) + ((functionp notmuch-show-header-line) + (funcall notmuch-show-header-line subject)) + (notmuch-show-header-line subject))))) + (defun notmuch-show--build-buffer (&optional state) "Display messages matching the current buffer context. @@ -1318,9 +1471,10 @@ Apply the previously saved STATE if supplied, otherwise show the first relevant message. If no messages match the query return NIL." - (let* ((cli-args (cons "--exclude=false" - (and notmuch-show-elide-non-matching-messages - (list "--entire-thread=false")))) + (let* ((cli-args (list "--exclude=false")) + (cli-args (if notmuch-show-elide-non-matching-messages (cons "--entire-thread=false" cli-args) cli-args)) + ;; "part 0 is the whole message (headers and body)" notmuch-show(1) + (cli-args (if notmuch-show-single-message (cons "--part=0" cli-args) cli-args)) (queries (notmuch-show--build-queries notmuch-show-thread-id notmuch-show-query-context)) (forest nil) @@ -1329,8 +1483,10 @@ If no messages match the query return NIL." (notmuch-show-previous-subject "")) ;; Use results from the first query that returns some. (while (and (not forest) queries) - (setq forest (notmuch-query-get-threads + (setq forest (notmuch--run-show (append cli-args (list "'") (car queries) (list "'")))) + (when (and forest notmuch-show-single-message) + (setq forest (list (list (list forest))))) (setq queries (cdr queries))) (when forest (notmuch-show-insert-forest forest) @@ -1338,12 +1494,7 @@ If no messages match the query return NIL." ;; display changes. (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags)))) - ;; Set the header line to the subject of the first message. - (setq header-line-format - (replace-regexp-in-string "%" "%%" - (notmuch-sanitize - (notmuch-show-strip-re - (notmuch-show-get-subject))))) + (setq header-line-format (notmuch-show--header-line-format)) (run-hooks 'notmuch-show-hook) (if state (notmuch-show-apply-state state) @@ -1415,6 +1566,7 @@ non-nil) then the state of the buffer (open/closed messages) is reset based on the original query." (interactive "P") (let ((inhibit-read-only t) + (mm-inline-override-types (notmuch--inline-override-types)) (state (unless reset-state (notmuch-show-capture-state)))) ;; `erase-buffer' does not seem to remove overlays, which can lead @@ -1503,6 +1655,7 @@ reset based on the original query." (define-key map "#" 'notmuch-show-print-message) (define-key map "!" 'notmuch-show-toggle-elide-non-matching) (define-key map "$" 'notmuch-show-toggle-process-crypto) + (define-key map "%" 'notmuch-show-choose-duplicate) (define-key map "<" 'notmuch-show-toggle-thread-indentation) (define-key map "t" 'toggle-truncate-lines) (define-key map "." 'notmuch-show-part-map) @@ -1666,13 +1819,13 @@ It gets property PROP from PROPS or, if PROPS is nil, the current message in either tree or show. This means that several utility functions in notmuch-show can be used directly by notmuch-tree as they just need the correct message properties." - (let ((props (or props - (cond ((eq major-mode 'notmuch-show-mode) - (notmuch-show-get-message-properties)) - ((eq major-mode 'notmuch-tree-mode) - (notmuch-tree-get-message-properties)) - (t nil))))) - (plist-get props prop))) + (plist-get (or props + (cond ((eq major-mode 'notmuch-show-mode) + (notmuch-show-get-message-properties)) + ((eq major-mode 'notmuch-tree-mode) + (notmuch-tree-get-message-properties)) + (t nil))) + prop)) (defun notmuch-show-get-message-id (&optional bare) "Return an id: query for the Message-Id of the current message. @@ -1697,10 +1850,10 @@ current thread." ;; dme: Would it make sense to use a macro for many of these? -;; XXX TODO figure out what to do about multiple filenames (defun notmuch-show-get-filename () "Return the filename of the current message." - (car (notmuch-show-get-prop :filename))) + (let ((duplicate (notmuch-show-get-duplicate))) + (nth (1- duplicate) (notmuch-show-get-prop :filename)))) (defun notmuch-show-get-header (header &optional props) "Return the named header of the current message, if any." @@ -1712,6 +1865,10 @@ current thread." (defun notmuch-show-get-date () (notmuch-show-get-header :Date)) +(defun notmuch-show-get-duplicate () + ;; if no duplicate property exists, assume first file + (or (notmuch-show-get-prop :duplicate) 1)) + (defun notmuch-show-get-timestamp () (notmuch-show-get-prop :timestamp)) @@ -1794,7 +1951,7 @@ user decision and we should not override it." Reshows the current thread with matches defined by the new query-string." (interactive (list (notmuch-read-query "Filter thread: "))) (let ((msg-id (notmuch-show-get-message-id))) - (setq notmuch-show-query-context (if (string= query "") nil query)) + (setq notmuch-show-query-context (if (string-empty-p query) nil query)) (notmuch-show-refresh-view t) (notmuch-show-goto-message msg-id))) @@ -1906,13 +2063,15 @@ any effects from previous calls to (defun notmuch-show-reply (&optional prompt-for-sender) "Reply to the sender and all recipients of the current message." (interactive "P") - (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t)) + (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t + (notmuch-show-get-prop :duplicate))) (put 'notmuch-show-reply-sender 'notmuch-prefix-doc "... and prompt for sender") (defun notmuch-show-reply-sender (&optional prompt-for-sender) "Reply to the sender of the current message." (interactive "P") - (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil)) + (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil + (notmuch-show-get-prop :duplicate))) (put 'notmuch-show-forward-message 'notmuch-prefix-doc "... and prompt for sender") @@ -2023,12 +2182,16 @@ to show, nil otherwise." "View the original source of the current message." (interactive) (let* ((id (notmuch-show-get-message-id)) - (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))) + (duplicate (notmuch-show-get-duplicate)) + (args (if (> duplicate 1) + (list (format "--duplicate=%d" duplicate) id) + (list id))) + (buf (get-buffer-create (format "*notmuch-raw-%s-%d*" id duplicate))) (inhibit-read-only t)) (pop-to-buffer-same-window buf) (erase-buffer) (let ((coding-system-for-read 'no-conversion)) - (call-process notmuch-command nil t nil "show" "--format=raw" id)) + (apply #'notmuch--call-process notmuch-command nil t nil "show" "--format=raw" args)) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -2057,7 +2220,7 @@ message." (interactive (let ((query-string (if current-prefix-arg "Pipe all open messages to command: " "Pipe message to command: "))) - (list current-prefix-arg (read-string query-string)))) + (list current-prefix-arg (read-shell-command query-string)))) (let (shell-command) (if entire-thread (setq shell-command @@ -2074,19 +2237,19 @@ message." (let ((cwd default-directory) (buf (get-buffer-create (concat "*notmuch-pipe*")))) (with-current-buffer buf - (setq buffer-read-only nil) - (erase-buffer) - ;; Use the originating buffer's working directory instead of - ;; that of the pipe buffer. - (cd cwd) - (let ((exit-code (call-process-shell-command shell-command nil buf))) - (goto-char (point-max)) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (unless (zerop exit-code) - (pop-to-buffer buf) - (message (format "Command '%s' exited abnormally with code %d" - shell-command exit-code)))))))) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + ;; Use the originating buffer's working directory instead of + ;; that of the pipe buffer. + (cd cwd) + (let ((exit-code (call-process-shell-command shell-command nil buf))) + (goto-char (point-max)) + (set-buffer-modified-p nil) + (unless (zerop exit-code) + (pop-to-buffer buf) + (message (format "Command '%s' exited abnormally with code %d" + shell-command exit-code))))))))) (defun notmuch-show-tag-message (&rest tag-changes) "Change tags for the current message. @@ -2193,7 +2356,9 @@ argument, hide all of the messages." If SHOW is non-nil, open the next item in a show buffer. Otherwise just highlight the next item in the search buffer. If PREVIOUS is non-nil, move to the previous item in the -search results instead." +search results instead. + +Return non-nil on success." (interactive "P") (let ((parent-buffer notmuch-show-parent-buffer)) (notmuch-bury-or-kill-this-buffer) @@ -2342,10 +2507,12 @@ kill-ring." (defun notmuch-show-stash-mlarchive-link (&optional mla) "Copy an ML Archive URI for the current message to the kill-ring. -This presumes that the message is available at the selected Mailing List Archive. +This presumes that the message is available at the selected +Mailing List Archive. -If optional argument MLA is non-nil, use the provided key instead of prompting -the user (see `notmuch-show-stash-mlarchive-link-alist')." +If optional argument MLA is non-nil, use the provided key instead +of prompting the user (see +`notmuch-show-stash-mlarchive-link-alist')." (interactive) (let ((url (cdr (assoc (or mla @@ -2362,12 +2529,15 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')." (concat url (notmuch-show-get-message-id t)))))) (defun notmuch-show-stash-mlarchive-link-and-go (&optional mla) - "Copy an ML Archive URI for the current message to the kill-ring and visit it. + "Copy an ML Archive URI for the current message to the + kill-ring and visit it. -This presumes that the message is available at the selected Mailing List Archive. +This presumes that the message is available at the selected +Mailing List Archive. -If optional argument MLA is non-nil, use the provided key instead of prompting -the user (see `notmuch-show-stash-mlarchive-link-alist')." +If optional argument MLA is non-nil, use the provided key instead +of prompting the user (see +`notmuch-show-stash-mlarchive-link-alist')." (interactive) (notmuch-show-stash-mlarchive-link mla) (browse-url (current-kill 0 t)))