config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

notmuch-hello.el (39021B)


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