notmuch-hello.el (39234B)
1 ;;; notmuch-hello.el --- welcome to notmuch, a frontend -*- lexical-binding: t -*- 2 ;; 3 ;; Copyright © David Edmondson 4 ;; 5 ;; This file is part of Notmuch. 6 ;; 7 ;; Notmuch is free software: you can redistribute it and/or modify it 8 ;; under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 ;; 12 ;; Notmuch is distributed in the hope that it will be useful, but 13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; General Public License for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>. 19 ;; 20 ;; Authors: David Edmondson <dme@dme.org> 21 22 ;;; Code: 23 24 (require 'widget) 25 (require 'wid-edit) ; For `widget-forward'. 26 27 (require 'notmuch-lib) 28 (require 'notmuch-mua) 29 30 (declare-function notmuch-search "notmuch" 31 (&optional query oldest-first target-thread target-line 32 no-display)) 33 (declare-function notmuch-poll "notmuch-lib" ()) 34 (declare-function notmuch-tree "notmuch-tree" 35 (&optional query query-context target buffer-name 36 open-target unthreaded parent-buffer 37 oldest-first hide-excluded)) 38 (declare-function notmuch-unthreaded "notmuch-tree" 39 (&optional query query-context target buffer-name 40 open-target oldest-first hide-excluded)) 41 42 43 ;;; Options 44 45 (defun notmuch-saved-search-get (saved-search field) 46 "Get FIELD from SAVED-SEARCH. 47 48 If SAVED-SEARCH is a plist, this is just `plist-get', but for 49 backwards compatibility, this also deals with the two other 50 possible formats for SAVED-SEARCH: cons cells (NAME . QUERY) and 51 lists (NAME QUERY COUNT-QUERY)." 52 (cond 53 ((keywordp (car saved-search)) 54 (plist-get saved-search field)) 55 ;; It is not a plist so it is an old-style entry. 56 ((consp (cdr saved-search)) 57 (pcase-let ((`(,name ,query ,count-query) saved-search)) 58 (cl-case field 59 (:name name) 60 (:query query) 61 (:count-query count-query) 62 (t nil)))) 63 (t 64 (pcase-let ((`(,name . ,query) saved-search)) 65 (cl-case field 66 (:name name) 67 (:query query) 68 (t nil)))))) 69 70 (defun notmuch-hello-saved-search-to-plist (saved-search) 71 "Return a copy of SAVED-SEARCH in plist form. 72 73 If saved search is a plist then just return a copy. In other 74 cases, for backwards compatibility, convert to plist form and 75 return that." 76 (if (keywordp (car saved-search)) 77 (copy-sequence saved-search) 78 (let ((fields (list :name :query :count-query)) 79 plist-search) 80 (dolist (field fields plist-search) 81 (let ((string (notmuch-saved-search-get saved-search field))) 82 (when string 83 (setq plist-search (append plist-search (list field string))))))))) 84 85 (defun notmuch-hello--saved-searches-to-plist (symbol) 86 "Extract a saved-search variable into plist form. 87 88 The new style saved search is just a plist, but for backwards 89 compatibility we use this function to extract old style saved 90 searches so they still work in customize." 91 (let ((saved-searches (default-value symbol))) 92 (mapcar #'notmuch-hello-saved-search-to-plist saved-searches))) 93 94 (define-widget 'notmuch-saved-search-plist 'list 95 "A single saved search property list." 96 :tag "Saved Search" 97 :args '((list :inline t 98 :format "%v" 99 (group :format "%v" :inline t 100 (const :format " Name: " :name) 101 (string :format "%v")) 102 (group :format "%v" :inline t 103 (const :format " Query: " :query) 104 (string :format "%v"))) 105 (checklist :inline t 106 :format "%v" 107 (group :format "%v" :inline t 108 (const :format "Shortcut key: " :key) 109 (key-sequence :format "%v")) 110 (group :format "%v" :inline t 111 (const :format "Count-Query: " :count-query) 112 (string :format "%v")) 113 (group :format "%v" :inline t 114 (const :format "" :sort-order) 115 (choice :tag " Sort Order" 116 (const :tag "Default" nil) 117 (const :tag "Oldest-first" oldest-first) 118 (const :tag "Newest-first" newest-first))) 119 (group :format "%v" :inline t 120 (const :format "" :excluded) 121 (choice :tag " Hide Excluded" 122 (const :tag "Default" nil) 123 (const :tag "Hide" hide) 124 (const :tag "Show" show))) 125 (group :format "%v" :inline t 126 (const :format "" :search-type) 127 (choice :tag " Search Type" 128 (const :tag "Search mode" nil) 129 (const :tag "Tree mode" tree) 130 (const :tag "Unthreaded mode" unthreaded)))))) 131 132 (defcustom notmuch-saved-searches 133 `((:name "inbox" :query "tag:inbox" :key ,(kbd "i")) 134 (:name "unread" :query "tag:unread" :key ,(kbd "u")) 135 (:name "flagged" :query "tag:flagged" :key ,(kbd "f")) 136 (:name "sent" :query "tag:sent" :key ,(kbd "t")) 137 (:name "drafts" :query "tag:draft" :key ,(kbd "d")) 138 (:name "all mail" :query "*" :key ,(kbd "a"))) 139 "A list of saved searches to display. 140 141 The saved search can be given in 3 forms. The preferred way is as 142 a plist. Supported properties are 143 144 :name Name of the search (required). 145 :query Search to run (required). 146 :key Optional shortcut key for `notmuch-jump-search'. 147 :count-query Optional extra query to generate the count 148 shown. If not present then the :query property 149 is used. 150 :sort-order Specify the sort order to be used for the search. 151 Possible values are `oldest-first', `newest-first' 152 or nil. Nil means use the default sort order. 153 :excluded Whether to show mail with excluded tags in the 154 search. Possible values are `hide', `show', 155 or nil. Nil means use the default value of 156 `notmuch-search-hide-excluded'. 157 :search-type Specify whether to run the search in search-mode, 158 tree mode or unthreaded mode. Set to `tree' to 159 specify tree mode, \\='unthreaded to specify 160 unthreaded mode, and set to nil (or anything 161 except tree and unthreaded) to specify search 162 mode. 163 164 Other accepted forms are a cons cell of the form (NAME . QUERY) 165 or a list of the form (NAME QUERY COUNT-QUERY)." 166 ;; The saved-search format is also used by the all-tags notmuch-hello 167 ;; section. This section generates its own saved-search list in one of 168 ;; the latter two forms. 169 :get 'notmuch-hello--saved-searches-to-plist 170 :type '(repeat notmuch-saved-search-plist) 171 :tag "List of Saved Searches" 172 :group 'notmuch-hello) 173 174 (defcustom notmuch-hello-recent-searches-max 10 175 "The number of recent searches to display." 176 :type 'integer 177 :group 'notmuch-hello) 178 179 (defcustom notmuch-show-empty-saved-searches nil 180 "Should saved searches with no messages be listed?" 181 :type 'boolean 182 :group 'notmuch-hello) 183 184 (defun notmuch-sort-saved-searches (saved-searches) 185 "Generate an alphabetically sorted saved searches list." 186 (sort (copy-sequence saved-searches) 187 (lambda (a b) 188 (string< (notmuch-saved-search-get a :name) 189 (notmuch-saved-search-get b :name))))) 190 191 (defcustom notmuch-saved-search-sort-function nil 192 "Function used to sort the saved searches for the notmuch-hello view. 193 194 This variable controls how saved searches should be sorted. No 195 sorting (nil) displays the saved searches in the order they are 196 stored in `notmuch-saved-searches'. Sort alphabetically sorts the 197 saved searches in alphabetical order. Custom sort function should 198 be a function or a lambda expression that takes the saved 199 searches list as a parameter, and returns a new saved searches 200 list to be used. For compatibility with the various saved-search 201 formats it should use notmuch-saved-search-get to access the 202 fields of the search." 203 :type '(choice (const :tag "No sorting" nil) 204 (const :tag "Sort alphabetically" notmuch-sort-saved-searches) 205 (function :tag "Custom sort function" 206 :value notmuch-sort-saved-searches)) 207 :group 'notmuch-hello) 208 209 (defvar notmuch-hello-indent 4 210 "How much to indent non-headers.") 211 212 (defimage notmuch-hello-logo ((:type svg :file "notmuch-logo.svg"))) 213 214 (defcustom notmuch-show-logo t 215 "Should the notmuch logo be shown?" 216 :type 'boolean 217 :group 'notmuch-hello) 218 219 (defcustom notmuch-show-all-tags-list nil 220 "Should all tags be shown in the notmuch-hello view?" 221 :type 'boolean 222 :group 'notmuch-hello) 223 224 (defcustom notmuch-hello-tag-list-make-query nil 225 "Function or string to generate queries for the all tags list. 226 227 This variable controls which query results are shown for each tag 228 in the \"all tags\" list. If nil, it will use all messages with 229 that tag. If this is set to a string, it is used as a filter for 230 messages having that tag (equivalent to \"tag:TAG and (THIS-VARIABLE)\"). 231 Finally this can be a function that will be called for each tag and 232 should return a filter for that tag, or nil to hide the tag." 233 :type '(choice (const :tag "All messages" nil) 234 (const :tag "Unread messages" "tag:unread") 235 (string :tag "Custom filter" 236 :value "tag:unread") 237 (function :tag "Custom filter function")) 238 :group 'notmuch-hello) 239 240 (defcustom notmuch-hello-hide-tags nil 241 "List of tags to be hidden in the \"all tags\"-section." 242 :type '(repeat string) 243 :group 'notmuch-hello) 244 245 (defface notmuch-hello-logo-background 246 '((((class color) 247 (background dark)) 248 (:background "#5f5f5f")) 249 (((class color) 250 (background light)) 251 (:background "white"))) 252 "Background colour for the notmuch logo." 253 :group 'notmuch-hello 254 :group 'notmuch-faces) 255 256 (defcustom notmuch-column-control t 257 "Controls the number of columns for saved searches/tags in notmuch view. 258 259 This variable has three potential sets of values: 260 261 - t: automatically calculate the number of columns possible based 262 on the tags to be shown and the window width, 263 - an integer: a lower bound on the number of characters that will 264 be used to display each column, 265 - a float: a fraction of the window width that is the lower bound 266 on the number of characters that should be used for each 267 column. 268 269 So: 270 - if you would like two columns of tags, set this to 0.5. 271 - if you would like a single column of tags, set this to 1.0. 272 - if you would like tags to be 30 characters wide, set this to 273 30. 274 - if you don't want to worry about all of this nonsense, leave 275 this set to `t'." 276 :type '(choice 277 (const :tag "Automatically calculated" t) 278 (integer :tag "Number of characters") 279 (float :tag "Fraction of window")) 280 :group 'notmuch-hello) 281 282 (defcustom notmuch-hello-thousands-separator " " 283 "The string used as a thousands separator. 284 285 Typically \",\" in the US and UK and \".\" or \" \" in Europe. 286 The latter is recommended in the SI/ISO 31-0 standard and by the 287 International Bureau of Weights and Measures." 288 :type 'string 289 :group 'notmuch-hello) 290 291 (defcustom notmuch-hello-mode-hook nil 292 "Functions called after entering `notmuch-hello-mode'." 293 :type 'hook 294 :group 'notmuch-hello 295 :group 'notmuch-hooks) 296 297 (defcustom notmuch-hello-refresh-hook nil 298 "Functions called after updating a `notmuch-hello' buffer." 299 :type 'hook 300 :group 'notmuch-hello 301 :group 'notmuch-hooks) 302 303 (defconst notmuch-hello-url "https://notmuchmail.org" 304 "The `notmuch' web site.") 305 306 (defvar notmuch-hello-custom-section-options 307 '((:filter (string :tag "Filter for each tag")) 308 (:filter-count (string :tag "Different filter to generate message counts")) 309 (:initially-hidden (const :tag "Hide this section on startup" t)) 310 (:show-empty-searches (const :tag "Show queries with no matching messages" t)) 311 (:hide-if-empty (const :tag "Hide this section if all queries are empty 312 \(and not shown by show-empty-searches)" t))) 313 "Various customization-options for notmuch-hello-tags/query-section.") 314 315 (define-widget 'notmuch-hello-tags-section 'lazy 316 "Customize-type for notmuch-hello tag-list sections." 317 :tag "Customized tag-list section (see docstring for details)" 318 :type 319 `(list :tag "" 320 (const :tag "" notmuch-hello-insert-tags-section) 321 (string :tag "Title for this section") 322 (plist 323 :inline t 324 :options 325 ,(append notmuch-hello-custom-section-options 326 '((:hide-tags (repeat :tag "Tags that will be hidden" 327 string))))))) 328 329 (define-widget 'notmuch-hello-query-section 'lazy 330 "Customize-type for custom saved-search-like sections" 331 :tag "Customized queries section (see docstring for details)" 332 :type 333 `(list :tag "" 334 (const :tag "" notmuch-hello-insert-searches) 335 (string :tag "Title for this section") 336 (repeat :tag "Queries" 337 (cons (string :tag "Name") (string :tag "Query"))) 338 (plist :inline t :options ,notmuch-hello-custom-section-options))) 339 340 (defcustom notmuch-hello-sections 341 (list #'notmuch-hello-insert-header 342 #'notmuch-hello-insert-saved-searches 343 #'notmuch-hello-insert-search 344 #'notmuch-hello-insert-recent-searches 345 #'notmuch-hello-insert-alltags 346 #'notmuch-hello-insert-footer) 347 "Sections for notmuch-hello. 348 349 The list contains functions which are used to construct sections in 350 notmuch-hello buffer. When notmuch-hello buffer is constructed, 351 these functions are run in the order they appear in this list. Each 352 function produces a section simply by adding content to the current 353 buffer. A section should not end with an empty line, because a 354 newline will be inserted after each section by `notmuch-hello'. 355 356 Each function should take no arguments. The return value is 357 ignored. 358 359 For convenience an element can also be a list of the form (FUNC ARG1 360 ARG2 .. ARGN) in which case FUNC will be applied to the rest of the 361 list. 362 363 A \"Customized tag-list section\" item in the customize-interface 364 displays a list of all tags, optionally hiding some of them. It 365 is also possible to filter the list of messages matching each tag 366 by an additional filter query. Similarly, the count of messages 367 displayed next to the buttons can be generated by applying a 368 different filter to the tag query. These filters are also 369 supported for \"Customized queries section\" items." 370 :group 'notmuch-hello 371 :type 372 '(repeat 373 (choice (function-item notmuch-hello-insert-header) 374 (function-item notmuch-hello-insert-saved-searches) 375 (function-item notmuch-hello-insert-search) 376 (function-item notmuch-hello-insert-recent-searches) 377 (function-item notmuch-hello-insert-alltags) 378 (function-item notmuch-hello-insert-footer) 379 (function-item notmuch-hello-insert-inbox) 380 notmuch-hello-tags-section 381 notmuch-hello-query-section 382 (function :tag "Custom section")))) 383 384 (defcustom notmuch-hello-auto-refresh t 385 "Automatically refresh when returning to the notmuch-hello buffer." 386 :group 'notmuch-hello 387 :type 'boolean) 388 389 ;;; Internal variables 390 391 (defvar notmuch-hello-hidden-sections nil 392 "List of sections titles whose contents are hidden.") 393 394 (defvar notmuch-hello-first-run t 395 "True if `notmuch-hello' is run for the first time, set to nil afterwards.") 396 397 ;;; Widgets for inserters 398 399 (define-widget 'notmuch-search-item 'item 400 "A recent search." 401 :format "%v\n" 402 :value-create 'notmuch-search-item-value-create) 403 404 (defun notmuch-search-item-value-create (widget) 405 (let ((value (widget-get widget :value))) 406 (widget-insert (make-string notmuch-hello-indent ?\s)) 407 (widget-create 'editable-field 408 :size (widget-get widget :size) 409 :parent widget 410 :action #'notmuch-hello-search 411 value) 412 (widget-insert " ") 413 (widget-create 'push-button 414 :parent widget 415 :notify #'notmuch-hello-add-saved-search 416 "save") 417 (widget-insert " ") 418 (widget-create 'push-button 419 :parent widget 420 :notify #'notmuch-hello-delete-search-from-history 421 "del"))) 422 423 (defun notmuch-search-item-field-width () 424 (max 8 ; Don't let the search boxes be less than 8 characters wide. 425 (- (window-width) 426 notmuch-hello-indent ; space at bol 427 notmuch-hello-indent ; space at eol 428 1 ; for the space before the [save] button 429 6 ; for the [save] button 430 1 ; for the space before the [del] button 431 5))) ; for the [del] button 432 433 ;;; Widget actions 434 435 (defun notmuch-hello-search (widget &rest _event) 436 (let ((search (widget-value widget))) 437 (when search 438 (setq search (string-trim search)) 439 (let ((history-delete-duplicates t)) 440 (add-to-history 'notmuch-search-history search))) 441 (notmuch-search search notmuch-search-oldest-first))) 442 443 (defun notmuch-hello-add-saved-search (widget &rest _event) 444 (let ((search (widget-value (widget-get widget :parent))) 445 (name (completing-read "Name for saved search: " 446 notmuch-saved-searches))) 447 ;; If an existing saved search with this name exists, remove it. 448 (setq notmuch-saved-searches 449 (cl-loop for elem in notmuch-saved-searches 450 unless (equal name (notmuch-saved-search-get elem :name)) 451 collect elem)) 452 ;; Add the new one. 453 (customize-save-variable 'notmuch-saved-searches 454 (add-to-list 'notmuch-saved-searches 455 (list :name name :query search) t)) 456 (message "Saved '%s' as '%s'." search name) 457 (notmuch-hello-update))) 458 459 (defun notmuch-hello-delete-search-from-history (widget &rest _event) 460 (when (y-or-n-p "Are you sure you want to delete this search? ") 461 (let ((search (widget-value (widget-get widget :parent)))) 462 (setq notmuch-search-history 463 (delete search notmuch-search-history))) 464 (notmuch-hello-update))) 465 466 ;;; Button utilities 467 468 ;; `notmuch-hello-query-counts', `notmuch-hello-nice-number' and 469 ;; `notmuch-hello-insert-buttons' are used outside this section. 470 ;; All other functions that are defined in this section are only 471 ;; used by these two functions. 472 473 (defun notmuch-hello-longest-label (searches-alist) 474 (or (cl-loop for elem in searches-alist 475 maximize (length (notmuch-saved-search-get elem :name))) 476 0)) 477 478 (defun notmuch-hello-reflect-generate-row (ncols nrows row list) 479 (let ((len (length list))) 480 (cl-loop for col from 0 to (- ncols 1) 481 collect (let ((offset (+ (* nrows col) row))) 482 (if (< offset len) 483 (nth offset list) 484 ;; Don't forget to insert an empty slot in the 485 ;; output matrix if there is no corresponding 486 ;; value in the input matrix. 487 nil))))) 488 489 (defun notmuch-hello-reflect (list ncols) 490 "Reflect a `ncols' wide matrix represented by `list' along the 491 diagonal." 492 ;; Not very lispy... 493 (let ((nrows (ceiling (length list) ncols))) 494 (cl-loop for row from 0 to (- nrows 1) 495 append (notmuch-hello-reflect-generate-row ncols nrows row list)))) 496 497 (defun notmuch-hello-widget-search (widget &rest _ignore) 498 (let ((search-terms (widget-get widget :notmuch-search-terms)) 499 (oldest-first (widget-get widget :notmuch-search-oldest-first)) 500 (exclude (widget-get widget :notmuch-search-hide-excluded))) 501 (cl-case (widget-get widget :notmuch-search-type) 502 (tree 503 (let ((n (notmuch-search-format-buffer-name (widget-value widget) "tree" t))) 504 (notmuch-tree search-terms nil nil n nil nil nil oldest-first exclude))) 505 (unthreaded 506 (let ((n (notmuch-search-format-buffer-name (widget-value widget) 507 "unthreaded" t))) 508 (notmuch-unthreaded search-terms nil nil n nil oldest-first exclude))) 509 (t 510 (notmuch-search search-terms oldest-first exclude))))) 511 512 (defun notmuch-saved-search-count (search) 513 (car (notmuch--process-lines notmuch-command "count" search))) 514 515 (defun notmuch-hello-tags-per-line (widest) 516 "Determine how many tags to show per line and how wide they 517 should be. Returns a cons cell `(tags-per-line width)'." 518 (let ((tags-per-line 519 (cond 520 ((integerp notmuch-column-control) 521 (max 1 522 (/ (- (window-width) notmuch-hello-indent) 523 ;; Count is 9 wide (8 digits plus space), 1 for the space 524 ;; after the name. 525 (+ 9 1 (max notmuch-column-control widest))))) 526 ((floatp notmuch-column-control) 527 (let* ((available-width (- (window-width) notmuch-hello-indent)) 528 (proposed-width (max (* available-width notmuch-column-control) 529 widest))) 530 (floor available-width proposed-width))) 531 (t 532 (max 1 533 (/ (- (window-width) notmuch-hello-indent) 534 ;; Count is 9 wide (8 digits plus space), 1 for the space 535 ;; after the name. 536 (+ 9 1 widest))))))) 537 (cons tags-per-line (/ (max 1 538 (- (window-width) notmuch-hello-indent 539 ;; Count is 9 wide (8 digits plus 540 ;; space), 1 for the space after the 541 ;; name. 542 (* tags-per-line (+ 9 1)))) 543 tags-per-line)))) 544 545 (defun notmuch-hello-filtered-query (query filter) 546 "Constructs a query to search all messages matching QUERY and FILTER. 547 548 If FILTER is a string, it is directly used in the returned query. 549 550 If FILTER is a function, it is called with QUERY as a parameter and 551 the string it returns is used as the query. If nil is returned, 552 the entry is hidden. 553 554 Otherwise, FILTER is ignored." 555 (cond 556 ((functionp filter) (funcall filter query)) 557 ((stringp filter) 558 (concat "(" query ") and (" filter ")")) 559 (t query))) 560 561 (defun notmuch-hello-query-counts (query-list &rest options) 562 "Compute list of counts of matched messages from QUERY-LIST. 563 564 QUERY-LIST must be a list of saved-searches. Ideally each of 565 these is a plist but other options are available for backwards 566 compatibility: see `notmuch-saved-searches' for details. 567 568 The result is a list of plists each of which includes the 569 properties :name NAME, :query QUERY and :count COUNT, together 570 with any properties in the original saved-search. 571 572 The values :show-empty-searches, :filter and :filter-count from 573 options will be handled as specified for 574 `notmuch-hello-insert-searches'. :disable-includes can be used to 575 turn off the default exclude processing in `notmuch-count(1)'" 576 (with-temp-buffer 577 (dolist (elem query-list nil) 578 (let ((count-query (or (notmuch-saved-search-get elem :count-query) 579 (notmuch-saved-search-get elem :query)))) 580 (insert 581 (replace-regexp-in-string 582 "\n" " " 583 (notmuch-hello-filtered-query count-query 584 (or (plist-get options :filter-count) 585 (plist-get options :filter)))) 586 "\n"))) 587 (unless (= (notmuch--call-process-region (point-min) (point-max) notmuch-command 588 t t nil "count" 589 (if (plist-get options :disable-excludes) 590 "--exclude=false" 591 "--exclude=true") 592 "--batch") 0) 593 (notmuch-logged-error 594 "notmuch count --batch failed" 595 "Please check that the notmuch CLI is new enough to support `count 596 --batch'. In general we recommend running matching versions of 597 the CLI and emacs interface.")) 598 (goto-char (point-min)) 599 (cl-mapcan 600 (lambda (elem) 601 (let* ((elem-plist (notmuch-hello-saved-search-to-plist elem)) 602 (search-query (plist-get elem-plist :query)) 603 (filtered-query (notmuch-hello-filtered-query 604 search-query (plist-get options :filter))) 605 (message-count (prog1 (read (current-buffer)) 606 (forward-line 1)))) 607 (when (and filtered-query (or (plist-get options :show-empty-searches) 608 (> message-count 0))) 609 (setq elem-plist (plist-put elem-plist :query filtered-query)) 610 (list (plist-put elem-plist :count message-count))))) 611 query-list))) 612 613 (defun notmuch-hello-nice-number (n) 614 (let (result) 615 (while (> n 0) 616 (push (% n 1000) result) 617 (setq n (/ n 1000))) 618 (setq result (or result '(0))) 619 (apply #'concat 620 (number-to-string (car result)) 621 (mapcar (lambda (elem) 622 (format "%s%03d" notmuch-hello-thousands-separator elem)) 623 (cdr result))))) 624 625 (defun notmuch-hello-insert-buttons (searches) 626 "Insert buttons for SEARCHES. 627 628 SEARCHES must be a list of plists each of which should contain at 629 least the properties :name NAME :query QUERY and :count COUNT, 630 where QUERY is the query to start when the button for the 631 corresponding entry is activated, and COUNT should be the number 632 of messages matching the query. Such a plist can be computed 633 with `notmuch-hello-query-counts'." 634 (let* ((widest (notmuch-hello-longest-label searches)) 635 (tags-and-width (notmuch-hello-tags-per-line widest)) 636 (tags-per-line (car tags-and-width)) 637 (column-width (cdr tags-and-width)) 638 (column-indent 0) 639 (count 0) 640 (reordered-list (notmuch-hello-reflect searches tags-per-line)) 641 ;; Hack the display of the buttons used. 642 (widget-push-button-prefix "") 643 (widget-push-button-suffix "")) 644 ;; dme: It feels as though there should be a better way to 645 ;; implement this loop than using an incrementing counter. 646 (mapc (lambda (elem) 647 ;; (not elem) indicates an empty slot in the matrix. 648 (when elem 649 (when (> column-indent 0) 650 (widget-insert (make-string column-indent ? ))) 651 (let* ((name (plist-get elem :name)) 652 (query (plist-get elem :query)) 653 (oldest-first (cl-case (plist-get elem :sort-order) 654 (newest-first nil) 655 (oldest-first t) 656 (otherwise notmuch-search-oldest-first))) 657 (exclude (cl-case (plist-get elem :excluded) 658 (hide t) 659 (show nil) 660 (otherwise notmuch-search-hide-excluded))) 661 (search-type (plist-get elem :search-type)) 662 (msg-count (plist-get elem :count))) 663 (widget-insert (format "%8s " 664 (notmuch-hello-nice-number msg-count))) 665 (widget-create 'push-button 666 :notify #'notmuch-hello-widget-search 667 :notmuch-search-terms query 668 :notmuch-search-oldest-first oldest-first 669 :notmuch-search-type search-type 670 :notmuch-search-hide-excluded exclude 671 name) 672 (setq column-indent 673 (1+ (max 0 (- column-width (length name))))))) 674 (cl-incf count) 675 (when (eq (% count tags-per-line) 0) 676 (setq column-indent 0) 677 (widget-insert "\n"))) 678 reordered-list) 679 ;; If the last line was not full (and hence did not include a 680 ;; carriage return), insert one now. 681 (unless (eq (% count tags-per-line) 0) 682 (widget-insert "\n")))) 683 684 ;;; Mode 685 686 (defun notmuch-hello-update () 687 "Update the notmuch-hello buffer." 688 ;; Lazy - rebuild everything. 689 (interactive) 690 (notmuch-hello t)) 691 692 (defun notmuch-hello-window-configuration-change () 693 "Hook function to update the hello buffer when it is switched to." 694 (let ((hello-buf (get-buffer "*notmuch-hello*")) 695 (do-refresh nil)) 696 ;; Consider all windows in the currently selected frame, since 697 ;; that's where the configuration change happened. This also 698 ;; refreshes our snapshot of all windows, so we have to do this 699 ;; even if we know we won't refresh (e.g., hello-buf is null). 700 (dolist (window (window-list)) 701 (let ((last-buf (window-parameter window 'notmuch-hello-last-buffer)) 702 (cur-buf (window-buffer window))) 703 (unless (eq last-buf cur-buf) 704 ;; This window changed or is new. Update recorded buffer 705 ;; for next time. 706 (set-window-parameter window 'notmuch-hello-last-buffer cur-buf) 707 (when (and (eq cur-buf hello-buf) last-buf) 708 ;; The user just switched to hello in this window (hello 709 ;; is currently visible, was not visible on the last 710 ;; configuration change, and this is not a new window) 711 (setq do-refresh t))))) 712 (when (and do-refresh notmuch-hello-auto-refresh) 713 ;; Refresh hello as soon as we get back to redisplay. On Emacs 714 ;; 24, we can't do it right here because something in this 715 ;; hook's call stack overrides hello's point placement. 716 ;; FIXME And on Emacs releases that we still support? 717 (run-at-time nil nil #'notmuch-hello t)) 718 (unless hello-buf 719 ;; Clean up hook 720 (remove-hook 'window-configuration-change-hook 721 #'notmuch-hello-window-configuration-change)))) 722 723 (defvar notmuch-hello-mode-map 724 ;; Inherit both widget-keymap and notmuch-common-keymap. We have 725 ;; to use make-sparse-keymap to force this to be a new keymap (so 726 ;; that when we modify map it does not modify widget-keymap). 727 (let ((map (make-composed-keymap (list (make-sparse-keymap) widget-keymap)))) 728 (set-keymap-parent map notmuch-common-keymap) 729 ;; Currently notmuch-hello-mode supports free text entry, but not 730 ;; tagging operations, so provide standard undo. 731 (define-key map [remap notmuch-tag-undo] #'undo) 732 map) 733 "Keymap for \"notmuch hello\" buffers.") 734 735 (define-derived-mode notmuch-hello-mode fundamental-mode "notmuch-hello" 736 "Major mode for convenient notmuch navigation. This is your entry 737 portal into notmuch. 738 739 Saved searches are \"bookmarks\" for arbitrary queries. Hit RET 740 or click on a saved search to view matching threads. Edit saved 741 searches with the `edit' button. Type `\\[notmuch-jump-search]' 742 in any Notmuch screen for quick access to saved searches that 743 have shortcut keys. 744 745 Type new searches in the search box and hit RET to view matching 746 threads. Hit RET in a recent search box to re-submit a previous 747 search. Edit it first if you like. Save a recent search to saved 748 searches with the `save' button. 749 750 Hit `\\[notmuch-search]' or `\\[notmuch-tree]' in any Notmuch 751 screen to search for messages and view matching threads or 752 messages, respectively. Recent searches are available in the 753 minibuffer history. 754 755 Expand the all tags view with the `show' button (and collapse 756 again with the `hide' button). Hit RET or click on a tag name to 757 view matching threads. 758 759 Hit `\\[notmuch-refresh-this-buffer]' to refresh the screen and 760 `\\[notmuch-bury-or-kill-this-buffer]' to quit. 761 762 The screen may be customized via `\\[customize]'. 763 764 Complete list of currently available key bindings: 765 766 \\{notmuch-hello-mode-map}" 767 (setq notmuch-buffer-refresh-function #'notmuch-hello-update)) 768 769 ;;; Inserters 770 771 (defun notmuch-hello-generate-tag-alist (&optional hide-tags) 772 "Return an alist from tags to queries to display in the all-tags section." 773 (cl-mapcan (lambda (tag) 774 (and (not (member tag hide-tags)) 775 (list (cons tag 776 (concat "tag:" 777 (notmuch-escape-boolean-term tag)))))) 778 (notmuch--process-lines notmuch-command "search" "--output=tags" "*"))) 779 780 (defun notmuch-hello-insert-header () 781 "Insert the default notmuch-hello header." 782 (when notmuch-show-logo 783 (let ((image notmuch-hello-logo)) 784 ;; The notmuch logo uses transparency. That can display poorly 785 ;; when inserting the image into an emacs buffer (black logo on 786 ;; a black background), so force the background colour of the 787 ;; image. We use a face to represent the colour so that 788 ;; `defface' can be used to declare the different possible 789 ;; colours, which depend on whether the frame has a light or 790 ;; dark background. 791 (setq image (cons 'image 792 (append (cdr image) 793 (list :background 794 (face-background 795 'notmuch-hello-logo-background))))) 796 (insert-image image)) 797 (widget-insert " ")) 798 799 (widget-insert "Welcome to ") 800 ;; Hack the display of the links used. 801 (let ((widget-link-prefix "") 802 (widget-link-suffix "")) 803 (widget-create 'link 804 :notify (lambda (&rest _ignore) 805 (browse-url notmuch-hello-url)) 806 :help-echo "Visit the notmuch website." 807 "notmuch") 808 (widget-insert ". ") 809 (widget-insert "You have ") 810 (widget-create 'link 811 :notify (lambda (&rest _ignore) 812 (notmuch-hello-update)) 813 :help-echo "Refresh" 814 (notmuch-hello-nice-number 815 (string-to-number 816 (car (notmuch--process-lines notmuch-command "count" "--exclude=false"))))) 817 (widget-insert " messages.\n"))) 818 819 (defun notmuch-hello-insert-saved-searches () 820 "Insert the saved-searches section." 821 (let ((searches (notmuch-hello-query-counts 822 (if notmuch-saved-search-sort-function 823 (funcall notmuch-saved-search-sort-function 824 notmuch-saved-searches) 825 notmuch-saved-searches) 826 :show-empty-searches notmuch-show-empty-saved-searches))) 827 (when searches 828 (widget-insert "Saved searches: ") 829 (widget-create 'push-button 830 :notify (lambda (&rest _ignore) 831 (customize-variable 'notmuch-saved-searches)) 832 "edit") 833 (widget-insert "\n\n") 834 (let ((start (point))) 835 (notmuch-hello-insert-buttons searches) 836 (indent-rigidly start (point) notmuch-hello-indent))))) 837 838 (defun notmuch-hello-insert-search () 839 "Insert a search widget." 840 (widget-insert "Search: ") 841 (widget-create 'editable-field 842 ;; Leave some space at the start and end of the 843 ;; search boxes. 844 :size (max 8 (- (window-width) notmuch-hello-indent 845 (length "Search: "))) 846 :action #'notmuch-hello-search) 847 ;; Add an invisible dot to make `widget-end-of-line' ignore 848 ;; trailing spaces in the search widget field. A dot is used 849 ;; instead of a space to make `show-trailing-whitespace' 850 ;; happy, i.e. avoid it marking the whole line as trailing 851 ;; spaces. 852 (widget-insert (propertize "." 'invisible t)) 853 (widget-insert "\n")) 854 855 (defun notmuch-hello-insert-recent-searches () 856 "Insert recent searches." 857 (when notmuch-search-history 858 (widget-insert "Recent searches: ") 859 (widget-create 860 'push-button 861 :notify (lambda (&rest _ignore) 862 (when (y-or-n-p "Are you sure you want to clear the searches? ") 863 (setq notmuch-search-history nil) 864 (notmuch-hello-update))) 865 "clear") 866 (widget-insert "\n\n") 867 (let ((width (notmuch-search-item-field-width))) 868 (dolist (search (seq-take notmuch-search-history 869 notmuch-hello-recent-searches-max)) 870 (widget-create 'notmuch-search-item :value search :size width))))) 871 872 (defun notmuch-hello-insert-searches (title query-list &rest options) 873 "Insert a section with TITLE showing a list of buttons made from 874 QUERY-LIST. 875 876 QUERY-LIST should ideally be a plist but for backwards 877 compatibility other forms are also accepted (see 878 `notmuch-saved-searches' for details). The plist should 879 contain keys :name and :query; if :count-query is also present 880 then it specifies an alternate query to be used to generate the 881 count for the associated search. 882 883 Supports the following entries in OPTIONS as a plist: 884 :initially-hidden - if non-nil, section will be hidden on startup 885 :show-empty-searches - show buttons with no matching messages 886 :hide-if-empty - hide if no buttons would be shown 887 (only makes sense without :show-empty-searches) 888 :filter - This can be a function that takes the search query as 889 its argument and returns a filter to be used in conjunction 890 with the query for that search or nil to hide the 891 element. This can also be a string that is used as a combined 892 with each query using \"and\". 893 :filter-count - Separate filter to generate the count displayed 894 each search. Accepts the same values as :filter. If :filter 895 and :filter-count are specified, this will be used instead of 896 :filter, not in conjunction with it." 897 898 (widget-insert title ": ") 899 (when (and notmuch-hello-first-run (plist-get options :initially-hidden)) 900 (add-to-list 'notmuch-hello-hidden-sections title)) 901 (let ((is-hidden (member title notmuch-hello-hidden-sections)) 902 (start (point))) 903 (if is-hidden 904 (widget-create 'push-button 905 :notify (lambda (&rest _ignore) 906 (setq notmuch-hello-hidden-sections 907 (delete title notmuch-hello-hidden-sections)) 908 (notmuch-hello-update)) 909 "show") 910 (widget-create 'push-button 911 :notify (lambda (&rest _ignore) 912 (add-to-list 'notmuch-hello-hidden-sections 913 title) 914 (notmuch-hello-update)) 915 "hide")) 916 (widget-insert "\n") 917 (unless is-hidden 918 (let ((searches (apply 'notmuch-hello-query-counts query-list options))) 919 (when (or (not (plist-get options :hide-if-empty)) 920 searches) 921 (widget-insert "\n") 922 (notmuch-hello-insert-buttons searches) 923 (indent-rigidly start (point) notmuch-hello-indent)))))) 924 925 (defun notmuch-hello-insert-tags-section (&optional title &rest options) 926 "Insert a section displaying all tags with message counts. 927 928 TITLE defaults to \"All tags\". 929 Allowed options are those accepted by `notmuch-hello-insert-searches' and the 930 following: 931 932 :hide-tags - List of tags that should be excluded." 933 (apply 'notmuch-hello-insert-searches 934 (or title "All tags") 935 (notmuch-hello-generate-tag-alist (plist-get options :hide-tags)) 936 options)) 937 938 (defun notmuch-hello-insert-inbox () 939 "Show an entry for each saved search and inboxed messages for each tag." 940 (notmuch-hello-insert-searches "What's in your inbox" 941 (append 942 notmuch-saved-searches 943 (notmuch-hello-generate-tag-alist)) 944 :filter "tag:inbox")) 945 946 (defun notmuch-hello-insert-alltags () 947 "Insert a section displaying all tags and associated message counts." 948 (notmuch-hello-insert-tags-section 949 nil 950 :initially-hidden (not notmuch-show-all-tags-list) 951 :hide-tags notmuch-hello-hide-tags 952 :filter notmuch-hello-tag-list-make-query 953 :disable-excludes t)) 954 955 (defun notmuch-hello-insert-footer () 956 "Insert the notmuch-hello footer." 957 (let ((start (point))) 958 (widget-insert "Hit `?' for context-sensitive help in any Notmuch screen.\n") 959 (widget-insert "Customize ") 960 (widget-create 'link 961 :notify (lambda (&rest _ignore) 962 (customize-group 'notmuch)) 963 :button-prefix "" :button-suffix "" 964 "Notmuch") 965 (widget-insert " or ") 966 (widget-create 'link 967 :notify (lambda (&rest _ignore) 968 (customize-variable 'notmuch-hello-sections)) 969 :button-prefix "" :button-suffix "" 970 "this page.") 971 (let ((fill-column (- (window-width) notmuch-hello-indent))) 972 (center-region start (point))))) 973 974 ;;; Hello! 975 976 ;;;###autoload 977 (defun notmuch-hello (&optional no-display) 978 "Run notmuch and display saved searches, known tags, etc." 979 (interactive) 980 (notmuch-assert-cli-sane) 981 ;; This may cause a window configuration change, so if the 982 ;; auto-refresh hook is already installed, avoid recursive refresh. 983 (let ((notmuch-hello-auto-refresh nil)) 984 (if no-display 985 (set-buffer "*notmuch-hello*") 986 (pop-to-buffer-same-window "*notmuch-hello*"))) 987 ;; Install auto-refresh hook 988 (when notmuch-hello-auto-refresh 989 (add-hook 'window-configuration-change-hook 990 #'notmuch-hello-window-configuration-change)) 991 (let ((target-line (line-number-at-pos)) 992 (target-column (current-column)) 993 (inhibit-read-only t)) 994 ;; Delete all editable widget fields. Editable widget fields are 995 ;; tracked in a buffer local variable `widget-field-list' (and 996 ;; others). If we do `erase-buffer' without properly deleting the 997 ;; widgets, some widget-related functions are confused later. 998 (mapc 'widget-delete widget-field-list) 999 (erase-buffer) 1000 (unless (eq major-mode 'notmuch-hello-mode) 1001 (notmuch-hello-mode)) 1002 (let ((all (overlay-lists))) 1003 ;; Delete all the overlays. 1004 (mapc 'delete-overlay (car all)) 1005 (mapc 'delete-overlay (cdr all))) 1006 (mapc 1007 (lambda (section) 1008 (let ((point-before (point))) 1009 (if (functionp section) 1010 (funcall section) 1011 (apply (car section) (cdr section))) 1012 ;; don't insert a newline when the previous section didn't 1013 ;; show anything. 1014 (unless (eq (point) point-before) 1015 (widget-insert "\n")))) 1016 notmuch-hello-sections) 1017 (widget-setup) 1018 ;; Move point back to where it was before refresh. Use line and 1019 ;; column instead of point directly to be insensitive to additions 1020 ;; and removals of text within earlier lines. 1021 (goto-char (point-min)) 1022 (forward-line (1- target-line)) 1023 (move-to-column target-column)) 1024 (run-hooks 'notmuch-hello-refresh-hook) 1025 (setq notmuch-hello-first-run nil)) 1026 1027 ;;; _ 1028 1029 (provide 'notmuch-hello) 1030 1031 ;;; notmuch-hello.el ends here