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