X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;ds=sidebyside;f=emacs%2Fnotmuch-show.el;h=8db5435fb291b22abf1317ebed0c7e79c0cfd0aa;hb=71fb37d48236e49b64e300c3764c0e17e02c8f9e;hp=cc1f9053c4266f4fb6f0943f1bfcaa8999162eff;hpb=e8414a72d478b55d2a5dd8b2fb30c67ee60b1732;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index cc1f9053..9f6fe077 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -1,6 +1,7 @@ -;; notmuch-show.el --- display notmuch messages within emacs +;; notmuch-show.el --- displaying notmuch forests. ;; ;; Copyright © Carl Worth +;; Copyright © David Edmondson ;; ;; This file is part of Notmuch. ;; @@ -18,23 +19,1253 @@ ;; along with Notmuch. If not, see . ;; ;; Authors: Carl Worth +;; David Edmondson -;; This is an part of an emacs-based interface to the notmuch mail system. - -(require 'cl) +(eval-when-compile (require 'cl)) (require 'mm-view) (require 'message) +(require 'mm-decode) +(require 'mailcap) +(require 'icalendar) +(require 'goto-addr) (require 'notmuch-lib) +(require 'notmuch-tag) +(require 'notmuch-query) +(require 'notmuch-wash) +(require 'notmuch-mua) +(require 'notmuch-crypto) +(require 'notmuch-print) (declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) -(declare-function notmuch-count-attachments "notmuch" (mm-handle)) -(declare-function notmuch-reply "notmuch" (query-string)) -(declare-function notmuch-fontify-headers "notmuch" nil) -(declare-function notmuch-toggle-invisible-action "notmuch" (cite-button)) -(declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms)) +(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-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)) +(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil) + +(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") + "Headers that should be shown in a message, in this order. + +For an open message, all of these headers will be made visible +according to `notmuch-message-headers-visible' or can be toggled +with `notmuch-show-toggle-visibility-headers'. For a closed message, +only the first header in the list will be visible." + :type '(repeat string) + :group 'notmuch-show) + +(defcustom notmuch-message-headers-visible t + "Should the headers be visible by default? + +If this value is non-nil, then all of the headers defined in +`notmuch-message-headers' will be visible by default in the display +of each message. Otherwise, these headers will be hidden and +`notmuch-show-toggle-visibility-headers' can be used to make them +visible for any given message." + :type 'boolean + :group 'notmuch-show) + +(defcustom notmuch-show-relative-dates t + "Display relative dates in the message summary line." + :type 'boolean + :group 'notmuch-show) + +(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers) + "A list of functions called to decorate the headers listed in +`notmuch-message-headers'.") + +(defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode) + "Functions called after populating a `notmuch-show' buffer." + :type 'hook + :options '(notmuch-show-turn-on-visual-line-mode) + :group 'notmuch-show + :group 'notmuch-hooks) + +(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines + notmuch-wash-tidy-citations + notmuch-wash-elide-blank-lines + notmuch-wash-excerpt-citations) + "Functions used to improve the display of text/plain parts." + :type 'hook + :options '(notmuch-wash-convert-inline-patch-to-part + notmuch-wash-wrap-long-lines + notmuch-wash-tidy-citations + notmuch-wash-elide-blank-lines + notmuch-wash-excerpt-citations) + :group 'notmuch-show + :group 'notmuch-hooks) + +;; Mostly useful for debugging. +(defcustom notmuch-show-all-multipart/alternative-parts nil + "Should all parts of multipart/alternative parts be shown?" + :type 'boolean + :group 'notmuch-show) + +(defcustom notmuch-show-indent-messages-width 1 + "Width of message indentation in threads. + +Messages are shown indented according to their depth in a thread. +This variable determines the width of this indentation measured +in number of blanks. Defaults to `1', choose `0' to disable +indentation." + :type 'integer + :group 'notmuch-show) + +(defcustom notmuch-show-indent-multipart nil + "Should the sub-parts of a multipart/* part be indented?" + ;; dme: Not sure which is a good default. + :type 'boolean + :group 'notmuch-show) + +(defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part + "Default part header button action (on ENTER or mouse click)." + :group 'notmuch-show + :type '(choice (const :tag "Save part" + notmuch-show-save-part) + (const :tag "View part" + notmuch-show-view-part) + (const :tag "View interactively" + notmuch-show-interactively-view-part))) + +(defcustom notmuch-show-only-matching-messages nil + "Only matching messages are shown by default." + :type 'boolean + :group 'notmuch-show) + +(defvar notmuch-show-thread-id nil) +(make-variable-buffer-local 'notmuch-show-thread-id) +(put 'notmuch-show-thread-id 'permanent-local t) + +(defvar notmuch-show-parent-buffer nil) +(make-variable-buffer-local 'notmuch-show-parent-buffer) +(put 'notmuch-show-parent-buffer 'permanent-local t) + +(defvar notmuch-show-query-context nil) +(make-variable-buffer-local 'notmuch-show-query-context) +(put 'notmuch-show-query-context 'permanent-local t) + +(defvar notmuch-show-process-crypto nil) +(make-variable-buffer-local 'notmuch-show-process-crypto) +(put 'notmuch-show-process-crypto 'permanent-local t) + +(defvar notmuch-show-elide-non-matching-messages nil) +(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages) +(put 'notmuch-show-elide-non-matching-messages 'permanent-local t) + +(defvar notmuch-show-indent-content t) +(make-variable-buffer-local 'notmuch-show-indent-content) +(put 'notmuch-show-indent-content 'permanent-local t) + +(defvar notmuch-show-attachment-debug nil + "If t log stdout and stderr from attachment handlers + +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.") + +(defcustom notmuch-show-stash-mlarchive-link-alist + '(("Gmane" . "http://mid.gmane.org/") + ("MARC" . "http://marc.info/?i=") + ("Mail Archive, The" . "http://mid.mail-archive.com/") + ("LKML" . "http://lkml.kernel.org/r/") + ;; FIXME: can these services be searched by `Message-Id' ? + ;; ("MarkMail" . "http://markmail.org/") + ;; ("Nabble" . "http://nabble.com/") + ;; ("opensubscriber" . "http://opensubscriber.com/") + ) + "List of Mailing List Archives to use when stashing links. + +This list is used for generating a Mailing List Archive reference +URI with the current message's Message-Id in +`notmuch-show-stash-mlarchive-link'. + +If the cdr of the alist element is not a function, the cdr is +expected to contain a URI that is concatenated with the current +message's Message-Id to create a ML archive reference URI. + +If the cdr is a function, the function is called with the +Message-Id as the argument, and the function is expected to +return the ML archive reference URI." + :type '(alist :key-type (string :tag "Name") + :value-type (choice + (string :tag "URL") + (function :tag "Function returning the URL"))) + :group 'notmuch-show) + +(defcustom notmuch-show-stash-mlarchive-link-default "Gmane" + "Default Mailing List Archive to use when stashing links. + +This is used when `notmuch-show-stash-mlarchive-link' isn't +provided with an MLA argument nor `completing-read' input." + :type `(choice + ,@(mapcar + (lambda (mla) + (list 'const :tag (car mla) :value (car mla))) + notmuch-show-stash-mlarchive-link-alist)) + :group 'notmuch-show) + +(defcustom notmuch-show-mark-read-tags '("-unread") + "List of tag changes to apply to a message when it is marked as read. + +Tags starting with \"+\" (or not starting with either \"+\" or +\"-\") in the list will be added, and tags starting with \"-\" +will be removed from the message being marked as read. + +For example, if you wanted to remove an \"unread\" tag and add a +\"read\" tag (which would make little sense), you would set: + (\"-unread\" \"+read\")" + :type '(repeat string) + :group 'notmuch-show) + +(defcustom notmuch-show-mark-read-function #'notmuch-show-seen-current-message + "Function to control which messages are marked read. + +The function should take two arguments START and END which will +be the start and end of the visible portion of the buffer and +should mark the appropriate messages read by applying +`notmuch-show-mark-read'. This function will be called after +every user interaction with notmuch." + :type 'function + :group 'notmuch-show) + +(defmacro with-current-notmuch-show-message (&rest body) + "Evaluate body with current buffer set to the text of current message" + `(save-excursion + (let ((id (notmuch-show-get-message-id))) + (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)) + ,@body) + (kill-buffer buf))))) + +(defun notmuch-show-turn-on-visual-line-mode () + "Enable Visual Line mode." + (visual-line-mode t)) + +;; 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. +(defun notmuch-show-view-all-mime-parts () + "Use external viewers to view all attachments from the current message." + (interactive) + (with-current-notmuch-show-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 + ;; with-current-notmuch-show-message and silently discarded. + ;; + ;; Any MIME part not explicitly mentioned here will be handled by an + ;; external viewer as configured in the various mailcap files. + (let ((mm-inline-media-tests '( + ("text/.*" ignore identity) + ("application/pgp-signature" ignore identity) + ("multipart/alternative" ignore identity) + ("multipart/mixed" ignore identity) + ("multipart/related" ignore identity) + ))) + (mm-display-parts (mm-dissect-buffer))))) + +(defun notmuch-show-save-attachments () + "Save all attachments from the current message." + (interactive) + (with-current-notmuch-show-message + (let ((mm-handle (mm-dissect-buffer))) + (notmuch-save-attachments + mm-handle (> (notmuch-count-attachments mm-handle) 1)))) + (message "Done")) + +(defun notmuch-show-with-message-as-text (fn) + "Apply FN to a text representation of the current message. + +FN is called with one argument, the message properties. It should +operation on the contents of the current buffer." + + ;; Remake the header to ensure that all information is available. + (let* ((to (notmuch-show-get-to)) + (cc (notmuch-show-get-cc)) + (from (notmuch-show-get-from)) + (subject (notmuch-show-get-subject)) + (date (notmuch-show-get-date)) + (tags (notmuch-show-get-tags)) + (depth (notmuch-show-get-depth)) + + (header (concat + "Subject: " subject "\n" + "To: " to "\n" + (if (not (string= cc "")) + (concat "Cc: " cc "\n") + "") + "From: " from "\n" + "Date: " date "\n" + (if tags + (concat "Tags: " + (mapconcat #'identity tags ", ") "\n") + ""))) + (all (buffer-substring (notmuch-show-message-top) + (notmuch-show-message-bottom))) + + (props (notmuch-show-get-message-properties)) + (indenting notmuch-show-indent-content)) + (with-temp-buffer + (insert all) + (if indenting + (indent-rigidly (point-min) (point-max) (- depth))) + ;; Remove the original header. + (goto-char (point-min)) + (re-search-forward "^$" (point-max) nil) + (delete-region (point-min) (point)) + (insert header) + (funcall fn props)))) + +(defun notmuch-show-print-message () + "Print the current message." + (interactive) + (notmuch-show-with-message-as-text 'notmuch-print-message)) + +(defun notmuch-show-fontify-header () + (let ((face (cond + ((looking-at "[Tt]o:") + 'message-header-to) + ((looking-at "[Bb]?[Cc][Cc]:") + 'message-header-cc) + ((looking-at "[Ss]ubject:") + 'message-header-subject) + ((looking-at "[Ff]rom:") + 'message-header-from) + (t + 'message-header-other)))) + + (overlay-put (make-overlay (point) (re-search-forward ":")) + 'face 'message-header-name) + (overlay-put (make-overlay (point) (re-search-forward ".*$")) + 'face face))) + +(defun notmuch-show-colour-headers () + "Apply some colouring to the current headers." + (goto-char (point-min)) + (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:") + (notmuch-show-fontify-header) + (forward-line))) + +(defun notmuch-show-spaces-n (n) + "Return a string comprised of `n' spaces." + (make-string n ? )) + +(defun notmuch-show-update-tags (tags) + "Update the displayed tags of the current message." + (save-excursion + (goto-char (notmuch-show-message-top)) + (if (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)) + ")")))))) + +(defun notmuch-clean-address (address) + "Try to clean a single email ADDRESS for display. Return a cons +cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if +parsing fails." + (condition-case nil + (let (p-name p-address) + ;; It would be convenient to use `mail-header-parse-address', + ;; but that expects un-decoded mailbox parts, whereas our + ;; mailbox parts are already decoded (and hence may contain + ;; UTF-8). Given that notmuch should handle most of the awkward + ;; cases, some simple string deconstruction should be sufficient + ;; here. + (cond + ;; "User " style. + ((string-match "\\(.*\\) <\\(.*\\)>" address) + (setq p-name (match-string 1 address) + p-address (match-string 2 address))) + + ;; "" style. + ((string-match "<\\(.*\\)>" address) + (setq p-address (match-string 1 address))) + + ;; Everything else. + (t + (setq p-address address))) + + (when p-name + ;; Remove elements of the mailbox part that are not relevant for + ;; display, even if they are required during transport: + ;; + ;; Backslashes. + (setq p-name (replace-regexp-in-string "\\\\" "" p-name)) + + ;; Outer single and double quotes, which might be nested. + (loop + with start-of-loop + do (setq start-of-loop p-name) + + when (string-match "^\"\\(.*\\)\"$" p-name) + do (setq p-name (match-string 1 p-name)) + + when (string-match "^'\\(.*\\)'$" p-name) + do (setq p-name (match-string 1 p-name)) + + until (string= start-of-loop p-name))) + + ;; If the address is 'foo@bar.com ' then show just + ;; 'foo@bar.com'. + (when (string= p-name p-address) + (setq p-name nil)) + + (cons p-address p-name)) + (error (cons address nil)))) + +(defun notmuch-show-clean-address (address) + "Try to clean a single email ADDRESS for display. Return +unchanged ADDRESS if parsing fails." + (let* ((clean-address (notmuch-clean-address address)) + (p-address (car clean-address)) + (p-name (cdr clean-address))) + ;; If no name, return just the address. + (if (not p-name) + p-address + ;; Otherwise format the name and address together. + (concat p-name " <" p-address ">")))) + +(defun notmuch-show-insert-headerline (headers date tags depth) + "Insert a notmuch style headerline based on HEADERS for a +message at DEPTH in the current thread." + (let ((start (point))) + (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth)) + (notmuch-sanitize + (notmuch-show-clean-address (plist-get headers :From))) + " (" + date + ") (" + (notmuch-tag-format-tags tags tags) + ")\n") + (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) + +(defun notmuch-show-insert-header (header header-value) + "Insert a single header." + (insert header ": " (notmuch-sanitize header-value) "\n")) + +(defun notmuch-show-insert-headers (headers) + "Insert the headers of the current message." + (let ((start (point))) + (mapc (lambda (header) + (let* ((header-symbol (intern (concat ":" header))) + (header-value (plist-get headers header-symbol))) + (if (and header-value + (not (string-equal "" header-value))) + (notmuch-show-insert-header header header-value)))) + notmuch-message-headers) + (save-excursion + (save-restriction + (narrow-to-region start (point-max)) + (run-hooks 'notmuch-show-markup-headers-hook))))) + +(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 &optional name comment) + (let ((button) + (base-label (concat (when name (concat name ": ")) + declared-type + (unless (string-equal declared-type content-type) + (concat " (as " content-type ")")) + comment))) + + (setq button + (insert-button + (concat "[ " base-label " ]") + :base-label base-label + :type 'notmuch-show-part-button-type + :notmuch-part-hidden nil)) + (insert "\n") + ;; return button + button)) + +(defun notmuch-show-toggle-part-invisibility (&optional button) + (interactive) + (let* ((button (or button (button-at (point)))) + (overlay (button-get button 'overlay)) + (lazy-part (button-get button :notmuch-lazy-part))) + ;; We have a part to toggle if there is an overlay or if there is a lazy part. + ;; If neither is present we cannot toggle the part so we just return nil. + (when (or overlay lazy-part) + (let* ((show (button-get button :notmuch-part-hidden)) + (new-start (button-start button)) + (button-label (button-get button :base-label)) + (old-point (point)) + (properties (text-properties-at (button-start button))) + (inhibit-read-only t)) + ;; Toggle the button itself. + (button-put button :notmuch-part-hidden (not show)) + (goto-char new-start) + (insert "[ " button-label (if show " ]" " (hidden) ]")) + (set-text-properties new-start (point) properties) + (let ((old-end (button-end button))) + (move-overlay button new-start (point)) + (delete-region (point) old-end)) + (goto-char (min old-point (1- (button-end button)))) + ;; Return nil if there is a lazy-part, it is empty, and we are + ;; trying to show it. In all other cases return t. + (if lazy-part + (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)) + t))))) + +;; MIME part renderers + +(defun notmuch-show-multipart/*-to-list (part) + (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) + (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) + (inner-parts (plist-get part :content)) + (start (point))) + ;; This inserts all parts of the chosen type rather than just one, + ;; but it's not clear that this is the wrong thing to do - which + ;; should be chosen if there are more than one that match? + (mapc (lambda (inner-part) + (let* ((inner-type (plist-get inner-part :content-type)) + (hide (not (or notmuch-show-all-multipart/alternative-parts + (string= chosen-type inner-type))))) + (notmuch-show-insert-bodypart msg inner-part depth hide))) + inner-parts) + + (when notmuch-show-indent-multipart + (indent-rigidly start (point) 1))) + t) + +(defun notmuch-show-setup-w3m () + "Instruct w3m how to retrieve content from a \"related\" part of a message." + (interactive) + (if (boundp 'w3m-cid-retrieve-function-alist) + (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist) + (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve) + w3m-cid-retrieve-function-alist))) + (setq mm-inline-text-html-with-images t)) + +(defvar w3m-current-buffer) ;; From `w3m.el'. +(defvar notmuch-show-w3m-cid-store nil) +(make-variable-buffer-local 'notmuch-show-w3m-cid-store) + +(defun notmuch-show-w3m-cid-store-internal (content-id + message-id + part-number + content-type + content) + (push (list content-id + message-id + part-number + content-type + content) + notmuch-show-w3m-cid-store)) + +(defun notmuch-show-w3m-cid-store (msg part) + (let ((content-id (plist-get part :content-id))) + (when content-id + (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id) + (plist-get msg :id) + (plist-get part :id) + (plist-get part :content-type) + nil)))) + +(defun notmuch-show-w3m-cid-retrieve (url &rest args) + (let ((matching-part (with-current-buffer w3m-current-buffer + (assoc url notmuch-show-w3m-cid-store)))) + (if matching-part + (let ((message-id (nth 1 matching-part)) + (part-number (nth 2 matching-part)) + (content-type (nth 3 matching-part)) + (content (nth 4 matching-part))) + ;; If we don't already have the content, get it and cache + ;; it, as some messages reference the same cid: part many + ;; times (hundreds!), which results in many calls to + ;; `notmuch part'. + (unless content + (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id) + part-number notmuch-show-process-crypto)) + (with-current-buffer w3m-current-buffer + (notmuch-show-w3m-cid-store-internal url + message-id + part-number + content-type + content))) + (insert content) + content-type) + nil))) + +(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button) + (let ((inner-parts (plist-get part :content)) + (start (point))) + + ;; We assume that the first part is text/html and the remainder + ;; things that it references. + + ;; Stash the non-primary parts. + (mapc (lambda (part) + (notmuch-show-w3m-cid-store msg part)) + (cdr inner-parts)) + + ;; Render the primary part. + (notmuch-show-insert-bodypart msg (car inner-parts) depth) + ;; Add hidden buttons for the rest + (mapc (lambda (inner-part) + (notmuch-show-insert-bodypart msg inner-part depth t)) + (cdr inner-parts)) + + (when notmuch-show-indent-multipart + (indent-rigidly start (point) 1))) + t) + +(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button) + (button-put button 'face 'notmuch-crypto-part-header) + ;; add signature status button if sigstatus provided + (if (plist-member part :sigstatus) + (let* ((from (notmuch-show-get-header :From msg)) + (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 button) + (button-put button 'face 'notmuch-crypto-part-header) + ;; 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* ((from (notmuch-show-get-header :From msg)) + (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 button) + (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-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) + ;; 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. + (let ((start (if button + (button-start button) + (point)))) + (insert (notmuch-get-bodypart-content msg part notmuch-show-process-crypto)) + (save-excursion + (save-restriction + (narrow-to-region start (point-max)) + (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) + (insert (with-temp-buffer + (insert (notmuch-get-bodypart-content msg part notmuch-show-process-crypto)) + ;; notmuch-get-bodypart-content provides "raw", non-converted + ;; data. Replace CRLF with LF before icalendar can use it. + (goto-char (point-min)) + (while (re-search-forward "\r\n" nil t) + (replace-match "\n" nil nil)) + (let ((file (make-temp-file "notmuch-ical")) + result) + (unwind-protect + (progn + (unless (icalendar-import-buffer file t) + (error "Icalendar import error. See *icalendar-errors* for more information")) + (set-buffer (get-file-buffer file)) + (setq result (buffer-substring (point-min) (point-max))) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (delete-file file)) + result))) + 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-get-mime-type-of-application/octet-stream (part) + ;; If we can deduce a MIME type from the filename of the attachment, + ;; we return that. + (if (plist-get part :filename) + (let ((extension (file-name-extension (plist-get part :filename))) + mime-type) + (if extension + (progn + (mailcap-parse-mimetypes) + (setq mime-type (mailcap-extension-to-mime extension)) + (if (and mime-type + (not (string-equal mime-type "application/octet-stream"))) + mime-type + nil)) + nil)))) + +(defun notmuch-show-insert-part-text/html (msg part content-type nth depth button) + ;; text/html handler to work around bugs in renderers and our + ;; invisibile parts code. In particular w3m sets up a keymap which + ;; "leaks" outside the invisible region and causes strange effects + ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to + ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map + ;; remains). + (let ((mm-inline-text-html-with-w3m-keymap nil)) + (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. + +(defun notmuch-show-handlers-for (content-type) + "Return a list of content handlers for a part of type CONTENT-TYPE." + (let (result) + (mapc (lambda (func) + (if (functionp func) + (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-" content-type)))) + result)) + +;; + +(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button) + (let ((handlers (notmuch-show-handlers-for content-type))) + ;; Run the content handlers until one of them returns a non-nil + ;; value. + (while (and handlers + (not (condition-case err + (funcall (car handlers) msg part content-type nth depth button) + ;; Specifying `debug' here lets the debugger + ;; run if `debug-on-error' is non-nil. + ((debug error) + (progn + (insert "!!! Bodypart insert error: ") + (insert (error-message-string err)) + (insert " !!!\n") nil))))) + (setq handlers (cdr handlers)))) + t) + +(defun notmuch-show-create-part-overlays (button beg end) + "Add an overlay to the part between BEG and END" + + ;; If there is no button (i.e., the part is text/plain and the first + ;; part) or if the part has no content then we don't make the part + ;; toggleable. + (when (and button (/= beg end)) + (button-put button 'overlay (make-overlay beg end)) + ;; Return true if we created an overlay. + t)) + +(defun notmuch-show-record-part-information (part beg end) + "Store PART as a text property from BEG to END" + + ;; Record part information. Since we already inserted subparts, + ;; don't override existing :notmuch-part properties. + (notmuch-map-text-property beg end :notmuch-part + (lambda (v) (or v part))) + ;; Make :notmuch-part front sticky and rear non-sticky so it stays + ;; applied to the beginning of each line when we indent the + ;; message. Since we're operating on arbitrary renderer output, + ;; watch out for sticky specs of t, which means all properties are + ;; front-sticky/rear-nonsticky. + (notmuch-map-text-property beg end 'front-sticky + (lambda (v) (if (listp v) + (pushnew :notmuch-part v) + v))) + (notmuch-map-text-property beg end 'rear-nonsticky + (lambda (v) (if (listp v) + (pushnew :notmuch-part v) + v)))) + +(defun notmuch-show-lazy-part (part-args button) + ;; Insert the lazy part after the button for the part. We would just + ;; move to the start of the new line following the button and insert + ;; the part but that point might have text properties (eg colours + ;; from a message header etc) so instead we start from the last + ;; character of the button by adding a newline and finish by + ;; removing the extra newline from the end of the part. + (save-excursion + (goto-char (button-end button)) + (insert "\n") + (let* ((inhibit-read-only t) + ;; We need to use markers for the start and end of the part + ;; because the part insertion functions do not guarantee + ;; to leave point at the end of the part. + (part-beg (copy-marker (point) nil)) + (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))) + (save-restriction + (narrow-to-region part-beg part-end) + (delete-region part-beg part-end) + (apply #'notmuch-show-insert-bodypart-internal part-args) + (indent-rigidly part-beg part-end depth)) + (goto-char part-end) + (delete-char 1) + (notmuch-show-record-part-information (second part-args) + (button-start button) + part-end) + ;; Create the overlay. If the lazy-part turned out to be empty/not + ;; showable this returns nil. + (notmuch-show-create-part-overlays button part-beg part-end)))) + +(defun notmuch-show-insert-bodypart (msg part depth &optional hide) + "Insert the body part PART at depth DEPTH in the current thread. + +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. If HIDE is +'no-buttons, show the part but do not add any buttons (this is +useful for quoting in replies)." + + (let* ((content-type (downcase (plist-get part :content-type))) + (mime-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") + "text/x-diff") + content-type)) + (nth (plist-get part :id)) + (beg (point)) + ;; Hide the part initially if HIDE is t. + (show-part (not (equal hide t))) + ;; We omit the part button for the first (or only) part if + ;; this is text/plain, or HIDE is 'no-buttons. + (button (unless (or (equal hide 'no-buttons) + (and (string= mime-type "text/plain") (<= nth 1))) + (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename)))) + (content-beg (point))) + + ;; 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) + (button-put button :notmuch-lazy-part + (list msg part mime-type nth depth button))) + + ;; 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)) + ;; Ensure that the part ends with a carriage return. + (unless (bolp) + (insert "\n")) + ;; We do not create the overlay for hidden (lazy) parts until + ;; they are inserted. + (if show-part + (notmuch-show-create-part-overlays button content-beg (point)) + (save-excursion + (notmuch-show-toggle-part-invisibility button))) + (notmuch-show-record-part-information part beg (point)))) + +(defun notmuch-show-insert-body (msg body depth) + "Insert the body BODY at depth DEPTH in the current thread." + (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) + +(defun notmuch-show-make-symbol (type) + (make-symbol (concat "notmuch-show-" type))) + +(defun notmuch-show-strip-re (string) + (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string)) + +(defvar notmuch-show-previous-subject "") +(make-variable-buffer-local 'notmuch-show-previous-subject) + +(defun notmuch-show-insert-msg (msg depth) + "Insert the message MSG at depth DEPTH in the current thread." + (let* ((headers (plist-get msg :headers)) + ;; Indentation causes the buffer offset of the start/end + ;; points to move, so we must use markers. + message-start message-end + content-start content-end + 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 (if notmuch-show-relative-dates + (plist-get msg :date_relative) + nil) + (plist-get headers :Date)) + (plist-get msg :tags) depth) + + (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 + ;; to after the first header. + (notmuch-show-insert-headers headers) + (save-excursion + (goto-char content-start) + ;; 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 (not (string= notmuch-show-previous-subject + bare-subject)) + (forward-line 1)) + (setq headers-start (point-marker))) + (setq headers-end (point-marker)) + + (setq notmuch-show-previous-subject bare-subject) + + ;; A blank line between the headers and the body. + (insert "\n") + (notmuch-show-insert-body msg (plist-get msg :body) + (if notmuch-show-indent-content depth 0)) + ;; Ensure that the body ends with a newline. + (unless (bolp) + (insert "\n")) + (setq content-end (point-marker)) + + ;; Indent according to the depth in the thread. + (if notmuch-show-indent-content + (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))) + + (setq message-end (point-max-marker)) + + ;; Save the extents of this message over the whole text of the + ;; message. + (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) + + ;; Create overlays used to control visibility + (plist-put msg :headers-overlay (make-overlay headers-start headers-end)) + (plist-put msg :message-overlay (make-overlay headers-start content-end)) + + (plist-put msg :depth depth) + + ;; Save the properties for this message. Currently this saves the + ;; entire message (augmented it with other stuff), which seems + ;; like overkill. We might save a reduced subset (for example, not + ;; the content). + (notmuch-show-set-message-properties msg) + + ;; Set header visibility. + (notmuch-show-headers-visible msg notmuch-message-headers-visible) + + ;; Message visibility depends on whether it matched the search + ;; criteria. + (notmuch-show-message-visible msg (and (plist-get msg :match) + (not (plist-get msg :excluded)))))) + +(defun notmuch-show-toggle-process-crypto () + "Toggle the processing of cryptographic MIME parts." + (interactive) + (setq notmuch-show-process-crypto (not notmuch-show-process-crypto)) + (message (if notmuch-show-process-crypto + "Processing cryptographic MIME parts." + "Not processing cryptographic MIME parts.")) + (notmuch-show-refresh-view)) + +(defun notmuch-show-toggle-elide-non-matching () + "Toggle the display of non-matching messages." + (interactive) + (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)) + (message (if notmuch-show-elide-non-matching-messages + "Showing matching messages only." + "Showing all messages.")) + (notmuch-show-refresh-view)) + +(defun notmuch-show-toggle-thread-indentation () + "Toggle the indentation of threads." + (interactive) + (setq notmuch-show-indent-content (not notmuch-show-indent-content)) + (message (if notmuch-show-indent-content + "Content is indented." + "Content is not indented.")) + (notmuch-show-refresh-view)) + +(defun notmuch-show-insert-tree (tree depth) + "Insert the message tree TREE at depth DEPTH in the current thread." + (let ((msg (car tree)) + (replies (cadr tree))) + ;; We test whether there is a message or just some replies. + (when msg + (notmuch-show-insert-msg msg depth)) + (notmuch-show-insert-thread replies (1+ depth)))) + +(defun notmuch-show-insert-thread (thread depth) + "Insert the thread THREAD at depth DEPTH in the current forest." + (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread)) + +(defun notmuch-show-insert-forest (forest) + "Insert the forest of threads FOREST." + (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest)) + +(defvar notmuch-id-regexp + (concat + ;; Match the id: prefix only if it begins a word (to disallow, for + ;; example, matching cid:). + "\\\"-parts and mid: links into +buttons for a corresponding notmuch search." + (goto-address-fontify-region start end) + (save-excursion + (let (links) + (goto-char start) + (while (re-search-forward notmuch-id-regexp end t) + (push (list (match-beginning 0) (match-end 0) + (match-string-no-properties 0)) links)) + (goto-char start) + (while (re-search-forward notmuch-mid-regexp end t) + (let* ((mid-cid (match-string-no-properties 1)) + (mid (save-match-data + (string-match "^[^/]*" mid-cid) + (url-unhex-string (match-string 0 mid-cid))))) + (push (list (match-beginning 0) (match-end 0) + (notmuch-id-to-query mid)) links))) + (dolist (link links) + ;; Remove the overlay created by goto-address-mode + (remove-overlays (first link) (second link) 'goto-address t) + (make-text-button (first link) (second link) + :type 'notmuch-button-type + 'action `(lambda (arg) + (notmuch-show ,(third link) current-prefix-arg)) + 'follow-link t + 'help-echo "Mouse-1, RET: search for this message" + 'face goto-address-mail-face))))) + +;;;###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. + +ELIDE-TOGGLE, if non-nil, inverts the default elide behavior. + +The optional PARENT-BUFFER is the notmuch-search buffer from +which this notmuch-show command was executed, (so that the +next thread from that buffer can be show when done with this +one). + +The optional QUERY-CONTEXT is a notmuch search term. Only +messages from the thread matching this search term are shown if +non-nil. + +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: \nP") + (let ((buffer-name (generate-new-buffer-name + (or buffer-name + (concat "*notmuch-" thread-id "*"))))) + (switch-to-buffer (get-buffer-create buffer-name)) + ;; Set the default value for `notmuch-show-process-crypto' in this + ;; buffer. + (setq notmuch-show-process-crypto notmuch-crypto-process-mime) + ;; Set the default value for + ;; `notmuch-show-elide-non-matching-messages' in this buffer. If + ;; elide-toggle is set, invert the default. + (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages) + (if elide-toggle + (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages))) + + (setq notmuch-show-thread-id thread-id + notmuch-show-parent-buffer parent-buffer + notmuch-show-query-context query-context) + (notmuch-show-build-buffer) + (notmuch-show-goto-first-wanted-message) + (current-buffer))) + +(defun notmuch-show-build-buffer () + (let ((inhibit-read-only t)) + + (notmuch-show-mode) + (add-hook 'post-command-hook #'notmuch-show-command-hook nil t) + + ;; Don't track undo information for this buffer + (set 'buffer-undo-list t) + + (notmuch-tag-clear-cache) + (erase-buffer) + (goto-char (point-min)) + (save-excursion + (let* ((basic-args (list notmuch-show-thread-id)) + (args (if notmuch-show-query-context + (append (list "\'") basic-args + (list "and (" notmuch-show-query-context ")\'")) + (append (list "\'") basic-args (list "\'")))) + (cli-args (cons "--exclude=false" + (when notmuch-show-elide-non-matching-messages + (list "--entire-thread=false"))))) + + (notmuch-show-insert-forest (notmuch-query-get-threads (append cli-args args))) + ;; If the query context reduced the results to nothing, run + ;; the basic query. + (when (and (eq (buffer-size) 0) + notmuch-show-query-context) + (notmuch-show-insert-forest + (notmuch-query-get-threads (append cli-args basic-args))))) + + (jit-lock-register #'notmuch-show-buttonise-links) + + (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 (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject)))) + + (run-hooks 'notmuch-show-hook)))) + +(defun notmuch-show-capture-state () + "Capture the state of the current buffer. + +This includes: + - the list of open messages, + - the current message." + (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages))) + +(defun notmuch-show-get-query () + "Return the current query in this show buffer" + (if notmuch-show-query-context + (concat notmuch-show-thread-id + " and (" + notmuch-show-query-context + ")") + notmuch-show-thread-id)) + +(defun notmuch-show-apply-state (state) + "Apply STATE to the current buffer. + +This includes: + - opening the messages previously opened, + - closing all other messages, + - moving to the correct current message." + (let ((current (car state)) + (open (cadr state))) + + ;; Open those that were open. + (goto-char (point-min)) + (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties) + (member (notmuch-show-get-message-id) open)) + until (not (notmuch-show-goto-message-next))) + + ;; Go to the previously open message. + (goto-char (point-min)) + (unless (loop if (string= current (notmuch-show-get-message-id)) + return t + until (not (notmuch-show-goto-message-next))) + (goto-char (point-min)) + (message "Previously current message not found.")) + (notmuch-show-message-adjust))) + +(defun notmuch-show-refresh-view (&optional reset-state) + "Refresh the current view. + +Refreshes the current view, observing changes in display +preferences. If invoked with a prefix argument (or RESET-STATE is +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) + (state (unless reset-state + (notmuch-show-capture-state)))) + ;; erase-buffer does not seem to remove overlays, which can lead + ;; to weird effects such as remaining images, so remove them + ;; manually. + (remove-overlays) + (erase-buffer) + (notmuch-show-build-buffer) + (if state + (notmuch-show-apply-state state) + ;; We're resetting state, so navigate to the first open message + ;; and mark it read, just like opening a new show buffer. + (notmuch-show-goto-first-wanted-message)))) (defvar notmuch-show-stash-map (let ((map (make-sparse-keymap))) @@ -43,507 +1274,401 @@ (define-key map "F" 'notmuch-show-stash-filename) (define-key map "f" 'notmuch-show-stash-from) (define-key map "i" 'notmuch-show-stash-message-id) + (define-key map "I" 'notmuch-show-stash-message-id-stripped) (define-key map "s" 'notmuch-show-stash-subject) (define-key map "T" 'notmuch-show-stash-tags) (define-key map "t" 'notmuch-show-stash-to) + (define-key map "l" 'notmuch-show-stash-mlarchive-link) + (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go) + (define-key map "G" 'notmuch-show-stash-git-send-email) + (define-key map "?" 'notmuch-subkeymap-help) map) - "Submap for stash commands" - ) - + "Submap for stash commands") (fset 'notmuch-show-stash-map notmuch-show-stash-map) +(defvar notmuch-show-part-map + (let ((map (make-sparse-keymap))) + (define-key map "s" 'notmuch-show-save-part) + (define-key map "v" 'notmuch-show-view-part) + (define-key map "o" 'notmuch-show-interactively-view-part) + (define-key map "|" 'notmuch-show-pipe-part) + (define-key map "?" 'notmuch-subkeymap-help) + map) + "Submap for part commands") +(fset 'notmuch-show-part-map notmuch-show-part-map) + (defvar notmuch-show-mode-map (let ((map (make-sparse-keymap))) - (define-key map "?" 'notmuch-help) - (define-key map "q" 'kill-this-buffer) - (define-key map (kbd "C-p") 'notmuch-show-previous-line) - (define-key map (kbd "C-n") 'notmuch-show-next-line) + (set-keymap-parent map notmuch-common-keymap) + (define-key map "Z" 'notmuch-tree-from-show-current-query) + (define-key map (kbd "") 'widget-backward) (define-key map (kbd "M-TAB") 'notmuch-show-previous-button) + (define-key map (kbd "") 'notmuch-show-previous-button) (define-key map (kbd "TAB") 'notmuch-show-next-button) - (define-key map "s" 'notmuch-search) - (define-key map "m" 'message-mail) - (define-key map "f" 'notmuch-show-forward-current) - (define-key map "r" 'notmuch-show-reply) + (define-key map "f" 'notmuch-show-forward-message) + (define-key map "r" 'notmuch-show-reply-sender) + (define-key map "R" 'notmuch-show-reply) (define-key map "|" 'notmuch-show-pipe-message) (define-key map "w" 'notmuch-show-save-attachments) (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 "b" 'notmuch-show-toggle-current-body) - (define-key map "h" 'notmuch-show-toggle-current-header) + (define-key map "h" 'notmuch-show-toggle-visibility-headers) + (define-key map "*" 'notmuch-show-tag-all) (define-key map "-" 'notmuch-show-remove-tag) (define-key map "+" 'notmuch-show-add-tag) - (define-key map "x" 'notmuch-show-archive-thread-then-exit) - (define-key map "a" 'notmuch-show-archive-thread) - (define-key map "P" 'notmuch-show-previous-message) + (define-key map "X" 'notmuch-show-archive-thread-then-exit) + (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit) + (define-key map "A" 'notmuch-show-archive-thread-then-next) + (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread) (define-key map "N" 'notmuch-show-next-message) - (define-key map "p" 'notmuch-show-previous-open-message) + (define-key map "P" 'notmuch-show-previous-message) (define-key map "n" 'notmuch-show-next-open-message) + (define-key map "p" 'notmuch-show-previous-open-message) + (define-key map (kbd "M-n") 'notmuch-show-next-thread-show) + (define-key map (kbd "M-p") 'notmuch-show-previous-thread-show) (define-key map (kbd "DEL") 'notmuch-show-rewind) (define-key map " " 'notmuch-show-advance-and-archive) + (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all) + (define-key map (kbd "RET") 'notmuch-show-toggle-message) + (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-toggle-thread-indentation) + (define-key map "t" 'toggle-truncate-lines) + (define-key map "." 'notmuch-show-part-map) map) "Keymap for \"notmuch show\" buffers.") (fset 'notmuch-show-mode-map notmuch-show-mode-map) -(defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$" - "Pattern to match a line that separates content from signature. +(defun notmuch-show-mode () + "Major mode for viewing a thread with notmuch. -The regexp can (and should) include $ to match the end of the -line, but should not include ^ to match the beginning of the -line. This is because notmuch may have inserted additional space -for indentation at the beginning of the line. But notmuch will -move past the indentation when testing this pattern, (so that the -pattern can still test against the entire line).") +This buffer contains the results of the \"notmuch show\" command +for displaying a single thread of email from your email archives. -(defvar notmuch-show-signature-button-format - "[ %d-line signature. Click/Enter to toggle visibility. ]" - "String used to construct button text for hidden signatures +By default, various components of email messages, (citations, +signatures, already-read messages), are hidden. You can make +these parts visible by clicking with the mouse button or by +pressing RET after positioning the cursor on a hidden part, (for +which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful). -Can use up to one integer format parameter, i.e. %d") +Reading the thread sequentially is well-supported by pressing +\\[notmuch-show-advance-and-archive]. This will scroll the current message (if necessary), advance +to the next message, or advance to the next thread (if already on +the last message of a thread). -(defvar notmuch-show-citation-button-format - "[ %d more citation lines. Click/Enter to toggle visibility. ]" - "String used to construct button text for hidden citations. +Other commands are available to read or manipulate the thread +more selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages +without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread +without scrolling through with \\[notmuch-show-advance-and-archive]). -Can use up to one integer format parameter, i.e. %d") +You can add or remove arbitrary tags from the current message with +'\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'. -(defvar notmuch-show-signature-lines-max 12 - "Maximum length of signature that will be hidden by default.") +All currently available key bindings: -(defvar notmuch-show-citation-lines-prefix 4 - "Always show at least this many lines of a citation. +\\{notmuch-show-mode-map}" + (interactive) + (kill-all-local-variables) + (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view) + (use-local-map notmuch-show-mode-map) + (setq major-mode 'notmuch-show-mode + mode-name "notmuch-show") + (setq buffer-read-only t + truncate-lines t)) -If there is one more line, show that, otherwise collapse -remaining lines into a button.") +(defun notmuch-tree-from-show-current-query () + "Call notmuch tree with the current query" + (interactive) + (notmuch-tree notmuch-show-thread-id + notmuch-show-query-context + (notmuch-show-get-message-id))) -(defvar notmuch-show-message-begin-regexp "\fmessage{") -(defvar notmuch-show-message-end-regexp "\fmessage}") -(defvar notmuch-show-header-begin-regexp "\fheader{") -(defvar notmuch-show-header-end-regexp "\fheader}") -(defvar notmuch-show-body-begin-regexp "\fbody{") -(defvar notmuch-show-body-end-regexp "\fbody}") -(defvar notmuch-show-attachment-begin-regexp "\fattachment{") -(defvar notmuch-show-attachment-end-regexp "\fattachment}") -(defvar notmuch-show-part-begin-regexp "\fpart{") -(defvar notmuch-show-part-end-regexp "\fpart}") -(defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$") +(defun notmuch-show-move-to-message-top () + (goto-char (notmuch-show-message-top))) -(defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)") -(defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ") -(defvar notmuch-show-filename-regexp "filename:\\(.*\\)$") -(defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)") +(defun notmuch-show-move-to-message-bottom () + (goto-char (notmuch-show-message-bottom))) -(defvar notmuch-show-tags-regexp "(\\([^)]*\\))$") +(defun notmuch-show-message-adjust () + (recenter 0)) -(defvar notmuch-show-parent-buffer nil) -(defvar notmuch-show-body-read-visible nil) -(defvar notmuch-show-citations-visible nil) -(defvar notmuch-show-signatures-visible nil) -(defvar notmuch-show-headers-visible nil) +;; Movement related functions. -(defun notmuch-show-next-line () - "Like builtin `next-line' but ensuring we end on a visible character. +;; 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. +(defun notmuch-show-message-extent () + (let (r) + (save-excursion + (while (not (setq r (get-text-property (point) :notmuch-message-extent))) + (backward-char))) + r)) -By advancing forward until reaching a visible character. +(defun notmuch-show-message-top () + (car (notmuch-show-message-extent))) -Unlike builtin `next-line' this version accepts no arguments." - (interactive) - (set 'this-command 'next-line) - (call-interactively 'next-line) - (while (point-invisible-p) - (forward-char))) +(defun notmuch-show-message-bottom () + (cdr (notmuch-show-message-extent))) -(defun notmuch-show-previous-line () - "Like builtin `previous-line' but ensuring we end on a visible character. +(defun notmuch-show-goto-message-next () + (let ((start (point))) + (notmuch-show-move-to-message-bottom) + (if (not (eobp)) + t + (goto-char start) + nil))) -By advancing forward until reaching a visible character. +(defun notmuch-show-goto-message-previous () + (notmuch-show-move-to-message-top) + (if (bobp) + nil + (backward-char) + (notmuch-show-move-to-message-top) + t)) + +(defun notmuch-show-mapc (function) + "Iterate through all messages in the current thread with +`notmuch-show-goto-message-next' and call FUNCTION for side +effects." + (save-excursion + (goto-char (point-min)) + (loop do (funcall function) + while (notmuch-show-goto-message-next)))) -Unlike builtin `previous-line' this version accepts no arguments." - (interactive) - (set 'this-command 'previous-line) - (call-interactively 'previous-line) - (while (point-invisible-p) - (forward-char))) +;; Functions relating to the visibility of messages and their +;; components. -(defun notmuch-show-get-message-id () - (save-excursion - (beginning-of-line) - (if (not (looking-at notmuch-show-message-begin-regexp)) - (re-search-backward notmuch-show-message-begin-regexp)) - (re-search-forward notmuch-show-id-regexp) - (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) +(defun notmuch-show-message-visible (props visible-p) + (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p)) + (notmuch-show-set-prop :message-visible visible-p props)) -(defun notmuch-show-get-filename () - (save-excursion - (beginning-of-line) - (if (not (looking-at notmuch-show-message-begin-regexp)) - (re-search-backward notmuch-show-message-begin-regexp)) - (re-search-forward notmuch-show-filename-regexp) - (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) +(defun notmuch-show-headers-visible (props visible-p) + (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p)) + (notmuch-show-set-prop :headers-visible visible-p props)) -(defun notmuch-show-set-tags (tags) +;; Functions for setting and getting attributes of the current +;; message. + +(defun notmuch-show-set-message-properties (props) (save-excursion - (beginning-of-line) - (if (not (looking-at notmuch-show-message-begin-regexp)) - (re-search-backward notmuch-show-message-begin-regexp)) - (re-search-forward notmuch-show-tags-regexp) - (let ((inhibit-read-only t) - (beg (match-beginning 1)) - (end (match-end 1))) - (delete-region beg end) - (goto-char beg) - (insert (mapconcat 'identity tags " "))))) + (notmuch-show-move-to-message-top) + (put-text-property (point) (+ (point) 1) :notmuch-message-properties props))) -(defun notmuch-show-get-tags () +(defun notmuch-show-get-message-properties () + "Return the properties of the current message as a plist. + +Some useful entries are: +:headers - Property list containing the headers :Date, :Subject, :From, etc. +:body - Body of the message +:tags - Tags for this message" (save-excursion - (beginning-of-line) - (if (not (looking-at notmuch-show-message-begin-regexp)) - (re-search-backward notmuch-show-message-begin-regexp)) - (re-search-forward notmuch-show-tags-regexp) - (split-string (buffer-substring (match-beginning 1) (match-end 1))))) + (notmuch-show-move-to-message-top) + (get-text-property (point) :notmuch-message-properties))) + +(defun notmuch-show-get-part-properties () + "Return the properties of the innermost part containing point. + +This is the part property list retrieved from the CLI. Signals +an error if there is no part containing point." + (or (get-text-property (point) :notmuch-part) + (error "No message part here"))) + +(defun notmuch-show-set-prop (prop val &optional props) + (let ((inhibit-read-only t) + (props (or props + (notmuch-show-get-message-properties)))) + (plist-put props prop val) + (notmuch-show-set-message-properties props))) + +(defun notmuch-show-get-prop (prop &optional props) + "Get property PROP from current message in show or tree mode. + +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))) + +(defun notmuch-show-get-message-id (&optional bare) + "Return an id: query for the Message-Id of the current message. + +If optional argument BARE is non-nil, return +the Message-Id without id: prefix and escaping." + (if bare + (notmuch-show-get-prop :id) + (notmuch-id-to-query (notmuch-show-get-prop :id)))) + +(defun notmuch-show-get-messages-ids () + "Return all id: queries of messages in the current thread." + (let ((message-ids)) + (notmuch-show-mapc + (lambda () (push (notmuch-show-get-message-id) message-ids))) + message-ids)) + +(defun notmuch-show-get-messages-ids-search () + "Return a search string for all message ids of messages in the +current thread." + (mapconcat 'identity (notmuch-show-get-messages-ids) " or ")) + +;; dme: Would it make sense to use a macro for many of these? + +(defun notmuch-show-get-filename () + "Return the filename of the current message." + (notmuch-show-get-prop :filename)) -(defun notmuch-show-get-bcc () - "Return BCC address(es) of current message" - (notmuch-show-get-header-field 'bcc)) +(defun notmuch-show-get-header (header &optional props) + "Return the named header of the current message, if any." + (plist-get (notmuch-show-get-prop :headers props) header)) (defun notmuch-show-get-cc () - "Return CC address(es) of current message" - (notmuch-show-get-header-field 'cc)) + (notmuch-show-get-header :Cc)) (defun notmuch-show-get-date () - "Return Date of current message" - (notmuch-show-get-header-field 'date)) + (notmuch-show-get-header :Date)) (defun notmuch-show-get-from () - "Return From address of current message" - (notmuch-show-get-header-field 'from)) + (notmuch-show-get-header :From)) (defun notmuch-show-get-subject () - "Return Subject of current message" - (notmuch-show-get-header-field 'subject)) + (notmuch-show-get-header :Subject)) (defun notmuch-show-get-to () - "Return To address(es) of current message" - (notmuch-show-get-header-field 'to)) - -(defun notmuch-show-get-header-field (name) - "Retrieve the header field NAME from the current message. -NAME should be a symbol, in lower case, as returned by -mail-header-extract-no-properties" - (let* ((result (assoc name (notmuch-show-get-header))) - (val (and result (cdr result)))) - val)) - -(defun notmuch-show-get-header () - "Retrieve and parse the header from the current message. Returns an alist with of (header . value) -where header is a symbol and value is a string. The summary from notmuch-show is returned as the -pseudoheader summary" - (require 'mailheader) - (save-excursion - (beginning-of-line) - (if (not (looking-at notmuch-show-message-begin-regexp)) - (re-search-backward notmuch-show-message-begin-regexp)) - (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n")) - (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - (beg (point))) - (re-search-forward notmuch-show-header-end-regexp) - (let ((text (buffer-substring beg (match-beginning 0)))) - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:") - (delete-region (match-beginning 1) (match-end 1)) - (forward-line) - ) - (goto-char (point-min)) - (cons (cons 'summary summary) (mail-header-extract-no-properties))))))) - -(defun notmuch-show-add-tag (&rest toadd) - "Add a tag to the current message." - (interactive - (list (notmuch-select-tag-with-completion "Tag to add: "))) - (apply 'notmuch-call-notmuch-process - (append (cons "tag" - (mapcar (lambda (s) (concat "+" s)) toadd)) - (cons (notmuch-show-get-message-id) nil))) - (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<))) - -(defun notmuch-show-remove-tag (&rest toremove) - "Remove a tag from the current message." - (interactive - (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id)))) - (let ((tags (notmuch-show-get-tags))) - (if (intersection tags toremove :test 'string=) - (progn - (apply 'notmuch-call-notmuch-process - (append (cons "tag" - (mapcar (lambda (s) (concat "-" s)) toremove)) - (cons (notmuch-show-get-message-id) nil))) - (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<)))))) - -(defun notmuch-show-archive-thread () - "Archive each message in thread, then show next thread from search. - -Archive each message currently shown by removing the \"inbox\" -tag from each. Then kill this buffer and show the next thread -from the search from which this thread was originally shown. + (notmuch-show-get-header :To)) -Note: This command is safe from any race condition of new messages -being delivered to the same thread. It does not archive the -entire thread, but only the messages shown in the current -buffer." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (notmuch-show-remove-tag "inbox") - (if (not (eobp)) - (forward-char)) - (if (not (re-search-forward notmuch-show-message-begin-regexp nil t)) - (goto-char (point-max))))) - (let ((parent-buffer notmuch-show-parent-buffer)) - (kill-this-buffer) - (if parent-buffer - (progn - (switch-to-buffer parent-buffer) - (forward-line) - (notmuch-search-show-thread))))) - -(defun notmuch-show-archive-thread-then-exit () - "Archive each message in thread, then exit back to search results." - (interactive) - (notmuch-show-archive-thread) - (kill-this-buffer)) - -(defun notmuch-show-view-raw-message () - "View the raw email of the current message." - (interactive) - (view-file (notmuch-show-get-filename))) +(defun notmuch-show-get-depth () + (notmuch-show-get-prop :depth)) -(defmacro with-current-notmuch-show-message (&rest body) - "Evaluate body with current buffer set to the text of current message" - `(save-excursion - (let ((filename (notmuch-show-get-filename))) - (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*")))) - (with-current-buffer buf - (insert-file-contents filename nil nil nil t) - ,@body) - (kill-buffer buf))))) - -(defun notmuch-show-view-all-mime-parts () - "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 - ; 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 - ; with-current-notmuch-show-message and silently discarded. - ; - ; Any MIME part not explicitly mentioned here will be handled by an - ; external viewer as configured in the various mailcap files. - (let ((mm-inline-media-tests '( - ("text/.*" ignore identity) - ("application/pgp-signature" ignore identity) - ("multipart/alternative" ignore identity) - ("multipart/mixed" ignore identity) - ("multipart/related" ignore identity) - ))) - (mm-display-parts (mm-dissect-buffer))))) - -(defun notmuch-show-save-attachments () - "Save all attachments from the current message." - (interactive) - (with-current-notmuch-show-message - (let ((mm-handle (mm-dissect-buffer))) - (notmuch-save-attachments - mm-handle (> (notmuch-count-attachments mm-handle) 1)))) - (message "Done")) - -(defun notmuch-show-reply () - "Begin composing a reply to the current message in a new buffer." - (interactive) - (let ((message-id (notmuch-show-get-message-id))) - (notmuch-reply message-id))) +(defun notmuch-show-set-tags (tags) + "Set the tags of the current message." + (notmuch-show-set-prop :tags tags) + (notmuch-show-update-tags tags)) -(defun notmuch-show-forward-current () - "Forward the current message." - (interactive) - (with-current-notmuch-show-message - (message-forward))) - -(defun notmuch-show-pipe-message (command) - "Pipe the contents of the current message to the given command. - -The given command will be executed with the raw contents of the -current email message as stdin. Anything printed by the command -to stdout or stderr will appear in the *Messages* buffer." - (interactive "sPipe message to command: ") - (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" - (list command " < " (shell-quote-argument (notmuch-show-get-filename))))) - -(defun notmuch-show-move-to-current-message-summary-line () - "Move to the beginning of the one-line summary of the current message. - -This gives us a stable place to move to and work from since the -summary line is always visible. This is important since moving to -an invisible location is unreliable, (the main command loop moves -point either forward or backward to the next visible character -when a command ends with point on an invisible character). - -Emits an error if point is not within a valid message, (that is -no pattern of `notmuch-show-message-begin-regexp' could be found -by searching backward)." - (beginning-of-line) - (if (not (looking-at notmuch-show-message-begin-regexp)) - (if (re-search-backward notmuch-show-message-begin-regexp nil t) - (forward-line 2) - (error "Not within a valid message.")) - (forward-line 2))) - -(defun notmuch-show-last-message-p () - "Predicate testing whether point is within the last message." - (save-window-excursion +(defun notmuch-show-get-tags () + "Return the tags of the current message." + (notmuch-show-get-prop :tags)) + +(defun notmuch-show-message-visible-p () + "Is the current message visible?" + (notmuch-show-get-prop :message-visible)) + +(defun notmuch-show-headers-visible-p () + "Are the headers of the current message visible?" + (notmuch-show-get-prop :headers-visible)) + +(put 'notmuch-show-mark-read 'notmuch-prefix-doc + "Mark the current message as unread.") +(defun notmuch-show-mark-read (&optional unread) + "Mark the current message as read. + +Mark the current message as read by applying the tag changes in +`notmuch-show-mark-read-tags' to it (remove the \"unread\" tag by +default). If a prefix argument is given, the message will be +marked as unread, i.e. the tag changes in +`notmuch-show-mark-read-tags' will be reversed." + (interactive "P") + (when notmuch-show-mark-read-tags + (apply 'notmuch-show-tag-message + (notmuch-tag-change-list notmuch-show-mark-read-tags unread)))) + +(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 +user decision and we should not override it." + (when (and (notmuch-show-message-visible-p) + (not (notmuch-show-get-prop :seen))) + (notmuch-show-mark-read) + (notmuch-show-set-prop :seen t))) + +(defun notmuch-show-command-hook () + (when (eq major-mode 'notmuch-show-mode) + ;; We need to redisplay to get window-start and window-end correct. + (redisplay) (save-excursion - (notmuch-show-move-to-current-message-summary-line) - (not (re-search-forward notmuch-show-message-begin-regexp nil t))))) - -(defun notmuch-show-message-unread-p () - "Predicate testing whether current message is unread." - (member "unread" (notmuch-show-get-tags))) - -(defun notmuch-show-message-open-p () - "Predicate testing whether current message is open (body is visible)." - (let ((btn (previous-button (point) t))) - (while (not (button-has-type-p btn 'notmuch-button-body-toggle-type)) - (setq btn (previous-button (button-start btn)))) - (not (invisible-p (button-get btn 'invisibility-spec))))) - -(defun notmuch-show-next-message-without-marking-read () - "Advance to the beginning of the next message in the buffer. - -Moves to the last visible character of the current message if -already on the last message in the buffer. - -Returns nil if already on the last message in the buffer." - (notmuch-show-move-to-current-message-summary-line) - (if (re-search-forward notmuch-show-message-begin-regexp nil t) - (progn - (notmuch-show-move-to-current-message-summary-line) - (recenter 0) - t) - (goto-char (- (point-max) 1)) - (while (point-invisible-p) - (backward-char)) - (recenter 0) - nil)) - -(defun notmuch-show-next-message () - "Advance to the next message (whether open or closed) -and remove the unread tag from that message. - -Moves to the last visible character of the current message if -already on the last message in the buffer. - -Returns nil if already on the last message in the buffer." - (interactive) - (notmuch-show-next-message-without-marking-read) - (notmuch-show-mark-read)) - -(defun notmuch-show-find-next-message () - "Returns the position of the next message in the buffer. - -Or the position of the last visible character of the current -message if already within the last message in the buffer." - ; save-excursion doesn't save our window position - ; save-window-excursion doesn't save point - ; Looks like we have to use both. - (save-excursion - (save-window-excursion - (notmuch-show-next-message-without-marking-read) - (point)))) + (funcall notmuch-show-mark-read-function (window-start) (window-end))))) -(defun notmuch-show-next-unread-message () - "Advance to the next unread message. +;; Functions for getting attributes of several messages in the current +;; thread. -Moves to the last visible character of the current message if -there are no more unread messages past the current point." - (notmuch-show-next-message-without-marking-read) - (while (and (not (notmuch-show-last-message-p)) - (not (notmuch-show-message-unread-p))) - (notmuch-show-next-message-without-marking-read)) - (if (not (notmuch-show-message-unread-p)) - (notmuch-show-next-message-without-marking-read)) - (notmuch-show-mark-read)) - -(defun notmuch-show-next-open-message () - "Advance to the next open message (that is, body is visible). - -Moves to the last visible character of the final message in the buffer -if there are no more open messages." - (interactive) - (while (and (notmuch-show-next-message-without-marking-read) - (not (notmuch-show-message-open-p)))) - (notmuch-show-mark-read)) +(defun notmuch-show-get-message-ids-for-open-messages () + "Return a list of all id: queries for open messages in the current thread." + (save-excursion + (let (message-ids done) + (goto-char (point-min)) + (while (not done) + (if (notmuch-show-message-visible-p) + (setq message-ids (append message-ids (list (notmuch-show-get-message-id))))) + (setq done (not (notmuch-show-goto-message-next))) + ) + message-ids + ))) -(defun notmuch-show-previous-message-without-marking-read () - "Backup to the beginning of the previous message in the buffer. +;; Commands typically bound to keys. -If within a message rather than at the beginning of it, then -simply move to the beginning of the current message. +(defun notmuch-show-advance () + "Advance through thread. -Returns nil if already on the first message in the buffer." - (let ((start (point))) - (notmuch-show-move-to-current-message-summary-line) - (if (not (< (point) start)) - ; Go backward twice to skip the current message's marker - (progn - (re-search-backward notmuch-show-message-begin-regexp nil t) - (re-search-backward notmuch-show-message-begin-regexp nil t) - (notmuch-show-move-to-current-message-summary-line) - (recenter 0) - (if (= (point) start) - nil - t)) - (recenter 0) - nil))) - -(defun notmuch-show-previous-message () - "Backup to the previous message (whether open or closed) -and remove the unread tag from that message. +If the current message in the thread is not yet fully visible, +scroll by a near screenful to read more of the message. -If within a message rather than at the beginning of it, then -simply move to the beginning of the current message." +Otherwise, (the end of the current message is already within the +current window), advance to the next open message." (interactive) - (notmuch-show-previous-message-without-marking-read) - (notmuch-show-mark-read)) + (let* ((end-of-this-message (notmuch-show-message-bottom)) + (visible-end-of-this-message (1- end-of-this-message)) + (ret nil)) + (while (invisible-p visible-end-of-this-message) + (setq visible-end-of-this-message + (max (point-min) + (1- (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. + ((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)) + + ((not (= end-of-this-message (point-max))) + ;; This is not the last message - move to the next visible one. + (notmuch-show-next-open-message)) + + ((not (= (point) (point-max))) + ;; This is the last message, but the cursor is not at the end of + ;; the buffer. Move it there. + (goto-char (point-max))) + + (t + ;; This is the last message - change the return value + (setq ret t))) + ret)) -(defun notmuch-show-find-previous-message () - "Returns the position of the previous message in the buffer. - -Or the position of the beginning of the current message if point -is originally within the message rather than at the beginning of -it." - ; save-excursion doesn't save our window position - ; save-window-excursion doesn't save point - ; Looks like we have to use both. - (save-excursion - (save-window-excursion - (notmuch-show-previous-message-without-marking-read) - (point)))) - -(defun notmuch-show-previous-open-message () - "Backup to previous open message (that is, body is visible). +(defun notmuch-show-advance-and-archive () + "Advance through thread and archive. -Moves to the first message in the buffer if there are no previous -open messages." +This command is intended to be one of the simplest ways to +process a thread of email. It works exactly like +notmuch-show-advance, in that it scrolls through messages in a +show buffer, except that when it gets to the end of the buffer it +archives the entire current thread, (apply changes in +`notmuch-archive-tags'), kills the buffer, and displays the next +thread from the search from which this thread was originally +shown." (interactive) - (while (and (notmuch-show-previous-message-without-marking-read) - (not (notmuch-show-message-open-p)))) - (notmuch-show-mark-read)) + (if (notmuch-show-advance) + (notmuch-show-archive-thread-then-next))) (defun notmuch-show-rewind () - "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]). + "Backup through the thread (reverse scrolling compared to \\[notmuch-show-advance-and-archive]). Specifically, if the beginning of the previous email is fewer than `window-height' lines from the current point, move to it @@ -555,47 +1680,269 @@ This command does not modify any message tags, (it does not undo any effects from previous calls to `notmuch-show-advance-and-archive'." (interactive) - (let ((previous (notmuch-show-find-previous-message))) - (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines)) - (progn - (condition-case nil - (scroll-down nil) - ((beginning-of-buffer) nil)) - (goto-char (window-start)) - ; Because count-lines counts invivisible lines, we may have - ; scrolled to far. If so., notice this and fix it up. - (if (< (point) previous) - (progn - (goto-char previous) - (recenter 0)))) - (notmuch-show-previous-message)))) + (let ((start-of-message (notmuch-show-message-top)) + (start-of-window (window-start))) + (cond + ;; Either this message is properly aligned with the start of the + ;; window or the start of this message is not visible on the + ;; screen - scroll. + ((or (= start-of-message start-of-window) + (< start-of-message start-of-window)) + (scroll-down) + ;; If a small number of lines from the previous message are + ;; visible, realign so that the top of the current message is at + ;; the top of the screen. + (when (<= (count-screen-lines (window-start) start-of-message) + next-screen-context-lines) + (goto-char (notmuch-show-message-top)) + (notmuch-show-message-adjust)) + ;; Move to the top left of the window. + (goto-char (window-start))) + (t + ;; Move to the previous message. + (notmuch-show-previous-message))))) + +(put 'notmuch-show-reply 'notmuch-prefix-doc "... and prompt for sender") +(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)) + +(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)) + +(put 'notmuch-show-forward-message 'notmuch-prefix-doc + "... and prompt for sender") +(defun notmuch-show-forward-message (&optional prompt-for-sender) + "Forward the current message." + (interactive "P") + (with-current-notmuch-show-message + (notmuch-mua-new-forward-message prompt-for-sender))) -(defun notmuch-show-advance-and-archive () - "Advance through thread and archive. +(defun notmuch-show-next-message (&optional pop-at-end) + "Show the next message. -This command is intended to be one of the simplest ways to -process a thread of email. It does the following: +If a prefix argument is given and this is the last message in the +thread, navigate to the next thread in the parent search buffer." + (interactive "P") + (if (notmuch-show-goto-message-next) + (notmuch-show-message-adjust) + (if pop-at-end + (notmuch-show-next-thread) + (goto-char (point-max))))) -If the current message in the thread is not yet fully visible, -scroll by a near screenful to read more of the message. +(defun notmuch-show-previous-message () + "Show the previous message or the start of the current message." + (interactive) + (if (= (point) (notmuch-show-message-top)) + (notmuch-show-goto-message-previous) + (notmuch-show-move-to-message-top)) + (notmuch-show-message-adjust)) + +(defun notmuch-show-next-open-message (&optional pop-at-end) + "Show the next open message. + +If a prefix argument is given and this is the last open message +in the thread, navigate to the next thread in the parent search +buffer. Return t if there was a next open message in the thread +to show, nil otherwise." + (interactive "P") + (let (r) + (while (and (setq r (notmuch-show-goto-message-next)) + (not (notmuch-show-message-visible-p)))) + (if r + (notmuch-show-message-adjust) + (if pop-at-end + (notmuch-show-next-thread) + (goto-char (point-max)))) + r)) + +(defun notmuch-show-next-matching-message () + "Show the next matching message." + (interactive) + (let (r) + (while (and (setq r (notmuch-show-goto-message-next)) + (not (notmuch-show-get-prop :match)))) + (if r + (notmuch-show-message-adjust) + (goto-char (point-max))))) + +(defun notmuch-show-open-if-matched () + "Open a message if it is matched (whether or not excluded)." + (let ((props (notmuch-show-get-message-properties))) + (notmuch-show-message-visible props (plist-get props :match)))) + +(defun notmuch-show-goto-first-wanted-message () + "Move to the first open message and mark it read" + (goto-char (point-min)) + (unless (notmuch-show-message-visible-p) + (notmuch-show-next-open-message)) + (when (eobp) + ;; There are no matched non-excluded messages so open all matched + ;; (necessarily excluded) messages and go to the first. + (notmuch-show-mapc 'notmuch-show-open-if-matched) + (force-window-update) + (goto-char (point-min)) + (unless (notmuch-show-message-visible-p) + (notmuch-show-next-open-message)))) -Otherwise, (the end of the current message is already within the -current window), advance to the next open message. - -Finally, if there is no further message to advance to, and this -last message is already read, then archive the entire current -thread, (remove the \"inbox\" tag from each message). Also kill -this buffer, and display the next thread from the search from -which this thread was originally shown." - (interactive) - (let ((next (notmuch-show-find-next-message)) - (unread (notmuch-show-message-unread-p))) - (if (> next (window-end)) - (scroll-up nil) - (let ((last (notmuch-show-last-message-p))) - (notmuch-show-next-open-message) - (if last - (notmuch-show-archive-thread)))))) +(defun notmuch-show-previous-open-message () + "Show the previous open message." + (interactive) + (while (and (if (= (point) (notmuch-show-message-top)) + (notmuch-show-goto-message-previous) + (notmuch-show-move-to-message-top)) + (not (notmuch-show-message-visible-p)))) + (notmuch-show-message-adjust)) + +(defun notmuch-show-view-raw-message () + "View the original source of the current message." + (interactive) + (let* ((id (notmuch-show-get-message-id)) + (buf (get-buffer-create (concat "*notmuch-raw-" id "*")))) + (let ((coding-system-for-read 'no-conversion)) + (call-process notmuch-command nil buf nil "show" "--format=raw" id)) + (switch-to-buffer buf) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (view-buffer buf 'kill-buffer-if-not-modified))) + +(put 'notmuch-show-pipe-message 'notmuch-doc + "Pipe the contents of the current message to a command.") +(put 'notmuch-show-pipe-message 'notmuch-prefix-doc + "Pipe the thread as an mbox to a command.") +(defun notmuch-show-pipe-message (entire-thread command) + "Pipe the contents of the current message (or thread) to COMMAND. + +COMMAND will be executed with the raw contents of the current +email message as stdin. Anything printed by the command to stdout +or stderr will appear in the *notmuch-pipe* buffer. + +If ENTIRE-THREAD is non-nil (or when invoked with a prefix +argument), COMMAND will receive all open messages in the current +thread (formatted as an mbox) rather than only the current +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)))) + (let (shell-command) + (if entire-thread + (setq shell-command + (concat notmuch-command " show --format=mbox --exclude=false " + (shell-quote-argument + (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR ")) + " | " command)) + (setq shell-command + (concat notmuch-command " show --format=raw " + (shell-quote-argument (notmuch-show-get-message-id)) " | " command))) + (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) + (switch-to-buffer-other-window 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. + +TAG-CHANGES is a list of tag operations for `notmuch-tag'." + (let* ((current-tags (notmuch-show-get-tags)) + (new-tags (notmuch-update-tags current-tags tag-changes))) + (unless (equal current-tags new-tags) + (notmuch-tag (notmuch-show-get-message-id) tag-changes) + (notmuch-show-set-tags new-tags)))) + +(defun notmuch-show-tag (tag-changes) + "Change tags for the current message. + +See `notmuch-tag' for information on the format of TAG-CHANGES." + (interactive (list (notmuch-read-tag-changes (notmuch-show-get-tags) + "Tag message"))) + (notmuch-tag (notmuch-show-get-message-id) tag-changes) + (let* ((current-tags (notmuch-show-get-tags)) + (new-tags (notmuch-update-tags current-tags tag-changes))) + (unless (equal current-tags new-tags) + (notmuch-show-set-tags new-tags)))) + +(defun notmuch-show-tag-all (tag-changes) + "Change tags for all messages in the current show buffer. + +See `notmuch-tag' for information on the format of TAG-CHANGES." + (interactive + (list (let (tags) + (notmuch-show-mapc + (lambda () (setq tags (append (notmuch-show-get-tags) tags)))) + (notmuch-read-tag-changes tags "Tag thread")))) + (notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes) + (notmuch-show-mapc + (lambda () + (let* ((current-tags (notmuch-show-get-tags)) + (new-tags (notmuch-update-tags current-tags tag-changes))) + (unless (equal current-tags new-tags) + (notmuch-show-set-tags new-tags)))))) + +(defun notmuch-show-add-tag (tag-changes) + "Change tags for the current message (defaulting to add). + +Same as `notmuch-show-tag' but sets initial input to '+'." + (interactive + (list (notmuch-read-tag-changes (notmuch-show-get-tags) "Tag message" "+"))) + (notmuch-show-tag tag-changes)) + +(defun notmuch-show-remove-tag (tag-changes) + "Change tags for the current message (defaulting to remove). + +Same as `notmuch-show-tag' but sets initial input to '-'." + (interactive + (list (notmuch-read-tag-changes (notmuch-show-get-tags) "Tag message" "-"))) + (notmuch-show-tag tag-changes)) + +(defun notmuch-show-toggle-visibility-headers () + "Toggle the visibility of the current message headers." + (interactive) + (let ((props (notmuch-show-get-message-properties))) + (notmuch-show-headers-visible + props + (not (plist-get props :headers-visible)))) + (force-window-update)) + +(defun notmuch-show-toggle-message () + "Toggle the visibility of the current message." + (interactive) + (let ((props (notmuch-show-get-message-properties))) + (notmuch-show-message-visible + props + (not (plist-get props :message-visible)))) + (force-window-update)) + +(put 'notmuch-show-open-or-close-all 'notmuch-doc "Show all messages.") +(put 'notmuch-show-open-or-close-all 'notmuch-prefix-doc "Hide all messages.") +(defun notmuch-show-open-or-close-all () + "Set the visibility all of the messages in the current thread. + +By default make all of the messages visible. With a prefix +argument, hide all of the messages." + (interactive) + (save-excursion + (goto-char (point-min)) + (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties) + (not current-prefix-arg)) + until (not (notmuch-show-goto-message-next)))) + (force-window-update)) (defun notmuch-show-next-button () "Advance point to the next button in the buffer." @@ -607,391 +1954,296 @@ which this thread was originally shown." (interactive) (backward-button 1)) -(defun notmuch-show-toggle-current-body () - "Toggle the display of the current message body." - (interactive) - (save-excursion - (notmuch-show-move-to-current-message-summary-line) - (unless (button-at (point)) - (notmuch-show-next-button)) - (push-button)) - ) +(defun notmuch-show-next-thread (&optional show previous) + "Move to the next item in the search results, if any. -(defun notmuch-show-toggle-current-header () - "Toggle the display of the current message header." +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." + (interactive "P") + (let ((parent-buffer notmuch-show-parent-buffer)) + (notmuch-bury-or-kill-this-buffer) + (when (buffer-live-p parent-buffer) + (switch-to-buffer parent-buffer) + (and (if previous + (notmuch-search-previous-thread) + (notmuch-search-next-thread)) + show + (notmuch-search-show-thread))))) + +(defun notmuch-show-next-thread-show () + "Show the next thread in the search results, if any." (interactive) - (save-excursion - (notmuch-show-move-to-current-message-summary-line) - (forward-line) - (unless (button-at (point)) - (notmuch-show-next-button)) - (push-button)) - ) - -(defun notmuch-show-citation-regexp (depth) - "Build a regexp for matching citations at a given DEPTH (indent)" - (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth))) - (concat "\\(?:^" line-regexp - "\\(?:[[:space:]]*\n" line-regexp - "\\)?\\)+"))) - -(defun notmuch-show-region-to-button (beg end type prefix button-text) - "Auxilary function to do the actual making of overlays and buttons - -BEG and END are buffer locations. TYPE should a string, either -\"citation\" or \"signature\". PREFIX is some arbitrary text to -insert before the button, probably for indentation. BUTTON-TEXT -is what to put on the button." - -;; This uses some slightly tricky conversions between strings and -;; symbols because of the way the button code works. Note that -;; replacing intern-soft with make-symbol will cause this to fail, -;; since the newly created symbol has no plist. - - (let ((overlay (make-overlay beg end)) - (invis-spec (make-symbol (concat "notmuch-" type "-region"))) - (button-type (intern-soft (concat "notmuch-button-" - type "-toggle-type")))) - (add-to-invisibility-spec invis-spec) - (overlay-put overlay 'invisible invis-spec) - (goto-char (1+ end)) - (save-excursion - (goto-char (1- beg)) - (insert prefix) - (insert-button button-text - 'invisibility-spec invis-spec - :type button-type) - ))) + (notmuch-show-next-thread t)) -(defun notmuch-show-markup-citations-region (beg end depth) - "Markup citations, and up to one signature in the given region" - ;; it would be nice if the untabify was not required, but - ;; that would require notmuch to indent with spaces. - (untabify beg end) - (let ((citation-regexp (notmuch-show-citation-regexp depth)) - (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth) - notmuch-show-signature-regexp)) - (indent (concat "\n" (make-string depth ? )))) - (goto-char beg) - (beginning-of-line) - (while (and (< (point) end) - (re-search-forward citation-regexp end t)) - (let* ((cite-start (match-beginning 0)) - (cite-end (match-end 0)) - (cite-lines (count-lines cite-start cite-end))) - (when (> cite-lines (1+ notmuch-show-citation-lines-prefix)) - (goto-char cite-start) - (forward-line notmuch-show-citation-lines-prefix) - (notmuch-show-region-to-button - (point) cite-end - "citation" - indent - (format notmuch-show-citation-button-format - (- cite-lines notmuch-show-citation-lines-prefix)) - )))) - (if (and (< (point) end) - (re-search-forward signature-regexp end t)) - (let* ((sig-start (match-beginning 0)) - (sig-end (match-end 0)) - (sig-lines (1- (count-lines sig-start end)))) - (if (<= sig-lines notmuch-show-signature-lines-max) - (notmuch-show-region-to-button - sig-start - end - "signature" - indent - (format notmuch-show-signature-button-format sig-lines) - )))))) - -(defun notmuch-show-markup-part (beg end depth) - (if (re-search-forward notmuch-show-part-begin-regexp nil t) - (progn - (let (mime-message mime-type) - (save-excursion - (re-search-forward notmuch-show-contentype-regexp end t) - (setq mime-type (car (split-string (buffer-substring - (match-beginning 1) (match-end 1)))))) - - (if (equal mime-type "text/html") - (let ((filename (notmuch-show-get-filename))) - (with-temp-buffer - (insert-file-contents filename nil nil nil t) - (setq mime-message (mm-dissect-buffer))))) - (forward-line) - (let ((beg (point-marker))) - (re-search-forward notmuch-show-part-end-regexp) - (let ((end (copy-marker (match-beginning 0)))) - (goto-char end) - (if (not (bolp)) - (insert "\n")) - (indent-rigidly beg end depth) - (if (not (eq mime-message nil)) - (save-excursion - (goto-char beg) - (forward-line -1) - (let ((handle-type (mm-handle-type mime-message)) - mime-type) - (if (sequencep (car handle-type)) - (setq mime-type (car handle-type)) - (setq mime-type (car (car (cdr handle-type)))) - ) - (if (equal mime-type "text/html") - (mm-display-part mime-message)))) - ) - (notmuch-show-markup-citations-region beg end depth) - ; Advance to the next part (if any) (so the outer loop can - ; determine whether we've left the current message. - (if (re-search-forward notmuch-show-part-begin-regexp nil t) - (beginning-of-line))))) - (goto-char end)) - (goto-char end))) - -(defun notmuch-show-markup-parts-region (beg end depth) - (save-excursion - (goto-char beg) - (while (< (point) end) - (notmuch-show-markup-part beg end depth)))) - -(defun notmuch-show-markup-body (depth match btn) - "Markup a message body, (indenting, buttonizing citations, -etc.), and hiding the body itself if the message does not match -the current search. - -DEPTH specifies the depth at which this message appears in the -tree of the current thread, (the top-level messages have depth 0 -and each reply increases depth by 1). MATCH indicates whether -this message is regarded as matching the current search. BTN is -the button which is used to toggle the visibility of this -message. - -When this function is called, point must be within the message, but -before the delimiter marking the beginning of the body." - (re-search-forward notmuch-show-body-begin-regexp) - (forward-line) - (let ((beg (point-marker))) - (re-search-forward notmuch-show-body-end-regexp) - (let ((end (copy-marker (match-beginning 0)))) - (notmuch-show-markup-parts-region beg end depth) - (let ((invis-spec (make-symbol "notmuch-show-body-read"))) - (overlay-put (make-overlay beg end) - 'invisible invis-spec) - (button-put btn 'invisibility-spec invis-spec) - (if (not match) - (add-to-invisibility-spec invis-spec))) - (set-marker beg nil) - (set-marker end nil) - ))) - -(defun notmuch-show-markup-header (message-begin depth) - "Buttonize and decorate faces in a message header. - -MESSAGE-BEGIN is the position of the absolute first character in -the message (including all delimiters that will end up being -invisible etc.). This is to allow a button to reliably extend to -the beginning of the message even if point is positioned at an -invisible character (such as the beginning of the buffer). - -DEPTH specifies the depth at which this message appears in the -tree of the current thread, (the top-level messages have depth 0 -and each reply increases depth by 1)." - (re-search-forward notmuch-show-header-begin-regexp) - (forward-line) - (let ((beg (point-marker)) - (summary-end (copy-marker (line-beginning-position 2))) - (subject-end (copy-marker (line-end-position 2))) - (invis-spec (make-symbol "notmuch-show-header")) - (btn nil)) - (re-search-forward notmuch-show-header-end-regexp) - (beginning-of-line) - (let ((end (point-marker))) - (indent-rigidly beg end depth) - (goto-char beg) - (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type)) - (forward-line) - (add-to-invisibility-spec invis-spec) - (overlay-put (make-overlay subject-end end) - 'invisible invis-spec) - (make-button (line-beginning-position) subject-end - 'invisibility-spec invis-spec - :type 'notmuch-button-headers-toggle-type) - (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:") - (beginning-of-line) - (notmuch-fontify-headers) - (forward-line) - ) - (goto-char end) - (insert "\n") - (set-marker beg nil) - (set-marker summary-end nil) - (set-marker subject-end nil) - (set-marker end nil) - ) - btn)) - -(defun notmuch-show-markup-message () - (if (re-search-forward notmuch-show-message-begin-regexp nil t) - (let ((message-begin (match-beginning 0))) - (re-search-forward notmuch-show-depth-match-regexp) - (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) - (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2)))) - (btn nil)) - (setq btn (notmuch-show-markup-header message-begin depth)) - (notmuch-show-markup-body depth match btn))) - (goto-char (point-max)))) - -(defun notmuch-show-hide-markers () - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (re-search-forward notmuch-show-marker-regexp nil t) - (progn - (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1)) - 'invisible 'notmuch-show-marker)) - (goto-char (point-max)))))) - -(defun notmuch-show-markup-messages () - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (notmuch-show-markup-message))) - (notmuch-show-hide-markers)) - -;;;###autoload -(defun notmuch-show-mode () - "Major mode for viewing a thread with notmuch. - -This buffer contains the results of the \"notmuch show\" command -for displaying a single thread of email from your email archives. - -By default, various components of email messages, (citations, -signatures, already-read messages), are hidden. You can make -these parts visible by clicking with the mouse button or by -pressing RET after positioning the cursor on a hidden part, (for -which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful). +(defun notmuch-show-previous-thread-show () + "Show the previous thread in the search results, if any." + (interactive) + (notmuch-show-next-thread t t)) -Reading the thread sequentially is well-supported by pressing -\\[notmuch-show-advance-and-archive]. This will -scroll the current message (if necessary), advance to the next -message, or advance to the next thread (if already on the last -message of a thread). +(put 'notmuch-show-archive-thread 'notmuch-prefix-doc + "Un-archive each message in thread.") +(defun notmuch-show-archive-thread (&optional unarchive) + "Archive each message in thread. -Other commands are available to read or manipulate the thread more -selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages without -removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without -scrolling through with \\[notmuch-show-advance-and-archive]). +Archive each message currently shown by applying the tag changes +in `notmuch-archive-tags' to each. If a prefix argument is given, +the messages will be \"unarchived\", i.e. the tag changes in +`notmuch-archive-tags' will be reversed. -You can add or remove arbitary tags from the current message with -'\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'. +Note: This command is safe from any race condition of new messages +being delivered to the same thread. It does not archive the +entire thread, but only the messages shown in the current +buffer." + (interactive "P") + (when notmuch-archive-tags + (notmuch-show-tag-all + (notmuch-tag-change-list notmuch-archive-tags unarchive)))) -All currently available key bindings: +(defun notmuch-show-archive-thread-then-next () + "Archive all messages in the current buffer, then show next thread from search." + (interactive) + (notmuch-show-archive-thread) + (notmuch-show-next-thread t)) -\\{notmuch-show-mode-map}" +(defun notmuch-show-archive-thread-then-exit () + "Archive all messages in the current buffer, then exit back to search results." (interactive) - (kill-all-local-variables) - (add-to-invisibility-spec 'notmuch-show-marker) - (use-local-map notmuch-show-mode-map) - (setq major-mode 'notmuch-show-mode - mode-name "notmuch-show") - (setq buffer-read-only t)) + (notmuch-show-archive-thread) + (notmuch-show-next-thread)) + +(put 'notmuch-show-archive-message 'notmuch-prefix-doc + "Un-archive the current message.") +(defun notmuch-show-archive-message (&optional unarchive) + "Archive the current message. + +Archive the current message by applying the tag changes in +`notmuch-archive-tags' to it. If a prefix argument is given, the +message will be \"unarchived\", i.e. the tag changes in +`notmuch-archive-tags' will be reversed." + (interactive "P") + (when notmuch-archive-tags + (apply 'notmuch-show-tag-message + (notmuch-tag-change-list notmuch-archive-tags unarchive)))) + +(defun notmuch-show-archive-message-then-next-or-exit () + "Archive the current message, then show the next open message in the current thread. + +If at the last open message in the current thread, then exit back +to search results." + (interactive) + (notmuch-show-archive-message) + (notmuch-show-next-open-message t)) -(defcustom notmuch-show-hook nil - "List of functions to call when notmuch displays a message." - :type 'hook - :options '(goto-address) - :group 'notmuch) +(defun notmuch-show-archive-message-then-next-or-next-thread () + "Archive the current message, then show the next open message in the current thread. -(defun notmuch-show-do-stash (text) - (kill-new text) - (message (concat "Saved: " text))) +If at the last open message in the current thread, then show next +thread from search." + (interactive) + (notmuch-show-archive-message) + (unless (notmuch-show-next-open-message) + (notmuch-show-next-thread t))) (defun notmuch-show-stash-cc () "Copy CC field of current message to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-cc))) + (notmuch-common-do-stash (notmuch-show-get-cc))) (defun notmuch-show-stash-date () "Copy date of current message to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-date))) + (notmuch-common-do-stash (notmuch-show-get-date))) (defun notmuch-show-stash-filename () "Copy filename of current message to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-filename))) + (notmuch-common-do-stash (notmuch-show-get-filename))) (defun notmuch-show-stash-from () "Copy From address of current message to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-from))) - -(defun notmuch-show-stash-message-id () - "Copy message ID of current message to kill-ring." + (notmuch-common-do-stash (notmuch-show-get-from))) + +(put 'notmuch-show-stash-message-id 'notmuch-prefix-doc + "Copy thread: query matching current thread to kill-ring.") +(defun notmuch-show-stash-message-id (&optional stash-thread-id) + "Copy id: query matching the current message to kill-ring. + +If invoked with a prefix argument (or STASH-THREAD-ID is +non-nil), copy thread: query matching the current thread to +kill-ring." + (interactive "P") + (if stash-thread-id + (notmuch-common-do-stash notmuch-show-thread-id) + (notmuch-common-do-stash (notmuch-show-get-message-id)))) + +(defun notmuch-show-stash-message-id-stripped () + "Copy message ID of current message (sans `id:' prefix) to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-message-id))) + (notmuch-common-do-stash (notmuch-show-get-message-id t))) (defun notmuch-show-stash-subject () "Copy Subject field of current message to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-subject))) + (notmuch-common-do-stash (notmuch-show-get-subject))) (defun notmuch-show-stash-tags () "Copy tags of current message to kill-ring as a comma separated list." (interactive) - (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ","))) + (notmuch-common-do-stash (mapconcat 'identity (notmuch-show-get-tags) ","))) (defun notmuch-show-stash-to () "Copy To address of current message to kill-ring." (interactive) - (notmuch-show-do-stash (notmuch-show-get-to))) + (notmuch-common-do-stash (notmuch-show-get-to))) -; Make show mode a bit prettier, highlighting URLs and using word wrap +(defun notmuch-show-stash-mlarchive-link (&optional mla) + "Copy an ML Archive URI for the current message to the kill-ring. -(defun notmuch-show-mark-read () - (notmuch-show-remove-tag "unread")) +This presumes that the message is available at the selected Mailing List Archive. -(defun notmuch-show-pretty-hook () - (goto-address-mode 1) - (visual-line-mode)) +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 + (let ((completion-ignore-case t)) + (completing-read + "Mailing List Archive: " + notmuch-show-stash-mlarchive-link-alist + nil t nil nil + notmuch-show-stash-mlarchive-link-default))) + notmuch-show-stash-mlarchive-link-alist)))) + (notmuch-common-do-stash + (if (functionp url) + (funcall url (notmuch-show-get-message-id t)) + (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. + +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')." + (interactive) + (notmuch-show-stash-mlarchive-link mla) + (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." + (mapconcat (lambda (x) + (concat prefix "\"" + ;; escape double-quotes + (replace-regexp-in-string + "\"" "\\\\\"" + ;; trim leading and trailing spaces + (replace-regexp-in-string + "\\(^ *\\| *$\\)" "" + x)) "\"")) + 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.") + +(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. + +If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil), +omit --in-reply-to=." + (interactive "P") + (notmuch-common-do-stash + (mapconcat 'identity + (remove "" + (list + (notmuch-show-stash-git-helper + (message-tokenize-header (notmuch-show-get-from)) "--to=") + (notmuch-show-stash-git-helper + (message-tokenize-header (notmuch-show-get-to)) "--to=") + (notmuch-show-stash-git-helper + (message-tokenize-header (notmuch-show-get-cc)) "--cc=") + (unless no-in-reply-to + (notmuch-show-stash-git-helper + (list (notmuch-show-get-message-id t)) "--in-reply-to=")))) + " "))) + +;; Interactive part functions and their helpers + +(defun notmuch-show-generate-part-buffer (message-id nth) + "Return a temporary buffer containing the specified part's content." + (let ((buf (generate-new-buffer " *notmuch-part*")) + (process-crypto notmuch-show-process-crypto)) + (with-current-buffer buf + (setq notmuch-show-process-crypto process-crypto) + ;; Always acquires the part via `notmuch part', even if it is + ;; available in the SEXP output. + (insert (notmuch-get-bodypart-internal message-id nth notmuch-show-process-crypto))) + buf)) + +(defun notmuch-show-current-part-handle () + "Return an mm-handle for the part containing point. + +This creates a temporary buffer for the part's content; the +caller is responsible for killing this buffer as appropriate." + (let* ((part (notmuch-show-get-part-properties)) + (message-id (notmuch-show-get-message-id)) + (nth (plist-get part :id)) + (buf (notmuch-show-generate-part-buffer message-id nth)) + (computed-type (plist-get part :computed-type)) + (filename (plist-get part :filename)) + (disposition (if filename `(attachment (filename . ,filename))))) + (mm-make-handle buf (list computed-type) nil nil disposition))) + +(defun notmuch-show-apply-to-current-part-handle (fn) + "Apply FN to an mm-handle for the part containing point. + +This ensures that the temporary buffer created for the mm-handle +is destroyed when FN returns." + (let ((handle (notmuch-show-current-part-handle))) + ;; 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*". + (unwind-protect + (if notmuch-show-attachment-debug + (with-current-buffer (generate-new-buffer " *notmuch-part*") + (funcall fn handle)) + (with-temp-buffer + (funcall fn handle))) + (kill-buffer (mm-handle-buffer handle))))) + +(defun notmuch-show-part-button-default (&optional button) + (interactive) + (let ((button (or button (button-at (point))))) + ;; Try to toggle the part, if that fails then call the default + ;; action. The toggle fails if the part has no emacs renderable + ;; content. + (unless (notmuch-show-toggle-part-invisibility button) + (call-interactively notmuch-show-part-button-default-action)))) + +(defun notmuch-show-save-part () + "Save the MIME part containing point to a file." + (interactive) + (notmuch-show-apply-to-current-part-handle #'mm-save-part)) -(add-hook 'notmuch-show-hook 'notmuch-show-mark-read) -(add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook) -(add-hook 'notmuch-search-hook - (lambda() - (hl-line-mode 1) )) +(defun notmuch-show-view-part () + "View the MIME part containing point in an external viewer." + (interactive) + ;; Set mm-inlined-types to nil to force an external viewer + (let ((mm-inlined-types nil)) + (notmuch-show-apply-to-current-part-handle #'mm-display-part))) -(defun notmuch-show (thread-id &optional parent-buffer query-context) - "Run \"notmuch show\" with the given thread ID and display results. +(defun notmuch-show-interactively-view-part () + "View the MIME part containing point, prompting for a viewer." + (interactive) + (notmuch-show-apply-to-current-part-handle #'mm-interactively-view-part)) + +(defun notmuch-show-pipe-part () + "Pipe the MIME part containing point to an external command." + (interactive) + (notmuch-show-apply-to-current-part-handle #'mm-pipe-part)) -The optional PARENT-BUFFER is the notmuch-search buffer from -which this notmuch-show command was executed, (so that the next -thread from that buffer can be show when done with this one). - -The optional QUERY-CONTEXT is a notmuch search term. Only messages from the thread -matching this search term are shown if non-nil. " - (interactive "sNotmuch show: ") - (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*")))) - (switch-to-buffer buffer) - (notmuch-show-mode) - (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer) - (let ((proc (get-buffer-process (current-buffer))) - (inhibit-read-only t)) - (if proc - (error "notmuch search process already running for query `%s'" thread-id) - ) - (erase-buffer) - (goto-char (point-min)) - (save-excursion - (let* ((basic-args (list notmuch-command nil t nil "show" "--entire-thread" thread-id)) - (args (if query-context (append basic-args (list "and (" query-context ")")) basic-args))) - (apply 'call-process args) - (when (and (eq (buffer-size) 0) query-context) - (apply 'call-process basic-args))) - (notmuch-show-markup-messages) - ) - (run-hooks 'notmuch-show-hook) - ; Move straight to the first open message - (if (not (notmuch-show-message-open-p)) - (notmuch-show-next-open-message)) - ))) (provide 'notmuch-show)