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