X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=2806879e53cfff412e07c4b175478f8ed728998e;hp=2ba151edfc81059ad8a69f79ab6e61d860052dab;hb=0bbfc5ce8be91b881d9542d86aceec7e6a716e86;hpb=f7cc259c10cc1a1c85b48d6c826c5e9effb3e34a diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 2ba151ed..2806879e 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -27,11 +27,13 @@ (require 'mm-decode) (require 'mailcap) (require 'icalendar) +(require 'goto-addr) (require 'notmuch-lib) (require 'notmuch-query) (require 'notmuch-wash) (require 'notmuch-mua) +(require 'notmuch-crypto) (declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) (declare-function notmuch-fontify-headers "notmuch" nil) @@ -64,17 +66,6 @@ any given message." :group 'notmuch :type 'boolean) -(defcustom notmuch-show-elide-same-subject nil - "Do not show the subject of a collapsed message if it is the -same as that of the previous message." - :group 'notmuch - :type 'boolean) - -(defcustom notmuch-show-always-show-subject t - "Should a collapsed message show the `Subject:' line?" - :group 'notmuch - :type 'boolean) - (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers) "A list of functions called to decorate the headers listed in `notmuch-message-headers'.") @@ -84,7 +75,10 @@ same as that of the previous message." :group 'notmuch :type 'hook) -(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations) +(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." :group 'notmuch :type 'hook @@ -95,11 +89,21 @@ same as that of the previous message." notmuch-wash-excerpt-citations)) ;; Mostly useful for debugging. -(defcustom notmuch-show-all-multipart/alternative-parts nil +(defcustom notmuch-show-all-multipart/alternative-parts t "Should all parts of multipart/alternative parts be shown?" :group 'notmuch :type 'boolean) +(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." + :group 'notmuch + :type 'integer) + (defcustom notmuch-show-indent-multipart nil "Should the sub-parts of a multipart/* part be indented?" ;; dme: Not sure which is a good default. @@ -120,7 +124,7 @@ same as that of the previous message." "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 + ; 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 @@ -223,28 +227,31 @@ same as that of the previous message." ")")))))) (defun notmuch-show-clean-address (address) - "Clean a single email address for display." - (let* ((parsed (mail-header-parse-address address)) - (address (car parsed)) - (name (cdr parsed))) - ;; Remove double quotes. They might be required during transport, - ;; but we don't need to see them. - (when name - (setq name (replace-regexp-in-string "\"" "" name))) - ;; If the address is 'foo@bar.com ' then show just - ;; 'foo@bar.com'. - (when (string= name address) - (setq name nil)) - - (if (not name) - address - (concat name " <" address ">")))) + "Try to clean a single email ADDRESS for display. Return +unchanged ADDRESS if parsing fails." + (condition-case nil + (let* ((parsed (mail-header-parse-address address)) + (address (car parsed)) + (name (cdr parsed))) + ;; Remove double quotes. They might be required during transport, + ;; but we don't need to see them. + (when name + (setq name (replace-regexp-in-string "\"" "" name))) + ;; If the address is 'foo@bar.com ' then show just + ;; 'foo@bar.com'. + (when (string= name address) + (setq name nil)) + + (if (not name) + address + (concat name " <" address ">"))) + (error 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 depth) + (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth)) (notmuch-show-clean-address (plist-get headers :From)) " (" date @@ -261,12 +268,12 @@ message at DEPTH in the current thread." (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)))) + (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 @@ -279,46 +286,54 @@ message at DEPTH in the current thread." 'face 'message-mml) (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment) - (insert-button - (concat "[ " - (if name (concat name ": ") "") - declared-type - (if (not (string-equal declared-type content-type)) - (concat " (as " content-type ")") - "") - (or comment "") - " ]\n") - :type 'notmuch-show-part-button-type - :notmuch-part nth - :notmuch-filename name)) + (let ((button)) + (setq button + (insert-button + (concat "[ " + (if name (concat name ": ") "") + declared-type + (if (not (string-equal declared-type content-type)) + (concat " (as " content-type ")") + "") + (or comment "") + " ]") + :type 'notmuch-show-part-button-type + :notmuch-part nth + :notmuch-filename name)) + (insert "\n") + ;; return button + button)) ;; Functions handling particular MIME parts. (defun notmuch-show-save-part (message-id nth &optional filename) - (with-temp-buffer - ;; Always acquires the part via `notmuch part', even if it is - ;; available in the JSON output. - (insert (notmuch-show-get-bodypart-internal message-id nth)) - (let ((file (read-file-name - "Filename to save as: " - (or mailcap-download-directory "~/") - nil nil - filename)) - (require-final-newline nil) - (coding-system-for-write 'no-conversion)) - (write-region (point-min) (point-max) file)))) - -(defun notmuch-show-mm-display-part-inline (msg part content-type content) + (let ((process-crypto notmuch-show-process-crypto)) + (with-temp-buffer + (setq notmuch-show-process-crypto process-crypto) + ;; Always acquires the part via `notmuch part', even if it is + ;; available in the JSON output. + (insert (notmuch-show-get-bodypart-internal message-id nth)) + (let ((file (read-file-name + "Filename to save as: " + (or mailcap-download-directory "~/") + nil nil + filename))) + ;; Don't re-compress .gz & al. Arguably we should make + ;; `file-name-handler-alist' nil, but that would chop + ;; ange-ftp, which is reasonable to use here. + (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t))))) + +(defun notmuch-show-mm-display-part-inline (msg part nth content-type) "Use the mm-decode/mm-view functions to display a part in the current buffer, if possible." (let ((display-buffer (current-buffer))) (with-temp-buffer - (insert content) (let ((handle (mm-make-handle (current-buffer) (list content-type)))) - (set-buffer display-buffer) (if (and (mm-inlinable-p handle) (mm-inlined-p handle)) - (progn + (let ((content (notmuch-show-get-bodypart-content msg part nth))) + (insert content) + (set-buffer display-buffer) (mm-display-part handle) t) nil))))) @@ -332,7 +347,7 @@ current buffer, if possible." )) (defun notmuch-show-multipart/*-to-list (part) - (mapcar '(lambda (inner-part) (plist-get inner-part :content-type)) + (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) (plist-get part :content))) (defun notmuch-show-multipart/alternative-choose (types) @@ -443,6 +458,54 @@ current buffer, if possible." (indent-rigidly start (point) 1))) t) +(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type) + (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) + (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 declared-type) + (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) + (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 declared-type) (notmuch-show-insert-part-header nth declared-type content-type nil) (let ((inner-parts (plist-get part :content)) @@ -457,21 +520,25 @@ current buffer, if possible." t) (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type) - (let* ((message-part (plist-get part :content)) - (inner-parts (plist-get message-part :content))) - (notmuch-show-insert-part-header nth declared-type content-type nil) + (notmuch-show-insert-part-header nth declared-type content-type nil) + (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 part :headers))) + (notmuch-show-insert-headers (plist-get message :headers))) + ;; Blank line after headers to be compatible with the normal ;; message display. (insert "\n") - ;; Show all of the parts. - (mapc (lambda (inner-part) - (notmuch-show-insert-bodypart msg inner-part depth)) - inner-parts)) + ;; 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 declared-type) @@ -484,7 +551,7 @@ current buffer, if possible." (save-excursion (save-restriction (narrow-to-region start (point-max)) - (run-hook-with-args 'notmuch-show-insert-text/plain-hook depth)))) + (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth)))) t) (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type) @@ -521,12 +588,14 @@ current buffer, if possible." nil)) nil)))) +;; Handler for wash generated inline patch fake parts. +(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type) + (notmuch-show-insert-part-*/* msg part "text/x-diff" nth depth "inline patch")) + (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) ;; This handler _must_ succeed - it is the handler of last resort. (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)) - (let ((content (notmuch-show-get-bodypart-content msg part nth))) - (if content - (notmuch-show-mm-display-part-inline msg part content-type content))) + (notmuch-show-mm-display-part-inline msg part nth content-type) t) ;; Functions for determining how to handle MIME parts. @@ -551,13 +620,20 @@ current buffer, if possible." ;; Helper for parts which are generally not included in the default ;; JSON output. - +;; Uses the buffer-local variable notmuch-show-process-crypto to +;; determine if parts should be decrypted first. (defun notmuch-show-get-bodypart-internal (message-id part-number) - (with-temp-buffer - (let ((coding-system-for-read 'no-conversion)) - (call-process notmuch-command nil t nil - "show" "--format=raw" (format "--part=%s" part-number) message-id) - (buffer-string)))) + (let ((args '("show" "--format=raw")) + (part-arg (format "--part=%s" part-number))) + (setq args (append args (list part-arg))) + (if notmuch-show-process-crypto + (setq args (append args '("--decrypt")))) + (setq args (append args (list message-id))) + (with-temp-buffer + (let ((coding-system-for-read 'no-conversion)) + (progn + (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args)) + (buffer-string)))))) (defun notmuch-show-get-bodypart-content (msg part nth) (or (plist-get part :content) @@ -588,7 +664,7 @@ current buffer, if possible." (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)) + (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) (defun notmuch-show-make-symbol (type) (make-symbol (concat "notmuch-show-" type))) @@ -639,6 +715,9 @@ current buffer, if possible." (setq content-start (point-marker)) + (plist-put msg :headers-invis-spec headers-invis-spec) + (plist-put msg :message-invis-spec message-invis-spec) + ;; 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. @@ -650,9 +729,8 @@ current buffer, if possible." ;; 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 (and notmuch-show-elide-same-subject - (not (string= notmuch-show-previous-subject - bare-subject))) + (when (not (string= notmuch-show-previous-subject + bare-subject)) (forward-line 1)) (setq headers-start (point-marker))) (setq headers-end (point-marker)) @@ -668,7 +746,7 @@ current buffer, if possible." (setq content-end (point-marker)) ;; Indent according to the depth in the thread. - (indent-rigidly content-start content-end depth) + (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)) (setq message-end (point-max-marker)) @@ -676,10 +754,10 @@ current buffer, if possible." ;; message. (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) - (plist-put msg :headers-invis-spec headers-invis-spec) - (overlay-put (make-overlay headers-start headers-end) 'invisible headers-invis-spec) - - (plist-put msg :message-invis-spec message-invis-spec) + (let ((headers-overlay (make-overlay headers-start headers-end)) + (invis-specs (list headers-invis-spec message-invis-spec))) + (overlay-put headers-overlay 'invisible invis-specs) + (overlay-put headers-overlay 'priority 10)) (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec) ;; Save the properties for this message. Currently this saves the @@ -704,16 +782,41 @@ current buffer, if possible." (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)) + (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)) + (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest)) +(defvar notmuch-show-thread-id nil) +(make-variable-buffer-local 'notmuch-show-thread-id) (defvar notmuch-show-parent-buffer nil) +(make-variable-buffer-local 'notmuch-show-parent-buffer) +(defvar notmuch-show-query-context nil) +(make-variable-buffer-local 'notmuch-show-query-context) +(defvar notmuch-show-buffer-name nil) +(make-variable-buffer-local 'notmuch-show-buffer-name) + +(defun notmuch-show-buttonise-links (start end) + "Buttonise URLs and mail addresses between START and END. + +This also turns id:\"\"-parts into buttons for +a corresponding notmuch search." + (goto-address-fontify-region start end) + (save-excursion + (goto-char start) + (while (re-search-forward "id:\\(\"?\\)[^[:space:]\"]+\\1" end t) + ;; remove the overlay created by goto-address-mode + (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t) + (make-text-button (match-beginning 0) (match-end 0) + 'action `(lambda (arg) + (notmuch-show ,(match-string-no-properties 0))) + 'follow-link t + 'help-echo "Mouse-1, RET: search for this message" + 'face goto-address-mail-face)))) ;;;###autoload -(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name) +(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch) "Run \"notmuch show\" with the given thread ID and display results. The optional PARENT-BUFFER is the notmuch-search buffer from @@ -725,18 +828,37 @@ 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 neame of the buffer in +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. " +function is used. + +The optional CRYPTO-SWITCH toggles the value of the +notmuch-crypto-process-mime customization variable for this show +buffer." (interactive "sNotmuch show: ") - (let ((buffer (get-buffer-create (generate-new-buffer-name - (or buffer-name - (concat "*notmuch-" thread-id "*"))))) - (inhibit-read-only t)) + (let* ((process-crypto (if crypto-switch + (not notmuch-crypto-process-mime) + notmuch-crypto-process-mime))) + (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto))) + +(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto) + (let* ((buffer-name (generate-new-buffer-name + (or buffer-name + (concat "*notmuch-" thread-id "*")))) + (buffer (get-buffer-create buffer-name)) + (inhibit-read-only t)) (switch-to-buffer buffer) (notmuch-show-mode) - (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer) + ;; Don't track undo information for this buffer + (set 'buffer-undo-list t) + + (setq notmuch-show-thread-id thread-id) + (setq notmuch-show-parent-buffer parent-buffer) + (setq notmuch-show-query-context query-context) + (setq notmuch-show-buffer-name buffer-name) + (setq notmuch-show-process-crypto process-crypto) + (erase-buffer) (goto-char (point-min)) (save-excursion @@ -752,9 +874,8 @@ function is used. " (notmuch-show-insert-forest (notmuch-query-get-threads basic-args)))) - ;; Enable buttonisation of URLs and email addresses in the - ;; buffer. - (goto-address-mode t) + (jit-lock-register #'notmuch-show-buttonise-links) + ;; Act on visual lines rather than logical lines. (visual-line-mode t) @@ -769,6 +890,22 @@ function is used. " (notmuch-show-mark-read))) +(defun notmuch-show-refresh-view (&optional crypto-switch) + "Refresh the current view (with crypto switch if prefix given). + +Kills the current buffer and reruns notmuch show with the same +thread id. If a prefix is given, crypto processing is toggled." + (interactive "P") + (let ((thread-id notmuch-show-thread-id) + (parent-buffer notmuch-show-parent-buffer) + (query-context notmuch-show-query-context) + (buffer-name notmuch-show-buffer-name) + (process-crypto (if crypto-switch + (not notmuch-show-process-crypto) + notmuch-show-process-crypto))) + (notmuch-kill-this-buffer) + (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto))) + (defvar notmuch-show-stash-map (let ((map (make-sparse-keymap))) (define-key map "c" 'notmuch-show-stash-cc) @@ -776,6 +913,7 @@ function is used. " (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) @@ -800,6 +938,7 @@ function is used. " (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 "=" 'notmuch-show-refresh-view) (define-key map "h" 'notmuch-show-toggle-headers) (define-key map "-" 'notmuch-show-remove-tag) (define-key map "+" 'notmuch-show-add-tag) @@ -839,7 +978,7 @@ more selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show- without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without scrolling through with \\[notmuch-show-advance-and-archive]). -You can add or remove arbitary tags from the current message with +You can add or remove arbitrary tags from the current message with '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'. All currently available key bindings: @@ -895,14 +1034,6 @@ All currently available key bindings: (notmuch-show-move-to-message-top) t)) -(defun notmuch-show-move-past-invisible-forward () - (while (point-invisible-p) - (forward-char))) - -(defun notmuch-show-move-past-invisible-backward () - (while (point-invisible-p) - (backward-char))) - ;; Functions relating to the visibility of messages and their ;; components. @@ -913,20 +1044,11 @@ All currently available key bindings: (add-to-invisibility-spec spec)))) (defun notmuch-show-message-visible (props visible-p) - (if visible-p - ;; When making the message visible, the headers may or not be - ;; visible. So we check that property separately. - (let ((headers-visible (plist-get props :headers-visible))) - (notmuch-show-element-visible props headers-visible :headers-invis-spec) - (notmuch-show-element-visible props t :message-invis-spec)) - (notmuch-show-element-visible props nil :headers-invis-spec) - (notmuch-show-element-visible props nil :message-invis-spec)) - + (notmuch-show-element-visible props visible-p :message-invis-spec) (notmuch-show-set-prop :message-visible visible-p props)) (defun notmuch-show-headers-visible (props visible-p) - (if (plist-get props :message-visible) - (notmuch-show-element-visible props visible-p :headers-invis-spec)) + (notmuch-show-element-visible props visible-p :headers-invis-spec) (notmuch-show-set-prop :headers-visible visible-p props)) ;; Functions for setting and getting attributes of the current @@ -938,6 +1060,12 @@ All currently available key bindings: (put-text-property (point) (+ (point) 1) :notmuch-message-properties props))) (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 (notmuch-show-move-to-message-top) (get-text-property (point) :notmuch-message-properties))) @@ -964,9 +1092,9 @@ All currently available key bindings: "Return the filename of the current message." (notmuch-show-get-prop :filename)) -(defun notmuch-show-get-header (header) +(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) header)) + (plist-get (notmuch-show-get-prop :headers props) header)) (defun notmuch-show-get-cc () (notmuch-show-get-header :Cc)) @@ -1022,35 +1150,29 @@ All currently available key bindings: ;; Commands typically bound to keys. -(defun notmuch-show-advance-and-archive () - "Advance through thread and archive. - -This command is intended to be one of the simplest ways to -process a thread of email. It does the following: +(defun notmuch-show-advance () + "Advance through thread. If the current message in the thread is not yet fully visible, scroll by a near screenful to read more of the 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." +current window), advance to the next open message." (interactive) - (let ((end-of-this-message (notmuch-show-message-bottom))) + (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, so we have to actually - ;; go to the end, walk back over invisible text and then see if - ;; point is visible. - ((save-excursion - (goto-char (- end-of-this-message 1)) - (notmuch-show-move-past-invisible-backward) - (> (point) (window-end))) + ;; 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)) @@ -1059,8 +1181,24 @@ which this thread was originally shown." (notmuch-show-next-open-message)) (t - ;; This is the last message - archive the thread. - (notmuch-show-archive-thread))))) + ;; This is the last message - change the return value + (setq ret t))) + ret)) + +(defun notmuch-show-advance-and-archive () + "Advance through thread and archive. + +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, (remove the \"inbox\" tag +from each message), kills the buffer, and displays the next +thread from the search from which this thread was originally +shown." + (interactive) + (if (notmuch-show-advance) + (notmuch-show-archive-thread))) (defun notmuch-show-rewind () "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]). @@ -1335,6 +1473,11 @@ buffer." (interactive) (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-common-do-stash (substring (notmuch-show-get-message-id) 4 -1))) + (defun notmuch-show-stash-subject () "Copy Subject field of current message to kill-ring." (interactive)