[PATCH 1/4] contrib: pick: move lisp names from pick to tree

Mark Walters markwalters1009 at gmail.com
Sat Oct 26 15:02:05 PDT 2013


This changes all the lisp names from pick to tree (variables,
functions etc). It also changes the lisp in the emacs-pick test files
to match the new names.
---
 contrib/notmuch-pick/notmuch-pick.el |  951 ----------------------------------
 contrib/notmuch-pick/notmuch-tree.el |  951 ++++++++++++++++++++++++++++++++++
 contrib/notmuch-pick/test/emacs-pick |   74 ++--
 3 files changed, 988 insertions(+), 988 deletions(-)
 delete mode 100644 contrib/notmuch-pick/notmuch-pick.el
 create mode 100644 contrib/notmuch-pick/notmuch-tree.el

diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el
deleted file mode 100644
index 156ea6d..0000000
--- a/contrib/notmuch-pick/notmuch-pick.el
+++ /dev/null
@@ -1,951 +0,0 @@
-;; notmuch-pick.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) ;; XXX ATM, as notmuch-search-mode-map is defined here
-
-(eval-when-compile (require 'cl))
-
-(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
-(declare-function notmuch-show "notmuch-show" (&rest args))
-(declare-function notmuch-tag "notmuch" (query &rest tags))
-(declare-function notmuch-show-strip-re "notmuch-show" (subject))
-(declare-function notmuch-show-spaces-n "notmuch-show" (n))
-(declare-function notmuch-read-query "notmuch" (prompt))
-(declare-function notmuch-read-tag-changes "notmuch" (current-tags &optional prompt initial-input))
-(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
-(declare-function notmuch-hello-trim "notmuch-hello" (search))
-(declare-function notmuch-search-find-thread-id "notmuch" ())
-(declare-function notmuch-search-find-subject "notmuch" ())
-
-;; the following variable is defined in notmuch.el
-(defvar notmuch-search-query-string)
-
-(defgroup notmuch-pick nil
-  "Showing message and thread structure."
-  :group 'notmuch)
-
-(defcustom notmuch-pick-show-out nil
-  "View selected messages in new window rather than split-pane."
-  :type 'boolean
-  :group 'notmuch-pick)
-
-(defcustom notmuch-pick-result-format
-  `(("date" . "%12s  ")
-    ("authors" . "%-20s")
-    ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
-    ("tags" . "(%s)"))
-  "Result formatting for Pick. 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-pick-result-format \(\(\"authors\" . \"%-40s\"\)
-                                             \(\"subject\" . \"%s\"\)\)\)"
-  :type '(alist :key-type (string) :value-type (string))
-  :group 'notmuch-pick)
-
-;; Faces for messages that match the query.
-(defface notmuch-pick-match-date-face
-  '((t :inherit default))
-  "Face used in pick mode for the date in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-match-author-face
-  '((((class color)
-      (background dark))
-     (:foreground "OliveDrab1"))
-    (((class color)
-      (background light))
-     (:foreground "dark blue"))
-    (t
-     (:bold t)))
-  "Face used in pick mode for the date in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-match-subject-face
-  '((t :inherit default))
-  "Face used in pick mode for the subject in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-match-tree-face
-  '((t :inherit default))
-  "Face used in pick mode for the thread tree block graphics in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-match-tag-face
-  '((((class color)
-      (background dark))
-     (:foreground "OliveDrab1"))
-    (((class color)
-      (background light))
-     (:foreground "navy blue" :bold t))
-    (t
-     (:bold t)))
-  "Face used in pick mode for tags in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-;; Faces for messages that do not match the query.
-(defface notmuch-pick-no-match-date-face
-  '((t (:foreground "gray")))
-  "Face used in pick mode for non-matching dates."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-no-match-subject-face
-  '((t (:foreground "gray")))
-  "Face used in pick mode for non-matching subjects."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-no-match-tree-face
-  '((t (:foreground "gray")))
-  "Face used in pick mode for the thread tree block graphics in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-no-match-author-face
-  '((t (:foreground "gray")))
-  "Face used in pick mode for the date in messages matching the query."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defface notmuch-pick-no-match-tag-face
-  '((t (:foreground "gray")))
-  "Face used in pick mode face for non-matching tags."
-  :group 'notmuch-pick
-  :group 'notmuch-faces)
-
-(defvar notmuch-pick-previous-subject
-  "The subject of the most recent result shown during the async display")
-(make-variable-buffer-local 'notmuch-pick-previous-subject)
-
-(defvar notmuch-pick-basic-query nil
-  "A buffer local copy of argument query to the function notmuch-pick")
-(make-variable-buffer-local 'notmuch-pick-basic-query)
-
-(defvar notmuch-pick-query-context nil
-  "A buffer local copy of argument query-context to the function notmuch-pick")
-(make-variable-buffer-local 'notmuch-pick-query-context)
-
-(defvar notmuch-pick-target-msg nil
-  "A buffer local copy of argument target to the function notmuch-pick")
-(make-variable-buffer-local 'notmuch-pick-target-msg)
-
-(defvar notmuch-pick-open-target nil
-  "A buffer local copy of argument open-target to the function notmuch-pick")
-(make-variable-buffer-local 'notmuch-pick-open-target)
-
-(defvar notmuch-pick-message-window nil
-  "The window of the message pane.
-
-It is set in both the pick buffer and the child show buffer. It
-is used to try and close the message pane when quitting pick or
-the child show buffer.")
-(make-variable-buffer-local 'notmuch-pick-message-window)
-(put 'notmuch-pick-message-window 'permanent-local t)
-
-(defvar notmuch-pick-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-pick-message-buffer)
-(put 'notmuch-pick-message-buffer 'permanent-local t)
-
-(defun notmuch-pick-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-pick-message-window)
-       (with-selected-window notmuch-pick-message-window
-	 (call-interactively #',func)))))
-
-(defun notmuch-pick-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-pick-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-pick-close-message-window)
-     (call-interactively #',func)))
-
-(defvar notmuch-pick-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-pick-close-message-pane-and #'notmuch-help))
-    ;; Override because we first close message pane and then close pick buffer.
-    (define-key map "q" 'notmuch-pick-quit)
-    ;; Override because we close message pane after the search query is entered.
-    (define-key map "s" 'notmuch-pick-to-search)
-    ;; Override because we want to close message pane first.
-    (define-key map "m" (notmuch-pick-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-pick-to-message-pane #'notmuch-show-previous-button))
-    (define-key map (kbd "<backtab>")  (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
-    (define-key map (kbd "TAB") (notmuch-pick-to-message-pane #'notmuch-show-next-button))
-    (define-key map "e" (notmuch-pick-to-message-pane #'notmuch-pick-button-activate))
-
-    ;; bindings from show (or elsewhere) but we close the message pane first.
-    (define-key map "f" (notmuch-pick-close-message-pane-and #'notmuch-show-forward-message))
-    (define-key map "r" (notmuch-pick-close-message-pane-and #'notmuch-show-reply-sender))
-    (define-key map "R" (notmuch-pick-close-message-pane-and #'notmuch-show-reply))
-    (define-key map "V" (notmuch-pick-close-message-pane-and #'notmuch-show-view-raw-message))
-
-    ;; The main pick bindings
-    (define-key map (kbd "RET") 'notmuch-pick-show-message)
-    (define-key map [mouse-1] 'notmuch-pick-show-message)
-    (define-key map "x" 'notmuch-pick-quit)
-    (define-key map "A" 'notmuch-pick-archive-thread)
-    (define-key map "a" 'notmuch-pick-archive-message-then-next)
-    (define-key map "=" 'notmuch-pick-refresh-view)
-    (define-key map "z" 'notmuch-pick-to-pick)
-    (define-key map "n" 'notmuch-pick-next-matching-message)
-    (define-key map "p" 'notmuch-pick-prev-matching-message)
-    (define-key map "N" 'notmuch-pick-next-message)
-    (define-key map "P" 'notmuch-pick-prev-message)
-    (define-key map (kbd "M-p") 'notmuch-pick-prev-thread)
-    (define-key map (kbd "M-n") 'notmuch-pick-next-thread)
-    (define-key map "-" 'notmuch-pick-remove-tag)
-    (define-key map "+" 'notmuch-pick-add-tag)
-    (define-key map "*" 'notmuch-pick-tag-thread)
-    (define-key map " " 'notmuch-pick-scroll-or-next)
-    (define-key map "b" 'notmuch-pick-scroll-message-window-back)
-    map))
-(fset 'notmuch-pick-mode-map notmuch-pick-mode-map)
-
-(defun notmuch-pick-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 pick overridden version of notmuch-show-get-prop
-
-It gets property PROP from PROPS or, if PROPS is nil, the current
-message in either pick or show. This means that several functions
-in notmuch-show now work unchanged in pick 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-pick-mode)
-			  (notmuch-pick-get-message-properties))))))
-    (plist-get props prop)))
-
-(defun notmuch-pick-set-message-properties (props)
-  (save-excursion
-    (beginning-of-line)
-    (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
-
-(defun notmuch-pick-set-prop (prop val &optional props)
-  (let ((inhibit-read-only t)
-	(props (or props
-		   (notmuch-pick-get-message-properties))))
-    (plist-put props prop val)
-    (notmuch-pick-set-message-properties props)))
-
-(defun notmuch-pick-get-prop (prop &optional props)
-  (let ((props (or props
-		   (notmuch-pick-get-message-properties))))
-    (plist-get props prop)))
-
-(defun notmuch-pick-set-tags (tags)
-  "Set the tags of the current message."
-  (notmuch-pick-set-prop :tags tags))
-
-(defun notmuch-pick-get-tags ()
-  "Return the tags of the current message."
-  (notmuch-pick-get-prop :tags))
-
-(defun notmuch-pick-get-message-id ()
-  "Return the message id of the current message."
-  (let ((id (notmuch-pick-get-prop :id)))
-    (if id
-	(notmuch-id-to-query id)
-      nil)))
-
-(defun notmuch-pick-get-match ()
-  "Return whether the current message is a match."
-  (interactive)
-  (notmuch-pick-get-prop :match))
-
-(defun notmuch-pick-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-pick-get-message-properties))
-	(inhibit-read-only t))
-    (beginning-of-line)
-    ;; This is a little tricky: we override
-    ;; notmuch-pick-previous-subject to get the decision between
-    ;; ... and a subject right and it stops notmuch-pick-insert-msg
-    ;; from overwriting the buffer local copy of
-    ;; notmuch-pick-previous-subject if this is called while the
-    ;; buffer is displaying.
-    (let ((notmuch-pick-previous-subject (notmuch-pick-get-prop :previous-subject)))
-      (delete-region (point) (1+ (line-end-position)))
-      (notmuch-pick-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-pick-tag-update-display (&optional tag-changes)
-  "Update display for TAG-CHANGES to current message.
-
-Does NOT change the database."
-  (let* ((current-tags (notmuch-pick-get-tags))
-	 (new-tags (notmuch-update-tags current-tags tag-changes)))
-    (unless (equal current-tags new-tags)
-      (notmuch-pick-set-tags new-tags)
-      (notmuch-pick-refresh-result))))
-
-(defun notmuch-pick-tag (tag-changes)
-  "Change tags for the current message"
-  (interactive
-   (list (notmuch-read-tag-changes (notmuch-pick-get-tags) "Tag message")))
-  (notmuch-tag (notmuch-pick-get-message-id) tag-changes)
-  (notmuch-pick-tag-update-display tag-changes))
-
-(defun notmuch-pick-add-tag (tag-changes)
-  "Same as `notmuch-pick-tag' but sets initial input to '+'."
-  (interactive
-   (list (notmuch-read-tag-changes (notmuch-pick-get-tags) "Tag message" "+")))
-  (notmuch-pick-tag tag-changes))
-
-(defun notmuch-pick-remove-tag (tag-changes)
-  "Same as `notmuch-pick-tag' but sets initial input to '-'."
-  (interactive
-   (list (notmuch-read-tag-changes (notmuch-pick-get-tags) "Tag message" "-")))
-  (notmuch-pick-tag tag-changes))
-
-;; The next two functions close the message window before searching or
-;; picking 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-pick-to-search ()
-  "Run \"notmuch search\" with the given `query' and display results."
-  (interactive)
-  (let ((query (notmuch-read-query "Notmuch search: ")))
-    (notmuch-pick-close-message-window)
-    (notmuch-search query)))
-
-(defun notmuch-pick-to-pick ()
-  "Run a query and display results in experimental notmuch-pick mode"
-  (interactive)
-  (let ((query (notmuch-read-query "Notmuch pick: ")))
-    (notmuch-pick-close-message-window)
-    (notmuch-pick query)))
-
-;; This function should be in notmuch-show.el but be we trying to
-;; minimise impact on the rest of the codebase.
-(defun notmuch-pick-from-show-current-query ()
-  "Call notmuch pick with the current query"
-  (interactive)
-  (notmuch-pick 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-pick-from-search-current-query ()
-  "Call notmuch pick with the current query"
-  (interactive)
-  (notmuch-pick 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-pick-from-search-thread ()
-  "Show the selected thread with notmuch-pick"
-  (interactive)
-  (notmuch-pick (notmuch-search-find-thread-id)
-                notmuch-search-query-string
-		nil
-                (notmuch-prettify-subject (notmuch-search-find-subject))
-		t))
-
-(defun notmuch-pick-message-window-kill-hook ()
-  "Close the message pane when exiting the show buffer."
-  (let ((buffer (current-buffer)))
-    (when (and (window-live-p notmuch-pick-message-window)
-	       (eq (window-buffer notmuch-pick-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-pick-message-window)))))
-
-(defun notmuch-pick-show-message-in ()
-  "Show the current message (in split-pane)."
-  (interactive)
-  (let ((id (notmuch-pick-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-pick-close-message-window)
-      (setq notmuch-pick-message-window
-	    (split-window-vertically (/ (window-height) 4)))
-      (with-selected-window notmuch-pick-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-pick-message-window is buffer local.
-      (let ((window notmuch-pick-message-window))
-	(with-current-buffer buffer
-	  (setq notmuch-pick-message-window window)
-	  (add-hook 'kill-buffer-hook 'notmuch-pick-message-window-kill-hook)))
-      (when notmuch-show-mark-read-tags
-	(notmuch-pick-tag-update-display notmuch-show-mark-read-tags))
-      (setq notmuch-pick-message-buffer buffer))))
-
-(defun notmuch-pick-show-message-out ()
-  "Show the current message (in whole window)."
-  (interactive)
-  (let ((id (notmuch-pick-get-message-id))
-	(inhibit-read-only t)
-	buffer)
-    (when id
-      ;; We close the window to kill off un-needed buffers.
-      (notmuch-pick-close-message-window)
-      (notmuch-show id))))
-
-(defun notmuch-pick-show-message (arg)
-  "Show the current message.
-
-Shows in split pane or whole window according to value of
-`notmuch-pick-show-out'. A prefix argument reverses the choice."
-  (interactive "P")
-  (if (or (and notmuch-pick-show-out  (not arg))
-	  (and (not notmuch-pick-show-out) arg))
-      (notmuch-pick-show-message-out)
-    (notmuch-pick-show-message-in)))
-
-(defun notmuch-pick-scroll-message-window ()
-  "Scroll the message window (if it exists)"
-  (interactive)
-  (when (window-live-p notmuch-pick-message-window)
-    (with-selected-window notmuch-pick-message-window
-      (if (pos-visible-in-window-p (point-max))
-	  t
-	(scroll-up)))))
-
-(defun notmuch-pick-scroll-message-window-back ()
-  "Scroll the message window back(if it exists)"
-  (interactive)
-  (when (window-live-p notmuch-pick-message-window)
-    (with-selected-window notmuch-pick-message-window
-      (if (pos-visible-in-window-p (point-min))
-	  t
-	(scroll-down)))))
-
-(defun notmuch-pick-scroll-or-next ()
-  "Scroll the message window. If it at end go to next message."
-  (interactive)
-  (when (notmuch-pick-scroll-message-window)
-    (notmuch-pick-next-matching-message)))
-
-(defun notmuch-pick-quit ()
-  "Close the split view or exit pick."
-  (interactive)
-  (unless (notmuch-pick-close-message-window)
-    (kill-buffer (current-buffer))))
-
-(defun notmuch-pick-close-message-window ()
-  "Close the message-window. Return t if close succeeds."
-  (interactive)
-  (when (and (window-live-p notmuch-pick-message-window)
-	     (eq (window-buffer notmuch-pick-message-window) notmuch-pick-message-buffer))
-    (delete-window notmuch-pick-message-window)
-    (unless (get-buffer-window-list notmuch-pick-message-buffer)
-      (kill-buffer notmuch-pick-message-buffer))
-    t))
-
-(defun notmuch-pick-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-pick-tag (notmuch-tag-change-list notmuch-archive-tags unarchive))))
-
-(defun notmuch-pick-archive-message-then-next (&optional unarchive)
-  "Archive the current message and move to next matching message."
-  (interactive "P")
-  (notmuch-pick-archive-message unarchive)
-  (notmuch-pick-next-matching-message))
-
-(defun notmuch-pick-next-message ()
-  "Move to next message."
-  (interactive)
-  (forward-line)
-  (when (window-live-p notmuch-pick-message-window)
-    (notmuch-pick-show-message-in)))
-
-(defun notmuch-pick-prev-message ()
-  "Move to previous message."
-  (interactive)
-  (forward-line -1)
-  (when (window-live-p notmuch-pick-message-window)
-    (notmuch-pick-show-message-in)))
-
-(defun notmuch-pick-prev-matching-message ()
-  "Move to previous matching message."
-  (interactive)
-  (forward-line -1)
-  (while (and (not (bobp)) (not (notmuch-pick-get-match)))
-    (forward-line -1))
-  (when (window-live-p notmuch-pick-message-window)
-    (notmuch-pick-show-message-in)))
-
-(defun notmuch-pick-next-matching-message ()
-  "Move to next matching message."
-  (interactive)
-  (forward-line)
-  (while (and (not (eobp)) (not (notmuch-pick-get-match)))
-    (forward-line))
-  (when (window-live-p notmuch-pick-message-window)
-    (notmuch-pick-show-message-in)))
-
-(defun notmuch-pick-refresh-view ()
-  "Refresh view."
-  (interactive)
-  (let ((inhibit-read-only t)
-	(basic-query notmuch-pick-basic-query)
-	(query-context notmuch-pick-query-context)
-	(target (notmuch-pick-get-message-id)))
-    (erase-buffer)
-    (notmuch-pick-worker basic-query
-			 query-context
-			 target)))
-
-(defun notmuch-pick-thread-top ()
-  (when (notmuch-pick-get-message-properties)
-    (while (not (or (notmuch-pick-get-prop :first) (eobp)))
-      (forward-line -1))))
-
-(defun notmuch-pick-prev-thread ()
-  (interactive)
-  (forward-line -1)
-  (notmuch-pick-thread-top))
-
-(defun notmuch-pick-next-thread ()
-  (interactive)
-  (forward-line 1)
-  (while (not (or (notmuch-pick-get-prop :first) (eobp)))
-    (forward-line 1)))
-
-(defun notmuch-pick-thread-mapcar (function)
-  "Iterate through all messages in the current thread
- and call FUNCTION for side effects."
-  (save-excursion
-    (notmuch-pick-thread-top)
-    (loop collect (funcall function)
-	  do (forward-line)
-	  while (and (notmuch-pick-get-message-properties)
-		     (not (notmuch-pick-get-prop :first))))))
-
-(defun notmuch-pick-get-messages-ids-thread-search ()
-  "Return a search string for all message ids of messages in the current thread."
-  (mapconcat 'identity
-	     (notmuch-pick-thread-mapcar 'notmuch-pick-get-message-id)
-	     " or "))
-
-(defun notmuch-pick-tag-thread (tag-changes)
-  "Tag all messages in the current thread"
-  (interactive
-   (let ((tags (apply #'append (notmuch-pick-thread-mapcar
-				(lambda () (notmuch-pick-get-tags))))))
-     (list (notmuch-read-tag-changes tags "Tag thread"))))
-  (when (notmuch-pick-get-message-properties)
-    (notmuch-tag (notmuch-pick-get-messages-ids-thread-search) tag-changes)
-    (notmuch-pick-thread-mapcar
-     (lambda () (notmuch-pick-tag-update-display tag-changes)))))
-
-(defun notmuch-pick-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-pick-tag-thread
-     (notmuch-tag-change-list notmuch-archive-tags unarchive))))
-
-;; Functions below here display the pick buffer itself.
-
-(defun notmuch-pick-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-pick-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-pick-format-field-list field msg)))
-
-     ((string-equal field "date")
-      (let ((face (if match
-		      'notmuch-pick-match-date-face
-		    'notmuch-pick-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-pick-match-tree-face
-		    'notmuch-pick-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-pick-previous-subject)
-	    (face (if match
-		      'notmuch-pick-match-subject-face
-		    'notmuch-pick-no-match-subject-face)))
-
-	(setq notmuch-pick-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-pick-clean-address (plist-get headers :From)))
-	    (len (length (format format-string "")))
-	    (face (if match
-		      'notmuch-pick-match-author-face
-		    'notmuch-pick-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-pick-match-tag-face
-		    'notmuch-pick-no-match-tag-face)))
-	(propertize (format format-string
-			    (mapconcat #'identity tags ", "))
-		    'face face))))))
-
-
-(defun notmuch-pick-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-pick-format-field (car spec) (cdr spec) msg)))
-	(setq result-string (concat result-string field-string))))))
-
-(defun notmuch-pick-insert-msg (msg)
-  "Insert the message MSG according to notmuch-pick-result-format"
-  ;; We need to save the previous subject as it will get overwritten
-  ;; by the insert-field calls.
-  (let ((previous-subject notmuch-pick-previous-subject))
-    (insert (notmuch-pick-format-field-list notmuch-pick-result-format msg))
-    (notmuch-pick-set-message-properties msg)
-    (notmuch-pick-set-prop :previous-subject previous-subject)
-    (insert "\n")))
-
-(defun notmuch-pick-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-pick-insert-msg msg))
-  (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
-	(target notmuch-pick-target-msg))
-    (when (or (and (not target) (plist-get msg :match))
-	      (string= msg-id target))
-      (setq notmuch-pick-target-msg "found")
-      (goto-char (point-max))
-      (forward-line -1)
-      (when notmuch-pick-open-target
-	(notmuch-pick-show-message-in)))))
-
-(defun notmuch-pick-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-pick-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-pick-insert-thread replies (1+ depth) tree-status)))
-
-(defun notmuch-pick-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-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
-
-(defun notmuch-pick-insert-forest-thread (forest-thread)
-  "Insert a single complete thread."
-  (let (tree-status)
-    ;; Reset at the start of each main thread.
-    (setq notmuch-pick-previous-subject nil)
-    (notmuch-pick-insert-thread forest-thread 0 tree-status)))
-
-(defun notmuch-pick-insert-forest (forest)
-  "Insert a forest of threads.
-
-This function inserts a collection of several complete threads as
-passed to it by notmuch-pick-process-filter."
-  (mapc 'notmuch-pick-insert-forest-thread forest))
-
-(defun notmuch-pick-mode ()
-  "Major mode displaying messages (as opposed to threads) of of a notmuch search.
-
-This buffer contains the results of a \"notmuch pick\" 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-pick-show-message] on any line displays that message.
-
-Complete list of currently available key bindings:
-
-\\{notmuch-pick-mode-map}"
-
-  (interactive)
-  (kill-all-local-variables)
-  (setq notmuch-buffer-refresh-function #'notmuch-pick-refresh-view)
-  (use-local-map notmuch-pick-mode-map)
-  (setq major-mode 'notmuch-pick-mode
-	mode-name "notmuch-pick")
-  (hl-line-mode 1)
-  (setq buffer-read-only t
-	truncate-lines t))
-
-(defun notmuch-pick-process-sentinel (proc msg)
-  "Add a message to let user know when \"notmuch pick\" 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 (pick 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-pick-process-filter (proc string)
-  "Process and filter the output of \"notmuch show\" (for pick)"
-  (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-pick-insert-forest-thread
-					 results-buf)))))
-
-(defun notmuch-pick-worker (basic-query &optional query-context target open-target)
-  "Insert the actual pick search in the current buffer.
-
-This is is a helper function for notmuch-pick. The arguments are
-the same as for the function notmuch-pick."
-  (interactive)
-  (notmuch-pick-mode)
-  (setq notmuch-pick-basic-query basic-query)
-  (setq notmuch-pick-query-context query-context)
-  (setq notmuch-pick-target-msg target)
-  (setq notmuch-pick-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-pick" (current-buffer) #'notmuch-pick-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 pick parse*")))
-      (process-put proc 'parse-buf parse-buf)
-      (set-process-filter proc 'notmuch-pick-process-filter)
-      (set-process-query-on-exit-flag proc nil))))
-
-(defun notmuch-pick (&optional query query-context target buffer-name open-target)
-  "Run notmuch pick with the given `query' and display the results.
-
-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 pick results.
-  BUFFER-NAME: the name of the buffer to show the pick tree. If
-      it is nil \"*notmuch-pick\" 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 pick: ")))
-  (let ((buffer (get-buffer-create (generate-new-buffer-name
-				    (or buffer-name
-					(concat "*notmuch-pick-" query "*")))))
-	(inhibit-read-only t))
-
-    (switch-to-buffer buffer))
-  ;; Don't track undo information for this buffer
-  (set 'buffer-undo-list t)
-
-  (notmuch-pick-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-pick)
-(define-key notmuch-search-mode-map "Z" 'notmuch-pick-from-search-current-query)
-(define-key notmuch-show-mode-map "Z" 'notmuch-pick-from-show-current-query)
-(message "Initialised notmuch-pick")
-
-(provide 'notmuch-pick)
diff --git a/contrib/notmuch-pick/notmuch-tree.el b/contrib/notmuch-pick/notmuch-tree.el
new file mode 100644
index 0000000..512589f
--- /dev/null
+++ b/contrib/notmuch-pick/notmuch-tree.el
@@ -0,0 +1,951 @@
+;; 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) ;; XXX ATM, as notmuch-search-mode-map is defined here
+
+(eval-when-compile (require 'cl))
+
+(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
+(declare-function notmuch-show "notmuch-show" (&rest args))
+(declare-function notmuch-tag "notmuch" (query &rest tags))
+(declare-function notmuch-show-strip-re "notmuch-show" (subject))
+(declare-function notmuch-show-spaces-n "notmuch-show" (n))
+(declare-function notmuch-read-query "notmuch" (prompt))
+(declare-function notmuch-read-tag-changes "notmuch" (current-tags &optional prompt initial-input))
+(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
+(declare-function notmuch-hello-trim "notmuch-hello" (search))
+(declare-function notmuch-search-find-thread-id "notmuch" ())
+(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/contrib/notmuch-pick/test/emacs-pick b/contrib/notmuch-pick/test/emacs-pick
index 40b0738..fae6e9e 100755
--- a/contrib/notmuch-pick/test/emacs-pick
+++ b/contrib/notmuch-pick/test/emacs-pick
@@ -16,8 +16,8 @@ test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Basic notmuch-pick view in emacs"
 test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-	    (require (quote notmuch-pick))
-	    (notmuch-pick "tag:inbox")
+	    (require (quote notmuch-tree))
+	    (notmuch-tree "tag:inbox")
 	    (notmuch-test-wait)
 	    (test-output)
 	    (delete-other-windows)'
@@ -25,10 +25,10 @@ test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-tag-inbox
 
 test_begin_subtest "Refreshed notmuch-pick view in emacs"
 test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-	    (require (quote notmuch-pick))
-	    (notmuch-pick "tag:inbox")
+	    (require (quote notmuch-tree))
+	    (notmuch-tree "tag:inbox")
 	    (notmuch-test-wait)
-	    (notmuch-pick-refresh-view)
+	    (notmuch-tree-refresh-view)
 	    (notmuch-test-wait)
 	    (test-output)
 	    (delete-other-windows)'
@@ -40,11 +40,11 @@ test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-tag-inbox
 
 test_begin_subtest "Tag message in notmuch pick view (display)"
 test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-	    (require (quote notmuch-pick))
-	    (notmuch-pick "tag:inbox")
+	    (require (quote notmuch-tree))
+	    (notmuch-tree "tag:inbox")
 	    (notmuch-test-wait)
 	    (forward-line)
-	    (notmuch-pick-tag (list "+test_tag"))
+	    (notmuch-tree-tag (list "+test_tag"))
 	    (test-output)
 	    (delete-other-windows)'
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-tag-inbox-tagged
@@ -55,11 +55,11 @@ test_expect_equal "$output" "id:877h1wv7mg.fsf at inf-8657.int-evry.fr"
 
 test_begin_subtest "Untag message in notmuch pick view"
 test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-	    (require (quote notmuch-pick))
-	    (notmuch-pick "tag:inbox")
+	    (require (quote notmuch-tree))
+	    (notmuch-tree "tag:inbox")
 	    (notmuch-test-wait)
 	    (forward-line)
-	    (notmuch-pick-tag (list "-test_tag"))
+	    (notmuch-tree-tag (list "-test_tag"))
 	    (test-output)
 	    (delete-other-windows)'
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-tag-inbox
@@ -70,12 +70,12 @@ test_expect_equal "$output" ""
 
 test_begin_subtest "Tag thread in notmuch pick view"
 test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-	    (require (quote notmuch-pick))
-	    (notmuch-pick "tag:inbox")
+	    (require (quote notmuch-tree))
+	    (notmuch-tree "tag:inbox")
 	    (notmuch-test-wait)
 	    ;; move to a sizable thread
 	    (forward-line 26)
-	    (notmuch-pick-tag-thread (list "+test_thread_tag"))
+	    (notmuch-tree-tag-thread (list "+test_thread_tag"))
 	    (test-output)
 	    (delete-other-windows)'
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-tag-inbox-thread-tagged
@@ -93,12 +93,12 @@ id:20091117190054.GU3165 at dottiness.seas.harvard.edu"
 
 test_begin_subtest "Untag thread in notmuch pick view"
 test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-	    (require (quote notmuch-pick))
-	    (notmuch-pick "tag:inbox")
+	    (require (quote notmuch-tree))
+	    (notmuch-tree "tag:inbox")
 	    (notmuch-test-wait)
 	    ;; move to the same sizable thread as above
 	    (forward-line 26)
-	    (notmuch-pick-tag-thread (list "-test_thread_tag"))
+	    (notmuch-tree-tag-thread (list "-test_thread_tag"))
 	    (test-output)
 	    (delete-other-windows)'
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-tag-inbox
@@ -113,7 +113,7 @@ test_emacs '(notmuch-hello)
 	    (re-search-forward "inbox")
 	    (widget-button-press (1- (point)))
 	    (notmuch-test-wait)
-	    (notmuch-pick-from-search-current-query)
+	    (notmuch-tree-from-search-current-query)
 	    (notmuch-test-wait)
 	    (test-output)
 	    (delete-other-windows)'
@@ -125,7 +125,7 @@ test_emacs '(notmuch-hello)
 	    (re-search-forward "inbox")
 	    (widget-button-press (1- (point)))
 	    (notmuch-test-wait)
-	    (notmuch-pick-from-search-thread)
+	    (notmuch-tree-from-search-thread)
 	    (notmuch-test-wait)
 	    (test-output)
 	    (delete-other-windows)'
@@ -138,7 +138,7 @@ test_emacs '(notmuch-hello)
 	    (widget-button-press (1- (point)))
 	    (notmuch-test-wait)
 	    (notmuch-search-show-thread)
-	    (notmuch-pick-from-show-current-query)
+	    (notmuch-tree-from-show-current-query)
 	    (notmuch-test-wait)
 	    (test-output)
 	    (delete-other-windows)'
@@ -151,9 +151,9 @@ test_emacs '(notmuch-hello)
 	    (widget-button-press (1- (point)))
 	    (notmuch-test-wait)
 	    (notmuch-search-next-thread)
-	    (notmuch-pick-from-search-thread)
+	    (notmuch-tree-from-search-thread)
 	    (notmuch-test-wait)
-	    (select-window notmuch-pick-message-window)
+	    (select-window notmuch-tree-message-window)
 	    (test-output)
 	    (delete-other-windows)'
 cp OUTPUT /tmp/mjwout
@@ -161,49 +161,49 @@ test_expect_equal_file OUTPUT $EXPECTED/notmuch-pick-show-window
 
 test_begin_subtest "Stash id"
 output=$(test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-		     (require (quote notmuch-pick))
-		     (notmuch-pick "id:1258498485-sup-142 at elly")
+		     (require (quote notmuch-tree))
+		     (notmuch-tree "id:1258498485-sup-142 at elly")
 		     (notmuch-test-wait)
 		     (notmuch-show-stash-message-id)')
 test_expect_equal "$output" "\"Stashed: id:1258498485-sup-142 at elly\""
 
 test_begin_subtest "Move to next matching message"
 output=$(test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-		     (require (quote notmuch-pick))
-		     (notmuch-pick "from:cworth")
+		     (require (quote notmuch-tree))
+		     (notmuch-tree "from:cworth")
 		     (notmuch-test-wait)
-		     (notmuch-pick-next-matching-message)
+		     (notmuch-tree-next-matching-message)
 		     (notmuch-show-stash-message-id)')
 test_expect_equal "$output" "\"Stashed: id:878we4qdqf.fsf at yoom.home.cworth.org\""
 
 test_begin_subtest "Move to next thread"
 output=$(test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-		     (require (quote notmuch-pick))
-		     (notmuch-pick "tag:inbox")
+		     (require (quote notmuch-tree))
+		     (notmuch-tree "tag:inbox")
 		     (notmuch-test-wait)
 		     (forward-line 26)
-		     (notmuch-pick-next-thread)
+		     (notmuch-tree-next-thread)
 		     (notmuch-show-stash-message-id)')
 test_expect_equal "$output" "\"Stashed: id:1258471718-6781-1-git-send-email-dottedmag at dottedmag.net\""
 
 test_begin_subtest "Move to previous thread"
 output=$(test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-		     (require (quote notmuch-pick))
-		     (notmuch-pick "tag:inbox")
+		     (require (quote notmuch-tree))
+		     (notmuch-tree "tag:inbox")
 		     (notmuch-test-wait)
 		     (forward-line 26)
-		     (notmuch-pick-prev-thread)
+		     (notmuch-tree-prev-thread)
 		     (notmuch-show-stash-message-id)')
 test_expect_equal "$output" "\"Stashed: id:20091117190054.GU3165 at dottiness.seas.harvard.edu\""
 
 test_begin_subtest "Move to previous previous thread"
 output=$(test_emacs '(add-to-list (quote load-path) "'$PICK_DIR'")
-		     (require (quote notmuch-pick))
-		     (notmuch-pick "tag:inbox")
+		     (require (quote notmuch-tree))
+		     (notmuch-tree "tag:inbox")
 		     (notmuch-test-wait)
 		     (forward-line 26)
-		     (notmuch-pick-prev-thread)
-		     (notmuch-pick-prev-thread)
+		     (notmuch-tree-prev-thread)
+		     (notmuch-tree-prev-thread)
 		     (notmuch-show-stash-message-id)')
 test_expect_equal "$output" "\"Stashed: id:1258493565-13508-1-git-send-email-keithp at keithp.com\""
 
-- 
1.7.9.1



More information about the notmuch mailing list