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