1 Return-Path: <markwalters1009@gmail.com>
\r
2 X-Original-To: notmuch@notmuchmail.org
\r
3 Delivered-To: notmuch@notmuchmail.org
\r
4 Received: from localhost (localhost [127.0.0.1])
\r
5 by olra.theworths.org (Postfix) with ESMTP id 46CAF429E40
\r
6 for <notmuch@notmuchmail.org>; Tue, 29 Oct 2013 15:56:00 -0700 (PDT)
\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org
\r
11 X-Spam-Status: No, score=0.201 tagged_above=-999 required=5
\r
12 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,
\r
13 FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,
\r
14 RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled
\r
15 Received: from olra.theworths.org ([127.0.0.1])
\r
16 by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)
\r
17 with ESMTP id k1fJ4zQVyPQ6 for <notmuch@notmuchmail.org>;
\r
18 Tue, 29 Oct 2013 15:55:50 -0700 (PDT)
\r
19 Received: from mail-wi0-f171.google.com (mail-wi0-f171.google.com
\r
20 [209.85.212.171]) (using TLSv1 with cipher RC4-SHA (128/128 bits))
\r
21 (No client certificate requested)
\r
22 by olra.theworths.org (Postfix) with ESMTPS id B5D77431FBD
\r
23 for <notmuch@notmuchmail.org>; Tue, 29 Oct 2013 15:55:49 -0700 (PDT)
\r
24 Received: by mail-wi0-f171.google.com with SMTP id f4so2033900wiw.16
\r
25 for <notmuch@notmuchmail.org>; Tue, 29 Oct 2013 15:55:48 -0700 (PDT)
\r
26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;
\r
27 h=from:to:cc:subject:date:message-id:in-reply-to:references
\r
28 :mime-version:content-type:content-transfer-encoding;
\r
29 bh=0MMbTXEGnVVUndWf1ROOPl3xG0QikuQkZXhOy/0iFn4=;
\r
30 b=yIfET+Gfzxc439PLchKz8PperhNk7KXWuUDkbMfbwTOPS/8f7GnO45up1MihCfR0/8
\r
31 nCA/+H3rlU6xAjkduzPkB8tT6hqQlgO3unrIuGnaKDiVeGxmsmXhHRCYfo2Nm1ZgTmVc
\r
32 C4Qg3bNC5vU/YZzoMmNaVdUUxMBzVhfUfh98KqKZb+Kq1jNuDrF7u0BGuaQOROq0gWzT
\r
33 3cZ2QAXr3lOm4utgV4Dow2itaaSdNn1/GPSvmWcIdy/ybaKNr4F1kqLYkbRTkQUwEXYq
\r
34 2ZIwb5BHUo6V5dPjpuTix/DzN8OuAy5mj+a11ZTTbcu8lr3fPJxRZK9bt0sxw85DgeAf
\r
36 X-Received: by 10.180.184.14 with SMTP id eq14mr125072wic.56.1383087348282;
\r
37 Tue, 29 Oct 2013 15:55:48 -0700 (PDT)
\r
38 Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])
\r
39 by mx.google.com with ESMTPSA id dn2sm9509726wid.1.2013.10.29.15.55.46
\r
40 for <multiple recipients>
\r
41 (version=TLSv1.2 cipher=RC4-SHA bits=128/128);
\r
42 Tue, 29 Oct 2013 15:55:47 -0700 (PDT)
\r
43 From: Mark Walters <markwalters1009@gmail.com>
\r
44 To: notmuch@notmuchmail.org
\r
45 Subject: [PATCH 03/11] emacs: move notmuch-tree from contrib to mainline
\r
46 Date: Tue, 29 Oct 2013 22:55:30 +0000
\r
47 Message-Id: <1383087338-10220-4-git-send-email-markwalters1009@gmail.com>
\r
48 X-Mailer: git-send-email 1.7.9.1
\r
49 In-Reply-To: <1383087338-10220-1-git-send-email-markwalters1009@gmail.com>
\r
50 References: <1383087338-10220-1-git-send-email-markwalters1009@gmail.com>
\r
52 Content-Type: text/plain; charset=UTF-8
\r
53 Content-Transfer-Encoding: 8bit
\r
54 X-BeenThere: notmuch@notmuchmail.org
\r
55 X-Mailman-Version: 2.1.13
\r
57 List-Id: "Use and development of the notmuch mail system."
\r
58 <notmuch.notmuchmail.org>
\r
59 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
60 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
61 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
62 List-Post: <mailto:notmuch@notmuchmail.org>
\r
63 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
64 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
65 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
66 X-List-Received-Date: Tue, 29 Oct 2013 22:56:00 -0000
\r
69 contrib/notmuch-pick/notmuch-tree.el | 946 ----------------------------------
\r
70 emacs/notmuch-tree.el | 946 ++++++++++++++++++++++++++++++++++
\r
71 2 files changed, 946 insertions(+), 946 deletions(-)
\r
72 delete mode 100644 contrib/notmuch-pick/notmuch-tree.el
\r
73 create mode 100644 emacs/notmuch-tree.el
\r
75 diff --git a/contrib/notmuch-pick/notmuch-tree.el b/contrib/notmuch-pick/notmuch-tree.el
\r
76 deleted file mode 100644
\r
77 index d3330a0..0000000
\r
78 --- a/contrib/notmuch-pick/notmuch-tree.el
\r
81 -;; notmuch-tree.el --- displaying notmuch forests.
\r
83 -;; Copyright © Carl Worth
\r
84 -;; Copyright © David Edmondson
\r
85 -;; Copyright © Mark Walters
\r
87 -;; This file is part of Notmuch.
\r
89 -;; Notmuch is free software: you can redistribute it and/or modify it
\r
90 -;; under the terms of the GNU General Public License as published by
\r
91 -;; the Free Software Foundation, either version 3 of the License, or
\r
92 -;; (at your option) any later version.
\r
94 -;; Notmuch is distributed in the hope that it will be useful, but
\r
95 -;; WITHOUT ANY WARRANTY; without even the implied warranty of
\r
96 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\r
97 -;; General Public License for more details.
\r
99 -;; You should have received a copy of the GNU General Public License
\r
100 -;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
\r
102 -;; Authors: David Edmondson <dme@dme.org>
\r
103 -;; Mark Walters <markwalters1009@gmail.com>
\r
105 -(require 'mail-parse)
\r
107 -(require 'notmuch-lib)
\r
108 -(require 'notmuch-query)
\r
109 -(require 'notmuch-show)
\r
110 -(require 'notmuch-tag)
\r
111 -(require 'notmuch-parser)
\r
112 -(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
\r
114 -(eval-when-compile (require 'cl))
\r
115 -(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line))
\r
116 -(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
\r
117 -(declare-function notmuch-read-query "notmuch" (prompt))
\r
118 -(declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
\r
119 -(declare-function notmuch-search-find-subject "notmuch" ())
\r
121 -;; the following variable is defined in notmuch.el
\r
122 -(defvar notmuch-search-query-string)
\r
124 -(defgroup notmuch-tree nil
\r
125 - "Showing message and thread structure."
\r
128 -(defcustom notmuch-tree-show-out nil
\r
129 - "View selected messages in new window rather than split-pane."
\r
131 - :group 'notmuch-tree)
\r
133 -(defcustom notmuch-tree-result-format
\r
134 - `(("date" . "%12s ")
\r
135 - ("authors" . "%-20s")
\r
136 - ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
\r
137 - ("tags" . "(%s)"))
\r
138 - "Result formatting for Tree view. Supported fields are: date,
\r
139 - authors, subject, tree, tags. Tree means the thread tree
\r
140 - box graphics. The field may also be a list in which case
\r
141 - the formatting rules are applied recursively and then the
\r
142 - output of all the fields in the list is inserted
\r
143 - according to format-string.
\r
145 -Note the author string should not contain
\r
146 - whitespace (put it in the neighbouring fields instead).
\r
148 - (setq notmuch-tree-result-format \(\(\"authors\" . \"%-40s\"\)
\r
149 - \(\"subject\" . \"%s\"\)\)\)"
\r
150 - :type '(alist :key-type (string) :value-type (string))
\r
151 - :group 'notmuch-tree)
\r
153 -;; Faces for messages that match the query.
\r
154 -(defface notmuch-tree-match-date-face
\r
155 - '((t :inherit default))
\r
156 - "Face used in tree mode for the date in messages matching the query."
\r
157 - :group 'notmuch-tree
\r
158 - :group 'notmuch-faces)
\r
160 -(defface notmuch-tree-match-author-face
\r
161 - '((((class color)
\r
162 - (background dark))
\r
163 - (:foreground "OliveDrab1"))
\r
165 - (background light))
\r
166 - (:foreground "dark blue"))
\r
169 - "Face used in tree mode for the date in messages matching the query."
\r
170 - :group 'notmuch-tree
\r
171 - :group 'notmuch-faces)
\r
173 -(defface notmuch-tree-match-subject-face
\r
174 - '((t :inherit default))
\r
175 - "Face used in tree mode for the subject in messages matching the query."
\r
176 - :group 'notmuch-tree
\r
177 - :group 'notmuch-faces)
\r
179 -(defface notmuch-tree-match-tree-face
\r
180 - '((t :inherit default))
\r
181 - "Face used in tree mode for the thread tree block graphics in messages matching the query."
\r
182 - :group 'notmuch-tree
\r
183 - :group 'notmuch-faces)
\r
185 -(defface notmuch-tree-match-tag-face
\r
186 - '((((class color)
\r
187 - (background dark))
\r
188 - (:foreground "OliveDrab1"))
\r
190 - (background light))
\r
191 - (:foreground "navy blue" :bold t))
\r
194 - "Face used in tree mode for tags in messages matching the query."
\r
195 - :group 'notmuch-tree
\r
196 - :group 'notmuch-faces)
\r
198 -;; Faces for messages that do not match the query.
\r
199 -(defface notmuch-tree-no-match-date-face
\r
200 - '((t (:foreground "gray")))
\r
201 - "Face used in tree mode for non-matching dates."
\r
202 - :group 'notmuch-tree
\r
203 - :group 'notmuch-faces)
\r
205 -(defface notmuch-tree-no-match-subject-face
\r
206 - '((t (:foreground "gray")))
\r
207 - "Face used in tree mode for non-matching subjects."
\r
208 - :group 'notmuch-tree
\r
209 - :group 'notmuch-faces)
\r
211 -(defface notmuch-tree-no-match-tree-face
\r
212 - '((t (:foreground "gray")))
\r
213 - "Face used in tree mode for the thread tree block graphics in messages matching the query."
\r
214 - :group 'notmuch-tree
\r
215 - :group 'notmuch-faces)
\r
217 -(defface notmuch-tree-no-match-author-face
\r
218 - '((t (:foreground "gray")))
\r
219 - "Face used in tree mode for the date in messages matching the query."
\r
220 - :group 'notmuch-tree
\r
221 - :group 'notmuch-faces)
\r
223 -(defface notmuch-tree-no-match-tag-face
\r
224 - '((t (:foreground "gray")))
\r
225 - "Face used in tree mode face for non-matching tags."
\r
226 - :group 'notmuch-tree
\r
227 - :group 'notmuch-faces)
\r
229 -(defvar notmuch-tree-previous-subject
\r
230 - "The subject of the most recent result shown during the async display")
\r
231 -(make-variable-buffer-local 'notmuch-tree-previous-subject)
\r
233 -(defvar notmuch-tree-basic-query nil
\r
234 - "A buffer local copy of argument query to the function notmuch-tree")
\r
235 -(make-variable-buffer-local 'notmuch-tree-basic-query)
\r
237 -(defvar notmuch-tree-query-context nil
\r
238 - "A buffer local copy of argument query-context to the function notmuch-tree")
\r
239 -(make-variable-buffer-local 'notmuch-tree-query-context)
\r
241 -(defvar notmuch-tree-target-msg nil
\r
242 - "A buffer local copy of argument target to the function notmuch-tree")
\r
243 -(make-variable-buffer-local 'notmuch-tree-target-msg)
\r
245 -(defvar notmuch-tree-open-target nil
\r
246 - "A buffer local copy of argument open-target to the function notmuch-tree")
\r
247 -(make-variable-buffer-local 'notmuch-tree-open-target)
\r
249 -(defvar notmuch-tree-message-window nil
\r
250 - "The window of the message pane.
\r
252 -It is set in both the tree buffer and the child show buffer. It
\r
253 -is used to try and close the message pane when quitting tree view
\r
254 -or the child show buffer.")
\r
255 -(make-variable-buffer-local 'notmuch-tree-message-window)
\r
256 -(put 'notmuch-tree-message-window 'permanent-local t)
\r
258 -(defvar notmuch-tree-message-buffer nil
\r
259 - "The buffer name of the show buffer in the message pane.
\r
261 -This is used to try and make sure we don't close the message pane
\r
262 -if the user has loaded a different buffer in that window.")
\r
263 -(make-variable-buffer-local 'notmuch-tree-message-buffer)
\r
264 -(put 'notmuch-tree-message-buffer 'permanent-local t)
\r
266 -(defun notmuch-tree-to-message-pane (func)
\r
267 - "Execute FUNC in message pane.
\r
269 -This function returns a function (so can be used as a keybinding)
\r
270 -which executes function FUNC in the message pane if it is
\r
271 -open (if the message pane is closed it does nothing)."
\r
273 - ,(concat "(In message pane) " (documentation func t))
\r
275 - (when (window-live-p notmuch-tree-message-window)
\r
276 - (with-selected-window notmuch-tree-message-window
\r
277 - (call-interactively #',func)))))
\r
279 -(defun notmuch-tree-button-activate (&optional button)
\r
280 - "Activate BUTTON or button at point
\r
282 -This function does not give an error if there is no button."
\r
284 - (let ((button (or button (button-at (point)))))
\r
285 - (when button (button-activate button))))
\r
287 -(defun notmuch-tree-close-message-pane-and (func)
\r
288 - "Close message pane and execute FUNC.
\r
290 -This function returns a function (so can be used as a keybinding)
\r
291 -which closes the message pane if open and then executes function
\r
294 - ,(concat "(Close message pane and) " (documentation func t))
\r
296 - (notmuch-tree-close-message-window)
\r
297 - (call-interactively #',func)))
\r
299 -(defvar notmuch-tree-mode-map
\r
300 - (let ((map (make-sparse-keymap)))
\r
301 - (set-keymap-parent map notmuch-common-keymap)
\r
302 - ;; The following override the global keymap.
\r
303 - ;; Override because we want to close message pane first.
\r
304 - (define-key map "?" (notmuch-tree-close-message-pane-and #'notmuch-help))
\r
305 - ;; Override because we first close message pane and then close tree buffer.
\r
306 - (define-key map "q" 'notmuch-tree-quit)
\r
307 - ;; Override because we close message pane after the search query is entered.
\r
308 - (define-key map "s" 'notmuch-tree-to-search)
\r
309 - ;; Override because we want to close message pane first.
\r
310 - (define-key map "m" (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
\r
312 - ;; these use notmuch-show functions directly
\r
313 - (define-key map "|" 'notmuch-show-pipe-message)
\r
314 - (define-key map "w" 'notmuch-show-save-attachments)
\r
315 - (define-key map "v" 'notmuch-show-view-all-mime-parts)
\r
316 - (define-key map "c" 'notmuch-show-stash-map)
\r
318 - ;; these apply to the message pane
\r
319 - (define-key map (kbd "M-TAB") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
\r
320 - (define-key map (kbd "<backtab>") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
\r
321 - (define-key map (kbd "TAB") (notmuch-tree-to-message-pane #'notmuch-show-next-button))
\r
322 - (define-key map "e" (notmuch-tree-to-message-pane #'notmuch-tree-button-activate))
\r
324 - ;; bindings from show (or elsewhere) but we close the message pane first.
\r
325 - (define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
\r
326 - (define-key map "r" (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
\r
327 - (define-key map "R" (notmuch-tree-close-message-pane-and #'notmuch-show-reply))
\r
328 - (define-key map "V" (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
\r
330 - ;; The main tree view bindings
\r
331 - (define-key map (kbd "RET") 'notmuch-tree-show-message)
\r
332 - (define-key map [mouse-1] 'notmuch-tree-show-message)
\r
333 - (define-key map "x" 'notmuch-tree-quit)
\r
334 - (define-key map "A" 'notmuch-tree-archive-thread)
\r
335 - (define-key map "a" 'notmuch-tree-archive-message-then-next)
\r
336 - (define-key map "=" 'notmuch-tree-refresh-view)
\r
337 - (define-key map "z" 'notmuch-tree-to-tree)
\r
338 - (define-key map "n" 'notmuch-tree-next-matching-message)
\r
339 - (define-key map "p" 'notmuch-tree-prev-matching-message)
\r
340 - (define-key map "N" 'notmuch-tree-next-message)
\r
341 - (define-key map "P" 'notmuch-tree-prev-message)
\r
342 - (define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
\r
343 - (define-key map (kbd "M-n") 'notmuch-tree-next-thread)
\r
344 - (define-key map "-" 'notmuch-tree-remove-tag)
\r
345 - (define-key map "+" 'notmuch-tree-add-tag)
\r
346 - (define-key map "*" 'notmuch-tree-tag-thread)
\r
347 - (define-key map " " 'notmuch-tree-scroll-or-next)
\r
348 - (define-key map "b" 'notmuch-tree-scroll-message-window-back)
\r
350 -(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
\r
352 -(defun notmuch-tree-get-message-properties ()
\r
353 - "Return the properties of the current message as a plist.
\r
355 -Some useful entries are:
\r
356 -:headers - Property list containing the headers :Date, :Subject, :From, etc.
\r
357 -:tags - Tags for this message"
\r
359 - (beginning-of-line)
\r
360 - (get-text-property (point) :notmuch-message-properties)))
\r
362 -;; XXX This should really be a lib function but we are trying to
\r
363 -;; reduce impact on the code base.
\r
364 -(defun notmuch-show-get-prop (prop &optional props)
\r
365 - "This is a tree view overridden version of notmuch-show-get-prop
\r
367 -It gets property PROP from PROPS or, if PROPS is nil, the current
\r
368 -message in either tree or show. This means that several functions
\r
369 -in notmuch-show now work unchanged in tree as they just need the
\r
370 -correct message properties."
\r
371 - (let ((props (or props
\r
372 - (cond ((eq major-mode 'notmuch-show-mode)
\r
373 - (notmuch-show-get-message-properties))
\r
374 - ((eq major-mode 'notmuch-tree-mode)
\r
375 - (notmuch-tree-get-message-properties))))))
\r
376 - (plist-get props prop)))
\r
378 -(defun notmuch-tree-set-message-properties (props)
\r
380 - (beginning-of-line)
\r
381 - (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
\r
383 -(defun notmuch-tree-set-prop (prop val &optional props)
\r
384 - (let ((inhibit-read-only t)
\r
386 - (notmuch-tree-get-message-properties))))
\r
387 - (plist-put props prop val)
\r
388 - (notmuch-tree-set-message-properties props)))
\r
390 -(defun notmuch-tree-get-prop (prop &optional props)
\r
391 - (let ((props (or props
\r
392 - (notmuch-tree-get-message-properties))))
\r
393 - (plist-get props prop)))
\r
395 -(defun notmuch-tree-set-tags (tags)
\r
396 - "Set the tags of the current message."
\r
397 - (notmuch-tree-set-prop :tags tags))
\r
399 -(defun notmuch-tree-get-tags ()
\r
400 - "Return the tags of the current message."
\r
401 - (notmuch-tree-get-prop :tags))
\r
403 -(defun notmuch-tree-get-message-id ()
\r
404 - "Return the message id of the current message."
\r
405 - (let ((id (notmuch-tree-get-prop :id)))
\r
407 - (notmuch-id-to-query id)
\r
410 -(defun notmuch-tree-get-match ()
\r
411 - "Return whether the current message is a match."
\r
413 - (notmuch-tree-get-prop :match))
\r
415 -(defun notmuch-tree-refresh-result ()
\r
416 - "Redisplay the current message line.
\r
418 -This redisplays the current line based on the messages
\r
419 -properties (as they are now). This is used when tags are
\r
421 - (let ((init-point (point))
\r
422 - (end (line-end-position))
\r
423 - (msg (notmuch-tree-get-message-properties))
\r
424 - (inhibit-read-only t))
\r
425 - (beginning-of-line)
\r
426 - ;; This is a little tricky: we override
\r
427 - ;; notmuch-tree-previous-subject to get the decision between
\r
428 - ;; ... and a subject right and it stops notmuch-tree-insert-msg
\r
429 - ;; from overwriting the buffer local copy of
\r
430 - ;; notmuch-tree-previous-subject if this is called while the
\r
431 - ;; buffer is displaying.
\r
432 - (let ((notmuch-tree-previous-subject (notmuch-tree-get-prop :previous-subject)))
\r
433 - (delete-region (point) (1+ (line-end-position)))
\r
434 - (notmuch-tree-insert-msg msg))
\r
435 - (let ((new-end (line-end-position)))
\r
436 - (goto-char (if (= init-point end)
\r
438 - (min init-point (- new-end 1)))))))
\r
440 -(defun notmuch-tree-tag-update-display (&optional tag-changes)
\r
441 - "Update display for TAG-CHANGES to current message.
\r
443 -Does NOT change the database."
\r
444 - (let* ((current-tags (notmuch-tree-get-tags))
\r
445 - (new-tags (notmuch-update-tags current-tags tag-changes)))
\r
446 - (unless (equal current-tags new-tags)
\r
447 - (notmuch-tree-set-tags new-tags)
\r
448 - (notmuch-tree-refresh-result))))
\r
450 -(defun notmuch-tree-tag (tag-changes)
\r
451 - "Change tags for the current message"
\r
453 - (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message")))
\r
454 - (notmuch-tag (notmuch-tree-get-message-id) tag-changes)
\r
455 - (notmuch-tree-tag-update-display tag-changes))
\r
457 -(defun notmuch-tree-add-tag (tag-changes)
\r
458 - "Same as `notmuch-tree-tag' but sets initial input to '+'."
\r
460 - (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "+")))
\r
461 - (notmuch-tree-tag tag-changes))
\r
463 -(defun notmuch-tree-remove-tag (tag-changes)
\r
464 - "Same as `notmuch-tree-tag' but sets initial input to '-'."
\r
466 - (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-")))
\r
467 - (notmuch-tree-tag tag-changes))
\r
469 -;; The next two functions close the message window before calling
\r
470 -;; notmuch-search or notmuch-tree but they do so after the user has
\r
471 -;; entered the query (in case the user was basing the query on
\r
472 -;; something in the message window).
\r
474 -(defun notmuch-tree-to-search ()
\r
475 - "Run \"notmuch search\" with the given `query' and display results."
\r
477 - (let ((query (notmuch-read-query "Notmuch search: ")))
\r
478 - (notmuch-tree-close-message-window)
\r
479 - (notmuch-search query)))
\r
481 -(defun notmuch-tree-to-tree ()
\r
482 - "Run a query and display results in Tree view"
\r
484 - (let ((query (notmuch-read-query "Notmuch tree view search: ")))
\r
485 - (notmuch-tree-close-message-window)
\r
486 - (notmuch-tree query)))
\r
488 -;; This function should be in notmuch-show.el but be we trying to
\r
489 -;; minimise impact on the rest of the codebase.
\r
490 -(defun notmuch-tree-from-show-current-query ()
\r
491 - "Call notmuch tree with the current query"
\r
493 - (notmuch-tree notmuch-show-thread-id
\r
494 - notmuch-show-query-context
\r
495 - (notmuch-show-get-message-id)))
\r
497 -;; This function should be in notmuch.el but be we trying to minimise
\r
498 -;; impact on the rest of the codebase.
\r
499 -(defun notmuch-tree-from-search-current-query ()
\r
500 - "Call notmuch tree with the current query"
\r
502 - (notmuch-tree notmuch-search-query-string))
\r
504 -;; This function should be in notmuch.el but be we trying to minimise
\r
505 -;; impact on the rest of the codebase.
\r
506 -(defun notmuch-tree-from-search-thread ()
\r
507 - "Show the selected thread with notmuch-tree"
\r
509 - (notmuch-tree (notmuch-search-find-thread-id)
\r
510 - notmuch-search-query-string
\r
512 - (notmuch-prettify-subject (notmuch-search-find-subject))
\r
515 -(defun notmuch-tree-message-window-kill-hook ()
\r
516 - "Close the message pane when exiting the show buffer."
\r
517 - (let ((buffer (current-buffer)))
\r
518 - (when (and (window-live-p notmuch-tree-message-window)
\r
519 - (eq (window-buffer notmuch-tree-message-window) buffer))
\r
520 - ;; We do not want an error if this is the sole window in the
\r
521 - ;; frame and I do not know how to test for that in emacs pre
\r
522 - ;; 24. Hence we just ignore-errors.
\r
524 - (delete-window notmuch-tree-message-window)))))
\r
526 -(defun notmuch-tree-show-message-in ()
\r
527 - "Show the current message (in split-pane)."
\r
529 - (let ((id (notmuch-tree-get-message-id))
\r
530 - (inhibit-read-only t)
\r
533 - ;; We close and reopen the window to kill off un-needed buffers
\r
534 - ;; this might cause flickering but seems ok.
\r
535 - (notmuch-tree-close-message-window)
\r
536 - (setq notmuch-tree-message-window
\r
537 - (split-window-vertically (/ (window-height) 4)))
\r
538 - (with-selected-window notmuch-tree-message-window
\r
539 - ;; Since we are only displaying one message do not indent.
\r
540 - (let ((notmuch-show-indent-messages-width 0)
\r
541 - (notmuch-show-only-matching-messages t))
\r
542 - (setq buffer (notmuch-show id))))
\r
543 - ;; We need the `let' as notmuch-tree-message-window is buffer local.
\r
544 - (let ((window notmuch-tree-message-window))
\r
545 - (with-current-buffer buffer
\r
546 - (setq notmuch-tree-message-window window)
\r
547 - (add-hook 'kill-buffer-hook 'notmuch-tree-message-window-kill-hook)))
\r
548 - (when notmuch-show-mark-read-tags
\r
549 - (notmuch-tree-tag-update-display notmuch-show-mark-read-tags))
\r
550 - (setq notmuch-tree-message-buffer buffer))))
\r
552 -(defun notmuch-tree-show-message-out ()
\r
553 - "Show the current message (in whole window)."
\r
555 - (let ((id (notmuch-tree-get-message-id))
\r
556 - (inhibit-read-only t)
\r
559 - ;; We close the window to kill off un-needed buffers.
\r
560 - (notmuch-tree-close-message-window)
\r
561 - (notmuch-show id))))
\r
563 -(defun notmuch-tree-show-message (arg)
\r
564 - "Show the current message.
\r
566 -Shows in split pane or whole window according to value of
\r
567 -`notmuch-tree-show-out'. A prefix argument reverses the choice."
\r
568 - (interactive "P")
\r
569 - (if (or (and notmuch-tree-show-out (not arg))
\r
570 - (and (not notmuch-tree-show-out) arg))
\r
571 - (notmuch-tree-show-message-out)
\r
572 - (notmuch-tree-show-message-in)))
\r
574 -(defun notmuch-tree-scroll-message-window ()
\r
575 - "Scroll the message window (if it exists)"
\r
577 - (when (window-live-p notmuch-tree-message-window)
\r
578 - (with-selected-window notmuch-tree-message-window
\r
579 - (if (pos-visible-in-window-p (point-max))
\r
583 -(defun notmuch-tree-scroll-message-window-back ()
\r
584 - "Scroll the message window back(if it exists)"
\r
586 - (when (window-live-p notmuch-tree-message-window)
\r
587 - (with-selected-window notmuch-tree-message-window
\r
588 - (if (pos-visible-in-window-p (point-min))
\r
590 - (scroll-down)))))
\r
592 -(defun notmuch-tree-scroll-or-next ()
\r
593 - "Scroll the message window. If it at end go to next message."
\r
595 - (when (notmuch-tree-scroll-message-window)
\r
596 - (notmuch-tree-next-matching-message)))
\r
598 -(defun notmuch-tree-quit ()
\r
599 - "Close the split view or exit tree."
\r
601 - (unless (notmuch-tree-close-message-window)
\r
602 - (kill-buffer (current-buffer))))
\r
604 -(defun notmuch-tree-close-message-window ()
\r
605 - "Close the message-window. Return t if close succeeds."
\r
607 - (when (and (window-live-p notmuch-tree-message-window)
\r
608 - (eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer))
\r
609 - (delete-window notmuch-tree-message-window)
\r
610 - (unless (get-buffer-window-list notmuch-tree-message-buffer)
\r
611 - (kill-buffer notmuch-tree-message-buffer))
\r
614 -(defun notmuch-tree-archive-message (&optional unarchive)
\r
615 - "Archive the current message.
\r
617 -Archive the current message by applying the tag changes in
\r
618 -`notmuch-archive-tags' to it. If a prefix argument is given, the
\r
619 -message will be \"unarchived\", i.e. the tag changes in
\r
620 -`notmuch-archive-tags' will be reversed."
\r
621 - (interactive "P")
\r
622 - (when notmuch-archive-tags
\r
623 - (notmuch-tree-tag (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
625 -(defun notmuch-tree-archive-message-then-next (&optional unarchive)
\r
626 - "Archive the current message and move to next matching message."
\r
627 - (interactive "P")
\r
628 - (notmuch-tree-archive-message unarchive)
\r
629 - (notmuch-tree-next-matching-message))
\r
631 -(defun notmuch-tree-next-message ()
\r
632 - "Move to next message."
\r
635 - (when (window-live-p notmuch-tree-message-window)
\r
636 - (notmuch-tree-show-message-in)))
\r
638 -(defun notmuch-tree-prev-message ()
\r
639 - "Move to previous message."
\r
641 - (forward-line -1)
\r
642 - (when (window-live-p notmuch-tree-message-window)
\r
643 - (notmuch-tree-show-message-in)))
\r
645 -(defun notmuch-tree-prev-matching-message ()
\r
646 - "Move to previous matching message."
\r
648 - (forward-line -1)
\r
649 - (while (and (not (bobp)) (not (notmuch-tree-get-match)))
\r
650 - (forward-line -1))
\r
651 - (when (window-live-p notmuch-tree-message-window)
\r
652 - (notmuch-tree-show-message-in)))
\r
654 -(defun notmuch-tree-next-matching-message ()
\r
655 - "Move to next matching message."
\r
658 - (while (and (not (eobp)) (not (notmuch-tree-get-match)))
\r
660 - (when (window-live-p notmuch-tree-message-window)
\r
661 - (notmuch-tree-show-message-in)))
\r
663 -(defun notmuch-tree-refresh-view ()
\r
666 - (let ((inhibit-read-only t)
\r
667 - (basic-query notmuch-tree-basic-query)
\r
668 - (query-context notmuch-tree-query-context)
\r
669 - (target (notmuch-tree-get-message-id)))
\r
671 - (notmuch-tree-worker basic-query
\r
675 -(defun notmuch-tree-thread-top ()
\r
676 - (when (notmuch-tree-get-message-properties)
\r
677 - (while (not (or (notmuch-tree-get-prop :first) (eobp)))
\r
678 - (forward-line -1))))
\r
680 -(defun notmuch-tree-prev-thread ()
\r
682 - (forward-line -1)
\r
683 - (notmuch-tree-thread-top))
\r
685 -(defun notmuch-tree-next-thread ()
\r
688 - (while (not (or (notmuch-tree-get-prop :first) (eobp)))
\r
689 - (forward-line 1)))
\r
691 -(defun notmuch-tree-thread-mapcar (function)
\r
692 - "Iterate through all messages in the current thread
\r
693 - and call FUNCTION for side effects."
\r
695 - (notmuch-tree-thread-top)
\r
696 - (loop collect (funcall function)
\r
697 - do (forward-line)
\r
698 - while (and (notmuch-tree-get-message-properties)
\r
699 - (not (notmuch-tree-get-prop :first))))))
\r
701 -(defun notmuch-tree-get-messages-ids-thread-search ()
\r
702 - "Return a search string for all message ids of messages in the current thread."
\r
703 - (mapconcat 'identity
\r
704 - (notmuch-tree-thread-mapcar 'notmuch-tree-get-message-id)
\r
707 -(defun notmuch-tree-tag-thread (tag-changes)
\r
708 - "Tag all messages in the current thread"
\r
710 - (let ((tags (apply #'append (notmuch-tree-thread-mapcar
\r
711 - (lambda () (notmuch-tree-get-tags))))))
\r
712 - (list (notmuch-read-tag-changes tags "Tag thread"))))
\r
713 - (when (notmuch-tree-get-message-properties)
\r
714 - (notmuch-tag (notmuch-tree-get-messages-ids-thread-search) tag-changes)
\r
715 - (notmuch-tree-thread-mapcar
\r
716 - (lambda () (notmuch-tree-tag-update-display tag-changes)))))
\r
718 -(defun notmuch-tree-archive-thread (&optional unarchive)
\r
719 - "Archive each message in thread.
\r
721 -Archive each message currently shown by applying the tag changes
\r
722 -in `notmuch-archive-tags' to each. If a prefix argument is given,
\r
723 -the messages will be \"unarchived\", i.e. the tag changes in
\r
724 -`notmuch-archive-tags' will be reversed.
\r
726 -Note: This command is safe from any race condition of new messages
\r
727 -being delivered to the same thread. It does not archive the
\r
728 -entire thread, but only the messages shown in the current
\r
730 - (interactive "P")
\r
731 - (when notmuch-archive-tags
\r
732 - (notmuch-tree-tag-thread
\r
733 - (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
735 -;; Functions below here display the tree buffer itself.
\r
737 -(defun notmuch-tree-clean-address (address)
\r
738 - "Try to clean a single email ADDRESS for display. Return
\r
739 -AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
\r
740 -unchanged ADDRESS if parsing fails."
\r
741 - (let* ((clean-address (notmuch-clean-address address))
\r
742 - (p-address (car clean-address))
\r
743 - (p-name (cdr clean-address)))
\r
745 - ;; If we have a name return that otherwise return the address.
\r
746 - (or p-name p-address)))
\r
748 -(defun notmuch-tree-format-field (field format-string msg)
\r
749 - "Format a FIELD of MSG according to FORMAT-STRING and return string"
\r
750 - (let* ((headers (plist-get msg :headers))
\r
751 - (match (plist-get msg :match)))
\r
754 - (format format-string (notmuch-tree-format-field-list field msg)))
\r
756 - ((string-equal field "date")
\r
757 - (let ((face (if match
\r
758 - 'notmuch-tree-match-date-face
\r
759 - 'notmuch-tree-no-match-date-face)))
\r
760 - (propertize (format format-string (plist-get msg :date_relative)) 'face face)))
\r
762 - ((string-equal field "tree")
\r
763 - (let ((tree-status (plist-get msg :tree-status))
\r
765 - 'notmuch-tree-match-tree-face
\r
766 - 'notmuch-tree-no-match-tree-face)))
\r
768 - (propertize (format format-string
\r
769 - (mapconcat #'identity (reverse tree-status) ""))
\r
772 - ((string-equal field "subject")
\r
773 - (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
\r
774 - (previous-subject notmuch-tree-previous-subject)
\r
776 - 'notmuch-tree-match-subject-face
\r
777 - 'notmuch-tree-no-match-subject-face)))
\r
779 - (setq notmuch-tree-previous-subject bare-subject)
\r
780 - (propertize (format format-string
\r
781 - (if (string= previous-subject bare-subject)
\r
786 - ((string-equal field "authors")
\r
787 - (let ((author (notmuch-tree-clean-address (plist-get headers :From)))
\r
788 - (len (length (format format-string "")))
\r
790 - 'notmuch-tree-match-author-face
\r
791 - 'notmuch-tree-no-match-author-face)))
\r
792 - (when (> (length author) len)
\r
793 - (setq author (substring author 0 len)))
\r
794 - (propertize (format format-string author) 'face face)))
\r
796 - ((string-equal field "tags")
\r
797 - (let ((tags (plist-get msg :tags))
\r
799 - 'notmuch-tree-match-tag-face
\r
800 - 'notmuch-tree-no-match-tag-face)))
\r
801 - (propertize (format format-string
\r
802 - (mapconcat #'identity tags ", "))
\r
806 -(defun notmuch-tree-format-field-list (field-list msg)
\r
807 - "Format fields of MSG according to FIELD-LIST and return string"
\r
808 - (let (result-string)
\r
809 - (dolist (spec field-list result-string)
\r
810 - (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
\r
811 - (setq result-string (concat result-string field-string))))))
\r
813 -(defun notmuch-tree-insert-msg (msg)
\r
814 - "Insert the message MSG according to notmuch-tree-result-format"
\r
815 - ;; We need to save the previous subject as it will get overwritten
\r
816 - ;; by the insert-field calls.
\r
817 - (let ((previous-subject notmuch-tree-previous-subject))
\r
818 - (insert (notmuch-tree-format-field-list notmuch-tree-result-format msg))
\r
819 - (notmuch-tree-set-message-properties msg)
\r
820 - (notmuch-tree-set-prop :previous-subject previous-subject)
\r
823 -(defun notmuch-tree-goto-and-insert-msg (msg)
\r
824 - "Insert msg at the end of the buffer. Move point to msg if it is the target"
\r
826 - (goto-char (point-max))
\r
827 - (notmuch-tree-insert-msg msg))
\r
828 - (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
\r
829 - (target notmuch-tree-target-msg))
\r
830 - (when (or (and (not target) (plist-get msg :match))
\r
831 - (string= msg-id target))
\r
832 - (setq notmuch-tree-target-msg "found")
\r
833 - (goto-char (point-max))
\r
834 - (forward-line -1)
\r
835 - (when notmuch-tree-open-target
\r
836 - (notmuch-tree-show-message-in)))))
\r
838 -(defun notmuch-tree-insert-tree (tree depth tree-status first last)
\r
839 - "Insert the message tree TREE at depth DEPTH in the current thread.
\r
841 -A message tree is another name for a single sub-thread: i.e., a
\r
842 -message together with all its descendents."
\r
843 - (let ((msg (car tree))
\r
844 - (replies (cadr tree)))
\r
847 - ((and (< 0 depth) (not last))
\r
848 - (push "├" tree-status))
\r
849 - ((and (< 0 depth) last)
\r
850 - (push "╰" tree-status))
\r
851 - ((and (eq 0 depth) first last)
\r
852 -;; (push "─" tree-status)) choice between this and next line is matter of taste.
\r
853 - (push " " tree-status))
\r
854 - ((and (eq 0 depth) first (not last))
\r
855 - (push "┬" tree-status))
\r
856 - ((and (eq 0 depth) (not first) last)
\r
857 - (push "╰" tree-status))
\r
858 - ((and (eq 0 depth) (not first) (not last))
\r
859 - (push "├" tree-status)))
\r
861 - (push (concat (if replies "┬" "─") "►") tree-status)
\r
862 - (plist-put msg :first (and first (eq 0 depth)))
\r
863 - (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status tree-status))
\r
864 - (pop tree-status)
\r
865 - (pop tree-status)
\r
868 - (push " " tree-status)
\r
869 - (push "│" tree-status))
\r
871 - (notmuch-tree-insert-thread replies (1+ depth) tree-status)))
\r
873 -(defun notmuch-tree-insert-thread (thread depth tree-status)
\r
874 - "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
\r
875 - (let ((n (length thread)))
\r
876 - (loop for tree in thread
\r
877 - for count from 1 to n
\r
879 - do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
\r
881 -(defun notmuch-tree-insert-forest-thread (forest-thread)
\r
882 - "Insert a single complete thread."
\r
883 - (let (tree-status)
\r
884 - ;; Reset at the start of each main thread.
\r
885 - (setq notmuch-tree-previous-subject nil)
\r
886 - (notmuch-tree-insert-thread forest-thread 0 tree-status)))
\r
888 -(defun notmuch-tree-insert-forest (forest)
\r
889 - "Insert a forest of threads.
\r
891 -This function inserts a collection of several complete threads as
\r
892 -passed to it by notmuch-tree-process-filter."
\r
893 - (mapc 'notmuch-tree-insert-forest-thread forest))
\r
895 -(defun notmuch-tree-mode ()
\r
896 - "Major mode displaying messages (as opposed to threads) of of a notmuch search.
\r
898 -This buffer contains the results of a \"notmuch tree\" of your
\r
899 -email archives. Each line in the buffer represents a single
\r
900 -message giving the relative date, the author, subject, and any
\r
903 -Pressing \\[notmuch-tree-show-message] on any line displays that message.
\r
905 -Complete list of currently available key bindings:
\r
907 -\\{notmuch-tree-mode-map}"
\r
910 - (kill-all-local-variables)
\r
911 - (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
\r
912 - (use-local-map notmuch-tree-mode-map)
\r
913 - (setq major-mode 'notmuch-tree-mode
\r
914 - mode-name "notmuch-tree")
\r
916 - (setq buffer-read-only t
\r
917 - truncate-lines t))
\r
919 -(defun notmuch-tree-process-sentinel (proc msg)
\r
920 - "Add a message to let user know when \"notmuch tree\" exits"
\r
921 - (let ((buffer (process-buffer proc))
\r
922 - (status (process-status proc))
\r
923 - (exit-status (process-exit-status proc))
\r
924 - (never-found-target-thread nil))
\r
925 - (when (memq status '(exit signal))
\r
926 - (kill-buffer (process-get proc 'parse-buf))
\r
927 - (if (buffer-live-p buffer)
\r
928 - (with-current-buffer buffer
\r
930 - (let ((inhibit-read-only t)
\r
932 - (goto-char (point-max))
\r
933 - (if (eq status 'signal)
\r
934 - (insert "Incomplete search results (tree view process was killed).\n"))
\r
935 - (when (eq status 'exit)
\r
936 - (insert "End of search results.")
\r
937 - (unless (= exit-status 0)
\r
938 - (insert (format " (process returned %d)" exit-status)))
\r
939 - (insert "\n")))))))))
\r
941 -(defun notmuch-tree-process-filter (proc string)
\r
942 - "Process and filter the output of \"notmuch show\" for tree view"
\r
943 - (let ((results-buf (process-buffer proc))
\r
944 - (parse-buf (process-get proc 'parse-buf))
\r
945 - (inhibit-read-only t)
\r
947 - (if (not (buffer-live-p results-buf))
\r
948 - (delete-process proc)
\r
949 - (with-current-buffer parse-buf
\r
950 - ;; Insert new data
\r
952 - (goto-char (point-max))
\r
954 - (notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread
\r
957 -(defun notmuch-tree-worker (basic-query &optional query-context target open-target)
\r
958 - "Insert the tree view of the search in the current buffer.
\r
960 -This is is a helper function for notmuch-tree. The arguments are
\r
961 -the same as for the function notmuch-tree."
\r
963 - (notmuch-tree-mode)
\r
964 - (setq notmuch-tree-basic-query basic-query)
\r
965 - (setq notmuch-tree-query-context query-context)
\r
966 - (setq notmuch-tree-target-msg target)
\r
967 - (setq notmuch-tree-open-target open-target)
\r
970 - (goto-char (point-min))
\r
971 - (let* ((search-args (concat basic-query
\r
972 - (if query-context (concat " and (" query-context ")"))
\r
974 - (message-arg "--entire-thread"))
\r
975 - (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
\r
976 - (setq search-args basic-query))
\r
977 - (let ((proc (notmuch-start-notmuch
\r
978 - "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
\r
979 - "show" "--body=false" "--format=sexp"
\r
980 - message-arg search-args))
\r
981 - ;; Use a scratch buffer to accumulate partial output.
\r
982 - ;; This buffer will be killed by the sentinel, which
\r
983 - ;; should be called no matter how the process dies.
\r
984 - (parse-buf (generate-new-buffer " *notmuch tree parse*")))
\r
985 - (process-put proc 'parse-buf parse-buf)
\r
986 - (set-process-filter proc 'notmuch-tree-process-filter)
\r
987 - (set-process-query-on-exit-flag proc nil))))
\r
989 -(defun notmuch-tree (&optional query query-context target buffer-name open-target)
\r
990 - "Display threads matching QUERY in Tree View.
\r
992 -The arguments are:
\r
993 - QUERY: the main query. This can be any query but in many cases will be
\r
994 - a single thread. If nil this is read interactively from the minibuffer.
\r
995 - QUERY-CONTEXT: is an additional term for the query. The query used
\r
996 - is QUERY and QUERY-CONTEXT unless that does not match any messages
\r
997 - in which case we fall back to just QUERY.
\r
998 - TARGET: A message ID (with the id: prefix) that will be made
\r
999 - current if it appears in the tree view results.
\r
1000 - BUFFER-NAME: the name of the buffer to display the tree view. If
\r
1001 - it is nil \"*notmuch-tree\" followed by QUERY is used.
\r
1002 - OPEN-TARGET: If TRUE open the target message in the message pane."
\r
1004 - (if (null query)
\r
1005 - (setq query (notmuch-read-query "Notmuch tree view search: ")))
\r
1006 - (let ((buffer (get-buffer-create (generate-new-buffer-name
\r
1008 - (concat "*notmuch-tree-" query "*")))))
\r
1009 - (inhibit-read-only t))
\r
1011 - (switch-to-buffer buffer))
\r
1012 - ;; Don't track undo information for this buffer
\r
1013 - (set 'buffer-undo-list t)
\r
1015 - (notmuch-tree-worker query query-context target open-target)
\r
1017 - (setq truncate-lines t))
\r
1020 -;; Set up key bindings from the rest of notmuch.
\r
1021 -(define-key notmuch-common-keymap "z" 'notmuch-tree)
\r
1022 -(define-key notmuch-search-mode-map "Z" 'notmuch-tree-from-search-current-query)
\r
1023 -(define-key notmuch-show-mode-map "Z" 'notmuch-tree-from-show-current-query)
\r
1024 -(message "Initialised notmuch-tree")
\r
1026 -(provide 'notmuch-tree)
\r
1027 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
\r
1028 new file mode 100644
\r
1029 index 0000000..d3330a0
\r
1031 +++ b/emacs/notmuch-tree.el
\r
1033 +;; notmuch-tree.el --- displaying notmuch forests.
\r
1035 +;; Copyright © Carl Worth
\r
1036 +;; Copyright © David Edmondson
\r
1037 +;; Copyright © Mark Walters
\r
1039 +;; This file is part of Notmuch.
\r
1041 +;; Notmuch is free software: you can redistribute it and/or modify it
\r
1042 +;; under the terms of the GNU General Public License as published by
\r
1043 +;; the Free Software Foundation, either version 3 of the License, or
\r
1044 +;; (at your option) any later version.
\r
1046 +;; Notmuch is distributed in the hope that it will be useful, but
\r
1047 +;; WITHOUT ANY WARRANTY; without even the implied warranty of
\r
1048 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\r
1049 +;; General Public License for more details.
\r
1051 +;; You should have received a copy of the GNU General Public License
\r
1052 +;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
\r
1054 +;; Authors: David Edmondson <dme@dme.org>
\r
1055 +;; Mark Walters <markwalters1009@gmail.com>
\r
1057 +(require 'mail-parse)
\r
1059 +(require 'notmuch-lib)
\r
1060 +(require 'notmuch-query)
\r
1061 +(require 'notmuch-show)
\r
1062 +(require 'notmuch-tag)
\r
1063 +(require 'notmuch-parser)
\r
1064 +(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
\r
1066 +(eval-when-compile (require 'cl))
\r
1067 +(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line))
\r
1068 +(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
\r
1069 +(declare-function notmuch-read-query "notmuch" (prompt))
\r
1070 +(declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
\r
1071 +(declare-function notmuch-search-find-subject "notmuch" ())
\r
1073 +;; the following variable is defined in notmuch.el
\r
1074 +(defvar notmuch-search-query-string)
\r
1076 +(defgroup notmuch-tree nil
\r
1077 + "Showing message and thread structure."
\r
1078 + :group 'notmuch)
\r
1080 +(defcustom notmuch-tree-show-out nil
\r
1081 + "View selected messages in new window rather than split-pane."
\r
1083 + :group 'notmuch-tree)
\r
1085 +(defcustom notmuch-tree-result-format
\r
1086 + `(("date" . "%12s ")
\r
1087 + ("authors" . "%-20s")
\r
1088 + ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
\r
1089 + ("tags" . "(%s)"))
\r
1090 + "Result formatting for Tree view. Supported fields are: date,
\r
1091 + authors, subject, tree, tags. Tree means the thread tree
\r
1092 + box graphics. The field may also be a list in which case
\r
1093 + the formatting rules are applied recursively and then the
\r
1094 + output of all the fields in the list is inserted
\r
1095 + according to format-string.
\r
1097 +Note the author string should not contain
\r
1098 + whitespace (put it in the neighbouring fields instead).
\r
1100 + (setq notmuch-tree-result-format \(\(\"authors\" . \"%-40s\"\)
\r
1101 + \(\"subject\" . \"%s\"\)\)\)"
\r
1102 + :type '(alist :key-type (string) :value-type (string))
\r
1103 + :group 'notmuch-tree)
\r
1105 +;; Faces for messages that match the query.
\r
1106 +(defface notmuch-tree-match-date-face
\r
1107 + '((t :inherit default))
\r
1108 + "Face used in tree mode for the date in messages matching the query."
\r
1109 + :group 'notmuch-tree
\r
1110 + :group 'notmuch-faces)
\r
1112 +(defface notmuch-tree-match-author-face
\r
1113 + '((((class color)
\r
1114 + (background dark))
\r
1115 + (:foreground "OliveDrab1"))
\r
1117 + (background light))
\r
1118 + (:foreground "dark blue"))
\r
1121 + "Face used in tree mode for the date in messages matching the query."
\r
1122 + :group 'notmuch-tree
\r
1123 + :group 'notmuch-faces)
\r
1125 +(defface notmuch-tree-match-subject-face
\r
1126 + '((t :inherit default))
\r
1127 + "Face used in tree mode for the subject in messages matching the query."
\r
1128 + :group 'notmuch-tree
\r
1129 + :group 'notmuch-faces)
\r
1131 +(defface notmuch-tree-match-tree-face
\r
1132 + '((t :inherit default))
\r
1133 + "Face used in tree mode for the thread tree block graphics in messages matching the query."
\r
1134 + :group 'notmuch-tree
\r
1135 + :group 'notmuch-faces)
\r
1137 +(defface notmuch-tree-match-tag-face
\r
1138 + '((((class color)
\r
1139 + (background dark))
\r
1140 + (:foreground "OliveDrab1"))
\r
1142 + (background light))
\r
1143 + (:foreground "navy blue" :bold t))
\r
1146 + "Face used in tree mode for tags in messages matching the query."
\r
1147 + :group 'notmuch-tree
\r
1148 + :group 'notmuch-faces)
\r
1150 +;; Faces for messages that do not match the query.
\r
1151 +(defface notmuch-tree-no-match-date-face
\r
1152 + '((t (:foreground "gray")))
\r
1153 + "Face used in tree mode for non-matching dates."
\r
1154 + :group 'notmuch-tree
\r
1155 + :group 'notmuch-faces)
\r
1157 +(defface notmuch-tree-no-match-subject-face
\r
1158 + '((t (:foreground "gray")))
\r
1159 + "Face used in tree mode for non-matching subjects."
\r
1160 + :group 'notmuch-tree
\r
1161 + :group 'notmuch-faces)
\r
1163 +(defface notmuch-tree-no-match-tree-face
\r
1164 + '((t (:foreground "gray")))
\r
1165 + "Face used in tree mode for the thread tree block graphics in messages matching the query."
\r
1166 + :group 'notmuch-tree
\r
1167 + :group 'notmuch-faces)
\r
1169 +(defface notmuch-tree-no-match-author-face
\r
1170 + '((t (:foreground "gray")))
\r
1171 + "Face used in tree mode for the date in messages matching the query."
\r
1172 + :group 'notmuch-tree
\r
1173 + :group 'notmuch-faces)
\r
1175 +(defface notmuch-tree-no-match-tag-face
\r
1176 + '((t (:foreground "gray")))
\r
1177 + "Face used in tree mode face for non-matching tags."
\r
1178 + :group 'notmuch-tree
\r
1179 + :group 'notmuch-faces)
\r
1181 +(defvar notmuch-tree-previous-subject
\r
1182 + "The subject of the most recent result shown during the async display")
\r
1183 +(make-variable-buffer-local 'notmuch-tree-previous-subject)
\r
1185 +(defvar notmuch-tree-basic-query nil
\r
1186 + "A buffer local copy of argument query to the function notmuch-tree")
\r
1187 +(make-variable-buffer-local 'notmuch-tree-basic-query)
\r
1189 +(defvar notmuch-tree-query-context nil
\r
1190 + "A buffer local copy of argument query-context to the function notmuch-tree")
\r
1191 +(make-variable-buffer-local 'notmuch-tree-query-context)
\r
1193 +(defvar notmuch-tree-target-msg nil
\r
1194 + "A buffer local copy of argument target to the function notmuch-tree")
\r
1195 +(make-variable-buffer-local 'notmuch-tree-target-msg)
\r
1197 +(defvar notmuch-tree-open-target nil
\r
1198 + "A buffer local copy of argument open-target to the function notmuch-tree")
\r
1199 +(make-variable-buffer-local 'notmuch-tree-open-target)
\r
1201 +(defvar notmuch-tree-message-window nil
\r
1202 + "The window of the message pane.
\r
1204 +It is set in both the tree buffer and the child show buffer. It
\r
1205 +is used to try and close the message pane when quitting tree view
\r
1206 +or the child show buffer.")
\r
1207 +(make-variable-buffer-local 'notmuch-tree-message-window)
\r
1208 +(put 'notmuch-tree-message-window 'permanent-local t)
\r
1210 +(defvar notmuch-tree-message-buffer nil
\r
1211 + "The buffer name of the show buffer in the message pane.
\r
1213 +This is used to try and make sure we don't close the message pane
\r
1214 +if the user has loaded a different buffer in that window.")
\r
1215 +(make-variable-buffer-local 'notmuch-tree-message-buffer)
\r
1216 +(put 'notmuch-tree-message-buffer 'permanent-local t)
\r
1218 +(defun notmuch-tree-to-message-pane (func)
\r
1219 + "Execute FUNC in message pane.
\r
1221 +This function returns a function (so can be used as a keybinding)
\r
1222 +which executes function FUNC in the message pane if it is
\r
1223 +open (if the message pane is closed it does nothing)."
\r
1225 + ,(concat "(In message pane) " (documentation func t))
\r
1227 + (when (window-live-p notmuch-tree-message-window)
\r
1228 + (with-selected-window notmuch-tree-message-window
\r
1229 + (call-interactively #',func)))))
\r
1231 +(defun notmuch-tree-button-activate (&optional button)
\r
1232 + "Activate BUTTON or button at point
\r
1234 +This function does not give an error if there is no button."
\r
1236 + (let ((button (or button (button-at (point)))))
\r
1237 + (when button (button-activate button))))
\r
1239 +(defun notmuch-tree-close-message-pane-and (func)
\r
1240 + "Close message pane and execute FUNC.
\r
1242 +This function returns a function (so can be used as a keybinding)
\r
1243 +which closes the message pane if open and then executes function
\r
1246 + ,(concat "(Close message pane and) " (documentation func t))
\r
1248 + (notmuch-tree-close-message-window)
\r
1249 + (call-interactively #',func)))
\r
1251 +(defvar notmuch-tree-mode-map
\r
1252 + (let ((map (make-sparse-keymap)))
\r
1253 + (set-keymap-parent map notmuch-common-keymap)
\r
1254 + ;; The following override the global keymap.
\r
1255 + ;; Override because we want to close message pane first.
\r
1256 + (define-key map "?" (notmuch-tree-close-message-pane-and #'notmuch-help))
\r
1257 + ;; Override because we first close message pane and then close tree buffer.
\r
1258 + (define-key map "q" 'notmuch-tree-quit)
\r
1259 + ;; Override because we close message pane after the search query is entered.
\r
1260 + (define-key map "s" 'notmuch-tree-to-search)
\r
1261 + ;; Override because we want to close message pane first.
\r
1262 + (define-key map "m" (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
\r
1264 + ;; these use notmuch-show functions directly
\r
1265 + (define-key map "|" 'notmuch-show-pipe-message)
\r
1266 + (define-key map "w" 'notmuch-show-save-attachments)
\r
1267 + (define-key map "v" 'notmuch-show-view-all-mime-parts)
\r
1268 + (define-key map "c" 'notmuch-show-stash-map)
\r
1270 + ;; these apply to the message pane
\r
1271 + (define-key map (kbd "M-TAB") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
\r
1272 + (define-key map (kbd "<backtab>") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
\r
1273 + (define-key map (kbd "TAB") (notmuch-tree-to-message-pane #'notmuch-show-next-button))
\r
1274 + (define-key map "e" (notmuch-tree-to-message-pane #'notmuch-tree-button-activate))
\r
1276 + ;; bindings from show (or elsewhere) but we close the message pane first.
\r
1277 + (define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
\r
1278 + (define-key map "r" (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
\r
1279 + (define-key map "R" (notmuch-tree-close-message-pane-and #'notmuch-show-reply))
\r
1280 + (define-key map "V" (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
\r
1282 + ;; The main tree view bindings
\r
1283 + (define-key map (kbd "RET") 'notmuch-tree-show-message)
\r
1284 + (define-key map [mouse-1] 'notmuch-tree-show-message)
\r
1285 + (define-key map "x" 'notmuch-tree-quit)
\r
1286 + (define-key map "A" 'notmuch-tree-archive-thread)
\r
1287 + (define-key map "a" 'notmuch-tree-archive-message-then-next)
\r
1288 + (define-key map "=" 'notmuch-tree-refresh-view)
\r
1289 + (define-key map "z" 'notmuch-tree-to-tree)
\r
1290 + (define-key map "n" 'notmuch-tree-next-matching-message)
\r
1291 + (define-key map "p" 'notmuch-tree-prev-matching-message)
\r
1292 + (define-key map "N" 'notmuch-tree-next-message)
\r
1293 + (define-key map "P" 'notmuch-tree-prev-message)
\r
1294 + (define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
\r
1295 + (define-key map (kbd "M-n") 'notmuch-tree-next-thread)
\r
1296 + (define-key map "-" 'notmuch-tree-remove-tag)
\r
1297 + (define-key map "+" 'notmuch-tree-add-tag)
\r
1298 + (define-key map "*" 'notmuch-tree-tag-thread)
\r
1299 + (define-key map " " 'notmuch-tree-scroll-or-next)
\r
1300 + (define-key map "b" 'notmuch-tree-scroll-message-window-back)
\r
1302 +(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
\r
1304 +(defun notmuch-tree-get-message-properties ()
\r
1305 + "Return the properties of the current message as a plist.
\r
1307 +Some useful entries are:
\r
1308 +:headers - Property list containing the headers :Date, :Subject, :From, etc.
\r
1309 +:tags - Tags for this message"
\r
1311 + (beginning-of-line)
\r
1312 + (get-text-property (point) :notmuch-message-properties)))
\r
1314 +;; XXX This should really be a lib function but we are trying to
\r
1315 +;; reduce impact on the code base.
\r
1316 +(defun notmuch-show-get-prop (prop &optional props)
\r
1317 + "This is a tree view overridden version of notmuch-show-get-prop
\r
1319 +It gets property PROP from PROPS or, if PROPS is nil, the current
\r
1320 +message in either tree or show. This means that several functions
\r
1321 +in notmuch-show now work unchanged in tree as they just need the
\r
1322 +correct message properties."
\r
1323 + (let ((props (or props
\r
1324 + (cond ((eq major-mode 'notmuch-show-mode)
\r
1325 + (notmuch-show-get-message-properties))
\r
1326 + ((eq major-mode 'notmuch-tree-mode)
\r
1327 + (notmuch-tree-get-message-properties))))))
\r
1328 + (plist-get props prop)))
\r
1330 +(defun notmuch-tree-set-message-properties (props)
\r
1332 + (beginning-of-line)
\r
1333 + (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
\r
1335 +(defun notmuch-tree-set-prop (prop val &optional props)
\r
1336 + (let ((inhibit-read-only t)
\r
1337 + (props (or props
\r
1338 + (notmuch-tree-get-message-properties))))
\r
1339 + (plist-put props prop val)
\r
1340 + (notmuch-tree-set-message-properties props)))
\r
1342 +(defun notmuch-tree-get-prop (prop &optional props)
\r
1343 + (let ((props (or props
\r
1344 + (notmuch-tree-get-message-properties))))
\r
1345 + (plist-get props prop)))
\r
1347 +(defun notmuch-tree-set-tags (tags)
\r
1348 + "Set the tags of the current message."
\r
1349 + (notmuch-tree-set-prop :tags tags))
\r
1351 +(defun notmuch-tree-get-tags ()
\r
1352 + "Return the tags of the current message."
\r
1353 + (notmuch-tree-get-prop :tags))
\r
1355 +(defun notmuch-tree-get-message-id ()
\r
1356 + "Return the message id of the current message."
\r
1357 + (let ((id (notmuch-tree-get-prop :id)))
\r
1359 + (notmuch-id-to-query id)
\r
1362 +(defun notmuch-tree-get-match ()
\r
1363 + "Return whether the current message is a match."
\r
1365 + (notmuch-tree-get-prop :match))
\r
1367 +(defun notmuch-tree-refresh-result ()
\r
1368 + "Redisplay the current message line.
\r
1370 +This redisplays the current line based on the messages
\r
1371 +properties (as they are now). This is used when tags are
\r
1373 + (let ((init-point (point))
\r
1374 + (end (line-end-position))
\r
1375 + (msg (notmuch-tree-get-message-properties))
\r
1376 + (inhibit-read-only t))
\r
1377 + (beginning-of-line)
\r
1378 + ;; This is a little tricky: we override
\r
1379 + ;; notmuch-tree-previous-subject to get the decision between
\r
1380 + ;; ... and a subject right and it stops notmuch-tree-insert-msg
\r
1381 + ;; from overwriting the buffer local copy of
\r
1382 + ;; notmuch-tree-previous-subject if this is called while the
\r
1383 + ;; buffer is displaying.
\r
1384 + (let ((notmuch-tree-previous-subject (notmuch-tree-get-prop :previous-subject)))
\r
1385 + (delete-region (point) (1+ (line-end-position)))
\r
1386 + (notmuch-tree-insert-msg msg))
\r
1387 + (let ((new-end (line-end-position)))
\r
1388 + (goto-char (if (= init-point end)
\r
1390 + (min init-point (- new-end 1)))))))
\r
1392 +(defun notmuch-tree-tag-update-display (&optional tag-changes)
\r
1393 + "Update display for TAG-CHANGES to current message.
\r
1395 +Does NOT change the database."
\r
1396 + (let* ((current-tags (notmuch-tree-get-tags))
\r
1397 + (new-tags (notmuch-update-tags current-tags tag-changes)))
\r
1398 + (unless (equal current-tags new-tags)
\r
1399 + (notmuch-tree-set-tags new-tags)
\r
1400 + (notmuch-tree-refresh-result))))
\r
1402 +(defun notmuch-tree-tag (tag-changes)
\r
1403 + "Change tags for the current message"
\r
1405 + (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message")))
\r
1406 + (notmuch-tag (notmuch-tree-get-message-id) tag-changes)
\r
1407 + (notmuch-tree-tag-update-display tag-changes))
\r
1409 +(defun notmuch-tree-add-tag (tag-changes)
\r
1410 + "Same as `notmuch-tree-tag' but sets initial input to '+'."
\r
1412 + (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "+")))
\r
1413 + (notmuch-tree-tag tag-changes))
\r
1415 +(defun notmuch-tree-remove-tag (tag-changes)
\r
1416 + "Same as `notmuch-tree-tag' but sets initial input to '-'."
\r
1418 + (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-")))
\r
1419 + (notmuch-tree-tag tag-changes))
\r
1421 +;; The next two functions close the message window before calling
\r
1422 +;; notmuch-search or notmuch-tree but they do so after the user has
\r
1423 +;; entered the query (in case the user was basing the query on
\r
1424 +;; something in the message window).
\r
1426 +(defun notmuch-tree-to-search ()
\r
1427 + "Run \"notmuch search\" with the given `query' and display results."
\r
1429 + (let ((query (notmuch-read-query "Notmuch search: ")))
\r
1430 + (notmuch-tree-close-message-window)
\r
1431 + (notmuch-search query)))
\r
1433 +(defun notmuch-tree-to-tree ()
\r
1434 + "Run a query and display results in Tree view"
\r
1436 + (let ((query (notmuch-read-query "Notmuch tree view search: ")))
\r
1437 + (notmuch-tree-close-message-window)
\r
1438 + (notmuch-tree query)))
\r
1440 +;; This function should be in notmuch-show.el but be we trying to
\r
1441 +;; minimise impact on the rest of the codebase.
\r
1442 +(defun notmuch-tree-from-show-current-query ()
\r
1443 + "Call notmuch tree with the current query"
\r
1445 + (notmuch-tree notmuch-show-thread-id
\r
1446 + notmuch-show-query-context
\r
1447 + (notmuch-show-get-message-id)))
\r
1449 +;; This function should be in notmuch.el but be we trying to minimise
\r
1450 +;; impact on the rest of the codebase.
\r
1451 +(defun notmuch-tree-from-search-current-query ()
\r
1452 + "Call notmuch tree with the current query"
\r
1454 + (notmuch-tree notmuch-search-query-string))
\r
1456 +;; This function should be in notmuch.el but be we trying to minimise
\r
1457 +;; impact on the rest of the codebase.
\r
1458 +(defun notmuch-tree-from-search-thread ()
\r
1459 + "Show the selected thread with notmuch-tree"
\r
1461 + (notmuch-tree (notmuch-search-find-thread-id)
\r
1462 + notmuch-search-query-string
\r
1464 + (notmuch-prettify-subject (notmuch-search-find-subject))
\r
1467 +(defun notmuch-tree-message-window-kill-hook ()
\r
1468 + "Close the message pane when exiting the show buffer."
\r
1469 + (let ((buffer (current-buffer)))
\r
1470 + (when (and (window-live-p notmuch-tree-message-window)
\r
1471 + (eq (window-buffer notmuch-tree-message-window) buffer))
\r
1472 + ;; We do not want an error if this is the sole window in the
\r
1473 + ;; frame and I do not know how to test for that in emacs pre
\r
1474 + ;; 24. Hence we just ignore-errors.
\r
1476 + (delete-window notmuch-tree-message-window)))))
\r
1478 +(defun notmuch-tree-show-message-in ()
\r
1479 + "Show the current message (in split-pane)."
\r
1481 + (let ((id (notmuch-tree-get-message-id))
\r
1482 + (inhibit-read-only t)
\r
1485 + ;; We close and reopen the window to kill off un-needed buffers
\r
1486 + ;; this might cause flickering but seems ok.
\r
1487 + (notmuch-tree-close-message-window)
\r
1488 + (setq notmuch-tree-message-window
\r
1489 + (split-window-vertically (/ (window-height) 4)))
\r
1490 + (with-selected-window notmuch-tree-message-window
\r
1491 + ;; Since we are only displaying one message do not indent.
\r
1492 + (let ((notmuch-show-indent-messages-width 0)
\r
1493 + (notmuch-show-only-matching-messages t))
\r
1494 + (setq buffer (notmuch-show id))))
\r
1495 + ;; We need the `let' as notmuch-tree-message-window is buffer local.
\r
1496 + (let ((window notmuch-tree-message-window))
\r
1497 + (with-current-buffer buffer
\r
1498 + (setq notmuch-tree-message-window window)
\r
1499 + (add-hook 'kill-buffer-hook 'notmuch-tree-message-window-kill-hook)))
\r
1500 + (when notmuch-show-mark-read-tags
\r
1501 + (notmuch-tree-tag-update-display notmuch-show-mark-read-tags))
\r
1502 + (setq notmuch-tree-message-buffer buffer))))
\r
1504 +(defun notmuch-tree-show-message-out ()
\r
1505 + "Show the current message (in whole window)."
\r
1507 + (let ((id (notmuch-tree-get-message-id))
\r
1508 + (inhibit-read-only t)
\r
1511 + ;; We close the window to kill off un-needed buffers.
\r
1512 + (notmuch-tree-close-message-window)
\r
1513 + (notmuch-show id))))
\r
1515 +(defun notmuch-tree-show-message (arg)
\r
1516 + "Show the current message.
\r
1518 +Shows in split pane or whole window according to value of
\r
1519 +`notmuch-tree-show-out'. A prefix argument reverses the choice."
\r
1520 + (interactive "P")
\r
1521 + (if (or (and notmuch-tree-show-out (not arg))
\r
1522 + (and (not notmuch-tree-show-out) arg))
\r
1523 + (notmuch-tree-show-message-out)
\r
1524 + (notmuch-tree-show-message-in)))
\r
1526 +(defun notmuch-tree-scroll-message-window ()
\r
1527 + "Scroll the message window (if it exists)"
\r
1529 + (when (window-live-p notmuch-tree-message-window)
\r
1530 + (with-selected-window notmuch-tree-message-window
\r
1531 + (if (pos-visible-in-window-p (point-max))
\r
1535 +(defun notmuch-tree-scroll-message-window-back ()
\r
1536 + "Scroll the message window back(if it exists)"
\r
1538 + (when (window-live-p notmuch-tree-message-window)
\r
1539 + (with-selected-window notmuch-tree-message-window
\r
1540 + (if (pos-visible-in-window-p (point-min))
\r
1542 + (scroll-down)))))
\r
1544 +(defun notmuch-tree-scroll-or-next ()
\r
1545 + "Scroll the message window. If it at end go to next message."
\r
1547 + (when (notmuch-tree-scroll-message-window)
\r
1548 + (notmuch-tree-next-matching-message)))
\r
1550 +(defun notmuch-tree-quit ()
\r
1551 + "Close the split view or exit tree."
\r
1553 + (unless (notmuch-tree-close-message-window)
\r
1554 + (kill-buffer (current-buffer))))
\r
1556 +(defun notmuch-tree-close-message-window ()
\r
1557 + "Close the message-window. Return t if close succeeds."
\r
1559 + (when (and (window-live-p notmuch-tree-message-window)
\r
1560 + (eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer))
\r
1561 + (delete-window notmuch-tree-message-window)
\r
1562 + (unless (get-buffer-window-list notmuch-tree-message-buffer)
\r
1563 + (kill-buffer notmuch-tree-message-buffer))
\r
1566 +(defun notmuch-tree-archive-message (&optional unarchive)
\r
1567 + "Archive the current message.
\r
1569 +Archive the current message by applying the tag changes in
\r
1570 +`notmuch-archive-tags' to it. If a prefix argument is given, the
\r
1571 +message will be \"unarchived\", i.e. the tag changes in
\r
1572 +`notmuch-archive-tags' will be reversed."
\r
1573 + (interactive "P")
\r
1574 + (when notmuch-archive-tags
\r
1575 + (notmuch-tree-tag (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
1577 +(defun notmuch-tree-archive-message-then-next (&optional unarchive)
\r
1578 + "Archive the current message and move to next matching message."
\r
1579 + (interactive "P")
\r
1580 + (notmuch-tree-archive-message unarchive)
\r
1581 + (notmuch-tree-next-matching-message))
\r
1583 +(defun notmuch-tree-next-message ()
\r
1584 + "Move to next message."
\r
1587 + (when (window-live-p notmuch-tree-message-window)
\r
1588 + (notmuch-tree-show-message-in)))
\r
1590 +(defun notmuch-tree-prev-message ()
\r
1591 + "Move to previous message."
\r
1593 + (forward-line -1)
\r
1594 + (when (window-live-p notmuch-tree-message-window)
\r
1595 + (notmuch-tree-show-message-in)))
\r
1597 +(defun notmuch-tree-prev-matching-message ()
\r
1598 + "Move to previous matching message."
\r
1600 + (forward-line -1)
\r
1601 + (while (and (not (bobp)) (not (notmuch-tree-get-match)))
\r
1602 + (forward-line -1))
\r
1603 + (when (window-live-p notmuch-tree-message-window)
\r
1604 + (notmuch-tree-show-message-in)))
\r
1606 +(defun notmuch-tree-next-matching-message ()
\r
1607 + "Move to next matching message."
\r
1610 + (while (and (not (eobp)) (not (notmuch-tree-get-match)))
\r
1612 + (when (window-live-p notmuch-tree-message-window)
\r
1613 + (notmuch-tree-show-message-in)))
\r
1615 +(defun notmuch-tree-refresh-view ()
\r
1618 + (let ((inhibit-read-only t)
\r
1619 + (basic-query notmuch-tree-basic-query)
\r
1620 + (query-context notmuch-tree-query-context)
\r
1621 + (target (notmuch-tree-get-message-id)))
\r
1623 + (notmuch-tree-worker basic-query
\r
1627 +(defun notmuch-tree-thread-top ()
\r
1628 + (when (notmuch-tree-get-message-properties)
\r
1629 + (while (not (or (notmuch-tree-get-prop :first) (eobp)))
\r
1630 + (forward-line -1))))
\r
1632 +(defun notmuch-tree-prev-thread ()
\r
1634 + (forward-line -1)
\r
1635 + (notmuch-tree-thread-top))
\r
1637 +(defun notmuch-tree-next-thread ()
\r
1639 + (forward-line 1)
\r
1640 + (while (not (or (notmuch-tree-get-prop :first) (eobp)))
\r
1641 + (forward-line 1)))
\r
1643 +(defun notmuch-tree-thread-mapcar (function)
\r
1644 + "Iterate through all messages in the current thread
\r
1645 + and call FUNCTION for side effects."
\r
1647 + (notmuch-tree-thread-top)
\r
1648 + (loop collect (funcall function)
\r
1649 + do (forward-line)
\r
1650 + while (and (notmuch-tree-get-message-properties)
\r
1651 + (not (notmuch-tree-get-prop :first))))))
\r
1653 +(defun notmuch-tree-get-messages-ids-thread-search ()
\r
1654 + "Return a search string for all message ids of messages in the current thread."
\r
1655 + (mapconcat 'identity
\r
1656 + (notmuch-tree-thread-mapcar 'notmuch-tree-get-message-id)
\r
1659 +(defun notmuch-tree-tag-thread (tag-changes)
\r
1660 + "Tag all messages in the current thread"
\r
1662 + (let ((tags (apply #'append (notmuch-tree-thread-mapcar
\r
1663 + (lambda () (notmuch-tree-get-tags))))))
\r
1664 + (list (notmuch-read-tag-changes tags "Tag thread"))))
\r
1665 + (when (notmuch-tree-get-message-properties)
\r
1666 + (notmuch-tag (notmuch-tree-get-messages-ids-thread-search) tag-changes)
\r
1667 + (notmuch-tree-thread-mapcar
\r
1668 + (lambda () (notmuch-tree-tag-update-display tag-changes)))))
\r
1670 +(defun notmuch-tree-archive-thread (&optional unarchive)
\r
1671 + "Archive each message in thread.
\r
1673 +Archive each message currently shown by applying the tag changes
\r
1674 +in `notmuch-archive-tags' to each. If a prefix argument is given,
\r
1675 +the messages will be \"unarchived\", i.e. the tag changes in
\r
1676 +`notmuch-archive-tags' will be reversed.
\r
1678 +Note: This command is safe from any race condition of new messages
\r
1679 +being delivered to the same thread. It does not archive the
\r
1680 +entire thread, but only the messages shown in the current
\r
1682 + (interactive "P")
\r
1683 + (when notmuch-archive-tags
\r
1684 + (notmuch-tree-tag-thread
\r
1685 + (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
1687 +;; Functions below here display the tree buffer itself.
\r
1689 +(defun notmuch-tree-clean-address (address)
\r
1690 + "Try to clean a single email ADDRESS for display. Return
\r
1691 +AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
\r
1692 +unchanged ADDRESS if parsing fails."
\r
1693 + (let* ((clean-address (notmuch-clean-address address))
\r
1694 + (p-address (car clean-address))
\r
1695 + (p-name (cdr clean-address)))
\r
1697 + ;; If we have a name return that otherwise return the address.
\r
1698 + (or p-name p-address)))
\r
1700 +(defun notmuch-tree-format-field (field format-string msg)
\r
1701 + "Format a FIELD of MSG according to FORMAT-STRING and return string"
\r
1702 + (let* ((headers (plist-get msg :headers))
\r
1703 + (match (plist-get msg :match)))
\r
1706 + (format format-string (notmuch-tree-format-field-list field msg)))
\r
1708 + ((string-equal field "date")
\r
1709 + (let ((face (if match
\r
1710 + 'notmuch-tree-match-date-face
\r
1711 + 'notmuch-tree-no-match-date-face)))
\r
1712 + (propertize (format format-string (plist-get msg :date_relative)) 'face face)))
\r
1714 + ((string-equal field "tree")
\r
1715 + (let ((tree-status (plist-get msg :tree-status))
\r
1717 + 'notmuch-tree-match-tree-face
\r
1718 + 'notmuch-tree-no-match-tree-face)))
\r
1720 + (propertize (format format-string
\r
1721 + (mapconcat #'identity (reverse tree-status) ""))
\r
1724 + ((string-equal field "subject")
\r
1725 + (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
\r
1726 + (previous-subject notmuch-tree-previous-subject)
\r
1728 + 'notmuch-tree-match-subject-face
\r
1729 + 'notmuch-tree-no-match-subject-face)))
\r
1731 + (setq notmuch-tree-previous-subject bare-subject)
\r
1732 + (propertize (format format-string
\r
1733 + (if (string= previous-subject bare-subject)
\r
1738 + ((string-equal field "authors")
\r
1739 + (let ((author (notmuch-tree-clean-address (plist-get headers :From)))
\r
1740 + (len (length (format format-string "")))
\r
1742 + 'notmuch-tree-match-author-face
\r
1743 + 'notmuch-tree-no-match-author-face)))
\r
1744 + (when (> (length author) len)
\r
1745 + (setq author (substring author 0 len)))
\r
1746 + (propertize (format format-string author) 'face face)))
\r
1748 + ((string-equal field "tags")
\r
1749 + (let ((tags (plist-get msg :tags))
\r
1751 + 'notmuch-tree-match-tag-face
\r
1752 + 'notmuch-tree-no-match-tag-face)))
\r
1753 + (propertize (format format-string
\r
1754 + (mapconcat #'identity tags ", "))
\r
1755 + 'face face))))))
\r
1758 +(defun notmuch-tree-format-field-list (field-list msg)
\r
1759 + "Format fields of MSG according to FIELD-LIST and return string"
\r
1760 + (let (result-string)
\r
1761 + (dolist (spec field-list result-string)
\r
1762 + (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
\r
1763 + (setq result-string (concat result-string field-string))))))
\r
1765 +(defun notmuch-tree-insert-msg (msg)
\r
1766 + "Insert the message MSG according to notmuch-tree-result-format"
\r
1767 + ;; We need to save the previous subject as it will get overwritten
\r
1768 + ;; by the insert-field calls.
\r
1769 + (let ((previous-subject notmuch-tree-previous-subject))
\r
1770 + (insert (notmuch-tree-format-field-list notmuch-tree-result-format msg))
\r
1771 + (notmuch-tree-set-message-properties msg)
\r
1772 + (notmuch-tree-set-prop :previous-subject previous-subject)
\r
1775 +(defun notmuch-tree-goto-and-insert-msg (msg)
\r
1776 + "Insert msg at the end of the buffer. Move point to msg if it is the target"
\r
1778 + (goto-char (point-max))
\r
1779 + (notmuch-tree-insert-msg msg))
\r
1780 + (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
\r
1781 + (target notmuch-tree-target-msg))
\r
1782 + (when (or (and (not target) (plist-get msg :match))
\r
1783 + (string= msg-id target))
\r
1784 + (setq notmuch-tree-target-msg "found")
\r
1785 + (goto-char (point-max))
\r
1786 + (forward-line -1)
\r
1787 + (when notmuch-tree-open-target
\r
1788 + (notmuch-tree-show-message-in)))))
\r
1790 +(defun notmuch-tree-insert-tree (tree depth tree-status first last)
\r
1791 + "Insert the message tree TREE at depth DEPTH in the current thread.
\r
1793 +A message tree is another name for a single sub-thread: i.e., a
\r
1794 +message together with all its descendents."
\r
1795 + (let ((msg (car tree))
\r
1796 + (replies (cadr tree)))
\r
1799 + ((and (< 0 depth) (not last))
\r
1800 + (push "├" tree-status))
\r
1801 + ((and (< 0 depth) last)
\r
1802 + (push "╰" tree-status))
\r
1803 + ((and (eq 0 depth) first last)
\r
1804 +;; (push "─" tree-status)) choice between this and next line is matter of taste.
\r
1805 + (push " " tree-status))
\r
1806 + ((and (eq 0 depth) first (not last))
\r
1807 + (push "┬" tree-status))
\r
1808 + ((and (eq 0 depth) (not first) last)
\r
1809 + (push "╰" tree-status))
\r
1810 + ((and (eq 0 depth) (not first) (not last))
\r
1811 + (push "├" tree-status)))
\r
1813 + (push (concat (if replies "┬" "─") "►") tree-status)
\r
1814 + (plist-put msg :first (and first (eq 0 depth)))
\r
1815 + (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status tree-status))
\r
1816 + (pop tree-status)
\r
1817 + (pop tree-status)
\r
1820 + (push " " tree-status)
\r
1821 + (push "│" tree-status))
\r
1823 + (notmuch-tree-insert-thread replies (1+ depth) tree-status)))
\r
1825 +(defun notmuch-tree-insert-thread (thread depth tree-status)
\r
1826 + "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
\r
1827 + (let ((n (length thread)))
\r
1828 + (loop for tree in thread
\r
1829 + for count from 1 to n
\r
1831 + do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
\r
1833 +(defun notmuch-tree-insert-forest-thread (forest-thread)
\r
1834 + "Insert a single complete thread."
\r
1835 + (let (tree-status)
\r
1836 + ;; Reset at the start of each main thread.
\r
1837 + (setq notmuch-tree-previous-subject nil)
\r
1838 + (notmuch-tree-insert-thread forest-thread 0 tree-status)))
\r
1840 +(defun notmuch-tree-insert-forest (forest)
\r
1841 + "Insert a forest of threads.
\r
1843 +This function inserts a collection of several complete threads as
\r
1844 +passed to it by notmuch-tree-process-filter."
\r
1845 + (mapc 'notmuch-tree-insert-forest-thread forest))
\r
1847 +(defun notmuch-tree-mode ()
\r
1848 + "Major mode displaying messages (as opposed to threads) of of a notmuch search.
\r
1850 +This buffer contains the results of a \"notmuch tree\" of your
\r
1851 +email archives. Each line in the buffer represents a single
\r
1852 +message giving the relative date, the author, subject, and any
\r
1855 +Pressing \\[notmuch-tree-show-message] on any line displays that message.
\r
1857 +Complete list of currently available key bindings:
\r
1859 +\\{notmuch-tree-mode-map}"
\r
1862 + (kill-all-local-variables)
\r
1863 + (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
\r
1864 + (use-local-map notmuch-tree-mode-map)
\r
1865 + (setq major-mode 'notmuch-tree-mode
\r
1866 + mode-name "notmuch-tree")
\r
1867 + (hl-line-mode 1)
\r
1868 + (setq buffer-read-only t
\r
1869 + truncate-lines t))
\r
1871 +(defun notmuch-tree-process-sentinel (proc msg)
\r
1872 + "Add a message to let user know when \"notmuch tree\" exits"
\r
1873 + (let ((buffer (process-buffer proc))
\r
1874 + (status (process-status proc))
\r
1875 + (exit-status (process-exit-status proc))
\r
1876 + (never-found-target-thread nil))
\r
1877 + (when (memq status '(exit signal))
\r
1878 + (kill-buffer (process-get proc 'parse-buf))
\r
1879 + (if (buffer-live-p buffer)
\r
1880 + (with-current-buffer buffer
\r
1882 + (let ((inhibit-read-only t)
\r
1884 + (goto-char (point-max))
\r
1885 + (if (eq status 'signal)
\r
1886 + (insert "Incomplete search results (tree view process was killed).\n"))
\r
1887 + (when (eq status 'exit)
\r
1888 + (insert "End of search results.")
\r
1889 + (unless (= exit-status 0)
\r
1890 + (insert (format " (process returned %d)" exit-status)))
\r
1891 + (insert "\n")))))))))
\r
1893 +(defun notmuch-tree-process-filter (proc string)
\r
1894 + "Process and filter the output of \"notmuch show\" for tree view"
\r
1895 + (let ((results-buf (process-buffer proc))
\r
1896 + (parse-buf (process-get proc 'parse-buf))
\r
1897 + (inhibit-read-only t)
\r
1899 + (if (not (buffer-live-p results-buf))
\r
1900 + (delete-process proc)
\r
1901 + (with-current-buffer parse-buf
\r
1902 + ;; Insert new data
\r
1904 + (goto-char (point-max))
\r
1905 + (insert string))
\r
1906 + (notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread
\r
1907 + results-buf)))))
\r
1909 +(defun notmuch-tree-worker (basic-query &optional query-context target open-target)
\r
1910 + "Insert the tree view of the search in the current buffer.
\r
1912 +This is is a helper function for notmuch-tree. The arguments are
\r
1913 +the same as for the function notmuch-tree."
\r
1915 + (notmuch-tree-mode)
\r
1916 + (setq notmuch-tree-basic-query basic-query)
\r
1917 + (setq notmuch-tree-query-context query-context)
\r
1918 + (setq notmuch-tree-target-msg target)
\r
1919 + (setq notmuch-tree-open-target open-target)
\r
1922 + (goto-char (point-min))
\r
1923 + (let* ((search-args (concat basic-query
\r
1924 + (if query-context (concat " and (" query-context ")"))
\r
1926 + (message-arg "--entire-thread"))
\r
1927 + (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
\r
1928 + (setq search-args basic-query))
\r
1929 + (let ((proc (notmuch-start-notmuch
\r
1930 + "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
\r
1931 + "show" "--body=false" "--format=sexp"
\r
1932 + message-arg search-args))
\r
1933 + ;; Use a scratch buffer to accumulate partial output.
\r
1934 + ;; This buffer will be killed by the sentinel, which
\r
1935 + ;; should be called no matter how the process dies.
\r
1936 + (parse-buf (generate-new-buffer " *notmuch tree parse*")))
\r
1937 + (process-put proc 'parse-buf parse-buf)
\r
1938 + (set-process-filter proc 'notmuch-tree-process-filter)
\r
1939 + (set-process-query-on-exit-flag proc nil))))
\r
1941 +(defun notmuch-tree (&optional query query-context target buffer-name open-target)
\r
1942 + "Display threads matching QUERY in Tree View.
\r
1944 +The arguments are:
\r
1945 + QUERY: the main query. This can be any query but in many cases will be
\r
1946 + a single thread. If nil this is read interactively from the minibuffer.
\r
1947 + QUERY-CONTEXT: is an additional term for the query. The query used
\r
1948 + is QUERY and QUERY-CONTEXT unless that does not match any messages
\r
1949 + in which case we fall back to just QUERY.
\r
1950 + TARGET: A message ID (with the id: prefix) that will be made
\r
1951 + current if it appears in the tree view results.
\r
1952 + BUFFER-NAME: the name of the buffer to display the tree view. If
\r
1953 + it is nil \"*notmuch-tree\" followed by QUERY is used.
\r
1954 + OPEN-TARGET: If TRUE open the target message in the message pane."
\r
1956 + (if (null query)
\r
1957 + (setq query (notmuch-read-query "Notmuch tree view search: ")))
\r
1958 + (let ((buffer (get-buffer-create (generate-new-buffer-name
\r
1960 + (concat "*notmuch-tree-" query "*")))))
\r
1961 + (inhibit-read-only t))
\r
1963 + (switch-to-buffer buffer))
\r
1964 + ;; Don't track undo information for this buffer
\r
1965 + (set 'buffer-undo-list t)
\r
1967 + (notmuch-tree-worker query query-context target open-target)
\r
1969 + (setq truncate-lines t))
\r
1972 +;; Set up key bindings from the rest of notmuch.
\r
1973 +(define-key notmuch-common-keymap "z" 'notmuch-tree)
\r
1974 +(define-key notmuch-search-mode-map "Z" 'notmuch-tree-from-search-current-query)
\r
1975 +(define-key notmuch-show-mode-map "Z" 'notmuch-tree-from-show-current-query)
\r
1976 +(message "Initialised notmuch-tree")
\r
1978 +(provide 'notmuch-tree)
\r
projects / notmuch-archives.git / blob