]> git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-tree.el
emacs/show: use n-s-i-headerline to update tags
[notmuch] / emacs / notmuch-tree.el
1 ;;; notmuch-tree.el --- displaying notmuch forests  -*- lexical-binding: t -*-
2 ;;
3 ;; Copyright © Carl Worth
4 ;; Copyright © David Edmondson
5 ;; Copyright © Mark Walters
6 ;;
7 ;; This file is part of Notmuch.
8 ;;
9 ;; Notmuch is free software: you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
13 ;;
14 ;; Notmuch is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 ;; General Public License for more details.
18 ;;
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with Notmuch.  If not, see <https://www.gnu.org/licenses/>.
21 ;;
22 ;; Authors: David Edmondson <dme@dme.org>
23 ;;          Mark Walters <markwalters1009@gmail.com>
24
25 ;;; Code:
26
27 (require 'mail-parse)
28
29 (require 'notmuch-lib)
30 (require 'notmuch-show)
31 (require 'notmuch-tag)
32 (require 'notmuch-parser)
33 (require 'notmuch-jump)
34
35 (declare-function notmuch-search "notmuch"
36                   (&optional query oldest-first target-thread target-line
37                              no-display))
38 (declare-function notmuch-call-notmuch-process "notmuch-lib" (&rest args))
39 (declare-function notmuch-read-query "notmuch" (prompt))
40 (declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
41 (declare-function notmuch-search-find-subject "notmuch" ())
42
43 ;; For `notmuch-tree-next-thread-from-search'.
44 (declare-function notmuch-search-next-thread "notmuch" ())
45 (declare-function notmuch-search-previous-thread "notmuch" ())
46 (declare-function notmuch-tree-from-search-thread "notmuch" ())
47
48 ;; this variable distinguishes the unthreaded display from the normal tree display
49 (defvar-local notmuch-tree-unthreaded nil
50   "A buffer local copy of argument unthreaded to the function notmuch-tree.")
51
52 ;;; Options
53
54 (defgroup notmuch-tree nil
55   "Showing message and thread structure."
56   :group 'notmuch)
57
58 (defcustom notmuch-tree-show-out nil
59   "View selected messages in new window rather than split-pane."
60   :type 'boolean
61   :group 'notmuch-tree)
62
63 (defcustom notmuch-unthreaded-show-out t
64   "View selected messages in new window rather than split-pane."
65   :type 'boolean
66   :group 'notmuch-tree)
67
68 (defun notmuch-tree-show-out ()
69   (if notmuch-tree-unthreaded
70       notmuch-unthreaded-show-out
71     notmuch-tree-show-out))
72
73 (defcustom notmuch-tree-thread-symbols
74   '((prefix . " ")
75     (top . "─")
76     (top-tee . "┬")
77     (vertical . "│")
78     (vertical-tee . "├")
79     (bottom . "╰")
80     (arrow . "►"))
81   "Strings used to draw trees in notmuch tree results.
82 Symbol keys denote where the corresponding string value is used:
83 `prefix' is used at the top of the tree, followed by `top' if it
84 has no children or `top-tee' if it does; `vertical' is a bar
85 connecting with a response down the list skipping the current
86 one, while `vertical-tee' marks the current message as a reply to
87 the previous one; `bottom' is used at the bottom of threads.
88 Finally, the `arrrow' string in the list is used as a pointer to
89 every message.
90
91 Common customizations include setting `prefix' to \"-\", to see
92 equal-length prefixes, and `arrow' to an empty string or to a
93 different kind of arrow point."
94   :type '(alist :key-type symbol :value-type string)
95   :group 'notmuch-tree)
96
97 (defconst notmuch-tree--field-names
98   '(choice :tag "Field"
99            (const :tag "Date" "date")
100            (const :tag "Authors" "authors")
101            (const :tag "Subject" "subject")
102            (const :tag "Tree" "tree")
103            (const :tag "Tags" "tags")
104            (function)))
105
106 (defcustom notmuch-tree-result-format
107   `(("date" . "%12s  ")
108     ("authors" . "%-20s")
109     ((("tree" . "%s")
110       ("subject" . "%s"))
111      . " %-54s ")
112     ("tags" . "(%s)"))
113   "Result formatting for tree view.
114
115 List of pairs of (field . format-string).  Supported field
116 strings are: \"date\", \"authors\", \"subject\", \"tree\",
117 \"tags\".  It is also supported to pass a function in place of a
118 field-name. In this case the function is passed the thread
119 object (plist) and format string.
120
121 Tree means the thread tree box graphics. The field may
122 also be a list in which case the formatting rules are
123 applied recursively and then the output of all the fields
124 in the list is inserted according to format-string.
125
126 Note that the author string should not contain whitespace
127 \(put it in the neighbouring fields instead)."
128
129   :type `(alist :key-type (choice ,notmuch-tree--field-names
130                                   (alist :key-type ,notmuch-tree--field-names
131                                          :value-type (string :tag "Format")))
132                 :value-type (string :tag "Format"))
133   :group 'notmuch-tree)
134
135 (defcustom notmuch-unthreaded-result-format
136   `(("date" . "%12s  ")
137     ("authors" . "%-20s")
138     ((("subject" . "%s")) ." %-54s ")
139     ("tags" . "(%s)"))
140   "Result formatting for unthreaded tree view.
141
142 List of pairs of (field . format-string).  Supported field
143 strings are: \"date\", \"authors\", \"subject\", \"tree\",
144 \"tags\".  It is also supported to pass a function in place of a
145 field-name. In this case the function is passed the thread
146 object (plist) and format string.
147
148 Tree means the thread tree box graphics. The field may
149 also be a list in which case the formatting rules are
150 applied recursively and then the output of all the fields
151 in the list is inserted according to format-string.
152
153 Note that the author string should not contain whitespace
154 \(put it in the neighbouring fields instead)."
155
156   :type `(alist :key-type (choice ,notmuch-tree--field-names
157                                   (alist :key-type ,notmuch-tree--field-names
158                                          :value-type (string :tag "Format")))
159                 :value-type (string :tag "Format"))
160   :group 'notmuch-tree)
161
162 (defun notmuch-tree-result-format ()
163   (if notmuch-tree-unthreaded
164       notmuch-unthreaded-result-format
165     notmuch-tree-result-format))
166
167 ;;; Faces
168 ;;;; Faces for messages that match the query
169
170 (defface notmuch-tree-match-face
171   '((t :inherit default))
172   "Default face used in tree mode face for matching messages"
173   :group 'notmuch-tree
174   :group 'notmuch-faces)
175
176 (defface notmuch-tree-match-date-face
177   nil
178   "Face used in tree mode for the date in messages matching the query."
179   :group 'notmuch-tree
180   :group 'notmuch-faces)
181
182 (defface notmuch-tree-match-author-face
183   '((((class color)
184       (background dark))
185      (:foreground "OliveDrab1"))
186     (((class color)
187       (background light))
188      (:foreground "dark blue"))
189     (t
190      (:bold t)))
191   "Face used in tree mode for the author in messages matching the query."
192   :group 'notmuch-tree
193   :group 'notmuch-faces)
194
195 (defface notmuch-tree-match-subject-face
196   nil
197   "Face used in tree mode for the subject in messages matching the query."
198   :group 'notmuch-tree
199   :group 'notmuch-faces)
200
201 (defface notmuch-tree-match-tree-face
202   nil
203   "Face used in tree mode for the thread tree block graphics in messages matching the query."
204   :group 'notmuch-tree
205   :group 'notmuch-faces)
206
207 (defface notmuch-tree-match-tag-face
208   '((((class color)
209       (background dark))
210      (:foreground "OliveDrab1"))
211     (((class color)
212       (background light))
213      (:foreground "navy blue" :bold t))
214     (t
215      (:bold t)))
216   "Face used in tree mode for tags in messages matching the query."
217   :group 'notmuch-tree
218   :group 'notmuch-faces)
219
220 ;;;; Faces for messages that do not match the query
221
222 (defface notmuch-tree-no-match-face
223   '((t (:foreground "gray")))
224   "Default face used in tree mode face for non-matching messages."
225   :group 'notmuch-tree
226   :group 'notmuch-faces)
227
228 (defface notmuch-tree-no-match-date-face
229   nil
230   "Face used in tree mode for non-matching dates."
231   :group 'notmuch-tree
232   :group 'notmuch-faces)
233
234 (defface notmuch-tree-no-match-subject-face
235   nil
236   "Face used in tree mode for non-matching subjects."
237   :group 'notmuch-tree
238   :group 'notmuch-faces)
239
240 (defface notmuch-tree-no-match-tree-face
241   nil
242   "Face used in tree mode for the thread tree block graphics in messages matching the query."
243   :group 'notmuch-tree
244   :group 'notmuch-faces)
245
246 (defface notmuch-tree-no-match-author-face
247   nil
248   "Face used in tree mode for non-matching authors."
249   :group 'notmuch-tree
250   :group 'notmuch-faces)
251
252 (defface notmuch-tree-no-match-tag-face
253   nil
254   "Face used in tree mode face for non-matching tags."
255   :group 'notmuch-tree
256   :group 'notmuch-faces)
257
258 ;;; Variables
259
260 (defvar-local notmuch-tree-previous-subject
261   "The subject of the most recent result shown during the async display.")
262
263 (defvar-local notmuch-tree-basic-query nil
264   "A buffer local copy of argument query to the function notmuch-tree.")
265
266 (defvar-local notmuch-tree-query-context nil
267   "A buffer local copy of argument query-context to the function notmuch-tree.")
268
269 (defvar-local notmuch-tree-target-msg nil
270   "A buffer local copy of argument target to the function notmuch-tree.")
271
272 (defvar-local notmuch-tree-open-target nil
273   "A buffer local copy of argument open-target to the function notmuch-tree.")
274
275 (defvar-local notmuch-tree-parent-buffer nil)
276
277 (defvar-local notmuch-tree-message-window nil
278   "The window of the message pane.
279
280 It is set in both the tree buffer and the child show buffer. It
281 is used to try and close the message pane when quitting tree view
282 or the child show buffer.")
283 (put 'notmuch-tree-message-window 'permanent-local t)
284
285 (defvar-local notmuch-tree-message-buffer nil
286   "The buffer name of the show buffer in the message pane.
287
288 This is used to try and make sure we don't close the message pane
289 if the user has loaded a different buffer in that window.")
290 (put 'notmuch-tree-message-buffer 'permanent-local t)
291
292 ;;; Tree wrapper commands
293
294 (defmacro notmuch-tree--define-do-in-message-window (name cmd)
295   "Define NAME as a command that calls CMD interactively in the message window.
296 If the message pane is closed then this command does nothing.
297 Avoid using this macro in new code; it will be removed."
298   `(defun ,name ()
299      ,(concat "(In message window) " (documentation cmd t))
300      (interactive)
301      (when (window-live-p notmuch-tree-message-window)
302        (with-selected-window notmuch-tree-message-window
303          (call-interactively #',cmd)))))
304
305 (notmuch-tree--define-do-in-message-window
306  notmuch-tree-previous-message-button
307  notmuch-show-previous-button)
308 (notmuch-tree--define-do-in-message-window
309  notmuch-tree-next-message-button
310  notmuch-show-next-button)
311 (notmuch-tree--define-do-in-message-window
312  notmuch-tree-toggle-message-process-crypto
313  notmuch-show-toggle-process-crypto)
314
315 (defun notmuch-tree--message-process-crypto ()
316   "Return value of `notmuch-show-process-crypto' in the message window.
317 If that window isn't alive, then return the current value.
318 Avoid using this function in new code; it will be removed."
319   (if (window-live-p notmuch-tree-message-window)
320       (with-selected-window notmuch-tree-message-window
321         notmuch-show-process-crypto)
322     notmuch-show-process-crypto))
323
324 (defmacro notmuch-tree--define-close-message-window-and (name cmd)
325   "Define NAME as a variant of CMD.
326
327 NAME determines the value of `notmuch-show-process-crypto' in the
328 message window, closes the window, and then call CMD interactively
329 with that value let-bound.  If the message window does not exist,
330 then NAME behaves like CMD."
331   `(defun ,name ()
332      ,(concat "(Close message pane and) " (documentation cmd t))
333      (interactive)
334      (let ((notmuch-show-process-crypto
335             (notmuch-tree--message-process-crypto)))
336        (notmuch-tree-close-message-window)
337        (call-interactively #',cmd))))
338
339 (notmuch-tree--define-close-message-window-and
340  notmuch-tree-help
341  notmuch-help)
342 (notmuch-tree--define-close-message-window-and
343  notmuch-tree-new-mail
344  notmuch-mua-new-mail)
345 (notmuch-tree--define-close-message-window-and
346  notmuch-tree-jump-search
347  notmuch-jump-search)
348 (notmuch-tree--define-close-message-window-and
349  notmuch-tree-forward-message
350  notmuch-show-forward-message)
351 (notmuch-tree--define-close-message-window-and
352  notmuch-tree-reply-sender
353  notmuch-show-reply-sender)
354 (notmuch-tree--define-close-message-window-and
355  notmuch-tree-reply
356  notmuch-show-reply)
357 (notmuch-tree--define-close-message-window-and
358  notmuch-tree-view-raw-message
359  notmuch-show-view-raw-message)
360
361 ;;; Keymap
362
363 (defvar notmuch-tree-mode-map
364   (let ((map (make-sparse-keymap)))
365     (set-keymap-parent map notmuch-common-keymap)
366     ;; These bindings shadow common bindings with variants
367     ;; that additionally close the message window.
368     (define-key map [remap notmuch-bury-or-kill-this-buffer] 'notmuch-tree-quit)
369     (define-key map [remap notmuch-search]        'notmuch-tree-to-search)
370     (define-key map [remap notmuch-help]          'notmuch-tree-help)
371     (define-key map [remap notmuch-mua-new-mail]  'notmuch-tree-new-mail)
372     (define-key map [remap notmuch-jump-search]   'notmuch-tree-jump-search)
373
374     (define-key map "o" 'notmuch-tree-toggle-order)
375     (define-key map "S" 'notmuch-search-from-tree-current-query)
376     (define-key map "U" 'notmuch-unthreaded-from-tree-current-query)
377     (define-key map "Z" 'notmuch-tree-from-unthreaded-current-query)
378
379     ;; these use notmuch-show functions directly
380     (define-key map "|" 'notmuch-show-pipe-message)
381     (define-key map "w" 'notmuch-show-save-attachments)
382     (define-key map "v" 'notmuch-show-view-all-mime-parts)
383     (define-key map "c" 'notmuch-show-stash-map)
384     (define-key map "b" 'notmuch-show-resend-message)
385
386     ;; these apply to the message pane
387     (define-key map (kbd "M-TAB")     'notmuch-tree-previous-message-button)
388     (define-key map (kbd "<backtab>") 'notmuch-tree-previous-message-button)
389     (define-key map (kbd "TAB")       'notmuch-tree-next-message-button)
390     (define-key map "$" 'notmuch-tree-toggle-message-process-crypto)
391
392     ;; bindings from show (or elsewhere) but we close the message pane first.
393     (define-key map "f" 'notmuch-tree-forward-message)
394     (define-key map "r" 'notmuch-tree-reply-sender)
395     (define-key map "R" 'notmuch-tree-reply)
396     (define-key map "V" 'notmuch-tree-view-raw-message)
397     (define-key map "l" 'notmuch-tree-filter)
398     (define-key map "t" 'notmuch-tree-filter-by-tag)
399     (define-key map "E" 'notmuch-tree-edit-search)
400
401     ;; The main tree view bindings
402     (define-key map (kbd "RET") 'notmuch-tree-show-message)
403     (define-key map [mouse-1] 'notmuch-tree-show-message)
404     (define-key map "x" 'notmuch-tree-archive-message-then-next-or-exit)
405     (define-key map "X" 'notmuch-tree-archive-thread-then-exit)
406     (define-key map "A" 'notmuch-tree-archive-thread-then-next)
407     (define-key map "a" 'notmuch-tree-archive-message-then-next)
408     (define-key map "z" 'notmuch-tree-to-tree)
409     (define-key map "n" 'notmuch-tree-next-matching-message)
410     (define-key map "p" 'notmuch-tree-prev-matching-message)
411     (define-key map "N" 'notmuch-tree-next-message)
412     (define-key map "P" 'notmuch-tree-prev-message)
413     (define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
414     (define-key map (kbd "M-n") 'notmuch-tree-next-thread)
415     (define-key map "k" 'notmuch-tag-jump)
416     (define-key map "-" 'notmuch-tree-remove-tag)
417     (define-key map "+" 'notmuch-tree-add-tag)
418     (define-key map "*" 'notmuch-tree-tag-thread)
419     (define-key map " " 'notmuch-tree-scroll-or-next)
420     (define-key map (kbd "DEL") 'notmuch-tree-scroll-message-window-back)
421     (define-key map "e" 'notmuch-tree-resume-message)
422     map)
423   "Keymap for \"notmuch tree\" buffers.")
424
425 ;;; Message properties
426
427 (defun notmuch-tree-get-message-properties ()
428   "Return the properties of the current message as a plist.
429
430 Some useful entries are:
431 :headers - Property list containing the headers :Date, :Subject, :From, etc.
432 :tags - Tags for this message."
433   (save-excursion
434     (beginning-of-line)
435     (get-text-property (point) :notmuch-message-properties)))
436
437 (defun notmuch-tree-set-message-properties (props)
438   (save-excursion
439     (beginning-of-line)
440     (put-text-property (point)
441                        (+ (point) 1)
442                        :notmuch-message-properties props)))
443
444 (defun notmuch-tree-set-prop (prop val &optional props)
445   (let ((inhibit-read-only t)
446         (props (or props
447                    (notmuch-tree-get-message-properties))))
448     (plist-put props prop val)
449     (notmuch-tree-set-message-properties props)))
450
451 (defun notmuch-tree-get-prop (prop &optional props)
452   (plist-get (or props (notmuch-tree-get-message-properties))
453              prop))
454
455 (defun notmuch-tree-set-tags (tags)
456   "Set the tags of the current message."
457   (notmuch-tree-set-prop :tags tags))
458
459 (defun notmuch-tree-get-tags ()
460   "Return the tags of the current message."
461   (notmuch-tree-get-prop :tags))
462
463 (defun notmuch-tree-get-message-id (&optional bare)
464   "Return the message id of the current message."
465   (let ((id (notmuch-tree-get-prop :id)))
466     (if id
467         (if bare
468             id
469           (notmuch-id-to-query id))
470       nil)))
471
472 (defun notmuch-tree-get-match ()
473   "Return whether the current message is a match."
474   (notmuch-tree-get-prop :match))
475
476 ;;; Update display
477
478 (defun notmuch-tree-refresh-result ()
479   "Redisplay the current message line.
480
481 This redisplays the current line based on the messages
482 properties (as they are now). This is used when tags are
483 updated."
484   (let ((init-point (point))
485         (end (line-end-position))
486         (msg (notmuch-tree-get-message-properties))
487         (inhibit-read-only t))
488     (beginning-of-line)
489     ;; This is a little tricky: we override
490     ;; notmuch-tree-previous-subject to get the decision between
491     ;; ... and a subject right and it stops notmuch-tree-insert-msg
492     ;; from overwriting the buffer local copy of
493     ;; notmuch-tree-previous-subject if this is called while the
494     ;; buffer is displaying.
495     (let ((notmuch-tree-previous-subject
496            (notmuch-tree-get-prop :previous-subject)))
497       (delete-region (point) (1+ (line-end-position)))
498       (notmuch-tree-insert-msg msg))
499     (let ((new-end (line-end-position)))
500       (goto-char (if (= init-point end)
501                      new-end
502                    (min init-point (- new-end 1)))))))
503
504 (defun notmuch-tree-tag-update-display (&optional tag-changes)
505   "Update display for TAG-CHANGES to current message.
506
507 Updates the message in the message pane if appropriate, but does
508 NOT change the database."
509   (let* ((current-tags (notmuch-tree-get-tags))
510          (new-tags (notmuch-update-tags current-tags tag-changes))
511          (tree-msg-id (notmuch-tree-get-message-id)))
512     (unless (equal current-tags new-tags)
513       (notmuch-tree-set-tags new-tags)
514       (notmuch-tree-refresh-result)
515       (when (window-live-p notmuch-tree-message-window)
516         (with-selected-window notmuch-tree-message-window
517           (when (string= tree-msg-id (notmuch-show-get-message-id))
518             (notmuch-show-update-tags new-tags)))))))
519
520 ;;; Commands (and some helper functions used by them)
521
522 (defun notmuch-tree-tag (tag-changes)
523   "Change tags for the current message."
524   (interactive
525    (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message")))
526   (notmuch-tag (notmuch-tree-get-message-id) tag-changes)
527   (notmuch-tree-tag-update-display tag-changes))
528
529 (defun notmuch-tree-add-tag (tag-changes)
530   "Same as `notmuch-tree-tag' but sets initial input to '+'."
531   (interactive
532    (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "+")))
533   (notmuch-tree-tag tag-changes))
534
535 (defun notmuch-tree-remove-tag (tag-changes)
536   "Same as `notmuch-tree-tag' but sets initial input to '-'."
537   (interactive
538    (list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-")))
539   (notmuch-tree-tag tag-changes))
540
541 (defun notmuch-tree-resume-message ()
542   "Resume EDITING the current draft message."
543   (interactive)
544   (notmuch-tree-close-message-window)
545   (let ((id (notmuch-tree-get-message-id)))
546     (if id
547         (notmuch-draft-resume id)
548       (message "No message to resume!"))))
549
550 ;; The next two functions close the message window before calling
551 ;; notmuch-search or notmuch-tree but they do so after the user has
552 ;; entered the query (in case the user was basing the query on
553 ;; something in the message window).
554
555 (defun notmuch-tree-to-search ()
556   "Run \"notmuch search\" with the given `query' and display results."
557   (interactive)
558   (let ((query (notmuch-read-query "Notmuch search: ")))
559     (notmuch-tree-close-message-window)
560     (notmuch-search query)))
561
562 (defun notmuch-tree-to-tree ()
563   "Run a query and display results in tree view."
564   (interactive)
565   (let ((query (notmuch-read-query "Notmuch tree view search: ")))
566     (notmuch-tree-close-message-window)
567     (notmuch-tree query)))
568
569 (defun notmuch-tree-archive-thread-then-next ()
570   "Archive all messages in the current buffer, then show next thread from search."
571   (interactive)
572   (notmuch-tree-archive-thread)
573   (notmuch-tree-next-thread))
574
575 (defun notmuch-unthreaded-from-tree-current-query ()
576   "Switch from tree view to unthreaded view."
577   (interactive)
578   (unless notmuch-tree-unthreaded
579     (notmuch-tree-refresh-view 'unthreaded)))
580
581 (defun notmuch-tree-from-unthreaded-current-query ()
582   "Switch from unthreaded view to tree view."
583   (interactive)
584   (when notmuch-tree-unthreaded
585     (notmuch-tree-refresh-view 'tree)))
586
587 (defun notmuch-search-from-tree-current-query ()
588   "Call notmuch search with the current query."
589   (interactive)
590   (notmuch-tree-close-message-window)
591   (notmuch-search (notmuch-tree-get-query)))
592
593 (defun notmuch-tree-message-window-kill-hook ()
594   "Close the message pane when exiting the show buffer."
595   (let ((buffer (current-buffer)))
596     (when (and (window-live-p notmuch-tree-message-window)
597                (eq (window-buffer notmuch-tree-message-window) buffer))
598       ;; We could check whether this is the only window in its frame,
599       ;; but simply ignoring the error that is thrown otherwise is
600       ;; what we had to do for Emacs 24 and we stick to that because
601       ;; it is still the simplest approach.
602       (ignore-errors
603         (delete-window notmuch-tree-message-window)))))
604
605 (defun notmuch-tree-command-hook ()
606   (when (eq major-mode 'notmuch-tree-mode)
607     ;; We just run the notmuch-show-command-hook on the message pane.
608     (when (buffer-live-p notmuch-tree-message-buffer)
609       (with-current-buffer notmuch-tree-message-buffer
610         (notmuch-show-command-hook)))))
611
612 (defun notmuch-tree-show-message-in ()
613   "Show the current message (in split-pane)."
614   (interactive)
615   (let ((id (notmuch-tree-get-message-id))
616         (inhibit-read-only t)
617         buffer)
618     (when id
619       ;; We close and reopen the window to kill off un-needed buffers
620       ;; this might cause flickering but seems ok.
621       (notmuch-tree-close-message-window)
622       (setq notmuch-tree-message-window
623             (split-window-vertically (/ (window-height) 4)))
624       (with-selected-window notmuch-tree-message-window
625         (let (;; Since we are only displaying one message do not indent.
626               (notmuch-show-indent-messages-width 0)
627               (notmuch-show-single-message t)
628               ;; Ensure that `pop-to-buffer-same-window' uses the
629               ;; window we want it to use.
630               (display-buffer-overriding-action
631                  '((display-buffer-same-window)
632                    (inhibit-same-window . nil))))
633           (setq buffer (notmuch-show id))))
634       ;; We need the `let' as notmuch-tree-message-window is buffer local.
635       (let ((window notmuch-tree-message-window))
636         (with-current-buffer buffer
637           (setq notmuch-tree-message-window window)
638           (add-hook 'kill-buffer-hook 'notmuch-tree-message-window-kill-hook)))
639       (when notmuch-show-mark-read-tags
640         (notmuch-tree-tag-update-display notmuch-show-mark-read-tags))
641       (setq notmuch-tree-message-buffer buffer))))
642
643 (defun notmuch-tree-show-message-out ()
644   "Show the current message (in whole window)."
645   (interactive)
646   (let ((id (notmuch-tree-get-message-id))
647         (inhibit-read-only t))
648     (when id
649       ;; We close the window to kill off un-needed buffers.
650       (notmuch-tree-close-message-window)
651       ;; n-s-s-m is buffer local, so use inner let.
652       (let ((notmuch-show-single-message t))
653         (notmuch-show id)))))
654
655 (defun notmuch-tree-show-message (arg)
656   "Show the current message.
657
658 Shows in split pane or whole window according to value of
659 `notmuch-tree-show-out'. A prefix argument reverses the choice."
660   (interactive "P")
661   (if (or (and (notmuch-tree-show-out) (not arg))
662           (and (not (notmuch-tree-show-out)) arg))
663       (notmuch-tree-show-message-out)
664     (notmuch-tree-show-message-in)))
665
666 (defun notmuch-tree-scroll-message-window ()
667   "Scroll the message window (if it exists)."
668   (interactive)
669   (when (window-live-p notmuch-tree-message-window)
670     (with-selected-window notmuch-tree-message-window
671       (if (pos-visible-in-window-p (point-max))
672           t
673         (scroll-up)))))
674
675 (defun notmuch-tree-scroll-message-window-back ()
676   "Scroll the message window back (if it exists)."
677   (interactive)
678   (when (window-live-p notmuch-tree-message-window)
679     (with-selected-window notmuch-tree-message-window
680       (if (pos-visible-in-window-p (point-min))
681           t
682         (scroll-down)))))
683
684 (defun notmuch-tree-scroll-or-next ()
685   "Scroll the message window.
686 If it at end go to next message."
687   (interactive)
688   (when (notmuch-tree-scroll-message-window)
689     (notmuch-tree-next-matching-message)))
690
691 (defun notmuch-tree-quit (&optional kill-both)
692   "Close the split view or exit tree."
693   (interactive "P")
694   (when (or (not (notmuch-tree-close-message-window)) kill-both)
695     (kill-buffer (current-buffer))))
696
697 (defun notmuch-tree-close-message-window ()
698   "Close the message-window. Return t if close succeeds."
699   (interactive)
700   (when (and (window-live-p notmuch-tree-message-window)
701              (eq (window-buffer notmuch-tree-message-window)
702                  notmuch-tree-message-buffer))
703     (delete-window notmuch-tree-message-window)
704     (unless (get-buffer-window-list notmuch-tree-message-buffer)
705       (kill-buffer notmuch-tree-message-buffer))
706     t))
707
708 (defun notmuch-tree-archive-message (&optional unarchive)
709   "Archive the current message.
710
711 Archive the current message by applying the tag changes in
712 `notmuch-archive-tags' to it. If a prefix argument is given, the
713 message will be \"unarchived\", i.e. the tag changes in
714 `notmuch-archive-tags' will be reversed."
715   (interactive "P")
716   (when notmuch-archive-tags
717     (notmuch-tree-tag
718      (notmuch-tag-change-list notmuch-archive-tags unarchive))))
719
720 (defun notmuch-tree-archive-message-then-next (&optional unarchive)
721   "Archive the current message and move to next matching message."
722   (interactive "P")
723   (notmuch-tree-archive-message unarchive)
724   (notmuch-tree-next-matching-message))
725
726 (defun notmuch-tree-archive-thread-then-exit ()
727   "Archive all messages in the current buffer, then exit notmuch-tree."
728   (interactive)
729   (notmuch-tree-archive-thread)
730   (notmuch-tree-quit t))
731
732 (defun notmuch-tree-archive-message-then-next-or-exit ()
733   "Archive current message, then show next open message in current thread.
734
735 If at the last open message in the current thread, then exit back
736 to search results."
737   (interactive)
738   (notmuch-tree-archive-message)
739   (notmuch-tree-next-matching-message t))
740
741 (defun notmuch-tree-next-message ()
742   "Move to next message."
743   (interactive)
744   (forward-line)
745   (when (window-live-p notmuch-tree-message-window)
746     (notmuch-tree-show-message-in)))
747
748 (defun notmuch-tree-prev-message ()
749   "Move to previous message."
750   (interactive)
751   (forward-line -1)
752   (when (window-live-p notmuch-tree-message-window)
753     (notmuch-tree-show-message-in)))
754
755 (defun notmuch-tree-goto-matching-message (&optional prev)
756   "Move to the next or previous matching message.
757
758 Returns t if there was a next matching message in the thread to show,
759 nil otherwise."
760   (let ((dir (if prev -1 nil))
761         (eobfn (if prev #'bobp #'eobp)))
762     (while (and (not (funcall eobfn))
763                 (not (notmuch-tree-get-match)))
764       (forward-line dir))
765     (not (funcall eobfn))))
766
767 (defun notmuch-tree-matching-message (&optional prev pop-at-end)
768   "Move to the next or previous matching message."
769   (interactive "P")
770   (forward-line (if prev -1 nil))
771   (if (and (not (notmuch-tree-goto-matching-message prev)) pop-at-end)
772       (notmuch-tree-quit pop-at-end)
773     (when (window-live-p notmuch-tree-message-window)
774       (notmuch-tree-show-message-in))))
775
776 (defun notmuch-tree-prev-matching-message (&optional pop-at-end)
777   "Move to previous matching message."
778   (interactive "P")
779   (notmuch-tree-matching-message t pop-at-end))
780
781 (defun notmuch-tree-next-matching-message (&optional pop-at-end)
782   "Move to next matching message."
783   (interactive "P")
784   (notmuch-tree-matching-message nil pop-at-end))
785
786 (defun notmuch-tree-refresh-view (&optional view)
787   "Refresh view."
788   (interactive)
789   (when (get-buffer-process (current-buffer))
790     (error "notmuch tree process already running for current buffer"))
791   (let ((inhibit-read-only t)
792         (basic-query notmuch-tree-basic-query)
793         (unthreaded (cond ((eq view 'unthreaded) t)
794                           ((eq view 'tree) nil)
795                           (t notmuch-tree-unthreaded)))
796         (query-context notmuch-tree-query-context)
797         (target (notmuch-tree-get-message-id)))
798     (erase-buffer)
799     (notmuch-tree-worker basic-query
800                          query-context
801                          target
802                          nil
803                          unthreaded
804                          notmuch-search-oldest-first)))
805
806 (defun notmuch-tree-thread-top ()
807   (when (notmuch-tree-get-message-properties)
808     (while (not (or (notmuch-tree-get-prop :first) (eobp)))
809       (forward-line -1))))
810
811 (defun notmuch-tree-prev-thread-in-tree ()
812   "Move to the previous thread in the current tree"
813   (interactive)
814   (forward-line -1)
815   (notmuch-tree-thread-top)
816   (not (bobp)))
817
818 (defun notmuch-tree-next-thread-in-tree ()
819   "Get the next thread in the current tree. Returns t if a thread was
820 found or nil if not."
821   (interactive)
822   (forward-line 1)
823   (while (not (or (notmuch-tree-get-prop :first) (eobp)))
824     (forward-line 1))
825   (not (eobp)))
826
827 (defun notmuch-tree-next-thread-from-search (&optional previous)
828   "Move to the next thread in the parent search results, if any.
829
830 If PREVIOUS is non-nil, move to the previous item in the
831 search results instead."
832   (interactive "P")
833   (let ((parent-buffer notmuch-tree-parent-buffer))
834     (notmuch-tree-quit t)
835     (when (buffer-live-p parent-buffer)
836       (switch-to-buffer parent-buffer)
837       (if previous
838           (notmuch-search-previous-thread)
839         (notmuch-search-next-thread))
840       (notmuch-tree-from-search-thread))))
841
842 (defun notmuch-tree-next-thread (&optional previous)
843   "Move to the next thread in the current tree or parent search results.
844
845 If PREVIOUS is non-nil, move to the previous thread in the tree or
846 search results instead."
847   (interactive)
848   (unless (if previous (notmuch-tree-prev-thread-in-tree)
849             (notmuch-tree-next-thread-in-tree))
850     (notmuch-tree-next-thread-from-search previous)))
851
852 (defun notmuch-tree-prev-thread ()
853   "Move to the previous thread in the current tree or parent search results."
854   (interactive)
855   (notmuch-tree-next-thread t))
856
857 (defun notmuch-tree-thread-mapcar (function)
858   "Call FUNCTION for each message in the current thread.
859 FUNCTION is called for side effects only."
860   (save-excursion
861     (notmuch-tree-thread-top)
862     (cl-loop collect (funcall function)
863              do (forward-line)
864              while (and (notmuch-tree-get-message-properties)
865                         (not (notmuch-tree-get-prop :first))))))
866
867 (defun notmuch-tree-get-messages-ids-thread-search ()
868   "Return a search string for all message ids of messages in the current thread."
869   (mapconcat 'identity
870              (notmuch-tree-thread-mapcar 'notmuch-tree-get-message-id)
871              " or "))
872
873 (defun notmuch-tree-tag-thread (tag-changes)
874   "Tag all messages in the current thread."
875   (interactive
876    (let ((tags (apply #'append (notmuch-tree-thread-mapcar
877                                 (lambda () (notmuch-tree-get-tags))))))
878      (list (notmuch-read-tag-changes tags "Tag thread"))))
879   (when (notmuch-tree-get-message-properties)
880     (notmuch-tag (notmuch-tree-get-messages-ids-thread-search) tag-changes)
881     (notmuch-tree-thread-mapcar
882      (lambda () (notmuch-tree-tag-update-display tag-changes)))))
883
884 (defun notmuch-tree-archive-thread (&optional unarchive)
885   "Archive each message in thread.
886
887 Archive each message currently shown by applying the tag changes
888 in `notmuch-archive-tags' to each. If a prefix argument is given,
889 the messages will be \"unarchived\", i.e. the tag changes in
890 `notmuch-archive-tags' will be reversed.
891
892 Note: This command is safe from any race condition of new messages
893 being delivered to the same thread. It does not archive the
894 entire thread, but only the messages shown in the current
895 buffer."
896   (interactive "P")
897   (when notmuch-archive-tags
898     (notmuch-tree-tag-thread
899      (notmuch-tag-change-list notmuch-archive-tags unarchive))))
900
901 ;;; Functions for displaying the tree buffer itself
902
903 (defun notmuch-tree-clean-address (address)
904   "Try to clean a single email ADDRESS for display. Return
905 AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
906 unchanged ADDRESS if parsing fails."
907   (let* ((clean-address (notmuch-clean-address address))
908          (p-address (car clean-address))
909          (p-name (cdr clean-address)))
910
911     ;; If we have a name return that otherwise return the address.
912     (or p-name p-address)))
913
914 (defun notmuch-tree-format-field (field format-string msg)
915   "Format a FIELD of MSG according to FORMAT-STRING and return string."
916   (let* ((headers (plist-get msg :headers))
917          (match (plist-get msg :match)))
918     (cond
919      ((listp field)
920       (format format-string (notmuch-tree-format-field-list field msg)))
921
922      ((functionp field)
923       (funcall field format-string msg))
924
925      ((string-equal field "date")
926       (let ((face (if match
927                       'notmuch-tree-match-date-face
928                     'notmuch-tree-no-match-date-face)))
929         (propertize (format format-string (plist-get msg :date_relative))
930                     'face face)))
931
932      ((string-equal field "tree")
933       (let ((tree-status (plist-get msg :tree-status))
934             (face (if match
935                       'notmuch-tree-match-tree-face
936                     'notmuch-tree-no-match-tree-face)))
937
938         (propertize (format format-string
939                             (mapconcat #'identity (reverse tree-status) ""))
940                     'face face)))
941
942      ((string-equal field "subject")
943       (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
944             (previous-subject notmuch-tree-previous-subject)
945             (face (if match
946                       'notmuch-tree-match-subject-face
947                     'notmuch-tree-no-match-subject-face)))
948
949         (setq notmuch-tree-previous-subject bare-subject)
950         (propertize (format format-string
951                             (if (string= previous-subject bare-subject)
952                                 " ..."
953                               bare-subject))
954                     'face face)))
955
956      ((string-equal field "authors")
957       (let ((author (notmuch-tree-clean-address (plist-get headers :From)))
958             (len (length (format format-string "")))
959             (face (if match
960                       'notmuch-tree-match-author-face
961                     'notmuch-tree-no-match-author-face)))
962         (when (> (length author) len)
963           (setq author (substring author 0 len)))
964         (propertize (format format-string author) 'face face)))
965
966      ((string-equal field "tags")
967       (let ((tags (plist-get msg :tags))
968             (orig-tags (plist-get msg :orig-tags))
969             (face (if match
970                       'notmuch-tree-match-tag-face
971                     'notmuch-tree-no-match-tag-face)))
972         (format format-string (notmuch-tag-format-tags tags orig-tags face)))))))
973
974 (defun notmuch-tree-format-field-list (field-list msg)
975   "Format fields of MSG according to FIELD-LIST and return string."
976   (let ((face (if (plist-get msg :match)
977                   'notmuch-tree-match-face
978                 'notmuch-tree-no-match-face))
979         (result-string))
980     (dolist (spec field-list result-string)
981       (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
982         (setq result-string (concat result-string field-string))))
983     (notmuch-apply-face result-string face t)))
984
985 (defun notmuch-tree-insert-msg (msg)
986   "Insert the message MSG according to notmuch-tree-result-format."
987   ;; We need to save the previous subject as it will get overwritten
988   ;; by the insert-field calls.
989   (let ((previous-subject notmuch-tree-previous-subject))
990     (insert (notmuch-tree-format-field-list (notmuch-tree-result-format) msg))
991     (notmuch-tree-set-message-properties msg)
992     (notmuch-tree-set-prop :previous-subject previous-subject)
993     (insert "\n")))
994
995 (defun notmuch-tree-goto-and-insert-msg (msg)
996   "Insert msg at the end of the buffer. Move point to msg if it is the target."
997   (save-excursion
998     (goto-char (point-max))
999     (notmuch-tree-insert-msg msg))
1000   (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
1001         (target notmuch-tree-target-msg))
1002     (when (or (and (not target) (plist-get msg :match))
1003               (string= msg-id target))
1004       (setq notmuch-tree-target-msg "found")
1005       (goto-char (point-max))
1006       (forward-line -1)
1007       (when notmuch-tree-open-target
1008         (notmuch-tree-show-message-in)
1009         (notmuch-tree-command-hook)))))
1010
1011 (defun notmuch-tree-insert-tree (tree depth tree-status first last)
1012   "Insert the message tree TREE at depth DEPTH in the current thread.
1013
1014 A message tree is another name for a single sub-thread: i.e., a
1015 message together with all its descendents."
1016   (let ((msg (car tree))
1017         (replies (cadr tree)))
1018     (cond
1019      ((and (< 0 depth) (not last))
1020       (push (alist-get 'vertical-tee  notmuch-tree-thread-symbols) tree-status))
1021      ((and (< 0 depth) last)
1022       (push (alist-get 'bottom notmuch-tree-thread-symbols) tree-status))
1023      ((and (eq 0 depth) first last)
1024       (push (alist-get 'prefix notmuch-tree-thread-symbols) tree-status))
1025      ((and (eq 0 depth) first (not last))
1026       (push (alist-get 'top-tee notmuch-tree-thread-symbols) tree-status))
1027      ((and (eq 0 depth) (not first) last)
1028       (push (alist-get 'bottom notmuch-tree-thread-symbols) tree-status))
1029      ((and (eq 0 depth) (not first) (not last))
1030       (push (alist-get 'vertical-tee notmuch-tree-thread-symbols) tree-status)))
1031     (push (concat (alist-get (if replies 'top-tee 'top) notmuch-tree-thread-symbols)
1032                   (alist-get 'arrow notmuch-tree-thread-symbols))
1033           tree-status)
1034     (setq msg (plist-put msg :first (and first (eq 0 depth))))
1035     (setq msg (plist-put msg :tree-status tree-status))
1036     (setq msg (plist-put msg :orig-tags (plist-get msg :tags)))
1037     (notmuch-tree-goto-and-insert-msg msg)
1038     (pop tree-status)
1039     (pop tree-status)
1040     (if last
1041         (push " " tree-status)
1042       (push (alist-get 'vertical notmuch-tree-thread-symbols) tree-status))
1043     (notmuch-tree-insert-thread replies (1+ depth) tree-status)))
1044
1045 (defun notmuch-tree-insert-thread (thread depth tree-status)
1046   "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
1047   (let ((n (length thread)))
1048     (cl-loop for tree in thread
1049              for count from 1 to n
1050              do (notmuch-tree-insert-tree tree depth tree-status
1051                                           (eq count 1)
1052                                           (eq count n)))))
1053
1054 (defun notmuch-tree-insert-forest-thread (forest-thread)
1055   "Insert a single complete thread."
1056   ;; Reset at the start of each main thread.
1057   (setq notmuch-tree-previous-subject nil)
1058   (notmuch-tree-insert-thread forest-thread 0 nil))
1059
1060 (defun notmuch-tree-insert-forest (forest)
1061   "Insert a forest of threads.
1062
1063 This function inserts a collection of several complete threads as
1064 passed to it by notmuch-tree-process-filter."
1065   (mapc 'notmuch-tree-insert-forest-thread forest))
1066
1067 (define-derived-mode notmuch-tree-mode fundamental-mode "notmuch-tree"
1068   "Major mode displaying messages (as opposed to threads) of a notmuch search.
1069
1070 This buffer contains the results of a \"notmuch tree\" of your
1071 email archives. Each line in the buffer represents a single
1072 message giving the relative date, the author, subject, and any
1073 tags.
1074
1075 Pressing \\[notmuch-tree-show-message] on any line displays that message.
1076
1077 Complete list of currently available key bindings:
1078
1079 \\{notmuch-tree-mode-map}"
1080   (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
1081   (hl-line-mode 1)
1082   (setq buffer-read-only t)
1083   (setq truncate-lines t))
1084
1085 (defvar notmuch-tree-process-exit-functions nil
1086   "Functions called when the process inserting a tree of results finishes.
1087
1088 Functions in this list are called with one argument, the process
1089 object, and with the tree results buffer as the current buffer.")
1090
1091 (defun notmuch-tree-process-sentinel (proc _msg)
1092   "Add a message to let user know when \"notmuch tree\" exits."
1093   (let ((buffer (process-buffer proc))
1094         (status (process-status proc))
1095         (exit-status (process-exit-status proc)))
1096     (when (memq status '(exit signal))
1097       (kill-buffer (process-get proc 'parse-buf))
1098       (when (buffer-live-p buffer)
1099         (with-current-buffer buffer
1100           (save-excursion
1101             (let ((inhibit-read-only t))
1102               (goto-char (point-max))
1103               (when (eq status 'signal)
1104                 (insert "Incomplete search results (tree view process was killed).\n"))
1105               (when (eq status 'exit)
1106                 (insert "End of search results.")
1107                 (unless (= exit-status 0)
1108                   (insert (format " (process returned %d)" exit-status)))
1109                 (insert "\n"))))
1110           (run-hook-with-args 'notmuch-tree-process-exit-functions proc))))))
1111
1112 (defun notmuch-tree-process-filter (proc string)
1113   "Process and filter the output of \"notmuch show\" for tree view."
1114   (let ((results-buf (process-buffer proc))
1115         (parse-buf (process-get proc 'parse-buf))
1116         (inhibit-read-only t))
1117     (if (not (buffer-live-p results-buf))
1118         (delete-process proc)
1119       (with-current-buffer parse-buf
1120         ;; Insert new data
1121         (save-excursion
1122           (goto-char (point-max))
1123           (insert string))
1124         (notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread
1125                                          results-buf)))))
1126
1127 (defun notmuch-tree-worker (basic-query &optional query-context target
1128                                         open-target unthreaded oldest-first)
1129   "Insert the tree view of the search in the current buffer.
1130
1131 This is is a helper function for notmuch-tree. The arguments are
1132 the same as for the function notmuch-tree."
1133   (interactive)
1134   (notmuch-tree-mode)
1135   (add-hook 'post-command-hook #'notmuch-tree-command-hook t t)
1136   (setq notmuch-search-oldest-first oldest-first)
1137   (setq notmuch-tree-unthreaded unthreaded)
1138   (setq notmuch-tree-basic-query basic-query)
1139   (setq notmuch-tree-query-context (if (or (string= query-context "")
1140                                            (string= query-context "*"))
1141                                        nil
1142                                      query-context))
1143   (setq notmuch-tree-target-msg target)
1144   (setq notmuch-tree-open-target open-target)
1145   ;; Set the default value for `notmuch-show-process-crypto' in this
1146   ;; buffer. Although we don't use this some of the functions we call
1147   ;; (such as reply) do. It is a buffer local variable so setting it
1148   ;; will not affect genuine show buffers.
1149   (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
1150   (erase-buffer)
1151   (goto-char (point-min))
1152   (let* ((search-args (concat basic-query
1153                               (and query-context
1154                                    (concat " and (" query-context ")"))))
1155          (sort-arg (if oldest-first "--sort=oldest-first" "--sort=newest-first"))
1156          (message-arg (if unthreaded "--unthreaded" "--entire-thread")))
1157     (when (equal (car (notmuch--process-lines notmuch-command "count" search-args)) "0")
1158       (setq search-args basic-query))
1159     (notmuch-tag-clear-cache)
1160     (let ((proc (notmuch-start-notmuch
1161                  "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
1162                  "show" "--body=false" "--format=sexp" "--format-version=5"
1163                  sort-arg message-arg search-args))
1164           ;; Use a scratch buffer to accumulate partial output.
1165           ;; This buffer will be killed by the sentinel, which
1166           ;; should be called no matter how the process dies.
1167           (parse-buf (generate-new-buffer " *notmuch tree parse*")))
1168       (process-put proc 'parse-buf parse-buf)
1169       (set-process-filter proc 'notmuch-tree-process-filter)
1170       (set-process-query-on-exit-flag proc nil))))
1171
1172 (defun notmuch-tree-get-query ()
1173   "Return the current query in this tree buffer."
1174   (if notmuch-tree-query-context
1175       (concat notmuch-tree-basic-query
1176               " and ("
1177               notmuch-tree-query-context
1178               ")")
1179     notmuch-tree-basic-query))
1180
1181 (defun notmuch-tree-toggle-order ()
1182   "Toggle the current search order.
1183
1184 This command toggles the sort order for the current search. The
1185 default sort order is defined by `notmuch-search-oldest-first'."
1186   (interactive)
1187   (setq notmuch-search-oldest-first (not notmuch-search-oldest-first))
1188   (notmuch-tree-refresh-view))
1189
1190 (defun notmuch-tree (&optional query query-context target buffer-name
1191                                open-target unthreaded parent-buffer oldest-first)
1192   "Display threads matching QUERY in tree view.
1193
1194 The arguments are:
1195   QUERY: the main query. This can be any query but in many cases will be
1196       a single thread. If nil this is read interactively from the minibuffer.
1197   QUERY-CONTEXT: is an additional term for the query. The query used
1198       is QUERY and QUERY-CONTEXT unless that does not match any messages
1199       in which case we fall back to just QUERY.
1200   TARGET: A message ID (with the id: prefix) that will be made
1201       current if it appears in the tree view results.
1202   BUFFER-NAME: the name of the buffer to display the tree view. If
1203       it is nil \"*notmuch-tree\" followed by QUERY is used.
1204   OPEN-TARGET: If TRUE open the target message in the message pane.
1205   UNTHREADED: If TRUE only show matching messages in an unthreaded view."
1206   (interactive)
1207   (unless query
1208     (setq query (notmuch-read-query (concat "Notmuch "
1209                                             (if unthreaded "unthreaded " "tree ")
1210                                             "view search: "))))
1211   (let* ((name
1212           (or buffer-name
1213               (notmuch-search-buffer-title query
1214                                            (if unthreaded "unthreaded" "tree"))))
1215          (buffer (get-buffer-create (generate-new-buffer-name name)))
1216         (inhibit-read-only t))
1217     (pop-to-buffer-same-window buffer))
1218   ;; Don't track undo information for this buffer
1219   (setq buffer-undo-list t)
1220   (notmuch-tree-worker query query-context target open-target unthreaded oldest-first)
1221   (setq notmuch-tree-parent-buffer parent-buffer)
1222   (setq truncate-lines t))
1223
1224 (defun notmuch-unthreaded (&optional query query-context target buffer-name
1225                                      open-target)
1226   "Display threads matching QUERY in unthreaded view.
1227
1228 See function NOTMUCH-TREE for documentation of the arguments"
1229   (interactive)
1230   (notmuch-tree query query-context target buffer-name open-target t))
1231
1232 (defun notmuch-tree-filter (query)
1233   "Filter or LIMIT the current search results based on an additional query string.
1234
1235 Runs a new tree search matching only messages that match both the
1236 current search results AND the additional query string provided."
1237   (interactive (list (notmuch-read-query "Filter search: ")))
1238   (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))
1239         (grouped-query (notmuch-group-disjunctive-query-string query))
1240         (grouped-original-query (notmuch-group-disjunctive-query-string
1241                                  (notmuch-tree-get-query))))
1242     (notmuch-tree-close-message-window)
1243     (notmuch-tree (if (string= grouped-original-query "*")
1244                       grouped-query
1245                     (concat grouped-original-query " and " grouped-query)))))
1246
1247 (defun notmuch-tree-filter-by-tag (tag)
1248   "Filter the current search results based on a single TAG.
1249
1250 Run a new search matching only messages that match the current
1251 search results and that are also tagged with the given TAG."
1252   (interactive
1253    (list (notmuch-select-tag-with-completion "Filter by tag: "
1254                                              notmuch-tree-basic-query)))
1255   (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
1256     (notmuch-tree-close-message-window)
1257     (notmuch-tree (concat notmuch-tree-basic-query " and tag:" tag)
1258                   notmuch-tree-query-context
1259                   nil
1260                   nil
1261                   nil
1262                   notmuch-tree-unthreaded
1263                   nil
1264                   notmuch-search-oldest-first)))
1265
1266 (defun notmuch-tree-edit-search (query)
1267   "Edit the current search"
1268   (interactive (list (read-from-minibuffer "Edit search: "
1269                                            notmuch-tree-basic-query)))
1270   (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
1271     (notmuch-tree-close-message-window)
1272     (notmuch-tree query
1273                   notmuch-tree-query-context
1274                   nil
1275                   nil
1276                   nil
1277                   notmuch-tree-unthreaded
1278                   nil
1279                   notmuch-search-oldest-first)))
1280
1281 ;;; _
1282
1283 (provide 'notmuch-tree)
1284
1285 ;;; notmuch-tree.el ends here