notmuch-tree.el (56147B)
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 950 (notmuch-sanitize 951 (notmuch-show-strip-re (plist-get headers :Subject)))) 952 (previous-subject notmuch-tree-previous-subject) 953 (face (if match 954 'notmuch-tree-match-subject-face 955 'notmuch-tree-no-match-subject-face))) 956 957 (setq notmuch-tree-previous-subject bare-subject) 958 (propertize (format format-string 959 (if (string= previous-subject bare-subject) 960 " ..." 961 bare-subject)) 962 'face face))) 963 964 ((string-equal field "authors") 965 (let ((author (notmuch-tree-clean-address (plist-get headers :From))) 966 (len (length (format format-string ""))) 967 (face (if match 968 'notmuch-tree-match-author-face 969 'notmuch-tree-no-match-author-face))) 970 (when (> (length author) len) 971 (setq author (substring author 0 len))) 972 (propertize (format format-string author) 'face face))) 973 974 ((string-equal field "tags") 975 (let ((tags (plist-get msg :tags)) 976 (orig-tags (plist-get msg :orig-tags)) 977 (face (if match 978 'notmuch-tree-match-tag-face 979 'notmuch-tree-no-match-tag-face))) 980 (format format-string (notmuch-tag-format-tags tags orig-tags face))))))) 981 982 (defun notmuch-tree-format-field-list (field-list msg) 983 "Format fields of MSG according to FIELD-LIST and return string." 984 (let ((face (if (plist-get msg :match) 985 'notmuch-tree-match-face 986 'notmuch-tree-no-match-face)) 987 (result-string)) 988 (dolist (spec field-list result-string) 989 (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg))) 990 (setq result-string (concat result-string field-string)))) 991 (notmuch-apply-face result-string face t))) 992 993 (defun notmuch-tree-insert-msg (msg) 994 "Insert the message MSG according to notmuch-tree-result-format." 995 ;; We need to save the previous subject as it will get overwritten 996 ;; by the insert-field calls. 997 (let ((previous-subject notmuch-tree-previous-subject)) 998 (insert (notmuch-tree-format-field-list (notmuch-tree-result-format) msg)) 999 (notmuch-tree-set-message-properties msg) 1000 (notmuch-tree-set-prop :previous-subject previous-subject) 1001 (insert "\n"))) 1002 1003 (defun notmuch-tree-goto-and-insert-msg (msg) 1004 "Insert msg at the end of the buffer. Move point to msg if it is the target." 1005 (save-excursion 1006 (goto-char (point-max)) 1007 (notmuch-tree-insert-msg msg)) 1008 (let ((msg-id (notmuch-id-to-query (plist-get msg :id))) 1009 (target notmuch-tree-target-msg)) 1010 (when (or (and (not target) (plist-get msg :match)) 1011 (string= msg-id target)) 1012 (setq notmuch-tree-target-msg "found") 1013 (goto-char (point-max)) 1014 (forward-line -1) 1015 (when notmuch-tree-open-target 1016 (notmuch-tree-show-message-in) 1017 (notmuch-tree-command-hook))))) 1018 1019 (defun notmuch-tree-insert-tree (tree depth tree-status first last) 1020 "Insert the message tree TREE at depth DEPTH in the current thread. 1021 1022 A message tree is another name for a single sub-thread: i.e., a 1023 message together with all its descendents." 1024 (let ((msg (car tree)) 1025 (replies (cadr tree)) 1026 ;; outline level, computed from the message's depth and 1027 ;; whether or not it's the first message in the tree. 1028 (level (1+ (if (and (eq 0 depth) (not first)) 1 depth)))) 1029 (cond 1030 ((and (< 0 depth) (not last)) 1031 (push (alist-get 'vertical-tee notmuch-tree-thread-symbols) tree-status)) 1032 ((and (< 0 depth) last) 1033 (push (alist-get 'bottom notmuch-tree-thread-symbols) tree-status)) 1034 ((and (eq 0 depth) first last) 1035 (push (alist-get 'prefix notmuch-tree-thread-symbols) tree-status)) 1036 ((and (eq 0 depth) first (not last)) 1037 (push (alist-get 'top-tee notmuch-tree-thread-symbols) tree-status)) 1038 ((and (eq 0 depth) (not first) last) 1039 (push (alist-get 'bottom notmuch-tree-thread-symbols) tree-status)) 1040 ((and (eq 0 depth) (not first) (not last)) 1041 (push (alist-get 'vertical-tee notmuch-tree-thread-symbols) tree-status))) 1042 (push (concat (alist-get (if replies 'top-tee 'top) notmuch-tree-thread-symbols) 1043 (alist-get 'arrow notmuch-tree-thread-symbols)) 1044 tree-status) 1045 (setq msg (plist-put msg :first (and first (eq 0 depth)))) 1046 (setq msg (plist-put msg :tree-status tree-status)) 1047 (setq msg (plist-put msg :orig-tags (plist-get msg :tags))) 1048 (setq msg (plist-put msg :level level)) 1049 (notmuch-tree-goto-and-insert-msg msg) 1050 (pop tree-status) 1051 (pop tree-status) 1052 (if last 1053 (push " " tree-status) 1054 (push (alist-get 'vertical notmuch-tree-thread-symbols) tree-status)) 1055 (notmuch-tree-insert-thread replies (1+ depth) tree-status))) 1056 1057 (defun notmuch-tree-insert-thread (thread depth tree-status) 1058 "Insert the collection of sibling sub-threads THREAD at depth 1059 DEPTH in the current forest." 1060 (let ((n (length thread))) 1061 (cl-loop for tree in thread 1062 for count from 1 to n 1063 do (notmuch-tree-insert-tree tree depth tree-status 1064 (eq count 1) 1065 (eq count n))))) 1066 1067 (defun notmuch-tree-insert-forest-thread (forest-thread) 1068 "Insert a single complete thread." 1069 ;; Reset at the start of each main thread. 1070 (setq notmuch-tree-previous-subject nil) 1071 (notmuch-tree-insert-thread forest-thread 0 nil)) 1072 1073 (defun notmuch-tree-insert-forest (forest) 1074 "Insert a forest of threads. 1075 1076 This function inserts a collection of several complete threads as 1077 passed to it by notmuch-tree-process-filter." 1078 (mapc 'notmuch-tree-insert-forest-thread forest)) 1079 1080 (define-derived-mode notmuch-tree-mode fundamental-mode "notmuch-tree" 1081 "Major mode displaying messages (as opposed to threads) of a notmuch search. 1082 1083 This buffer contains the results of a \"notmuch tree\" of your 1084 email archives. Each line in the buffer represents a single 1085 message giving the relative date, the author, subject, and any 1086 tags. 1087 1088 Pressing \\[notmuch-tree-show-message] on any line displays that message. 1089 1090 Complete list of currently available key bindings: 1091 1092 \\{notmuch-tree-mode-map}" 1093 (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view) 1094 (hl-line-mode 1) 1095 (setq buffer-read-only t) 1096 (setq truncate-lines t) 1097 (when notmuch-tree-outline-enabled (notmuch-tree-outline-mode 1))) 1098 1099 (defvar notmuch-tree-process-exit-functions nil 1100 "Functions called when the process inserting a tree of results finishes. 1101 1102 Functions in this list are called with one argument, the process 1103 object, and with the tree results buffer as the current buffer.") 1104 1105 (defun notmuch-tree-process-sentinel (proc _msg) 1106 "Add a message to let user know when \"notmuch tree\" exits." 1107 (let ((buffer (process-buffer proc)) 1108 (status (process-status proc)) 1109 (exit-status (process-exit-status proc))) 1110 (when (memq status '(exit signal)) 1111 (kill-buffer (process-get proc 'parse-buf)) 1112 (when (buffer-live-p buffer) 1113 (with-current-buffer buffer 1114 (save-excursion 1115 (let ((inhibit-read-only t)) 1116 (goto-char (point-max)) 1117 (when (eq status 'signal) 1118 (insert "Incomplete search results (tree view process was killed).\n")) 1119 (when (eq status 'exit) 1120 (insert "End of search results.") 1121 (unless (= exit-status 0) 1122 (insert (format " (process returned %d)" exit-status))) 1123 (insert "\n")))) 1124 (run-hook-with-args 'notmuch-tree-process-exit-functions proc)))))) 1125 1126 (defun notmuch-tree-process-filter (proc string) 1127 "Process and filter the output of \"notmuch show\" for tree view." 1128 (let ((results-buf (process-buffer proc)) 1129 (parse-buf (process-get proc 'parse-buf)) 1130 (inhibit-read-only t)) 1131 (if (not (buffer-live-p results-buf)) 1132 (delete-process proc) 1133 (with-current-buffer parse-buf 1134 ;; Insert new data 1135 (save-excursion 1136 (goto-char (point-max)) 1137 (insert string)) 1138 (notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread 1139 results-buf))))) 1140 1141 (defun notmuch-tree-worker (basic-query &optional query-context target 1142 open-target unthreaded oldest-first 1143 exclude) 1144 "Insert the tree view of the search in the current buffer. 1145 1146 This is is a helper function for notmuch-tree. The arguments are 1147 the same as for the function notmuch-tree." 1148 (interactive) 1149 (notmuch-tree-mode) 1150 (add-hook 'post-command-hook #'notmuch-tree-command-hook t t) 1151 (setq notmuch-search-oldest-first oldest-first) 1152 (setq notmuch-search-hide-excluded exclude) 1153 (setq notmuch-tree-unthreaded unthreaded) 1154 (setq notmuch-tree-basic-query basic-query) 1155 (setq notmuch-tree-query-context (if (or (string= query-context "") 1156 (string= query-context "*")) 1157 nil 1158 query-context)) 1159 (setq notmuch-tree-target-msg target) 1160 (setq notmuch-tree-open-target open-target) 1161 ;; Set the default value for `notmuch-show-process-crypto' in this 1162 ;; buffer. Although we don't use this some of the functions we call 1163 ;; (such as reply) do. It is a buffer local variable so setting it 1164 ;; will not affect genuine show buffers. 1165 (setq notmuch-show-process-crypto notmuch-crypto-process-mime) 1166 (erase-buffer) 1167 (goto-char (point-min)) 1168 (let* ((search-args (concat basic-query 1169 (and query-context 1170 (concat " and (" query-context ")")))) 1171 (sort-arg (if oldest-first "--sort=oldest-first" "--sort=newest-first")) 1172 (message-arg (if unthreaded "--unthreaded" "--entire-thread")) 1173 (exclude-arg (if exclude "--exclude=true" "--exclude=false"))) 1174 (when (equal (car (notmuch--process-lines notmuch-command "count" search-args)) "0") 1175 (setq search-args basic-query)) 1176 (notmuch-tag-clear-cache) 1177 (let ((proc (notmuch-start-notmuch 1178 "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel 1179 "show" "--body=false" "--format=sexp" "--format-version=5" 1180 sort-arg message-arg exclude-arg search-args)) 1181 ;; Use a scratch buffer to accumulate partial output. 1182 ;; This buffer will be killed by the sentinel, which 1183 ;; should be called no matter how the process dies. 1184 (parse-buf (generate-new-buffer " *notmuch tree parse*"))) 1185 (process-put proc 'parse-buf parse-buf) 1186 (set-process-filter proc 'notmuch-tree-process-filter) 1187 (set-process-query-on-exit-flag proc nil)))) 1188 1189 (defun notmuch-tree-get-query () 1190 "Return the current query in this tree buffer." 1191 (if notmuch-tree-query-context 1192 (concat notmuch-tree-basic-query 1193 " and (" 1194 notmuch-tree-query-context 1195 ")") 1196 notmuch-tree-basic-query)) 1197 1198 (defun notmuch-tree-toggle-order () 1199 "Toggle the current search order. 1200 1201 This command toggles the sort order for the current search. The 1202 default sort order is defined by `notmuch-search-oldest-first'." 1203 (interactive) 1204 (setq notmuch-search-oldest-first (not notmuch-search-oldest-first)) 1205 (notmuch-tree-refresh-view)) 1206 1207 (defun notmuch-tree-toggle-hide-excluded () 1208 "Toggle whether to hide excluded messages. 1209 1210 This command toggles whether to hide excluded messages for the current 1211 search. The default value for this is defined by `notmuch-search-hide-excluded'." 1212 (interactive) 1213 (setq notmuch-search-hide-excluded (not notmuch-search-hide-excluded)) 1214 (notmuch-tree-refresh-view)) 1215 1216 ;;;###autoload 1217 (defun notmuch-tree (&optional query query-context target buffer-name 1218 open-target unthreaded parent-buffer 1219 oldest-first hide-excluded) 1220 "Display threads matching QUERY in tree view. 1221 1222 The arguments are: 1223 QUERY: the main query. This can be any query but in many cases will be 1224 a single thread. If nil this is read interactively from the minibuffer. 1225 QUERY-CONTEXT: is an additional term for the query. The query used 1226 is QUERY and QUERY-CONTEXT unless that does not match any messages 1227 in which case we fall back to just QUERY. 1228 TARGET: A message ID (with the id: prefix) that will be made 1229 current if it appears in the tree view results. 1230 BUFFER-NAME: the name of the buffer to display the tree view. If 1231 it is nil \"*notmuch-tree\" followed by QUERY is used. 1232 OPEN-TARGET: If TRUE open the target message in the message pane. 1233 UNTHREADED: If TRUE only show matching messages in an unthreaded view." 1234 (interactive 1235 (list 1236 ;; Prompt for a query 1237 nil 1238 ;; Fill other args with nil. 1239 nil nil nil nil nil nil 1240 ;; Populate these from the default value of these options. 1241 (default-value 'notmuch-search-oldest-first) 1242 (default-value 'notmuch-search-hide-excluded))) 1243 (unless query 1244 (setq query (notmuch-read-query (concat "Notmuch " 1245 (if unthreaded "unthreaded " "tree ") 1246 "view search: ")))) 1247 (let* ((name 1248 (or buffer-name 1249 (notmuch-search-buffer-title query 1250 (if unthreaded "unthreaded" "tree")))) 1251 (buffer (get-buffer-create (generate-new-buffer-name name))) 1252 (inhibit-read-only t)) 1253 (pop-to-buffer-same-window buffer)) 1254 ;; Don't track undo information for this buffer 1255 (setq buffer-undo-list t) 1256 (notmuch-tree-worker query query-context target open-target 1257 unthreaded oldest-first hide-excluded) 1258 (setq notmuch-tree-parent-buffer parent-buffer) 1259 (setq truncate-lines t)) 1260 1261 (defun notmuch-unthreaded (&optional query query-context target buffer-name 1262 open-target oldest-first hide-excluded) 1263 "Display threads matching QUERY in unthreaded view. 1264 1265 See function NOTMUCH-TREE for documentation of the arguments" 1266 (interactive 1267 (list 1268 ;; Prompt for a query 1269 nil 1270 ;; Fill other args with nil. 1271 nil nil nil nil 1272 ;; Populate these from the default value of these options. 1273 (default-value 'notmuch-search-oldest-first) 1274 (default-value 'notmuch-search-hide-excluded))) 1275 (notmuch-tree query query-context target buffer-name open-target 1276 t nil oldest-first hide-excluded)) 1277 1278 (defun notmuch-tree-filter (query) 1279 "Filter or LIMIT the current search results based on an additional query string. 1280 1281 Runs a new tree search matching only messages that match both the 1282 current search results AND the additional query string provided." 1283 (interactive (list (notmuch-read-query "Filter search: "))) 1284 (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)) 1285 (grouped-query (notmuch-group-disjunctive-query-string query)) 1286 (grouped-original-query (notmuch-group-disjunctive-query-string 1287 (notmuch-tree-get-query)))) 1288 (notmuch-tree-close-message-window) 1289 (notmuch-tree (if (string= grouped-original-query "*") 1290 grouped-query 1291 (concat grouped-original-query " and " grouped-query))))) 1292 1293 (defun notmuch-tree-filter-by-tag (tag) 1294 "Filter the current search results based on a single TAG. 1295 1296 Run a new search matching only messages that match the current 1297 search results and that are also tagged with the given TAG." 1298 (interactive 1299 (list (notmuch-select-tag-with-completion "Filter by tag: " 1300 notmuch-tree-basic-query))) 1301 (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))) 1302 (notmuch-tree-close-message-window) 1303 (notmuch-tree (concat notmuch-tree-basic-query " and tag:" tag) 1304 notmuch-tree-query-context 1305 nil 1306 nil 1307 nil 1308 notmuch-tree-unthreaded 1309 nil 1310 notmuch-search-oldest-first 1311 notmuch-search-hide-excluded))) 1312 1313 (defun notmuch-tree-edit-search (query) 1314 "Edit the current search" 1315 (interactive (list (read-from-minibuffer "Edit search: " 1316 notmuch-tree-basic-query))) 1317 (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))) 1318 (notmuch-tree-close-message-window) 1319 (notmuch-tree query 1320 notmuch-tree-query-context 1321 nil 1322 nil 1323 nil 1324 notmuch-tree-unthreaded 1325 nil 1326 notmuch-search-oldest-first))) 1327 1328 ;;; Tree outline mode 1329 ;;;; Custom variables 1330 (defcustom notmuch-tree-outline-enabled nil 1331 "Whether to automatically activate `notmuch-tree-outline-mode' in tree views." 1332 :type 'boolean) 1333 1334 (defcustom notmuch-tree-outline-visibility 'hide-others 1335 "Default state of the forest outline for `notmuch-tree-outline-mode'. 1336 1337 This variable controls the state of a forest initially and after 1338 a movement command. If set to nil, all trees are displayed while 1339 the symbol hide-all indicates that all trees in the forest should 1340 be folded and hide-other that only the first one should be 1341 unfolded." 1342 :type '(choice (const :tag "Show all" nil) 1343 (const :tag "Hide others" hide-others) 1344 (const :tag "Hide all" hide-all))) 1345 1346 (defcustom notmuch-tree-outline-auto-close nil 1347 "Close message and tree windows when moving past the last message." 1348 :type 'boolean) 1349 1350 (defcustom notmuch-tree-outline-open-on-next nil 1351 "Open new messages under point if they are closed when moving to next one. 1352 1353 When this flag is set, using the command 1354 `notmuch-tree-outline-next' with point on a header for a new 1355 message that is not shown will open its `notmuch-show' buffer 1356 instead of moving point to next matching message." 1357 :type 'boolean) 1358 1359 ;;;; Helper functions 1360 (defsubst notmuch-tree-outline--pop-at-end (pop-at-end) 1361 (if notmuch-tree-outline-auto-close (not pop-at-end) pop-at-end)) 1362 1363 (defun notmuch-tree-outline--set-visibility () 1364 (when (and notmuch-tree-outline-mode (> (point-max) (point-min))) 1365 (cl-case notmuch-tree-outline-visibility 1366 (hide-others (notmuch-tree-outline-hide-others)) 1367 (hide-all (outline-hide-body))))) 1368 1369 (defun notmuch-tree-outline--on-exit (proc) 1370 (when (eq (process-status proc) 'exit) 1371 (notmuch-tree-outline--set-visibility))) 1372 1373 (add-hook 'notmuch-tree-process-exit-functions #'notmuch-tree-outline--on-exit) 1374 1375 (defsubst notmuch-tree-outline--level (&optional props) 1376 (or (plist-get (or props (notmuch-tree-get-message-properties)) :level) 0)) 1377 1378 (defsubst notmuch-tree-outline--message-open-p () 1379 (and (buffer-live-p notmuch-tree-message-buffer) 1380 (get-buffer-window notmuch-tree-message-buffer) 1381 (let ((id (notmuch-tree-get-message-id))) 1382 (and id 1383 (with-current-buffer notmuch-tree-message-buffer 1384 (string= (notmuch-show-get-message-id) id)))))) 1385 1386 (defsubst notmuch-tree-outline--at-original-match-p () 1387 (and (notmuch-tree-get-prop :match) 1388 (equal (notmuch-tree-get-prop :orig-tags) 1389 (notmuch-tree-get-prop :tags)))) 1390 1391 (defun notmuch-tree-outline--next (prev thread pop-at-end &optional open-new) 1392 (cond (thread 1393 (notmuch-tree-thread-top) 1394 (if prev 1395 (outline-backward-same-level 1) 1396 (outline-forward-same-level 1)) 1397 (when (> (notmuch-tree-outline--level) 0) (outline-show-branches)) 1398 (notmuch-tree-outline--next nil nil pop-at-end t)) 1399 ((and (or open-new notmuch-tree-outline-open-on-next) 1400 (notmuch-tree-outline--at-original-match-p) 1401 (not (notmuch-tree-outline--message-open-p))) 1402 (notmuch-tree-outline-hide-others t)) 1403 (t (outline-next-visible-heading (if prev -1 1)) 1404 (unless (notmuch-tree-get-prop :match) 1405 (notmuch-tree-matching-message prev pop-at-end)) 1406 (notmuch-tree-outline-hide-others t)))) 1407 1408 ;;;; User commands 1409 (defun notmuch-tree-outline-hide-others (&optional and-show) 1410 "Fold all threads except the one around point. 1411 If AND-SHOW is t, make the current message visible if it's not." 1412 (interactive) 1413 (save-excursion 1414 (while (and (not (bobp)) (> (notmuch-tree-outline--level) 1)) 1415 (outline-previous-heading)) 1416 (outline-hide-sublevels 1)) 1417 (when (> (notmuch-tree-outline--level) 0) 1418 (outline-show-subtree) 1419 (when and-show (notmuch-tree-show-message nil)))) 1420 1421 (defun notmuch-tree-outline-next (&optional pop-at-end) 1422 "Next matching message in a forest, taking care of thread visibility. 1423 A prefix argument reverses the meaning of `notmuch-tree-outline-auto-close'." 1424 (interactive "P") 1425 (let ((pop (notmuch-tree-outline--pop-at-end pop-at-end))) 1426 (if (null notmuch-tree-outline-visibility) 1427 (notmuch-tree-matching-message nil pop) 1428 (notmuch-tree-outline--next nil nil pop)))) 1429 1430 (defun notmuch-tree-outline-previous (&optional pop-at-end) 1431 "Previous matching message in forest, taking care of thread visibility. 1432 With prefix, quit the tree view if there is no previous message." 1433 (interactive "P") 1434 (if (null notmuch-tree-outline-visibility) 1435 (notmuch-tree-prev-matching-message pop-at-end) 1436 (notmuch-tree-outline--next t nil pop-at-end))) 1437 1438 (defun notmuch-tree-outline-next-thread () 1439 "Next matching thread in forest, taking care of thread visibility." 1440 (interactive) 1441 (if (null notmuch-tree-outline-visibility) 1442 (notmuch-tree-next-thread) 1443 (notmuch-tree-outline--next nil t nil))) 1444 1445 (defun notmuch-tree-outline-previous-thread () 1446 "Previous matching thread in forest, taking care of thread visibility." 1447 (interactive) 1448 (if (null notmuch-tree-outline-visibility) 1449 (notmuch-tree-prev-thread) 1450 (notmuch-tree-outline--next t t nil))) 1451 1452 ;;;; Mode definition 1453 (defvar notmuch-tree-outline-mode-lighter nil 1454 "The lighter mark for notmuch-tree-outline mode. 1455 Usually empty since outline-minor-mode's lighter will be active.") 1456 1457 (define-minor-mode notmuch-tree-outline-mode 1458 "Minor mode allowing message trees to be folded as outlines. 1459 1460 When this mode is set, each thread and subthread in the results 1461 list is treated as a foldable section, with its first message as 1462 its header. 1463 1464 The mode just makes available in the tree buffer all the 1465 keybindings in `outline-minor-mode', and binds the following 1466 additional keys: 1467 1468 \\{notmuch-tree-outline-mode-map} 1469 1470 The customizable variable `notmuch-tree-outline-visibility' 1471 controls how navigation in the buffer is affected by this mode: 1472 1473 - If it is set to nil, `notmuch-tree-outline-previous', 1474 `notmuch-tree-outline-next', and their thread counterparts 1475 behave just as the corresponding notmuch-tree navigation keys 1476 when this mode is not enabled. 1477 1478 - If, on the other hand, `notmuch-tree-outline-visibility' is 1479 set to a non-nil value, these commands hiding the outlines of 1480 the trees you are not reading as you move to new messages. 1481 1482 To enable notmuch-tree-outline-mode by default in all 1483 notmuch-tree buffers, just set 1484 `notmuch-tree-outline-mode-enabled' to t." 1485 :lighter notmuch-tree-outline-mode-lighter 1486 :keymap `((,(kbd "TAB") . outline-cycle) 1487 (,(kbd "M-TAB") . outline-cycle-buffer) 1488 ("n" . notmuch-tree-outline-next) 1489 ("p" . notmuch-tree-outline-previous) 1490 (,(kbd "M-n") . notmuch-tree-outline-next-thread) 1491 (,(kbd "M-p") . notmuch-tree-outline-previous-thread)) 1492 (outline-minor-mode notmuch-tree-outline-mode) 1493 (unless (derived-mode-p 'notmuch-tree-mode) 1494 (user-error "notmuch-tree-outline-mode is only meaningful for notmuch trees!")) 1495 (if notmuch-tree-outline-mode 1496 (progn (setq-local outline-regexp "^[^\n]+") 1497 (setq-local outline-level #'notmuch-tree-outline--level) 1498 (notmuch-tree-outline--set-visibility)) 1499 (setq-local outline-regexp (default-value 'outline-regexp)) 1500 (setq-local outline-level (default-value 'outline-level)))) 1501 1502 ;;; _ 1503 1504 (provide 'notmuch-tree) 1505 1506 ;;; notmuch-tree.el ends here