;; 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)
(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))
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
(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))
(headers-invis-spec (notmuch-show-make-symbol "header"))
(message-invis-spec (notmuch-show-make-symbol "message")))
+ ;; 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)
;; 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.
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
(let ((map (make-sparse-keymap)))
(define-key map "?" 'notmuch-help)
(define-key map "q" '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" 'notmuch-mua-mail)
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)))
(interactive)
(view-file (notmuch-show-get-filename)))
-(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 *Messages* 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 show --format=mbox "
+ (shell-quote-argument
+ (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
+ " | " command))
+ (setq shell-command
+ (concat command " < " (shell-quote-argument (notmuch-show-get-filename)))))
+ (start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
+
+(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."
projects / notmuch / blobdiff