;; Authors: Carl Worth <cworth@cworth.org>
;; David Edmondson <dme@dme.org>
-(require 'cl)
+(eval-when-compile (require 'cl))
(require 'mm-view)
(require 'message)
+(require 'mm-decode)
+(require 'mailcap)
+(require 'icalendar)
(require 'notmuch-lib)
(require 'notmuch-query)
(require 'notmuch-wash)
+(require 'notmuch-mua)
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
-(declare-function notmuch-reply "notmuch" (query-string))
(declare-function notmuch-fontify-headers "notmuch" nil)
(declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
(declare-function notmuch-search-show-thread "notmuch" nil)
-(defvar notmuch-show-headers '("Subject" "To" "Cc" "From" "Date")
- "Headers that should be shown in a message, in this order. Note
-that if this order is changed the headers shown when a message is
-collapsed will change.")
+(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
+ "Headers that should be shown in a message, in this order.
-(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
- "A list of functions called to decorate the headers listed in
-`notmuch-show-headers'.")
+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-headers'. For a closed message, only
+the first header in the list will be visible."
+ :group 'notmuch
+ :type '(repeat string))
-(defvar notmuch-show-hook '(notmuch-show-pretty-hook)
- "A list of functions called after populating a
-`notmuch-show' buffer.")
+(defcustom notmuch-message-headers-visible t
+ "Should the headers be visible by default?
-(defvar notmuch-show-insert-text/plain-hook '(notmuch-wash-text/plain-citations)
- "A list of functions called to clean up text/plain body parts.")
+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-headers' can be used to make the visible for
+any given message."
+ :group 'notmuch
+ :type 'boolean)
-(defun notmuch-show-pretty-hook ()
- (goto-address-mode 1)
- (visual-line-mode))
+(defcustom notmuch-show-relative-dates t
+ "Display relative dates in the message summary 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'.")
+
+(defcustom notmuch-show-hook nil
+ "Functions called after populating a `notmuch-show' buffer."
+ :group 'notmuch
+ :type 'hook)
+
+(defcustom notmuch-show-insert-text/plain-hook '(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))
+
+;; Mostly useful for debugging.
+(defcustom notmuch-show-all-multipart/alternative-parts nil
+ "Should all parts of multipart/alternative parts be shown?"
+ :group 'notmuch
+ :type 'boolean)
+
+(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)
(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 "*"))))
+ (let ((id (notmuch-show-get-message-id)))
+ (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
(with-current-buffer buf
- (insert-file-contents filename nil nil nil t)
+ (call-process notmuch-command nil t nil "show" "--format=raw" id)
,@body)
(kill-buffer buf)))))
(if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
(let ((inhibit-read-only t))
(replace-match (concat "("
- (mapconcat 'identity tags " ")
+ (propertize (mapconcat 'identity tags " ")
+ 'face 'notmuch-tag-face)
")"))))))
(defun notmuch-show-insert-headerline (headers date tags depth)
" ("
date
") ("
- (mapconcat 'identity tags " ")
+ (propertize (mapconcat 'identity tags " ")
+ 'face 'notmuch-tag-face)
")\n")
(overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
(if (and header-value
(not (string-equal "" header-value)))
(notmuch-show-insert-header header header-value))))
- notmuch-show-headers)
+ notmuch-message-headers)
(save-excursion
(save-restriction
(narrow-to-region start (point-max))
(run-hooks 'notmuch-show-markup-headers-hook)))))
-(defun notmuch-show-insert-part-header (content-type &optional name)
- (let ((start (point)))
- ;; XXX dme: Make this a more useful button (save the part, display
- ;; external, etc.)
- (insert "[ Part of type "
- content-type
- (if name (concat " named " name) "")
- ". ]\n")
- (overlay-put (make-overlay start (point)) 'face 'bold)))
+(define-button-type 'notmuch-show-part-button-type
+ 'action 'notmuch-show-part-button-action
+ 'follow-link t
+ '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))
;; Functions handling particular MIME parts.
-(defun notmuch-show-insert-part-text/plain (part content-type nth depth)
+(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)
+ "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)))))
+
+(defvar notmuch-show-multipart/alternative-discouraged
+ '(
+ ;; Avoid HTML parts.
+ "text/html"
+ ;; multipart/related usually contain a text/html part and some associated graphics.
+ "multipart/related"
+ ))
+
+(defun notmuch-show-multipart/*-to-list (part)
+ (mapcar '(lambda (inner-part) (plist-get inner-part :content-type))
+ (plist-get part :content)))
+
+(defun notmuch-show-multipart/alternative-choose (types)
+ ;; Based on `mm-preferred-alternative-precedence'.
+ (let ((seq types))
+ (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
+ (dolist (elem (copy-sequence seq))
+ (when (string-match pref elem)
+ (setq seq (nconc (delete elem seq) (list elem))))))
+ seq))
+
+(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
+ (notmuch-show-insert-part-header nth declared-type content-type nil)
+ (let ((chosen-type (car (notmuch-show-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)))
+ (if (or notmuch-show-all-multipart/alternative-parts
+ (string= chosen-type inner-type))
+ (notmuch-show-insert-bodypart msg inner-part depth)
+ (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
+ 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))
+ (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 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)
+ ;; 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)))
+ ;; 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))
+ t)
+
+(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
(let ((start (point)))
;; If this text/plain part is not the first part in the message,
;; insert a header to make this clear.
(if (> nth 1)
- (notmuch-show-insert-part-header content-type (plist-get part :filename)))
- (insert (plist-get part :content))
+ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
+ (insert (notmuch-show-get-bodypart-content msg part nth))
(save-excursion
(save-restriction
(narrow-to-region start (point-max))
(run-hook-with-args 'notmuch-show-insert-text/plain-hook depth))))
t)
-(defun notmuch-show-insert-part-text/* (part content-type nth depth)
- ;; Handle all text types other than text/html.
- (if (string-equal "text/html" content-type)
- nil
- (notmuch-show-insert-part-header content-type (plist-get part :filename))
- (insert (plist-get part :content))
- t))
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
+ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
+ (insert (with-temp-buffer
+ (insert (notmuch-show-get-bodypart-content msg part nth))
+ (goto-char (point-min))
+ (let ((file (make-temp-file "notmuch-ical"))
+ result)
+ (icalendar--convert-ical-to-diary
+ (icalendar--read-element nil nil)
+ file t)
+ (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)
-(defun notmuch-show-insert-part-*/* (part content-type nth depth)
- (notmuch-show-insert-part-header content-type (plist-get part :filename))
+(defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
+ ;; If we can deduce a MIME type from the filename of the attachment,
+ ;; do so and pass it on to the handler for that type.
+ (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")))
+ (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
+ nil))
+ nil))))
+
+(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)))
t)
;; Functions for determining how to handle MIME parts.
(intern (concat "notmuch-show-insert-part-" content-type))))
result))
+;; Helper for parts which are generally not included in the default
+;; JSON output.
+
+(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
+ "part" (format "--part=%s" part-number) message-id)
+ (buffer-string))))
+
+(defun notmuch-show-get-bodypart-content (msg part nth)
+ (or (plist-get part :content)
+ (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
+
;; \f
-(defun notmuch-show-insert-bodypart (part depth)
- "Insert the body part PART at depth DEPTH in the current thread."
- (let* ((content-type (downcase (plist-get part :content-type)))
- (handlers (notmuch-show-handlers-for content-type))
- (nth (plist-get part :id)))
+(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
+ (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 (funcall (car handlers) part content-type nth depth)))
+ (not (funcall (car handlers) msg part content-type nth depth declared-type)))
(setq handlers (cdr handlers))))
+ t)
+
+(defun notmuch-show-insert-bodypart (msg part depth)
+ "Insert the body part PART at depth DEPTH in the current thread."
+ (let ((content-type (downcase (plist-get part :content-type)))
+ (nth (plist-get part :id)))
+ (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
+ ;; 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.
(if (not (bolp))
- (insert "\n"))
- )
+ (insert "\n")))
-(defun notmuch-show-insert-body (body depth)
+(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 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)))
+(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
- body-start body-end
- (headers-invis-spec (notmuch-show-make-symbol "header"))
- (message-invis-spec (notmuch-show-make-symbol "message")))
+ (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
+ body-start body-end
+ (headers-invis-spec (notmuch-show-make-symbol "header"))
+ (message-invis-spec (notmuch-show-make-symbol "message"))
+ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
+
+ ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
+ ;; removing items from `buffer-invisibility-spec' (which is what
+ ;; `notmuch-show-headers-visible' and
+ ;; `notmuch-show-message-visible' do) is a no-op and has no
+ ;; effect. This caused threads with only matching messages to have
+ ;; those messages hidden initially because
+ ;; `buffer-invisibility-spec' stayed `t'.
+ ;;
+ ;; This needs to be set here (rather than just above the call to
+ ;; `notmuch-show-headers-visible') because some of the part
+ ;; rendering or body washing functions
+ ;; (e.g. `notmuch-wash-text/plain-citations') manipulate
+ ;; `buffer-invisibility-spec').
+ (when (eq buffer-invisibility-spec t)
+ (setq buffer-invisibility-spec nil))
(setq message-start (point-marker))
(notmuch-show-insert-headerline headers
- (or (plist-get msg :date_relative)
+ (or (if notmuch-show-relative-dates
+ (plist-get msg :date_relative)
+ nil)
(plist-get headers :Date))
(plist-get msg :tags) depth)
(insert "\n")
(save-excursion
(goto-char content-start)
- (forward-line 1)
+ ;; 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)
+
(setq body-start (point-marker))
- (notmuch-show-insert-body (plist-get msg :body) depth)
+ (notmuch-show-insert-body msg (plist-get msg :body) depth)
;; Ensure that the body ends with a newline.
(if (not (bolp))
(insert "\n"))
;; the content).
(notmuch-show-set-message-properties msg)
- ;; Headers are hidden by default.
- (notmuch-show-headers-visible msg nil)
+ ;; Set header visibility.
+ (notmuch-show-headers-visible msg notmuch-message-headers-visible)
;; Message visibility depends on whether it matched the search
;; criteria.
(save-excursion
(let* ((basic-args (list thread-id))
(args (if query-context
- (append basic-args (list "and (" query-context ")"))
- basic-args)))
+ (append (list "\'") basic-args (list "and (" query-context ")\'"))
+ (append (list "\'") basic-args (list "\'")))))
(notmuch-show-insert-forest (notmuch-query-get-threads args))
;; If the query context reduced the results to nothing, run
;; the basic query.
query-context)
(notmuch-show-insert-forest
(notmuch-query-get-threads basic-args))))
+
+ ;; Enable buttonisation of URLs and email addresses in the
+ ;; buffer.
+ (goto-address-mode t)
+ ;; 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))
+
+ ;; Set the header line to the subject of the first open message.
+ (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
+
(notmuch-show-mark-read)))
(defvar notmuch-show-stash-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 "q" 'notmuch-kill-this-buffer)
+ (define-key map (kbd "<C-tab>") 'widget-backward)
(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
+ (define-key map (kbd "<backtab>") '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 "m" 'notmuch-mua-mail)
(define-key map "f" 'notmuch-show-forward-message)
(define-key map "r" 'notmuch-show-reply)
(define-key map "|" 'notmuch-show-pipe-message)
(define-key map "p" 'notmuch-show-previous-open-message)
(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)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
-;;;###autoload
(defun notmuch-show-mode ()
"Major mode for viewing a thread with notmuch.
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).
+which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
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).
+\\[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).
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]).
+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]).
You can add or remove arbitary tags from the current message with
'\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
(defun notmuch-show-get-message-id ()
"Return the message id of the current message."
- (concat "id:" (notmuch-show-get-prop :id)))
+ (concat "id:\"" (notmuch-show-get-prop :id) "\""))
;; dme: Would it make sense to use a macro for many of these?
"Mark the current message as read."
(notmuch-show-remove-tag "unread"))
+;; Functions for getting attributes of several messages in the current
+;; thread.
+
+(defun notmuch-show-get-message-ids-for-open-messages ()
+ "Return a list of all message IDs 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
+ )))
+
;; Commands typically bound to keys.
(defun notmuch-show-advance-and-archive ()
;; 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.
- (if (< (count-lines (window-start) (notmuch-show-message-top))
- next-screen-context-lines)
+ (if (<= (count-screen-lines (window-start) start-of-message)
+ next-screen-context-lines)
(progn
(goto-char (notmuch-show-message-top))
(notmuch-show-message-adjust)))
(defun notmuch-show-reply ()
"Reply to the current message."
(interactive)
- (notmuch-reply (notmuch-show-get-message-id)))
+ (notmuch-mua-reply (notmuch-show-get-message-id)))
(defun notmuch-show-forward-message ()
"Forward the current message."
(interactive)
(with-current-notmuch-show-message
- (message-forward)))
+ (notmuch-mua-forward-message)))
(defun notmuch-show-next-message ()
"Show the next message."
(interactive)
- (notmuch-show-goto-message-next)
- (notmuch-show-mark-read)
- (notmuch-show-message-adjust))
+ (if (notmuch-show-goto-message-next)
+ (progn
+ (notmuch-show-mark-read)
+ (notmuch-show-message-adjust))
+ (goto-char (point-max))))
(defun notmuch-show-previous-message ()
"Show the previous message."
(defun notmuch-show-next-open-message ()
"Show the next message."
(interactive)
- (while (and (notmuch-show-goto-message-next)
- (not (notmuch-show-message-visible-p))))
- (notmuch-show-mark-read)
- (notmuch-show-message-adjust))
+ (let (r)
+ (while (and (setq r (notmuch-show-goto-message-next))
+ (not (notmuch-show-message-visible-p))))
+ (if r
+ (progn
+ (notmuch-show-mark-read)
+ (notmuch-show-message-adjust))
+ (goto-char (point-max)))))
(defun notmuch-show-previous-open-message ()
"Show the previous message."
(defun notmuch-show-view-raw-message ()
"View the file holding the current message."
(interactive)
- (view-file (notmuch-show-get-filename)))
+ (let* ((id (notmuch-show-get-message-id))
+ (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
+ (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)))
-(defun notmuch-show-pipe-message (command)
- "Pipe the contents of the current message to the given command.
+(defun notmuch-show-pipe-message (entire-thread command)
+ "Pipe the contents of the current message (or thread) 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)))))
+to stdout or stderr will appear in the *notmuch-pipe* buffer.
+
+When invoked with a prefix argument, the command will receive all
+open messages in the current thread (formatted as an mbox) rather
+than only the current message."
+ (interactive "P\nsPipe message to command: ")
+ (let (shell-command)
+ (if entire-thread
+ (setq shell-command
+ (concat notmuch-command " show --format=mbox "
+ (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 ((buf (get-buffer-create (concat "*notmuch-pipe*"))))
+ (with-current-buffer buf
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (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-add-tags-worker (current-tags add-tags)
+ "Add to `current-tags' with any tags from `add-tags' not
+currently present and return the result."
+ (let ((result-tags (copy-sequence current-tags)))
+ (mapc (lambda (add-tag)
+ (unless (member add-tag current-tags)
+ (setq result-tags (push add-tag result-tags))))
+ add-tags)
+ (sort result-tags 'string<)))
+
+(defun notmuch-show-del-tags-worker (current-tags del-tags)
+ "Remove any tags in `del-tags' from `current-tags' and return
+the result."
+ (let ((result-tags (copy-sequence current-tags)))
+ (mapc (lambda (del-tag)
+ (setq result-tags (delete del-tag result-tags)))
+ del-tags)
+ result-tags))
(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<)))
+
+ (let* ((current-tags (notmuch-show-get-tags))
+ (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
+
+ (unless (equal current-tags new-tags)
+ (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 new-tags))))
(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<))))))
+
+ (let* ((current-tags (notmuch-show-get-tags))
+ (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
+
+ (unless (equal current-tags new-tags)
+ (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 new-tags))))
(defun notmuch-show-toggle-headers ()
"Toggle the visibility of the current message headers."
(not (plist-get props :message-visible))))
(force-window-update))
+(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."
(interactive)
until (not (notmuch-show-goto-message-next)))
;; Move to the next item in the search results, if any.
(let ((parent-buffer notmuch-show-parent-buffer))
- (kill-this-buffer)
+ (notmuch-kill-this-buffer)
(if parent-buffer
(progn
(switch-to-buffer parent-buffer)
(interactive)
(notmuch-show-archive-thread-internal nil))
-(defun notmuch-show-do-stash (text)
- (kill-new text)
- (message "Saved: %s" text))
-
(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)))
+ (notmuch-common-do-stash (notmuch-show-get-from)))
(defun notmuch-show-stash-message-id ()
"Copy message ID of current message to kill-ring."
(interactive)
- (notmuch-show-do-stash (notmuch-show-get-message-id)))
+ (notmuch-common-do-stash (notmuch-show-get-message-id)))
(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)))
+
+;; 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?)."))))
;;
projects / notmuch / blobdiff