X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=0954d87639813cbd0236ee1ce7b9847bd8703d3b;hb=5500868bd96f9461a230d16839591cb7ebc035df;hp=ea4444e5d744bb76aaaebe2640e175e2bac52455;hpb=9ca1f945d9f5030600dc14ffff10d4dad14db4ca;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index ea4444e5..0954d876 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -32,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 @@ -82,6 +83,33 @@ 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-relative-dates t "Display relative dates in the message summary line." :type 'boolean @@ -178,6 +206,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. @@ -189,10 +219,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/") @@ -217,7 +247,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 @@ -275,7 +305,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))))) @@ -333,7 +363,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" @@ -581,16 +611,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. @@ -599,16 +630,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." @@ -717,21 +745,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 @@ -822,7 +852,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 @@ -951,7 +982,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") @@ -991,7 +1023,7 @@ 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)) (long (and (notmuch-match-content-type mime-type "text/*") @@ -1003,7 +1035,8 @@ is t, hide the part initially and show the button." ;; the first (or only) part if this is text/plain. (button (and (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 ;; and we have a button to allow toggling. @@ -1252,14 +1285,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) @@ -1307,6 +1334,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. @@ -1314,9 +1353,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) @@ -1325,8 +1365,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) @@ -1334,12 +1376,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) @@ -1790,7 +1827,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))) @@ -2024,7 +2061,7 @@ to show, nil otherwise." (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)) + (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id)) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -2070,19 +2107,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. @@ -2189,7 +2226,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)