(require 'notmuch-wash)
(require 'notmuch-mua)
(require 'notmuch-crypto)
+(require 'notmuch-print)
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-fontify-headers "notmuch" nil)
(declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
+(declare-function notmuch-search-next-thread "notmuch" nil)
(declare-function notmuch-search-show-thread "notmuch" nil)
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
according to `notmuch-message-headers-visible' or can be toggled
with `notmuch-show-toggle-headers'. For a closed message, only
the first header in the list will be visible."
- :group 'notmuch
- :type '(repeat string))
+ :type '(repeat string)
+ :group 'notmuch-show)
(defcustom notmuch-message-headers-visible t
"Should the headers be visible by default?
of each message. Otherwise, these headers will be hidden and
`notmuch-show-toggle-headers' can be used to make the visible for
any given message."
- :group 'notmuch
- :type 'boolean)
+ :type 'boolean
+ :group 'notmuch-show)
(defcustom notmuch-show-relative-dates t
"Display relative dates in the message summary line."
- :group 'notmuch
- :type 'boolean)
+ :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 nil
+(defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
"Functions called after populating a `notmuch-show' buffer."
- :group 'notmuch
- :type 'hook)
-
-(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)
+ :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."
- :group 'notmuch
: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))
+ notmuch-wash-excerpt-citations)
+ :group 'notmuch-show
+ :group 'notmuch-hooks)
;; Mostly useful for debugging.
(defcustom notmuch-show-all-multipart/alternative-parts t
"Should all parts of multipart/alternative parts be shown?"
- :group 'notmuch
- :type 'boolean)
+ :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.
- :group 'notmuch
- :type 'boolean)
+ :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)))
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
,@body)
(kill-buffer buf)))))
+(defun notmuch-show-turn-on-visual-line-mode ()
+ "Enable Visual Line mode."
+ (visual-line-mode t))
+
(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.
+ ;; 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)
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)))
+ (with-temp-buffer
+ (insert all)
+ (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:")
"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)))
+ (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 <user@dom.ain>" style.
+ ((string-match "\\(.*\\) <\\(.*\\)>" address)
+ (setq p-name (match-string 1 address)
+ p-address (match-string 2 address)))
+
+ ;; "<user@dom.ain>" style.
+ ((string-match "<\\(.*\\)>" address)
+ (setq p-address (match-string 1 address)))
+
+ ;; Everything else.
+ (t
+ (setq p-address address)))
+
+ ;; Remove elements of the mailbox part that are not relevant for
+ ;; display, even if they are required during transport.
+ (when p-name
+ ;; Outer double quotes.
+ (when (string-match "^\"\\(.*\\)\"$" p-name)
+ (setq p-name (match-string 1 p-name)))
+
+ ;; Backslashes.
+ (setq p-name (replace-regexp-in-string "\\\\" "" p-name)))
+
;; If the address is 'foo@bar.com <foo@bar.com>' then show just
;; 'foo@bar.com'.
- (when (string= name address)
- (setq name nil))
-
- (if (not name)
- address
- (concat name " <" address ">")))
+ (when (string= p-name p-address)
+ (setq p-name nil))
+
+ ;; If no name results, return just the address.
+ (if (not p-name)
+ p-address
+ ;; Otherwise format the name and address together.
+ (concat p-name " <" p-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
(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
(run-hooks 'notmuch-show-markup-headers-hook)))))
(define-button-type 'notmuch-show-part-button-type
- 'action 'notmuch-show-part-button-action
+ 'action 'notmuch-show-part-button-default
+ 'keymap 'notmuch-show-part-button-map
'follow-link t
'face 'message-mml)
+(defvar notmuch-show-part-button-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map button-map)
+ (define-key map "s" 'notmuch-show-part-button-save)
+ (define-key map "v" 'notmuch-show-part-button-view)
+ (define-key map "o" 'notmuch-show-part-button-interactively-view)
+ map)
+ "Submap for button commands")
+(fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
+
(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
(let ((button))
(setq button
" ]")
:type 'notmuch-show-part-button-type
:notmuch-part nth
- :notmuch-filename name))
+ :notmuch-filename name
+ :notmuch-content-type content-type))
(insert "\n")
;; return button
button))
;; Functions handling particular MIME parts.
-(defun notmuch-show-save-part (message-id nth &optional filename)
- (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 content-type content)
+(defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)
+ (declare (indent 2))
+ (let ((process-crypto (make-symbol "process-crypto")))
+ `(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))
+ ,@body))))
+
+(defun notmuch-show-save-part (message-id nth &optional filename content-type)
+ (notmuch-with-temp-part-buffer 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-view-part (message-id nth &optional filename content-type )
+ (notmuch-with-temp-part-buffer message-id nth
+ ;; set mm-inlined-types to nil to force an external viewer
+ (let ((handle (mm-make-handle (current-buffer) (list content-type)))
+ (mm-inlined-types nil))
+ ;; We override mm-save-part as notmuch-show-save-part is better
+ ;; since it offers the filename. We need to lexically bind
+ ;; everything we need for notmuch-show-save-part to prevent
+ ;; potential dynamic shadowing.
+ (lexical-let ((message-id message-id)
+ (nth nth)
+ (filename filename)
+ (content-type content-type))
+ (flet ((mm-save-part (&rest args) (notmuch-show-save-part
+ message-id nth filename content-type)))
+ (mm-display-part handle))))))
+
+(defun notmuch-show-interactively-view-part (message-id nth &optional filename content-type)
+ (notmuch-with-temp-part-buffer message-id nth
+ (let ((handle (mm-make-handle (current-buffer) (list content-type))))
+ (mm-interactively-view-part handle))))
+
+(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
- (mm-display-part handle)
- t)
- nil)))))
+ (let* ((charset (plist-get part :content-charset))
+ (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
+ ;; If the user wants the part inlined, insert the content and
+ ;; test whether we are able to inline it (which includes both
+ ;; capability and suitability tests).
+ (when (mm-inlined-p handle)
+ (insert (notmuch-show-get-bodypart-content msg part nth))
+ (when (mm-inlinable-p handle)
+ (set-buffer display-buffer)
+ (mm-display-part handle)
+ t))))))
(defvar notmuch-show-multipart/alternative-discouraged
'(
))
(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)
(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 '(:foreground "blue"))
+ (button-put button 'face 'notmuch-crypto-part-header)
;; add signature status button if sigstatus provided
(if (plist-member part :sigstatus)
- (let* ((headers (plist-get msg :headers))
- (from (plist-get headers :From))
+ (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
(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 '(:foreground "blue"))
+ (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* ((headers (plist-get msg :headers))
- (from (plist-get headers :From))
+ (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
(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
(notmuch-show-insert-part-header nth declared-type content-type nil)
(let* ((message (car (plist-get part :content)))
- (headers (plist-get message :headers))
(body (car (plist-get message :body)))
(start (point)))
nil))
nil))))
-(defun notmuch-show-insert-part-application/* (msg part content-type nth depth declared-type
-)
- ;; do not render random "application" parts
- (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)))
+;; 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.
;; 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.
- (if (not (bolp))
- (insert "\n")))
+ (unless (bolp)
+ (insert "\n")))
(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)))
(setq body-start (point-marker))
(notmuch-show-insert-body msg (plist-get msg :body) depth)
;; Ensure that the body ends with a newline.
- (if (not (bolp))
- (insert "\n"))
+ (unless (bolp)
+ (insert "\n"))
(setq body-end (point-marker))
(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))
(overlay-put headers-overlay 'priority 10))
(overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
+ (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
(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)
(remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
(make-text-button (match-beginning 0) (match-end 0)
'action `(lambda (arg)
- (notmuch-search ,(match-string-no-properties 0)))
+ (notmuch-show ,(match-string-no-properties 0)))
'follow-link t
'help-echo "Mouse-1, RET: search for this message"
'face goto-address-mail-face))))
(jit-lock-register #'notmuch-show-buttonise-links)
- ;; Act on visual lines rather than logical lines.
- (visual-line-mode t)
-
(run-hooks 'notmuch-show-hook))
;; Move straight to the first open message
- (if (not (notmuch-show-message-visible-p))
- (notmuch-show-next-open-message))
+ (unless (notmuch-show-message-visible-p)
+ (notmuch-show-next-open-message))
;; Set the header line to the subject of the first open message.
(setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
(define-key map "s" 'notmuch-search)
(define-key map "m" 'notmuch-mua-new-mail)
(define-key map "f" 'notmuch-show-forward-message)
- (define-key map "r" 'notmuch-show-reply)
+ (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 "-" '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 "a" 'notmuch-show-archive-message-then-next)
+ (define-key map "A" 'notmuch-show-archive-thread-then-next)
(define-key map "N" 'notmuch-show-next-message)
(define-key map "P" 'notmuch-show-previous-message)
(define-key map "n" 'notmuch-show-next-open-message)
(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)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
(use-local-map notmuch-show-mode-map)
(setq major-mode 'notmuch-show-mode
mode-name "notmuch-show")
- (setq buffer-read-only t))
+ (setq buffer-read-only t
+ truncate-lines t))
(defun notmuch-show-move-to-message-top ()
(goto-char (notmuch-show-message-top)))
(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)))
"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))
(defun notmuch-show-get-to ()
(notmuch-show-get-header :To))
+(defun notmuch-show-get-depth ()
+ (notmuch-show-get-prop :depth))
+
(defun notmuch-show-set-tags (tags)
"Set the tags of the current message."
(notmuch-show-set-prop :tags tags)
(ret nil))
(while (invisible-p visible-end-of-this-message)
(setq visible-end-of-this-message
- (previous-single-char-property-change visible-end-of-this-message
- 'invisible)))
+ (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
shown."
(interactive)
(if (notmuch-show-advance)
- (notmuch-show-archive-thread)))
+ (notmuch-show-archive-thread-then-next)))
(defun notmuch-show-rewind ()
"Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
(notmuch-show-previous-message)))))
(defun notmuch-show-reply (&optional prompt-for-sender)
- "Reply to the current message."
+ "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))
+
+(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))
+ (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil))
(defun notmuch-show-forward-message (&optional prompt-for-sender)
"Forward the current message."
(with-current-notmuch-show-message
(notmuch-mua-new-forward-message prompt-for-sender)))
-(defun notmuch-show-next-message ()
- "Show the next message."
- (interactive)
+(defun notmuch-show-next-message (&optional pop-at-end)
+ "Show the next message.
+
+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)
(progn
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
- (goto-char (point-max))))
+ (if pop-at-end
+ (notmuch-show-next-thread)
+ (goto-char (point-max)))))
(defun notmuch-show-previous-message ()
"Show the previous message."
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
-(defun notmuch-show-next-open-message ()
- "Show the next message."
- (interactive)
+(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."
+ (interactive "P")
(let (r)
(while (and (setq r (notmuch-show-goto-message-next))
(not (notmuch-show-message-visible-p))))
(progn
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
- (goto-char (point-max)))))
+ (if pop-at-end
+ (notmuch-show-next-thread)
+ (goto-char (point-max))))))
(defun notmuch-show-previous-open-message ()
- "Show the previous message."
+ "Show the previous open message."
(interactive)
(while (and (notmuch-show-goto-message-previous)
(not (notmuch-show-message-visible-p))))
(interactive "P\nsPipe message to command: ")
(let (shell-command)
(if entire-thread
- (setq shell-command
+ (setq shell-command
(concat notmuch-command " show --format=mbox "
(shell-quote-argument
(mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
(interactive)
(backward-button 1))
-(defun notmuch-show-archive-thread-internal (show-next)
- ;; Remove the tag from the current set of messages.
+(defun notmuch-show-tag-thread-internal (tag &optional remove)
+ "Add tag to the current set of messages.
+
+If the remove switch is given, tags will be removed instead of
+added."
(goto-char (point-min))
- (loop do (notmuch-show-remove-tag "inbox")
- until (not (notmuch-show-goto-message-next)))
- ;; Move to the next item in the search results, if any.
+ (let ((tag-function (if remove
+ 'notmuch-show-remove-tag
+ 'notmuch-show-add-tag)))
+ (loop do (funcall tag-function tag)
+ until (not (notmuch-show-goto-message-next)))))
+
+(defun notmuch-show-add-tag-thread (tag)
+ "Add tag to all messages in the current thread."
+ (interactive)
+ (notmuch-show-tag-thread-internal tag))
+
+(defun notmuch-show-remove-tag-thread (tag)
+ "Remove tag from all messages in the current thread."
+ (interactive)
+ (notmuch-show-tag-thread-internal tag t))
+
+(defun notmuch-show-next-thread (&optional show-next)
+ "Move to the next item in the search results, if any."
+ (interactive "P")
(let ((parent-buffer notmuch-show-parent-buffer))
(notmuch-kill-this-buffer)
- (if parent-buffer
- (progn
- (switch-to-buffer parent-buffer)
- (forward-line)
- (if show-next
- (notmuch-search-show-thread))))))
+ (when parent-buffer
+ (switch-to-buffer parent-buffer)
+ (notmuch-search-next-thread)
+ (if show-next
+ (notmuch-search-show-thread)))))
+
+(defun notmuch-show-archive-thread (&optional unarchive)
+ "Archive each message in thread.
-(defun notmuch-show-archive-thread ()
- "Archive each message in thread, then show next thread from search.
+If a prefix argument is given, the messages will be
+\"unarchived\" (ie. the \"inbox\" tag will be added instead of
+removed).
Archive each message currently shown by removing the \"inbox\"
tag from each. Then kill this buffer and show the next thread
being delivered to the same thread. It does not archive the
entire thread, but only the messages shown in the current
buffer."
+ (interactive "P")
+ (if unarchive
+ (notmuch-show-add-tag-thread "inbox")
+ (notmuch-show-remove-tag-thread "inbox")))
+
+(defun notmuch-show-archive-thread-then-next ()
+ "Archive each message in thread, then show next thread from search."
(interactive)
- (notmuch-show-archive-thread-internal t))
+ (notmuch-show-archive-thread)
+ (notmuch-show-next-thread t))
(defun notmuch-show-archive-thread-then-exit ()
"Archive each message in thread, then exit back to search results."
(interactive)
- (notmuch-show-archive-thread-internal nil))
+ (notmuch-show-archive-thread)
+ (notmuch-show-next-thread))
+
+(defun notmuch-show-archive-message (&optional unarchive)
+ "Archive the current message.
+
+If a prefix argument is given, the message will be
+\"unarchived\" (ie. the \"inbox\" tag will be added instead of
+removed)."
+ (interactive "P")
+ (if unarchive
+ (notmuch-show-add-tag "inbox")
+ (notmuch-show-remove-tag "inbox")))
+
+(defun notmuch-show-archive-message-then-next ()
+ "Archive the current message, then show the next open message in the current thread."
+ (interactive)
+ (notmuch-show-archive-message)
+ (notmuch-show-next-open-message t))
(defun notmuch-show-stash-cc ()
"Copy CC field of current message to kill-ring."
;; Commands typically bound to buttons.
-(defun notmuch-show-part-button-action (button)
- (let ((nth (button-get button :notmuch-part)))
- (if nth
- (notmuch-show-save-part (notmuch-show-get-message-id) nth
- (button-get button :notmuch-filename))
- (message "Not a valid part (is it a fake part?)."))))
+(defun notmuch-show-part-button-default (&optional button)
+ (interactive)
+ (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))
+
+(defun notmuch-show-part-button-save (&optional button)
+ (interactive)
+ (notmuch-show-part-button-internal button #'notmuch-show-save-part))
+
+(defun notmuch-show-part-button-view (&optional button)
+ (interactive)
+ (notmuch-show-part-button-internal button #'notmuch-show-view-part))
+
+(defun notmuch-show-part-button-interactively-view (&optional button)
+ (interactive)
+ (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))
+
+(defun notmuch-show-part-button-internal (button handler)
+ (let ((button (or button (button-at (point)))))
+ (if button
+ (let ((nth (button-get button :notmuch-part)))
+ (if nth
+ (funcall handler (notmuch-show-get-message-id) nth
+ (button-get button :notmuch-filename)
+ (button-get button :notmuch-content-type)))))))
;;
projects / notmuch / blobdiff