[PATCH 03/11] emacs: move notmuch-tree from contrib to mainline
Mark Walters
markwalters1009 at gmail.com
Tue Oct 29 15:55:30 PDT 2013
---
contrib/notmuch-pick/notmuch-tree.el | 946 ----------------------------------
emacs/notmuch-tree.el | 946 ++++++++++++++++++++++++++++++++++
2 files changed, 946 insertions(+), 946 deletions(-)
delete mode 100644 contrib/notmuch-pick/notmuch-tree.el
create mode 100644 emacs/notmuch-tree.el
diff --git a/contrib/notmuch-pick/notmuch-tree.el b/contrib/notmuch-pick/notmuch-tree.el
deleted file mode 100644
index d3330a0..0000000
--- a/contrib/notmuch-pick/notmuch-tree.el
+++ /dev/null
@@ -1,946 +0,0 @@
-;; notmuch-tree.el --- displaying notmuch forests.
-;;
-;; Copyright © Carl Worth
-;; Copyright © David Edmondson
-;; Copyright © Mark Walters
-;;
-;; This file is part of Notmuch.
-;;
-;; Notmuch is free software: you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; Notmuch is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
-;;
-;; Authors: David Edmondson <dme at dme.org>
-;; Mark Walters <markwalters1009 at gmail.com>
-
-(require 'mail-parse)
-
-(require 'notmuch-lib)
-(require 'notmuch-query)
-(require 'notmuch-show)
-(require 'notmuch-tag)
-(require 'notmuch-parser)
-(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
-
-(eval-when-compile (require 'cl))
-(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line))
-(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
-(declare-function notmuch-read-query "notmuch" (prompt))
-(declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
-(declare-function notmuch-search-find-subject "notmuch" ())
-
-;; the following variable is defined in notmuch.el
-(defvar notmuch-search-query-string)
-
-(defgroup notmuch-tree nil
- "Showing message and thread structure."
- :group 'notmuch)
-
-(defcustom notmuch-tree-show-out nil
- "View selected messages in new window rather than split-pane."
- :type 'boolean
- :group 'notmuch-tree)
-
-(defcustom notmuch-tree-result-format
- `(("date" . "%12s ")
- ("authors" . "%-20s")
- ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
- ("tags" . "(%s)"))
- "Result formatting for Tree view. Supported fields are: date,
- authors, subject, tree, tags. Tree means the thread tree
- box graphics. The field may also be a list in which case
- the formatting rules are applied recursively and then the
- output of all the fields in the list is inserted
- according to format-string.
-
-Note the author string should not contain
- whitespace (put it in the neighbouring fields instead).
- For example:
- (setq notmuch-tree-result-format \(\(\"authors\" . \"%-40s\"\)
- \(\"subject\" . \"%s\"\)\)\)"
- :type '(alist :key-type (string) :value-type (string))
- :group 'notmuch-tree)
-
-;; Faces for messages that match the query.
-(defface notmuch-tree-match-date-face
- '((t :inherit default))
- "Face used in tree mode for the date in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-match-author-face
- '((((class color)
- (background dark))
- (:foreground "OliveDrab1"))
- (((class color)
- (background light))
- (:foreground "dark blue"))
- (t
- (:bold t)))
- "Face used in tree mode for the date in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-match-subject-face
- '((t :inherit default))
- "Face used in tree mode for the subject in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-match-tree-face
- '((t :inherit default))
- "Face used in tree mode for the thread tree block graphics in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-match-tag-face
- '((((class color)
- (background dark))
- (:foreground "OliveDrab1"))
- (((class color)
- (background light))
- (:foreground "navy blue" :bold t))
- (t
- (:bold t)))
- "Face used in tree mode for tags in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-;; Faces for messages that do not match the query.
-(defface notmuch-tree-no-match-date-face
- '((t (:foreground "gray")))
- "Face used in tree mode for non-matching dates."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-no-match-subject-face
- '((t (:foreground "gray")))
- "Face used in tree mode for non-matching subjects."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-no-match-tree-face
- '((t (:foreground "gray")))
- "Face used in tree mode for the thread tree block graphics in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-no-match-author-face
- '((t (:foreground "gray")))
- "Face used in tree mode for the date in messages matching the query."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defface notmuch-tree-no-match-tag-face
- '((t (:foreground "gray")))
- "Face used in tree mode face for non-matching tags."
- :group 'notmuch-tree
- :group 'notmuch-faces)
-
-(defvar notmuch-tree-previous-subject
- "The subject of the most recent result shown during the async display")
-(make-variable-buffer-local 'notmuch-tree-previous-subject)
-
-(defvar notmuch-tree-basic-query nil
- "A buffer local copy of argument query to the function notmuch-tree")
-(make-variable-buffer-local 'notmuch-tree-basic-query)
-
-(defvar notmuch-tree-query-context nil
- "A buffer local copy of argument query-context to the function notmuch-tree")
-(make-variable-buffer-local 'notmuch-tree-query-context)
-
-(defvar notmuch-tree-target-msg nil
- "A buffer local copy of argument target to the function notmuch-tree")
-(make-variable-buffer-local 'notmuch-tree-target-msg)
-
-(defvar notmuch-tree-open-target nil
- "A buffer local copy of argument open-target to the function notmuch-tree")
-(make-variable-buffer-local 'notmuch-tree-open-target)
-
-(defvar notmuch-tree-message-window nil
- "The window of the message pane.
-
-It is set in both the tree buffer and the child show buffer. It
-is used to try and close the message pane when quitting tree view
-or the child show buffer.")
-(make-variable-buffer-local 'notmuch-tree-message-window)
-(put 'notmuch-tree-message-window 'permanent-local t)
-
-(defvar notmuch-tree-message-buffer nil
- "The buffer name of the show buffer in the message pane.
-
-This is used to try and make sure we don't close the message pane
-if the user has loaded a different buffer in that window.")
-(make-variable-buffer-local 'notmuch-tree-message-buffer)
-(put 'notmuch-tree-message-buffer 'permanent-local t)
-
-(defun notmuch-tree-to-message-pane (func)
- "Execute FUNC in message pane.
-
-This function returns a function (so can be used as a keybinding)
-which executes function FUNC in the message pane if it is
-open (if the message pane is closed it does nothing)."
- `(lambda ()
- ,(concat "(In message pane) " (documentation func t))
- (interactive)
- (when (window-live-p notmuch-tree-message-window)
- (with-selected-window notmuch-tree-message-window
- (call-interactively #',func)))))
-
-(defun notmuch-tree-button-activate (&optional button)
- "Activate BUTTON or button at point
-
-This function does not give an error if there is no button."
- (interactive)
- (let ((button (or button (button-at (point)))))
- (when button (button-activate button))))
-
-(defun notmuch-tree-close-message-pane-and (func)
- "Close message pane and execute FUNC.
-
-This function returns a function (so can be used as a keybinding)
-which closes the message pane if open and then executes function
-FUNC."
- `(lambda ()
- ,(concat "(Close message pane and) " (documentation func t))
- (interactive)
- (notmuch-tree-close-message-window)
- (call-interactively #',func)))
-
-(defvar notmuch-tree-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map notmuch-common-keymap)
- ;; The following override the global keymap.
- ;; Override because we want to close message pane first.
- (define-key map "?" (notmuch-tree-close-message-pane-and #'notmuch-help))
- ;; Override because we first close message pane and then close tree buffer.
- (define-key map "q" 'notmuch-tree-quit)
- ;; Override because we close message pane after the search query is entered.
- (define-key map "s" 'notmuch-tree-to-search)
- ;; Override because we want to close message pane first.
- (define-key map "m" (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
-
- ;; these use notmuch-show functions directly
- (define-key map "|" 'notmuch-show-pipe-message)
- (define-key map "w" 'notmuch-show-save-attachments)
- (define-key map "v" 'notmuch-show-view-all-mime-parts)
- (define-key map "c" 'notmuch-show-stash-map)
-
- ;; these apply to the message pane
- (define-key map (kbd "M-TAB") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
- (define-key map (kbd "<backtab>") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
- (define-key map (kbd "TAB") (notmuch-tree-to-message-pane #'notmuch-show-next-button))
- (define-key map "e" (notmuch-tree-to-message-pane #'notmuch-tree-button-activate))
-
- ;; bindings from show (or elsewhere) but we close the message pane first.
- (define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
- (define-key map "r" (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
- (define-key map "R" (notmuch-tree-close-message-pane-and #'notmuch-show-reply))
- (define-key map "V" (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
-
- ;; The main tree view bindings
- (define-key map (kbd "RET") 'notmuch-tree-show-message)
- (define-key map [mouse-1] 'notmuch-tree-show-message)
- (define-key map "x" 'notmuch-tree-quit)
- (define-key map "A" 'notmuch-tree-archive-thread)
- (define-key map "a" 'notmuch-tree-archive-message-then-next)
- (define-key map "=" 'notmuch-tree-refresh-view)
- (define-key map "z" 'notmuch-tree-to-tree)
- (define-key map "n" 'notmuch-tree-next-matching-message)
- (define-key map "p" 'notmuch-tree-prev-matching-message)
- (define-key map "N" 'notmuch-tree-next-message)
- (define-key map "P" 'notmuch-tree-prev-message)
- (define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
- (define-key map (kbd "M-n") 'notmuch-tree-next-thread)
- (define-key map "-" 'notmuch-tree-remove-tag)
- (define-key map "+" 'notmuch-tree-add-tag)
- (define-key map "*" 'notmuch-tree-tag-thread)
- (define-key map " " 'notmuch-tree-scroll-or-next)
- (define-key map "b" 'notmuch-tree-scroll-message-window-back)
- map))
-(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
-
-(defun notmuch-tree-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.
-:tags - Tags for this message"
- (save-excursion
- (beginning-of-line)
- (get-text-property (point) :notmuch-message-properties)))
-
-;; XXX This should really be a lib function but we are trying to
-;; reduce impact on the code base.
-(defun notmuch-show-get-prop (prop &optional props)
- "This is a tree view overridden version of notmuch-show-get-prop
-
-It gets property PROP from PROPS or, if PROPS is nil, the current
-message in either tree or show. This means that several functions
-in notmuch-show now work unchanged in tree as they just need the
-correct message properties."
- (let ((props (or props
- (cond ((eq major-mode 'notmuch-show-mode)
- (notmuch-show-get-message-properties))
- ((eq major-mode 'notmuch-tree-mode)
- (notmuch-tree-get-message-properties))))))
- (plist-get props prop)))
-
-(defun notmuch-tree-set-message-properties (props)
- (save-excursion
- (beginning-of-line)
- (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
-
-(defun notmuch-tree-set-prop (prop val &optional props)
- (let ((inhibit-read-only t)
- (props (or props
- (notmuch-tree-get-message-properties))))
- (plist-put props prop val)
- (notmuch-tree-set-message-properties props)))
-
-(defun notmuch-tree-get-prop (prop &optional props)
- (let ((props (or props
- (notmuch-tree-get-message-properties))))
- (plist-get props prop)))
-
-(defun notmuch-tree-set-tags (tags)
- "Set the tags of the current message."
- (notmuch-tree-set-prop :tags tags))
-
-(defun notmuch-tree-get-tags ()
- "Return the tags of the current message."
- (notmuch-tree-get-prop :tags))
-
-(defun notmuch-tree-get-message-id ()
- "Return the message id of the current message."
- (let ((id (notmuch-tree-get-prop :id)))
- (if id
- (notmuch-id-to-query id)
- nil)))
-
-(defun notmuch-tree-get-match ()
- "Return whether the current message is a match."
- (interactive)
- (notmuch-tree-get-prop :match))
-
-(defun notmuch-tree-refresh-result ()
- "Redisplay the current message line.
-
-This redisplays the current line based on the messages
-properties (as they are now). This is used when tags are
-updated."
- (let ((init-point (point))
- (end (line-end-position))
- (msg (notmuch-tree-get-message-properties))
- (inhibit-read-only t))
- (beginning-of-line)
- ;; This is a little tricky: we override
- ;; notmuch-tree-previous-subject to get the decision between
- ;; ... and a subject right and it stops notmuch-tree-insert-msg
- ;; from overwriting the buffer local copy of
- ;; notmuch-tree-previous-subject if this is called while the
- ;; buffer is displaying.
- (let ((notmuch-tree-previous-subject (notmuch-tree-get-prop :previous-subject)))
- (delete-region (point) (1+ (line-end-position)))
- (notmuch-tree-insert-msg msg))
- (let ((new-end (line-end-position)))
- (goto-char (if (= init-point end)
- new-end
- (min init-point (- new-end 1)))))))
-
-(defun notmuch-tree-tag-update-display (&optional tag-changes)
- "Update display for TAG-CHANGES to current message.
-
-Does NOT change the database."
- (let* ((current-tags (notmuch-tree-get-tags))
- (new-tags (notmuch-update-tags current-tags tag-changes)))
- (unless (equal current-tags new-tags)
- (notmuch-tree-set-tags new-tags)
- (notmuch-tree-refresh-result))))
-
-(defun notmuch-tree-tag (tag-changes)
- "Change tags for the current message"
- (interactive
- (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message")))
- (notmuch-tag (notmuch-tree-get-message-id) tag-changes)
- (notmuch-tree-tag-update-display tag-changes))
-
-(defun notmuch-tree-add-tag (tag-changes)
- "Same as `notmuch-tree-tag' but sets initial input to '+'."
- (interactive
- (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "+")))
- (notmuch-tree-tag tag-changes))
-
-(defun notmuch-tree-remove-tag (tag-changes)
- "Same as `notmuch-tree-tag' but sets initial input to '-'."
- (interactive
- (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-")))
- (notmuch-tree-tag tag-changes))
-
-;; The next two functions close the message window before calling
-;; notmuch-search or notmuch-tree but they do so after the user has
-;; entered the query (in case the user was basing the query on
-;; something in the message window).
-
-(defun notmuch-tree-to-search ()
- "Run \"notmuch search\" with the given `query' and display results."
- (interactive)
- (let ((query (notmuch-read-query "Notmuch search: ")))
- (notmuch-tree-close-message-window)
- (notmuch-search query)))
-
-(defun notmuch-tree-to-tree ()
- "Run a query and display results in Tree view"
- (interactive)
- (let ((query (notmuch-read-query "Notmuch tree view search: ")))
- (notmuch-tree-close-message-window)
- (notmuch-tree query)))
-
-;; This function should be in notmuch-show.el but be we trying to
-;; minimise impact on the rest of the codebase.
-(defun notmuch-tree-from-show-current-query ()
- "Call notmuch tree with the current query"
- (interactive)
- (notmuch-tree notmuch-show-thread-id
- notmuch-show-query-context
- (notmuch-show-get-message-id)))
-
-;; This function should be in notmuch.el but be we trying to minimise
-;; impact on the rest of the codebase.
-(defun notmuch-tree-from-search-current-query ()
- "Call notmuch tree with the current query"
- (interactive)
- (notmuch-tree notmuch-search-query-string))
-
-;; This function should be in notmuch.el but be we trying to minimise
-;; impact on the rest of the codebase.
-(defun notmuch-tree-from-search-thread ()
- "Show the selected thread with notmuch-tree"
- (interactive)
- (notmuch-tree (notmuch-search-find-thread-id)
- notmuch-search-query-string
- nil
- (notmuch-prettify-subject (notmuch-search-find-subject))
- t))
-
-(defun notmuch-tree-message-window-kill-hook ()
- "Close the message pane when exiting the show buffer."
- (let ((buffer (current-buffer)))
- (when (and (window-live-p notmuch-tree-message-window)
- (eq (window-buffer notmuch-tree-message-window) buffer))
- ;; We do not want an error if this is the sole window in the
- ;; frame and I do not know how to test for that in emacs pre
- ;; 24. Hence we just ignore-errors.
- (ignore-errors
- (delete-window notmuch-tree-message-window)))))
-
-(defun notmuch-tree-show-message-in ()
- "Show the current message (in split-pane)."
- (interactive)
- (let ((id (notmuch-tree-get-message-id))
- (inhibit-read-only t)
- buffer)
- (when id
- ;; We close and reopen the window to kill off un-needed buffers
- ;; this might cause flickering but seems ok.
- (notmuch-tree-close-message-window)
- (setq notmuch-tree-message-window
- (split-window-vertically (/ (window-height) 4)))
- (with-selected-window notmuch-tree-message-window
- ;; Since we are only displaying one message do not indent.
- (let ((notmuch-show-indent-messages-width 0)
- (notmuch-show-only-matching-messages t))
- (setq buffer (notmuch-show id))))
- ;; We need the `let' as notmuch-tree-message-window is buffer local.
- (let ((window notmuch-tree-message-window))
- (with-current-buffer buffer
- (setq notmuch-tree-message-window window)
- (add-hook 'kill-buffer-hook 'notmuch-tree-message-window-kill-hook)))
- (when notmuch-show-mark-read-tags
- (notmuch-tree-tag-update-display notmuch-show-mark-read-tags))
- (setq notmuch-tree-message-buffer buffer))))
-
-(defun notmuch-tree-show-message-out ()
- "Show the current message (in whole window)."
- (interactive)
- (let ((id (notmuch-tree-get-message-id))
- (inhibit-read-only t)
- buffer)
- (when id
- ;; We close the window to kill off un-needed buffers.
- (notmuch-tree-close-message-window)
- (notmuch-show id))))
-
-(defun notmuch-tree-show-message (arg)
- "Show the current message.
-
-Shows in split pane or whole window according to value of
-`notmuch-tree-show-out'. A prefix argument reverses the choice."
- (interactive "P")
- (if (or (and notmuch-tree-show-out (not arg))
- (and (not notmuch-tree-show-out) arg))
- (notmuch-tree-show-message-out)
- (notmuch-tree-show-message-in)))
-
-(defun notmuch-tree-scroll-message-window ()
- "Scroll the message window (if it exists)"
- (interactive)
- (when (window-live-p notmuch-tree-message-window)
- (with-selected-window notmuch-tree-message-window
- (if (pos-visible-in-window-p (point-max))
- t
- (scroll-up)))))
-
-(defun notmuch-tree-scroll-message-window-back ()
- "Scroll the message window back(if it exists)"
- (interactive)
- (when (window-live-p notmuch-tree-message-window)
- (with-selected-window notmuch-tree-message-window
- (if (pos-visible-in-window-p (point-min))
- t
- (scroll-down)))))
-
-(defun notmuch-tree-scroll-or-next ()
- "Scroll the message window. If it at end go to next message."
- (interactive)
- (when (notmuch-tree-scroll-message-window)
- (notmuch-tree-next-matching-message)))
-
-(defun notmuch-tree-quit ()
- "Close the split view or exit tree."
- (interactive)
- (unless (notmuch-tree-close-message-window)
- (kill-buffer (current-buffer))))
-
-(defun notmuch-tree-close-message-window ()
- "Close the message-window. Return t if close succeeds."
- (interactive)
- (when (and (window-live-p notmuch-tree-message-window)
- (eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer))
- (delete-window notmuch-tree-message-window)
- (unless (get-buffer-window-list notmuch-tree-message-buffer)
- (kill-buffer notmuch-tree-message-buffer))
- t))
-
-(defun notmuch-tree-archive-message (&optional unarchive)
- "Archive the current message.
-
-Archive the current message by applying the tag changes in
-`notmuch-archive-tags' to it. If a prefix argument is given, the
-message will be \"unarchived\", i.e. the tag changes in
-`notmuch-archive-tags' will be reversed."
- (interactive "P")
- (when notmuch-archive-tags
- (notmuch-tree-tag (notmuch-tag-change-list notmuch-archive-tags unarchive))))
-
-(defun notmuch-tree-archive-message-then-next (&optional unarchive)
- "Archive the current message and move to next matching message."
- (interactive "P")
- (notmuch-tree-archive-message unarchive)
- (notmuch-tree-next-matching-message))
-
-(defun notmuch-tree-next-message ()
- "Move to next message."
- (interactive)
- (forward-line)
- (when (window-live-p notmuch-tree-message-window)
- (notmuch-tree-show-message-in)))
-
-(defun notmuch-tree-prev-message ()
- "Move to previous message."
- (interactive)
- (forward-line -1)
- (when (window-live-p notmuch-tree-message-window)
- (notmuch-tree-show-message-in)))
-
-(defun notmuch-tree-prev-matching-message ()
- "Move to previous matching message."
- (interactive)
- (forward-line -1)
- (while (and (not (bobp)) (not (notmuch-tree-get-match)))
- (forward-line -1))
- (when (window-live-p notmuch-tree-message-window)
- (notmuch-tree-show-message-in)))
-
-(defun notmuch-tree-next-matching-message ()
- "Move to next matching message."
- (interactive)
- (forward-line)
- (while (and (not (eobp)) (not (notmuch-tree-get-match)))
- (forward-line))
- (when (window-live-p notmuch-tree-message-window)
- (notmuch-tree-show-message-in)))
-
-(defun notmuch-tree-refresh-view ()
- "Refresh view."
- (interactive)
- (let ((inhibit-read-only t)
- (basic-query notmuch-tree-basic-query)
- (query-context notmuch-tree-query-context)
- (target (notmuch-tree-get-message-id)))
- (erase-buffer)
- (notmuch-tree-worker basic-query
- query-context
- target)))
-
-(defun notmuch-tree-thread-top ()
- (when (notmuch-tree-get-message-properties)
- (while (not (or (notmuch-tree-get-prop :first) (eobp)))
- (forward-line -1))))
-
-(defun notmuch-tree-prev-thread ()
- (interactive)
- (forward-line -1)
- (notmuch-tree-thread-top))
-
-(defun notmuch-tree-next-thread ()
- (interactive)
- (forward-line 1)
- (while (not (or (notmuch-tree-get-prop :first) (eobp)))
- (forward-line 1)))
-
-(defun notmuch-tree-thread-mapcar (function)
- "Iterate through all messages in the current thread
- and call FUNCTION for side effects."
- (save-excursion
- (notmuch-tree-thread-top)
- (loop collect (funcall function)
- do (forward-line)
- while (and (notmuch-tree-get-message-properties)
- (not (notmuch-tree-get-prop :first))))))
-
-(defun notmuch-tree-get-messages-ids-thread-search ()
- "Return a search string for all message ids of messages in the current thread."
- (mapconcat 'identity
- (notmuch-tree-thread-mapcar 'notmuch-tree-get-message-id)
- " or "))
-
-(defun notmuch-tree-tag-thread (tag-changes)
- "Tag all messages in the current thread"
- (interactive
- (let ((tags (apply #'append (notmuch-tree-thread-mapcar
- (lambda () (notmuch-tree-get-tags))))))
- (list (notmuch-read-tag-changes tags "Tag thread"))))
- (when (notmuch-tree-get-message-properties)
- (notmuch-tag (notmuch-tree-get-messages-ids-thread-search) tag-changes)
- (notmuch-tree-thread-mapcar
- (lambda () (notmuch-tree-tag-update-display tag-changes)))))
-
-(defun notmuch-tree-archive-thread (&optional unarchive)
- "Archive each message in thread.
-
-Archive each message currently shown by applying the tag changes
-in `notmuch-archive-tags' to each. If a prefix argument is given,
-the messages will be \"unarchived\", i.e. the tag changes in
-`notmuch-archive-tags' will be reversed.
-
-Note: This command is safe from any race condition of new messages
-being delivered to the same thread. It does not archive the
-entire thread, but only the messages shown in the current
-buffer."
- (interactive "P")
- (when notmuch-archive-tags
- (notmuch-tree-tag-thread
- (notmuch-tag-change-list notmuch-archive-tags unarchive))))
-
-;; Functions below here display the tree buffer itself.
-
-(defun notmuch-tree-clean-address (address)
- "Try to clean a single email ADDRESS for display. Return
-AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
-unchanged ADDRESS if parsing fails."
- (let* ((clean-address (notmuch-clean-address address))
- (p-address (car clean-address))
- (p-name (cdr clean-address)))
-
- ;; If we have a name return that otherwise return the address.
- (or p-name p-address)))
-
-(defun notmuch-tree-format-field (field format-string msg)
- "Format a FIELD of MSG according to FORMAT-STRING and return string"
- (let* ((headers (plist-get msg :headers))
- (match (plist-get msg :match)))
- (cond
- ((listp field)
- (format format-string (notmuch-tree-format-field-list field msg)))
-
- ((string-equal field "date")
- (let ((face (if match
- 'notmuch-tree-match-date-face
- 'notmuch-tree-no-match-date-face)))
- (propertize (format format-string (plist-get msg :date_relative)) 'face face)))
-
- ((string-equal field "tree")
- (let ((tree-status (plist-get msg :tree-status))
- (face (if match
- 'notmuch-tree-match-tree-face
- 'notmuch-tree-no-match-tree-face)))
-
- (propertize (format format-string
- (mapconcat #'identity (reverse tree-status) ""))
- 'face face)))
-
- ((string-equal field "subject")
- (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
- (previous-subject notmuch-tree-previous-subject)
- (face (if match
- 'notmuch-tree-match-subject-face
- 'notmuch-tree-no-match-subject-face)))
-
- (setq notmuch-tree-previous-subject bare-subject)
- (propertize (format format-string
- (if (string= previous-subject bare-subject)
- " ..."
- bare-subject))
- 'face face)))
-
- ((string-equal field "authors")
- (let ((author (notmuch-tree-clean-address (plist-get headers :From)))
- (len (length (format format-string "")))
- (face (if match
- 'notmuch-tree-match-author-face
- 'notmuch-tree-no-match-author-face)))
- (when (> (length author) len)
- (setq author (substring author 0 len)))
- (propertize (format format-string author) 'face face)))
-
- ((string-equal field "tags")
- (let ((tags (plist-get msg :tags))
- (face (if match
- 'notmuch-tree-match-tag-face
- 'notmuch-tree-no-match-tag-face)))
- (propertize (format format-string
- (mapconcat #'identity tags ", "))
- 'face face))))))
-
-
-(defun notmuch-tree-format-field-list (field-list msg)
- "Format fields of MSG according to FIELD-LIST and return string"
- (let (result-string)
- (dolist (spec field-list result-string)
- (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
- (setq result-string (concat result-string field-string))))))
-
-(defun notmuch-tree-insert-msg (msg)
- "Insert the message MSG according to notmuch-tree-result-format"
- ;; We need to save the previous subject as it will get overwritten
- ;; by the insert-field calls.
- (let ((previous-subject notmuch-tree-previous-subject))
- (insert (notmuch-tree-format-field-list notmuch-tree-result-format msg))
- (notmuch-tree-set-message-properties msg)
- (notmuch-tree-set-prop :previous-subject previous-subject)
- (insert "\n")))
-
-(defun notmuch-tree-goto-and-insert-msg (msg)
- "Insert msg at the end of the buffer. Move point to msg if it is the target"
- (save-excursion
- (goto-char (point-max))
- (notmuch-tree-insert-msg msg))
- (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
- (target notmuch-tree-target-msg))
- (when (or (and (not target) (plist-get msg :match))
- (string= msg-id target))
- (setq notmuch-tree-target-msg "found")
- (goto-char (point-max))
- (forward-line -1)
- (when notmuch-tree-open-target
- (notmuch-tree-show-message-in)))))
-
-(defun notmuch-tree-insert-tree (tree depth tree-status first last)
- "Insert the message tree TREE at depth DEPTH in the current thread.
-
-A message tree is another name for a single sub-thread: i.e., a
-message together with all its descendents."
- (let ((msg (car tree))
- (replies (cadr tree)))
-
- (cond
- ((and (< 0 depth) (not last))
- (push "├" tree-status))
- ((and (< 0 depth) last)
- (push "╰" tree-status))
- ((and (eq 0 depth) first last)
-;; (push "─" tree-status)) choice between this and next line is matter of taste.
- (push " " tree-status))
- ((and (eq 0 depth) first (not last))
- (push "┬" tree-status))
- ((and (eq 0 depth) (not first) last)
- (push "╰" tree-status))
- ((and (eq 0 depth) (not first) (not last))
- (push "├" tree-status)))
-
- (push (concat (if replies "┬" "─") "►") tree-status)
- (plist-put msg :first (and first (eq 0 depth)))
- (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status tree-status))
- (pop tree-status)
- (pop tree-status)
-
- (if last
- (push " " tree-status)
- (push "│" tree-status))
-
- (notmuch-tree-insert-thread replies (1+ depth) tree-status)))
-
-(defun notmuch-tree-insert-thread (thread depth tree-status)
- "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
- (let ((n (length thread)))
- (loop for tree in thread
- for count from 1 to n
-
- do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
-
-(defun notmuch-tree-insert-forest-thread (forest-thread)
- "Insert a single complete thread."
- (let (tree-status)
- ;; Reset at the start of each main thread.
- (setq notmuch-tree-previous-subject nil)
- (notmuch-tree-insert-thread forest-thread 0 tree-status)))
-
-(defun notmuch-tree-insert-forest (forest)
- "Insert a forest of threads.
-
-This function inserts a collection of several complete threads as
-passed to it by notmuch-tree-process-filter."
- (mapc 'notmuch-tree-insert-forest-thread forest))
-
-(defun notmuch-tree-mode ()
- "Major mode displaying messages (as opposed to threads) of of a notmuch search.
-
-This buffer contains the results of a \"notmuch tree\" of your
-email archives. Each line in the buffer represents a single
-message giving the relative date, the author, subject, and any
-tags.
-
-Pressing \\[notmuch-tree-show-message] on any line displays that message.
-
-Complete list of currently available key bindings:
-
-\\{notmuch-tree-mode-map}"
-
- (interactive)
- (kill-all-local-variables)
- (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
- (use-local-map notmuch-tree-mode-map)
- (setq major-mode 'notmuch-tree-mode
- mode-name "notmuch-tree")
- (hl-line-mode 1)
- (setq buffer-read-only t
- truncate-lines t))
-
-(defun notmuch-tree-process-sentinel (proc msg)
- "Add a message to let user know when \"notmuch tree\" exits"
- (let ((buffer (process-buffer proc))
- (status (process-status proc))
- (exit-status (process-exit-status proc))
- (never-found-target-thread nil))
- (when (memq status '(exit signal))
- (kill-buffer (process-get proc 'parse-buf))
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (save-excursion
- (let ((inhibit-read-only t)
- (atbob (bobp)))
- (goto-char (point-max))
- (if (eq status 'signal)
- (insert "Incomplete search results (tree view process was killed).\n"))
- (when (eq status 'exit)
- (insert "End of search results.")
- (unless (= exit-status 0)
- (insert (format " (process returned %d)" exit-status)))
- (insert "\n")))))))))
-
-(defun notmuch-tree-process-filter (proc string)
- "Process and filter the output of \"notmuch show\" for tree view"
- (let ((results-buf (process-buffer proc))
- (parse-buf (process-get proc 'parse-buf))
- (inhibit-read-only t)
- done)
- (if (not (buffer-live-p results-buf))
- (delete-process proc)
- (with-current-buffer parse-buf
- ;; Insert new data
- (save-excursion
- (goto-char (point-max))
- (insert string))
- (notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread
- results-buf)))))
-
-(defun notmuch-tree-worker (basic-query &optional query-context target open-target)
- "Insert the tree view of the search in the current buffer.
-
-This is is a helper function for notmuch-tree. The arguments are
-the same as for the function notmuch-tree."
- (interactive)
- (notmuch-tree-mode)
- (setq notmuch-tree-basic-query basic-query)
- (setq notmuch-tree-query-context query-context)
- (setq notmuch-tree-target-msg target)
- (setq notmuch-tree-open-target open-target)
-
- (erase-buffer)
- (goto-char (point-min))
- (let* ((search-args (concat basic-query
- (if query-context (concat " and (" query-context ")"))
- ))
- (message-arg "--entire-thread"))
- (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
- (setq search-args basic-query))
- (let ((proc (notmuch-start-notmuch
- "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
- "show" "--body=false" "--format=sexp"
- message-arg search-args))
- ;; Use a scratch buffer to accumulate partial output.
- ;; This buffer will be killed by the sentinel, which
- ;; should be called no matter how the process dies.
- (parse-buf (generate-new-buffer " *notmuch tree parse*")))
- (process-put proc 'parse-buf parse-buf)
- (set-process-filter proc 'notmuch-tree-process-filter)
- (set-process-query-on-exit-flag proc nil))))
-
-(defun notmuch-tree (&optional query query-context target buffer-name open-target)
- "Display threads matching QUERY in Tree View.
-
-The arguments are:
- QUERY: the main query. This can be any query but in many cases will be
- a single thread. If nil this is read interactively from the minibuffer.
- QUERY-CONTEXT: is an additional term for the query. The query used
- is QUERY and QUERY-CONTEXT unless that does not match any messages
- in which case we fall back to just QUERY.
- TARGET: A message ID (with the id: prefix) that will be made
- current if it appears in the tree view results.
- BUFFER-NAME: the name of the buffer to display the tree view. If
- it is nil \"*notmuch-tree\" followed by QUERY is used.
- OPEN-TARGET: If TRUE open the target message in the message pane."
- (interactive)
- (if (null query)
- (setq query (notmuch-read-query "Notmuch tree view search: ")))
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- (or buffer-name
- (concat "*notmuch-tree-" query "*")))))
- (inhibit-read-only t))
-
- (switch-to-buffer buffer))
- ;; Don't track undo information for this buffer
- (set 'buffer-undo-list t)
-
- (notmuch-tree-worker query query-context target open-target)
-
- (setq truncate-lines t))
-
-
-;; Set up key bindings from the rest of notmuch.
-(define-key notmuch-common-keymap "z" 'notmuch-tree)
-(define-key notmuch-search-mode-map "Z" 'notmuch-tree-from-search-current-query)
-(define-key notmuch-show-mode-map "Z" 'notmuch-tree-from-show-current-query)
-(message "Initialised notmuch-tree")
-
-(provide 'notmuch-tree)
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
new file mode 100644
index 0000000..d3330a0
--- /dev/null
+++ b/emacs/notmuch-tree.el
@@ -0,0 +1,946 @@
+;; notmuch-tree.el --- displaying notmuch forests.
+;;
+;; Copyright © Carl Worth
+;; Copyright © David Edmondson
+;; Copyright © Mark Walters
+;;
+;; This file is part of Notmuch.
+;;
+;; Notmuch is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Notmuch is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
+;;
+;; Authors: David Edmondson <dme at dme.org>
+;; Mark Walters <markwalters1009 at gmail.com>
+
+(require 'mail-parse)
+
+(require 'notmuch-lib)
+(require 'notmuch-query)
+(require 'notmuch-show)
+(require 'notmuch-tag)
+(require 'notmuch-parser)
+(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
+
+(eval-when-compile (require 'cl))
+(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line))
+(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
+(declare-function notmuch-read-query "notmuch" (prompt))
+(declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
+(declare-function notmuch-search-find-subject "notmuch" ())
+
+;; the following variable is defined in notmuch.el
+(defvar notmuch-search-query-string)
+
+(defgroup notmuch-tree nil
+ "Showing message and thread structure."
+ :group 'notmuch)
+
+(defcustom notmuch-tree-show-out nil
+ "View selected messages in new window rather than split-pane."
+ :type 'boolean
+ :group 'notmuch-tree)
+
+(defcustom notmuch-tree-result-format
+ `(("date" . "%12s ")
+ ("authors" . "%-20s")
+ ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
+ ("tags" . "(%s)"))
+ "Result formatting for Tree view. Supported fields are: date,
+ authors, subject, tree, tags. Tree means the thread tree
+ box graphics. The field may also be a list in which case
+ the formatting rules are applied recursively and then the
+ output of all the fields in the list is inserted
+ according to format-string.
+
+Note the author string should not contain
+ whitespace (put it in the neighbouring fields instead).
+ For example:
+ (setq notmuch-tree-result-format \(\(\"authors\" . \"%-40s\"\)
+ \(\"subject\" . \"%s\"\)\)\)"
+ :type '(alist :key-type (string) :value-type (string))
+ :group 'notmuch-tree)
+
+;; Faces for messages that match the query.
+(defface notmuch-tree-match-date-face
+ '((t :inherit default))
+ "Face used in tree mode for the date in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-match-author-face
+ '((((class color)
+ (background dark))
+ (:foreground "OliveDrab1"))
+ (((class color)
+ (background light))
+ (:foreground "dark blue"))
+ (t
+ (:bold t)))
+ "Face used in tree mode for the date in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-match-subject-face
+ '((t :inherit default))
+ "Face used in tree mode for the subject in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-match-tree-face
+ '((t :inherit default))
+ "Face used in tree mode for the thread tree block graphics in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-match-tag-face
+ '((((class color)
+ (background dark))
+ (:foreground "OliveDrab1"))
+ (((class color)
+ (background light))
+ (:foreground "navy blue" :bold t))
+ (t
+ (:bold t)))
+ "Face used in tree mode for tags in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+;; Faces for messages that do not match the query.
+(defface notmuch-tree-no-match-date-face
+ '((t (:foreground "gray")))
+ "Face used in tree mode for non-matching dates."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-no-match-subject-face
+ '((t (:foreground "gray")))
+ "Face used in tree mode for non-matching subjects."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-no-match-tree-face
+ '((t (:foreground "gray")))
+ "Face used in tree mode for the thread tree block graphics in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-no-match-author-face
+ '((t (:foreground "gray")))
+ "Face used in tree mode for the date in messages matching the query."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defface notmuch-tree-no-match-tag-face
+ '((t (:foreground "gray")))
+ "Face used in tree mode face for non-matching tags."
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
+(defvar notmuch-tree-previous-subject
+ "The subject of the most recent result shown during the async display")
+(make-variable-buffer-local 'notmuch-tree-previous-subject)
+
+(defvar notmuch-tree-basic-query nil
+ "A buffer local copy of argument query to the function notmuch-tree")
+(make-variable-buffer-local 'notmuch-tree-basic-query)
+
+(defvar notmuch-tree-query-context nil
+ "A buffer local copy of argument query-context to the function notmuch-tree")
+(make-variable-buffer-local 'notmuch-tree-query-context)
+
+(defvar notmuch-tree-target-msg nil
+ "A buffer local copy of argument target to the function notmuch-tree")
+(make-variable-buffer-local 'notmuch-tree-target-msg)
+
+(defvar notmuch-tree-open-target nil
+ "A buffer local copy of argument open-target to the function notmuch-tree")
+(make-variable-buffer-local 'notmuch-tree-open-target)
+
+(defvar notmuch-tree-message-window nil
+ "The window of the message pane.
+
+It is set in both the tree buffer and the child show buffer. It
+is used to try and close the message pane when quitting tree view
+or the child show buffer.")
+(make-variable-buffer-local 'notmuch-tree-message-window)
+(put 'notmuch-tree-message-window 'permanent-local t)
+
+(defvar notmuch-tree-message-buffer nil
+ "The buffer name of the show buffer in the message pane.
+
+This is used to try and make sure we don't close the message pane
+if the user has loaded a different buffer in that window.")
+(make-variable-buffer-local 'notmuch-tree-message-buffer)
+(put 'notmuch-tree-message-buffer 'permanent-local t)
+
+(defun notmuch-tree-to-message-pane (func)
+ "Execute FUNC in message pane.
+
+This function returns a function (so can be used as a keybinding)
+which executes function FUNC in the message pane if it is
+open (if the message pane is closed it does nothing)."
+ `(lambda ()
+ ,(concat "(In message pane) " (documentation func t))
+ (interactive)
+ (when (window-live-p notmuch-tree-message-window)
+ (with-selected-window notmuch-tree-message-window
+ (call-interactively #',func)))))
+
+(defun notmuch-tree-button-activate (&optional button)
+ "Activate BUTTON or button at point
+
+This function does not give an error if there is no button."
+ (interactive)
+ (let ((button (or button (button-at (point)))))
+ (when button (button-activate button))))
+
+(defun notmuch-tree-close-message-pane-and (func)
+ "Close message pane and execute FUNC.
+
+This function returns a function (so can be used as a keybinding)
+which closes the message pane if open and then executes function
+FUNC."
+ `(lambda ()
+ ,(concat "(Close message pane and) " (documentation func t))
+ (interactive)
+ (notmuch-tree-close-message-window)
+ (call-interactively #',func)))
+
+(defvar notmuch-tree-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map notmuch-common-keymap)
+ ;; The following override the global keymap.
+ ;; Override because we want to close message pane first.
+ (define-key map "?" (notmuch-tree-close-message-pane-and #'notmuch-help))
+ ;; Override because we first close message pane and then close tree buffer.
+ (define-key map "q" 'notmuch-tree-quit)
+ ;; Override because we close message pane after the search query is entered.
+ (define-key map "s" 'notmuch-tree-to-search)
+ ;; Override because we want to close message pane first.
+ (define-key map "m" (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
+
+ ;; these use notmuch-show functions directly
+ (define-key map "|" 'notmuch-show-pipe-message)
+ (define-key map "w" 'notmuch-show-save-attachments)
+ (define-key map "v" 'notmuch-show-view-all-mime-parts)
+ (define-key map "c" 'notmuch-show-stash-map)
+
+ ;; these apply to the message pane
+ (define-key map (kbd "M-TAB") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
+ (define-key map (kbd "<backtab>") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
+ (define-key map (kbd "TAB") (notmuch-tree-to-message-pane #'notmuch-show-next-button))
+ (define-key map "e" (notmuch-tree-to-message-pane #'notmuch-tree-button-activate))
+
+ ;; bindings from show (or elsewhere) but we close the message pane first.
+ (define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
+ (define-key map "r" (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
+ (define-key map "R" (notmuch-tree-close-message-pane-and #'notmuch-show-reply))
+ (define-key map "V" (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
+
+ ;; The main tree view bindings
+ (define-key map (kbd "RET") 'notmuch-tree-show-message)
+ (define-key map [mouse-1] 'notmuch-tree-show-message)
+ (define-key map "x" 'notmuch-tree-quit)
+ (define-key map "A" 'notmuch-tree-archive-thread)
+ (define-key map "a" 'notmuch-tree-archive-message-then-next)
+ (define-key map "=" 'notmuch-tree-refresh-view)
+ (define-key map "z" 'notmuch-tree-to-tree)
+ (define-key map "n" 'notmuch-tree-next-matching-message)
+ (define-key map "p" 'notmuch-tree-prev-matching-message)
+ (define-key map "N" 'notmuch-tree-next-message)
+ (define-key map "P" 'notmuch-tree-prev-message)
+ (define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
+ (define-key map (kbd "M-n") 'notmuch-tree-next-thread)
+ (define-key map "-" 'notmuch-tree-remove-tag)
+ (define-key map "+" 'notmuch-tree-add-tag)
+ (define-key map "*" 'notmuch-tree-tag-thread)
+ (define-key map " " 'notmuch-tree-scroll-or-next)
+ (define-key map "b" 'notmuch-tree-scroll-message-window-back)
+ map))
+(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
+
+(defun notmuch-tree-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.
+:tags - Tags for this message"
+ (save-excursion
+ (beginning-of-line)
+ (get-text-property (point) :notmuch-message-properties)))
+
+;; XXX This should really be a lib function but we are trying to
+;; reduce impact on the code base.
+(defun notmuch-show-get-prop (prop &optional props)
+ "This is a tree view overridden version of notmuch-show-get-prop
+
+It gets property PROP from PROPS or, if PROPS is nil, the current
+message in either tree or show. This means that several functions
+in notmuch-show now work unchanged in tree as they just need the
+correct message properties."
+ (let ((props (or props
+ (cond ((eq major-mode 'notmuch-show-mode)
+ (notmuch-show-get-message-properties))
+ ((eq major-mode 'notmuch-tree-mode)
+ (notmuch-tree-get-message-properties))))))
+ (plist-get props prop)))
+
+(defun notmuch-tree-set-message-properties (props)
+ (save-excursion
+ (beginning-of-line)
+ (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
+
+(defun notmuch-tree-set-prop (prop val &optional props)
+ (let ((inhibit-read-only t)
+ (props (or props
+ (notmuch-tree-get-message-properties))))
+ (plist-put props prop val)
+ (notmuch-tree-set-message-properties props)))
+
+(defun notmuch-tree-get-prop (prop &optional props)
+ (let ((props (or props
+ (notmuch-tree-get-message-properties))))
+ (plist-get props prop)))
+
+(defun notmuch-tree-set-tags (tags)
+ "Set the tags of the current message."
+ (notmuch-tree-set-prop :tags tags))
+
+(defun notmuch-tree-get-tags ()
+ "Return the tags of the current message."
+ (notmuch-tree-get-prop :tags))
+
+(defun notmuch-tree-get-message-id ()
+ "Return the message id of the current message."
+ (let ((id (notmuch-tree-get-prop :id)))
+ (if id
+ (notmuch-id-to-query id)
+ nil)))
+
+(defun notmuch-tree-get-match ()
+ "Return whether the current message is a match."
+ (interactive)
+ (notmuch-tree-get-prop :match))
+
+(defun notmuch-tree-refresh-result ()
+ "Redisplay the current message line.
+
+This redisplays the current line based on the messages
+properties (as they are now). This is used when tags are
+updated."
+ (let ((init-point (point))
+ (end (line-end-position))
+ (msg (notmuch-tree-get-message-properties))
+ (inhibit-read-only t))
+ (beginning-of-line)
+ ;; This is a little tricky: we override
+ ;; notmuch-tree-previous-subject to get the decision between
+ ;; ... and a subject right and it stops notmuch-tree-insert-msg
+ ;; from overwriting the buffer local copy of
+ ;; notmuch-tree-previous-subject if this is called while the
+ ;; buffer is displaying.
+ (let ((notmuch-tree-previous-subject (notmuch-tree-get-prop :previous-subject)))
+ (delete-region (point) (1+ (line-end-position)))
+ (notmuch-tree-insert-msg msg))
+ (let ((new-end (line-end-position)))
+ (goto-char (if (= init-point end)
+ new-end
+ (min init-point (- new-end 1)))))))
+
+(defun notmuch-tree-tag-update-display (&optional tag-changes)
+ "Update display for TAG-CHANGES to current message.
+
+Does NOT change the database."
+ (let* ((current-tags (notmuch-tree-get-tags))
+ (new-tags (notmuch-update-tags current-tags tag-changes)))
+ (unless (equal current-tags new-tags)
+ (notmuch-tree-set-tags new-tags)
+ (notmuch-tree-refresh-result))))
+
+(defun notmuch-tree-tag (tag-changes)
+ "Change tags for the current message"
+ (interactive
+ (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message")))
+ (notmuch-tag (notmuch-tree-get-message-id) tag-changes)
+ (notmuch-tree-tag-update-display tag-changes))
+
+(defun notmuch-tree-add-tag (tag-changes)
+ "Same as `notmuch-tree-tag' but sets initial input to '+'."
+ (interactive
+ (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "+")))
+ (notmuch-tree-tag tag-changes))
+
+(defun notmuch-tree-remove-tag (tag-changes)
+ "Same as `notmuch-tree-tag' but sets initial input to '-'."
+ (interactive
+ (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-")))
+ (notmuch-tree-tag tag-changes))
+
+;; The next two functions close the message window before calling
+;; notmuch-search or notmuch-tree but they do so after the user has
+;; entered the query (in case the user was basing the query on
+;; something in the message window).
+
+(defun notmuch-tree-to-search ()
+ "Run \"notmuch search\" with the given `query' and display results."
+ (interactive)
+ (let ((query (notmuch-read-query "Notmuch search: ")))
+ (notmuch-tree-close-message-window)
+ (notmuch-search query)))
+
+(defun notmuch-tree-to-tree ()
+ "Run a query and display results in Tree view"
+ (interactive)
+ (let ((query (notmuch-read-query "Notmuch tree view search: ")))
+ (notmuch-tree-close-message-window)
+ (notmuch-tree query)))
+
+;; This function should be in notmuch-show.el but be we trying to
+;; minimise impact on the rest of the codebase.
+(defun notmuch-tree-from-show-current-query ()
+ "Call notmuch tree with the current query"
+ (interactive)
+ (notmuch-tree notmuch-show-thread-id
+ notmuch-show-query-context
+ (notmuch-show-get-message-id)))
+
+;; This function should be in notmuch.el but be we trying to minimise
+;; impact on the rest of the codebase.
+(defun notmuch-tree-from-search-current-query ()
+ "Call notmuch tree with the current query"
+ (interactive)
+ (notmuch-tree notmuch-search-query-string))
+
+;; This function should be in notmuch.el but be we trying to minimise
+;; impact on the rest of the codebase.
+(defun notmuch-tree-from-search-thread ()
+ "Show the selected thread with notmuch-tree"
+ (interactive)
+ (notmuch-tree (notmuch-search-find-thread-id)
+ notmuch-search-query-string
+ nil
+ (notmuch-prettify-subject (notmuch-search-find-subject))
+ t))
+
+(defun notmuch-tree-message-window-kill-hook ()
+ "Close the message pane when exiting the show buffer."
+ (let ((buffer (current-buffer)))
+ (when (and (window-live-p notmuch-tree-message-window)
+ (eq (window-buffer notmuch-tree-message-window) buffer))
+ ;; We do not want an error if this is the sole window in the
+ ;; frame and I do not know how to test for that in emacs pre
+ ;; 24. Hence we just ignore-errors.
+ (ignore-errors
+ (delete-window notmuch-tree-message-window)))))
+
+(defun notmuch-tree-show-message-in ()
+ "Show the current message (in split-pane)."
+ (interactive)
+ (let ((id (notmuch-tree-get-message-id))
+ (inhibit-read-only t)
+ buffer)
+ (when id
+ ;; We close and reopen the window to kill off un-needed buffers
+ ;; this might cause flickering but seems ok.
+ (notmuch-tree-close-message-window)
+ (setq notmuch-tree-message-window
+ (split-window-vertically (/ (window-height) 4)))
+ (with-selected-window notmuch-tree-message-window
+ ;; Since we are only displaying one message do not indent.
+ (let ((notmuch-show-indent-messages-width 0)
+ (notmuch-show-only-matching-messages t))
+ (setq buffer (notmuch-show id))))
+ ;; We need the `let' as notmuch-tree-message-window is buffer local.
+ (let ((window notmuch-tree-message-window))
+ (with-current-buffer buffer
+ (setq notmuch-tree-message-window window)
+ (add-hook 'kill-buffer-hook 'notmuch-tree-message-window-kill-hook)))
+ (when notmuch-show-mark-read-tags
+ (notmuch-tree-tag-update-display notmuch-show-mark-read-tags))
+ (setq notmuch-tree-message-buffer buffer))))
+
+(defun notmuch-tree-show-message-out ()
+ "Show the current message (in whole window)."
+ (interactive)
+ (let ((id (notmuch-tree-get-message-id))
+ (inhibit-read-only t)
+ buffer)
+ (when id
+ ;; We close the window to kill off un-needed buffers.
+ (notmuch-tree-close-message-window)
+ (notmuch-show id))))
+
+(defun notmuch-tree-show-message (arg)
+ "Show the current message.
+
+Shows in split pane or whole window according to value of
+`notmuch-tree-show-out'. A prefix argument reverses the choice."
+ (interactive "P")
+ (if (or (and notmuch-tree-show-out (not arg))
+ (and (not notmuch-tree-show-out) arg))
+ (notmuch-tree-show-message-out)
+ (notmuch-tree-show-message-in)))
+
+(defun notmuch-tree-scroll-message-window ()
+ "Scroll the message window (if it exists)"
+ (interactive)
+ (when (window-live-p notmuch-tree-message-window)
+ (with-selected-window notmuch-tree-message-window
+ (if (pos-visible-in-window-p (point-max))
+ t
+ (scroll-up)))))
+
+(defun notmuch-tree-scroll-message-window-back ()
+ "Scroll the message window back(if it exists)"
+ (interactive)
+ (when (window-live-p notmuch-tree-message-window)
+ (with-selected-window notmuch-tree-message-window
+ (if (pos-visible-in-window-p (point-min))
+ t
+ (scroll-down)))))
+
+(defun notmuch-tree-scroll-or-next ()
+ "Scroll the message window. If it at end go to next message."
+ (interactive)
+ (when (notmuch-tree-scroll-message-window)
+ (notmuch-tree-next-matching-message)))
+
+(defun notmuch-tree-quit ()
+ "Close the split view or exit tree."
+ (interactive)
+ (unless (notmuch-tree-close-message-window)
+ (kill-buffer (current-buffer))))
+
+(defun notmuch-tree-close-message-window ()
+ "Close the message-window. Return t if close succeeds."
+ (interactive)
+ (when (and (window-live-p notmuch-tree-message-window)
+ (eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer))
+ (delete-window notmuch-tree-message-window)
+ (unless (get-buffer-window-list notmuch-tree-message-buffer)
+ (kill-buffer notmuch-tree-message-buffer))
+ t))
+
+(defun notmuch-tree-archive-message (&optional unarchive)
+ "Archive the current message.
+
+Archive the current message by applying the tag changes in
+`notmuch-archive-tags' to it. If a prefix argument is given, the
+message will be \"unarchived\", i.e. the tag changes in
+`notmuch-archive-tags' will be reversed."
+ (interactive "P")
+ (when notmuch-archive-tags
+ (notmuch-tree-tag (notmuch-tag-change-list notmuch-archive-tags unarchive))))
+
+(defun notmuch-tree-archive-message-then-next (&optional unarchive)
+ "Archive the current message and move to next matching message."
+ (interactive "P")
+ (notmuch-tree-archive-message unarchive)
+ (notmuch-tree-next-matching-message))
+
+(defun notmuch-tree-next-message ()
+ "Move to next message."
+ (interactive)
+ (forward-line)
+ (when (window-live-p notmuch-tree-message-window)
+ (notmuch-tree-show-message-in)))
+
+(defun notmuch-tree-prev-message ()
+ "Move to previous message."
+ (interactive)
+ (forward-line -1)
+ (when (window-live-p notmuch-tree-message-window)
+ (notmuch-tree-show-message-in)))
+
+(defun notmuch-tree-prev-matching-message ()
+ "Move to previous matching message."
+ (interactive)
+ (forward-line -1)
+ (while (and (not (bobp)) (not (notmuch-tree-get-match)))
+ (forward-line -1))
+ (when (window-live-p notmuch-tree-message-window)
+ (notmuch-tree-show-message-in)))
+
+(defun notmuch-tree-next-matching-message ()
+ "Move to next matching message."
+ (interactive)
+ (forward-line)
+ (while (and (not (eobp)) (not (notmuch-tree-get-match)))
+ (forward-line))
+ (when (window-live-p notmuch-tree-message-window)
+ (notmuch-tree-show-message-in)))
+
+(defun notmuch-tree-refresh-view ()
+ "Refresh view."
+ (interactive)
+ (let ((inhibit-read-only t)
+ (basic-query notmuch-tree-basic-query)
+ (query-context notmuch-tree-query-context)
+ (target (notmuch-tree-get-message-id)))
+ (erase-buffer)
+ (notmuch-tree-worker basic-query
+ query-context
+ target)))
+
+(defun notmuch-tree-thread-top ()
+ (when (notmuch-tree-get-message-properties)
+ (while (not (or (notmuch-tree-get-prop :first) (eobp)))
+ (forward-line -1))))
+
+(defun notmuch-tree-prev-thread ()
+ (interactive)
+ (forward-line -1)
+ (notmuch-tree-thread-top))
+
+(defun notmuch-tree-next-thread ()
+ (interactive)
+ (forward-line 1)
+ (while (not (or (notmuch-tree-get-prop :first) (eobp)))
+ (forward-line 1)))
+
+(defun notmuch-tree-thread-mapcar (function)
+ "Iterate through all messages in the current thread
+ and call FUNCTION for side effects."
+ (save-excursion
+ (notmuch-tree-thread-top)
+ (loop collect (funcall function)
+ do (forward-line)
+ while (and (notmuch-tree-get-message-properties)
+ (not (notmuch-tree-get-prop :first))))))
+
+(defun notmuch-tree-get-messages-ids-thread-search ()
+ "Return a search string for all message ids of messages in the current thread."
+ (mapconcat 'identity
+ (notmuch-tree-thread-mapcar 'notmuch-tree-get-message-id)
+ " or "))
+
+(defun notmuch-tree-tag-thread (tag-changes)
+ "Tag all messages in the current thread"
+ (interactive
+ (let ((tags (apply #'append (notmuch-tree-thread-mapcar
+ (lambda () (notmuch-tree-get-tags))))))
+ (list (notmuch-read-tag-changes tags "Tag thread"))))
+ (when (notmuch-tree-get-message-properties)
+ (notmuch-tag (notmuch-tree-get-messages-ids-thread-search) tag-changes)
+ (notmuch-tree-thread-mapcar
+ (lambda () (notmuch-tree-tag-update-display tag-changes)))))
+
+(defun notmuch-tree-archive-thread (&optional unarchive)
+ "Archive each message in thread.
+
+Archive each message currently shown by applying the tag changes
+in `notmuch-archive-tags' to each. If a prefix argument is given,
+the messages will be \"unarchived\", i.e. the tag changes in
+`notmuch-archive-tags' will be reversed.
+
+Note: This command is safe from any race condition of new messages
+being delivered to the same thread. It does not archive the
+entire thread, but only the messages shown in the current
+buffer."
+ (interactive "P")
+ (when notmuch-archive-tags
+ (notmuch-tree-tag-thread
+ (notmuch-tag-change-list notmuch-archive-tags unarchive))))
+
+;; Functions below here display the tree buffer itself.
+
+(defun notmuch-tree-clean-address (address)
+ "Try to clean a single email ADDRESS for display. Return
+AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
+unchanged ADDRESS if parsing fails."
+ (let* ((clean-address (notmuch-clean-address address))
+ (p-address (car clean-address))
+ (p-name (cdr clean-address)))
+
+ ;; If we have a name return that otherwise return the address.
+ (or p-name p-address)))
+
+(defun notmuch-tree-format-field (field format-string msg)
+ "Format a FIELD of MSG according to FORMAT-STRING and return string"
+ (let* ((headers (plist-get msg :headers))
+ (match (plist-get msg :match)))
+ (cond
+ ((listp field)
+ (format format-string (notmuch-tree-format-field-list field msg)))
+
+ ((string-equal field "date")
+ (let ((face (if match
+ 'notmuch-tree-match-date-face
+ 'notmuch-tree-no-match-date-face)))
+ (propertize (format format-string (plist-get msg :date_relative)) 'face face)))
+
+ ((string-equal field "tree")
+ (let ((tree-status (plist-get msg :tree-status))
+ (face (if match
+ 'notmuch-tree-match-tree-face
+ 'notmuch-tree-no-match-tree-face)))
+
+ (propertize (format format-string
+ (mapconcat #'identity (reverse tree-status) ""))
+ 'face face)))
+
+ ((string-equal field "subject")
+ (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
+ (previous-subject notmuch-tree-previous-subject)
+ (face (if match
+ 'notmuch-tree-match-subject-face
+ 'notmuch-tree-no-match-subject-face)))
+
+ (setq notmuch-tree-previous-subject bare-subject)
+ (propertize (format format-string
+ (if (string= previous-subject bare-subject)
+ " ..."
+ bare-subject))
+ 'face face)))
+
+ ((string-equal field "authors")
+ (let ((author (notmuch-tree-clean-address (plist-get headers :From)))
+ (len (length (format format-string "")))
+ (face (if match
+ 'notmuch-tree-match-author-face
+ 'notmuch-tree-no-match-author-face)))
+ (when (> (length author) len)
+ (setq author (substring author 0 len)))
+ (propertize (format format-string author) 'face face)))
+
+ ((string-equal field "tags")
+ (let ((tags (plist-get msg :tags))
+ (face (if match
+ 'notmuch-tree-match-tag-face
+ 'notmuch-tree-no-match-tag-face)))
+ (propertize (format format-string
+ (mapconcat #'identity tags ", "))
+ 'face face))))))
+
+
+(defun notmuch-tree-format-field-list (field-list msg)
+ "Format fields of MSG according to FIELD-LIST and return string"
+ (let (result-string)
+ (dolist (spec field-list result-string)
+ (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
+ (setq result-string (concat result-string field-string))))))
+
+(defun notmuch-tree-insert-msg (msg)
+ "Insert the message MSG according to notmuch-tree-result-format"
+ ;; We need to save the previous subject as it will get overwritten
+ ;; by the insert-field calls.
+ (let ((previous-subject notmuch-tree-previous-subject))
+ (insert (notmuch-tree-format-field-list notmuch-tree-result-format msg))
+ (notmuch-tree-set-message-properties msg)
+ (notmuch-tree-set-prop :previous-subject previous-subject)
+ (insert "\n")))
+
+(defun notmuch-tree-goto-and-insert-msg (msg)
+ "Insert msg at the end of the buffer. Move point to msg if it is the target"
+ (save-excursion
+ (goto-char (point-max))
+ (notmuch-tree-insert-msg msg))
+ (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
+ (target notmuch-tree-target-msg))
+ (when (or (and (not target) (plist-get msg :match))
+ (string= msg-id target))
+ (setq notmuch-tree-target-msg "found")
+ (goto-char (point-max))
+ (forward-line -1)
+ (when notmuch-tree-open-target
+ (notmuch-tree-show-message-in)))))
+
+(defun notmuch-tree-insert-tree (tree depth tree-status first last)
+ "Insert the message tree TREE at depth DEPTH in the current thread.
+
+A message tree is another name for a single sub-thread: i.e., a
+message together with all its descendents."
+ (let ((msg (car tree))
+ (replies (cadr tree)))
+
+ (cond
+ ((and (< 0 depth) (not last))
+ (push "├" tree-status))
+ ((and (< 0 depth) last)
+ (push "╰" tree-status))
+ ((and (eq 0 depth) first last)
+;; (push "─" tree-status)) choice between this and next line is matter of taste.
+ (push " " tree-status))
+ ((and (eq 0 depth) first (not last))
+ (push "┬" tree-status))
+ ((and (eq 0 depth) (not first) last)
+ (push "╰" tree-status))
+ ((and (eq 0 depth) (not first) (not last))
+ (push "├" tree-status)))
+
+ (push (concat (if replies "┬" "─") "►") tree-status)
+ (plist-put msg :first (and first (eq 0 depth)))
+ (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status tree-status))
+ (pop tree-status)
+ (pop tree-status)
+
+ (if last
+ (push " " tree-status)
+ (push "│" tree-status))
+
+ (notmuch-tree-insert-thread replies (1+ depth) tree-status)))
+
+(defun notmuch-tree-insert-thread (thread depth tree-status)
+ "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
+ (let ((n (length thread)))
+ (loop for tree in thread
+ for count from 1 to n
+
+ do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
+
+(defun notmuch-tree-insert-forest-thread (forest-thread)
+ "Insert a single complete thread."
+ (let (tree-status)
+ ;; Reset at the start of each main thread.
+ (setq notmuch-tree-previous-subject nil)
+ (notmuch-tree-insert-thread forest-thread 0 tree-status)))
+
+(defun notmuch-tree-insert-forest (forest)
+ "Insert a forest of threads.
+
+This function inserts a collection of several complete threads as
+passed to it by notmuch-tree-process-filter."
+ (mapc 'notmuch-tree-insert-forest-thread forest))
+
+(defun notmuch-tree-mode ()
+ "Major mode displaying messages (as opposed to threads) of of a notmuch search.
+
+This buffer contains the results of a \"notmuch tree\" of your
+email archives. Each line in the buffer represents a single
+message giving the relative date, the author, subject, and any
+tags.
+
+Pressing \\[notmuch-tree-show-message] on any line displays that message.
+
+Complete list of currently available key bindings:
+
+\\{notmuch-tree-mode-map}"
+
+ (interactive)
+ (kill-all-local-variables)
+ (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
+ (use-local-map notmuch-tree-mode-map)
+ (setq major-mode 'notmuch-tree-mode
+ mode-name "notmuch-tree")
+ (hl-line-mode 1)
+ (setq buffer-read-only t
+ truncate-lines t))
+
+(defun notmuch-tree-process-sentinel (proc msg)
+ "Add a message to let user know when \"notmuch tree\" exits"
+ (let ((buffer (process-buffer proc))
+ (status (process-status proc))
+ (exit-status (process-exit-status proc))
+ (never-found-target-thread nil))
+ (when (memq status '(exit signal))
+ (kill-buffer (process-get proc 'parse-buf))
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (atbob (bobp)))
+ (goto-char (point-max))
+ (if (eq status 'signal)
+ (insert "Incomplete search results (tree view process was killed).\n"))
+ (when (eq status 'exit)
+ (insert "End of search results.")
+ (unless (= exit-status 0)
+ (insert (format " (process returned %d)" exit-status)))
+ (insert "\n")))))))))
+
+(defun notmuch-tree-process-filter (proc string)
+ "Process and filter the output of \"notmuch show\" for tree view"
+ (let ((results-buf (process-buffer proc))
+ (parse-buf (process-get proc 'parse-buf))
+ (inhibit-read-only t)
+ done)
+ (if (not (buffer-live-p results-buf))
+ (delete-process proc)
+ (with-current-buffer parse-buf
+ ;; Insert new data
+ (save-excursion
+ (goto-char (point-max))
+ (insert string))
+ (notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread
+ results-buf)))))
+
+(defun notmuch-tree-worker (basic-query &optional query-context target open-target)
+ "Insert the tree view of the search in the current buffer.
+
+This is is a helper function for notmuch-tree. The arguments are
+the same as for the function notmuch-tree."
+ (interactive)
+ (notmuch-tree-mode)
+ (setq notmuch-tree-basic-query basic-query)
+ (setq notmuch-tree-query-context query-context)
+ (setq notmuch-tree-target-msg target)
+ (setq notmuch-tree-open-target open-target)
+
+ (erase-buffer)
+ (goto-char (point-min))
+ (let* ((search-args (concat basic-query
+ (if query-context (concat " and (" query-context ")"))
+ ))
+ (message-arg "--entire-thread"))
+ (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
+ (setq search-args basic-query))
+ (let ((proc (notmuch-start-notmuch
+ "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
+ "show" "--body=false" "--format=sexp"
+ message-arg search-args))
+ ;; Use a scratch buffer to accumulate partial output.
+ ;; This buffer will be killed by the sentinel, which
+ ;; should be called no matter how the process dies.
+ (parse-buf (generate-new-buffer " *notmuch tree parse*")))
+ (process-put proc 'parse-buf parse-buf)
+ (set-process-filter proc 'notmuch-tree-process-filter)
+ (set-process-query-on-exit-flag proc nil))))
+
+(defun notmuch-tree (&optional query query-context target buffer-name open-target)
+ "Display threads matching QUERY in Tree View.
+
+The arguments are:
+ QUERY: the main query. This can be any query but in many cases will be
+ a single thread. If nil this is read interactively from the minibuffer.
+ QUERY-CONTEXT: is an additional term for the query. The query used
+ is QUERY and QUERY-CONTEXT unless that does not match any messages
+ in which case we fall back to just QUERY.
+ TARGET: A message ID (with the id: prefix) that will be made
+ current if it appears in the tree view results.
+ BUFFER-NAME: the name of the buffer to display the tree view. If
+ it is nil \"*notmuch-tree\" followed by QUERY is used.
+ OPEN-TARGET: If TRUE open the target message in the message pane."
+ (interactive)
+ (if (null query)
+ (setq query (notmuch-read-query "Notmuch tree view search: ")))
+ (let ((buffer (get-buffer-create (generate-new-buffer-name
+ (or buffer-name
+ (concat "*notmuch-tree-" query "*")))))
+ (inhibit-read-only t))
+
+ (switch-to-buffer buffer))
+ ;; Don't track undo information for this buffer
+ (set 'buffer-undo-list t)
+
+ (notmuch-tree-worker query query-context target open-target)
+
+ (setq truncate-lines t))
+
+
+;; Set up key bindings from the rest of notmuch.
+(define-key notmuch-common-keymap "z" 'notmuch-tree)
+(define-key notmuch-search-mode-map "Z" 'notmuch-tree-from-search-current-query)
+(define-key notmuch-show-mode-map "Z" 'notmuch-tree-from-show-current-query)
+(message "Initialised notmuch-tree")
+
+(provide 'notmuch-tree)
--
1.7.9.1
More information about the notmuch
mailing list