X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=7c1f02c92f1499be58df08929863d4e1aa013118;hb=332b3b639ebd797eac6980fc7bd547f6cd064e84;hp=c9b1e966bc654e6345411eb699424fc18588f3f6;hpb=9fadab4e63afcc2adf06eac964da8bc8e5c9cd47;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index c9b1e966..7c1f02c9 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -1,4 +1,4 @@ -;;; notmuch-show.el --- displaying notmuch forests +;;; notmuch-show.el --- displaying notmuch forests -*- lexical-binding: t -*- ;; ;; Copyright © Carl Worth ;; Copyright © David Edmondson @@ -23,10 +23,6 @@ ;;; Code: -(eval-when-compile - (require 'cl-lib) - (require 'pcase)) - (require 'mm-view) (require 'message) (require 'mm-decode) @@ -43,22 +39,30 @@ (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 + (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") "Headers that should be shown in a message, in this order. @@ -80,6 +84,11 @@ visible for any given message." :type 'boolean :group 'notmuch-show) +(defcustom notmuch-show-header-line t + "Show a header line with the current message's subject." + :type 'boolean + :group 'notmuch-show) + (defcustom notmuch-show-relative-dates t "Display relative dates in the message summary line." :type 'boolean @@ -162,6 +171,8 @@ indentation." :type '(choice (const nil) regexp) :group 'notmuch-show) +;;; Variables + (defvar-local notmuch-show-thread-id nil) (defvar-local notmuch-show-parent-buffer nil) @@ -174,6 +185,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. @@ -182,11 +195,13 @@ handlers is discarded. When set to t the stdout and stderr from each attachment handler is logged in buffers with names beginning \" *notmuch-part*\".") +;;; 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/") @@ -211,7 +226,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 @@ -260,6 +275,8 @@ position of the message in the thread." :type 'boolean :group 'notmuch-show) +;;; Utilities + (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message." `(save-excursion @@ -267,7 +284,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))))) @@ -275,6 +292,8 @@ position of the message in the thread." "Enable Visual Line mode." (visual-line-mode t)) +;;; Commands + ;; DEPRECATED in Notmuch 0.16 since we now have convenient part ;; commands. We'll keep the command around for a version or two in ;; case people want to bind it themselves. @@ -323,7 +342,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" @@ -355,6 +374,8 @@ operation on the contents of the current buffer." (interactive) (notmuch-show-with-message-as-text 'notmuch-print-message)) +;;; Headers + (defun notmuch-show-fontify-header () (let ((face (cond ((looking-at "[Tt]o:") @@ -493,13 +514,15 @@ message at DEPTH in the current thread." (narrow-to-region start (point-max)) (run-hooks 'notmuch-show-markup-headers-hook))))) +;;; Parts + (define-button-type 'notmuch-show-part-button-type 'action 'notmuch-show-part-button-default 'follow-link t 'face 'message-mml :supertype 'notmuch-button-type) -(defun notmuch-show-insert-part-header (nth content-type declared-type +(defun notmuch-show-insert-part-header (_nth content-type declared-type &optional name comment) (let ((base-label (concat (and name (concat name ": ")) declared-type @@ -548,7 +571,7 @@ message at DEPTH in the current thread." (overlay-put overlay 'invisible (not show)) t))))))) -;; Part content ID handling +;;; Part content ID handling (defvar notmuch-show--cids nil "Alist from raw content ID to (MSG PART).") @@ -567,16 +590,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. @@ -585,16 +609,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." @@ -606,7 +627,7 @@ will return nil if the CID is unknown or cannot be retrieved." (setq mm-html-inhibit-images nil)) (defvar w3m-current-buffer) ;; From `w3m.el'. -(defun notmuch-show--cid-w3m-retrieve (url &rest args) +(defun notmuch-show--cid-w3m-retrieve (url &rest _args) ;; url includes the cid: prefix and is URL encoded (see RFC 2392). (let* ((cid (url-unhex-string (substring url 4))) (content-and-type @@ -622,7 +643,7 @@ will return nil if the CID is unknown or cannot be retrieved." (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) (plist-get part :content))) -(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button) +(defun notmuch-show-insert-part-multipart/alternative (msg part _content-type _nth depth _button) (let ((chosen-type (car (notmuch-multipart/alternative-choose msg (notmuch-show-multipart/*-to-list part)))) (inner-parts (plist-get part :content)) @@ -641,7 +662,7 @@ will return nil if the CID is unknown or cannot be retrieved." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button) +(defun notmuch-show-insert-part-multipart/related (msg part _content-type _nth depth _button) (let ((inner-parts (plist-get part :content)) (start (point))) ;; Render the primary part. FIXME: Support RFC 2387 Start header. @@ -654,7 +675,7 @@ will return nil if the CID is unknown or cannot be retrieved." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button) +(defun notmuch-show-insert-part-multipart/signed (msg part _content-type _nth depth button) (when button (button-put button 'face 'notmuch-crypto-part-header)) ;; Insert a button detailing the signature status. @@ -670,7 +691,7 @@ will return nil if the CID is unknown or cannot be retrieved." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button) +(defun notmuch-show-insert-part-multipart/encrypted (msg part _content-type _nth depth button) (when button (button-put button 'face 'notmuch-crypto-part-header)) ;; Insert a button detailing the encryption status. @@ -688,10 +709,10 @@ will return nil if the CID is unknown or cannot be retrieved." (indent-rigidly start (point) 1))) t) -(defun notmuch-show-insert-part-application/pgp-encrypted (msg part content-type nth depth button) +(defun notmuch-show-insert-part-application/pgp-encrypted (_msg _part _content-type _nth _depth _button) t) -(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button) +(defun notmuch-show-insert-part-multipart/* (msg part _content-type _nth depth _button) (let ((inner-parts (plist-get part :content)) (start (point))) ;; Show all of the parts. @@ -702,24 +723,26 @@ will return nil if the CID is unknown or cannot be retrieved." (indent-rigidly start (point) 1))) 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) - -(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth button) +(defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button) + (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 ;; to the whole of the part including the part button if there is ;; one. @@ -733,7 +756,7 @@ will return nil if the CID is unknown or cannot be retrieved." (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth)))) t) -(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth button) +(defun notmuch-show-insert-part-text/calendar (msg part _content-type _nth _depth _button) (insert (with-temp-buffer (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto)) ;; notmuch-get-bodypart-text does no newline conversion. @@ -757,8 +780,8 @@ will return nil if the CID is unknown or cannot be retrieved." t) ;; For backwards compatibility. -(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button) - (notmuch-show-insert-part-text/calendar msg part content-type nth depth button)) +(defun notmuch-show-insert-part-text/x-vcalendar (msg part _content-type _nth depth _button) + (notmuch-show-insert-part-text/calendar msg part nil nil depth nil)) (when (version< emacs-version "25.3") ;; https://bugs.gnu.org/28350 @@ -774,7 +797,7 @@ will return nil if the CID is unknown or cannot be retrieved." ;; the first time). (require 'enriched) (cl-letf (((symbol-function 'enriched-decode-display-prop) - (lambda (start end &optional param) (list start end)))) + (lambda (start end &optional _param) (list start end)))) (notmuch-show-insert-part-*/* msg part content-type nth depth button)))) (defun notmuch-show-get-mime-type-of-application/octet-stream (part) @@ -808,10 +831,12 @@ 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)))) -;; These functions are used by notmuch-show--insert-part-text/html-shr +;;; Functions used by notmuch-show--insert-part-text/html-shr + (declare-function libxml-parse-html-region "xml.c") (declare-function shr-insert-document "shr") @@ -831,12 +856,12 @@ will return nil if the CID is unknown or cannot be retrieved." (shr-insert-document dom) t)) -(defun notmuch-show-insert-part-*/* (msg part content-type nth depth button) +(defun notmuch-show-insert-part-*/* (msg part content-type _nth _depth _button) ;; This handler _must_ succeed - it is the handler of last resort. (notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto) t) -;; Functions for determining how to handle MIME parts. +;;; Functions for determining how to handle MIME parts. (defun notmuch-show-handlers-for (content-type) "Return a list of content handlers for a part of type CONTENT-TYPE." @@ -852,7 +877,7 @@ will return nil if the CID is unknown or cannot be retrieved." (intern (concat "notmuch-show-insert-part-" content-type)))) result)) -;; +;;; Parts (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button) ;; Run the handlers until one of them succeeds. @@ -936,7 +961,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") @@ -951,13 +977,13 @@ The function should take two parameters, PART and HIDE, and should return non-NIL if a header button should be inserted for this part.") -(defun notmuch-show-insert-header-p (part hide) +(defun notmuch-show-insert-header-p (part _hide) ;; Show all part buttons except for the first part if it is text/plain. (let ((mime-type (notmuch-show-mime-type part))) (not (and (string= mime-type "text/plain") (<= (plist-get part :id) 1))))) -(defun notmuch-show-reply-insert-header-p-never (part hide) +(defun notmuch-show-reply-insert-header-p-never (_part _hide) nil) (defun notmuch-show-reply-insert-header-p-trimmed (part hide) @@ -976,7 +1002,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/*") @@ -988,7 +1014,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. @@ -1098,6 +1125,8 @@ is t, hide the part initially and show the button." (notmuch-show-message-visible msg (and (plist-get msg :match) (not (plist-get msg :excluded)))))) +;;; Toggle commands + (defun notmuch-show-toggle-process-crypto () "Toggle the processing of cryptographic MIME parts." (interactive) @@ -1126,6 +1155,8 @@ is t, hide the part initially and show the button." "Content is not indented.")) (notmuch-show-refresh-view)) +;;; Main insert functions + (defun notmuch-show-insert-tree (tree depth) "Insert the message tree TREE at depth DEPTH in the current thread." (let ((msg (car tree)) @@ -1143,6 +1174,8 @@ is t, hide the part initially and show the button." "Insert the forest of threads FOREST." (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest)) +;;; Link buttons + (defvar notmuch-id-regexp (concat ;; Match the id: prefix only if it begins a word (to disallow, for @@ -1203,6 +1236,8 @@ buttons for a corresponding notmuch search." 'help-echo "Mouse-1, RET: search for this message" 'face goto-address-mail-face))))) +;;; Show command + ;;;###autoload (defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name) "Run \"notmuch show\" with the given thread ID and display results. @@ -1291,9 +1326,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) @@ -1304,6 +1340,8 @@ If no messages match the query return NIL." (while (and (not forest) queries) (setq forest (notmuch-query-get-threads (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) @@ -1312,11 +1350,12 @@ If no messages match the query return NIL." (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))))) + (when notmuch-show-header-line + (setq header-line-format + (replace-regexp-in-string "%" "%%" + (notmuch-sanitize + (notmuch-show-strip-re + (notmuch-show-get-subject)))))) (run-hooks 'notmuch-show-hook) (if state (notmuch-show-apply-state state) @@ -1325,6 +1364,8 @@ If no messages match the query return NIL." ;; Report back to the caller whether any messages matched. forest)) +;;; Refresh command + (defun notmuch-show-capture-state () "Capture the state of the current buffer. @@ -1399,6 +1440,8 @@ reset based on the original query." (ding) (message "Refreshing the buffer resulted in no messages!")))) +;;; Keymaps + (defvar notmuch-show-stash-map (let ((map (make-sparse-keymap))) (define-key map "c" 'notmuch-show-stash-cc) @@ -1479,6 +1522,8 @@ reset based on the original query." map) "Keymap for \"notmuch show\" buffers.") +;;; Mode + (define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show" "Major mode for viewing a thread with notmuch. @@ -1515,6 +1560,8 @@ All currently available key bindings: (setq imenu-extract-index-name-function #'notmuch-show-imenu-extract-index-name-function)) +;;; Tree commands + (defun notmuch-tree-from-show-current-query () "Call notmuch tree with the current query." (interactive) @@ -1529,17 +1576,14 @@ All currently available key bindings: notmuch-show-query-context (notmuch-show-get-message-id))) +;;; Movement related functions. + (defun notmuch-show-move-to-message-top () (goto-char (notmuch-show-message-top))) (defun notmuch-show-move-to-message-bottom () (goto-char (notmuch-show-message-bottom))) -(defun notmuch-show-message-adjust () - (recenter 0)) - -;; Movement related functions. - ;; There's some strangeness here where a text property applied to a ;; region a->b is not found when point is at b. We walk backwards ;; until finding the property. @@ -1583,8 +1627,7 @@ effects." (cl-loop do (funcall function) while (notmuch-show-goto-message-next)))) -;; Functions relating to the visibility of messages and their -;; components. +;;; Functions relating to the visibility of messages and their components. (defun notmuch-show-message-visible (props visible-p) (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p)) @@ -1594,8 +1637,7 @@ effects." (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p)) (notmuch-show-set-prop :headers-visible visible-p props)) -;; Functions for setting and getting attributes of the current -;; message. +;;; Functions for setting and getting attributes of the current message. (defun notmuch-show-set-message-properties (props) (save-excursion @@ -1636,13 +1678,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. @@ -1729,7 +1771,7 @@ marked as unread, i.e. the tag changes in (apply 'notmuch-show-tag-message (notmuch-tag-change-list notmuch-show-mark-read-tags unread)))) -(defun notmuch-show-seen-current-message (start end) +(defun notmuch-show-seen-current-message (_start _end) "Mark the current message read if it is open. We only mark it read once: if it is changed back then that is a @@ -1747,11 +1789,11 @@ user decision and we should not override it." ;; We need to redisplay to get window-start and window-end correct. (redisplay) (save-excursion - (condition-case err + (condition-case nil (funcall notmuch-show-mark-read-function (window-start) (window-end)) ((debug error) (unless notmuch-show--seen-has-errored - (setq notmuch-show--seen-has-errored 't) + (setq notmuch-show--seen-has-errored t) (setq header-line-format (concat header-line-format (propertize @@ -1764,12 +1806,11 @@ 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))) -;; Functions for getting attributes of several messages in the current -;; thread. +;;; Functions for getting attributes of several messages in the current thread. (defun notmuch-show-get-message-ids-for-open-messages () "Return a list of all id: queries for open messages in the current thread." @@ -1783,7 +1824,7 @@ Reshows the current thread with matches defined by the new query-string." (setq done (not (notmuch-show-goto-message-next)))) message-ids))) -;; Commands typically bound to keys. +;;; Commands typically bound to keys. (defun notmuch-show-advance () "Advance through thread. @@ -1911,6 +1952,9 @@ any effects from previous calls to (message-resend addresses) (notmuch-bury-or-kill-this-buffer))) +(defun notmuch-show-message-adjust () + (recenter 0)) + (defun notmuch-show-next-message (&optional pop-at-end) "Show the next message. @@ -1996,7 +2040,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) @@ -2042,19 +2086,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. @@ -2381,7 +2425,7 @@ omit --in-reply-to=." (list (notmuch-show-get-message-id t)) "--in-reply-to=")))) " "))) -;; Interactive part functions and their helpers +;;; Interactive part functions and their helpers (defun notmuch-show-generate-part-buffer (msg part) "Return a temporary buffer containing the specified part's content." @@ -2528,6 +2572,8 @@ browsing." (funcall fn (completing-read prompt urls nil nil nil nil (car urls))) (message "No URLs found.")))) +;;; _ + (provide 'notmuch-show) ;;; notmuch-show.el ends here