X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;ds=sidebyside;f=emacs%2Fnotmuch-show.el;h=72e21d94387c698739e7cc435d34d13ce40598d1;hb=fc4cda07a9afbbb545dcc6cd835ca697f6ef2a1b;hp=b0f2d28bd6f02057f6e524d81fdcde5d6b46f864;hpb=df3fab18fe70ea750f6f06da30291c67de7e74f2;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index b0f2d28b..72e21d94 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 @@ -59,6 +59,12 @@ (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) + +;;; Options + (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") "Headers that should be shown in a message, in this order. @@ -162,23 +168,19 @@ indentation." :type '(choice (const nil) regexp) :group 'notmuch-show) -(defvar notmuch-show-thread-id nil) -(make-variable-buffer-local 'notmuch-show-thread-id) +;;; Variables -(defvar notmuch-show-parent-buffer nil) -(make-variable-buffer-local 'notmuch-show-parent-buffer) +(defvar-local notmuch-show-thread-id nil) -(defvar notmuch-show-query-context nil) -(make-variable-buffer-local 'notmuch-show-query-context) +(defvar-local notmuch-show-parent-buffer nil) -(defvar notmuch-show-process-crypto nil) -(make-variable-buffer-local 'notmuch-show-process-crypto) +(defvar-local notmuch-show-query-context nil) -(defvar notmuch-show-elide-non-matching-messages nil) -(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages) +(defvar-local notmuch-show-process-crypto nil) -(defvar notmuch-show-indent-content t) -(make-variable-buffer-local 'notmuch-show-indent-content) +(defvar-local notmuch-show-elide-non-matching-messages nil) + +(defvar-local notmuch-show-indent-content t) (defvar notmuch-show-attachment-debug nil "If t log stdout and stderr from attachment handlers. @@ -186,8 +188,9 @@ indentation." When set to nil (the default) stdout and stderr from attachment handlers is discarded. When set to t the stdout and stderr from each attachment handler is logged in buffers with names beginning -\" *notmuch-part*\". This option requires emacs version at least -24.3 to work.") +\" *notmuch-part*\".") + +;;; Options (defcustom notmuch-show-stash-mlarchive-link-alist '(("Gmane" . "https://mid.gmane.org/") @@ -267,6 +270,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 @@ -282,6 +287,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. @@ -362,6 +369,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:") @@ -468,7 +477,10 @@ message at DEPTH in the current thread." ;; invisible U+200E LEFT-TO-RIGHT MARK character which forces ;; the header paragraph as left-to-right text. (insert (propertize (string ?\x200e) 'invisible t))) - (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth)) + (insert (if notmuch-show-indent-content + (notmuch-show-spaces-n (* notmuch-show-indent-messages-width + depth)) + "") from " (" date @@ -497,6 +509,8 @@ 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 @@ -552,7 +566,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).") @@ -571,12 +585,13 @@ 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 - (let ((ctype (notmuch-split-content-type - (downcase (plist-get part :content-type))))) - (cond ((equal (car ctype) "multipart") + (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))) - ((equal ctype '("message" "rfc822")) + ((and (equal content "message") + (equal type "rfc822")) (notmuch-show--register-cids msg (car (plist-get (car (plist-get part :content)) :body))))))) @@ -814,7 +829,8 @@ will return nil if the CID is unknown or cannot be retrieved." (gnus-blocked-images 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") @@ -839,7 +855,7 @@ will return nil if the CID is unknown or cannot be retrieved." (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." @@ -849,14 +865,13 @@ will return nil if the CID is unknown or cannot be retrieved." (push func result))) ;; Reverse order of prefrence. (list (intern (concat "notmuch-show-insert-part-*/*")) - (intern (concat - "notmuch-show-insert-part-" - (car (notmuch-split-content-type content-type)) - "/*")) + (intern (concat "notmuch-show-insert-part-" + (car (split-string content-type "/")) + "/*")) (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. @@ -1102,6 +1117,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) @@ -1130,6 +1147,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)) @@ -1147,6 +1166,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 @@ -1207,6 +1228,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. @@ -1241,7 +1264,7 @@ matched." (eval (car (get 'mm-inline-override-types 'standard-value)))) (cons "application/*" mm-inline-override-types) mm-inline-override-types))) - (switch-to-buffer (get-buffer-create buffer-name)) + (pop-to-buffer-same-window (get-buffer-create buffer-name)) ;; No need to track undo information for this buffer. (setq buffer-undo-list t) (notmuch-show-mode) @@ -1329,6 +1352,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. @@ -1403,6 +1428,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) @@ -1482,7 +1509,8 @@ reset based on the original query." (define-key map "B" 'notmuch-show-browse-urls) map) "Keymap for \"notmuch show\" buffers.") -(fset 'notmuch-show-mode-map notmuch-show-mode-map) + +;;; Mode (define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show" "Major mode for viewing a thread with notmuch. @@ -1520,6 +1548,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) @@ -1534,17 +1564,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. @@ -1588,8 +1615,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)) @@ -1599,8 +1625,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 @@ -1756,7 +1781,7 @@ user decision and we should not override it." (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 @@ -1773,8 +1798,7 @@ Reshows the current thread with matches defined by the new query-string." (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." @@ -1788,7 +1812,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. @@ -1916,6 +1940,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. @@ -1998,7 +2025,7 @@ to show, nil otherwise." (let* ((id (notmuch-show-get-message-id)) (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))) (inhibit-read-only t)) - (switch-to-buffer buf) + (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)) @@ -2057,7 +2084,7 @@ message." (set-buffer-modified-p nil) (setq buffer-read-only t) (unless (zerop exit-code) - (switch-to-buffer-other-window buf) + (pop-to-buffer buf) (message (format "Command '%s' exited abnormally with code %d" shell-command exit-code)))))))) @@ -2346,7 +2373,9 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')." (browse-url (current-kill 0 t))) (defun notmuch-show-stash-git-helper (addresses prefix) - "Escape, trim, quote, and add PREFIX to each address in list of ADDRESSES, and return the result as a single string." + "Normalize all ADDRESSES while adding PREFIX. +Escape, trim, quote and add PREFIX to each address in list +of ADDRESSES, and return the result as a single string." (mapconcat (lambda (x) (concat prefix "\"" ;; escape double-quotes @@ -2359,10 +2388,12 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')." addresses " ")) (put 'notmuch-show-stash-git-send-email 'notmuch-prefix-doc - "Copy From/To/Cc of current message to kill-ring in a form suitable for pasting to git send-email command line.") + "Copy From/To/Cc of current message to kill-ring. +Use a form suitable for pasting to git send-email command line.") (defun notmuch-show-stash-git-send-email (&optional no-in-reply-to) - "Copy From/To/Cc/Message-Id of current message to kill-ring in a form suitable for pasting to git send-email command line. + "Copy From/To/Cc/Message-Id of current message to kill-ring. +Use a form suitable for pasting to git send-email command line. If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil), omit --in-reply-to=." @@ -2382,7 +2413,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." @@ -2415,10 +2446,9 @@ This ensures that the temporary buffer created for the mm-handle is destroyed when FN returns. If MIME-TYPE is given then force part to be treated as if it had that mime-type." (let ((handle (notmuch-show-current-part-handle mime-type))) - ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we - ;; call it from a temp-buffer, unless - ;; notmuch-show-attachment-debug is non-nil in which case we put - ;; it in " *notmuch-part*". + ;; Emacs puts stdout/stderr into the calling buffer so we call + ;; it from a temp-buffer, unless notmuch-show-attachment-debug + ;; is non-nil, in which case we put it in " *notmuch-part*". (unwind-protect (if notmuch-show-attachment-debug (with-current-buffer (generate-new-buffer " *notmuch-part*") @@ -2465,7 +2495,7 @@ If the part is displayed in an external application then close the new buffer." (let ((buf (get-buffer-create (generate-new-buffer-name (concat " *notmuch-internal-part*"))))) - (switch-to-buffer buf) + (pop-to-buffer-same-window buf) (if (eq (mm-display-part handle) 'external) (kill-buffer buf) (goto-char (point-min)) @@ -2530,6 +2560,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