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