-;; notmuch-hello.el --- welcome to notmuch, a frontend
+;;; notmuch-hello.el --- welcome to notmuch, a frontend -*- lexical-binding: t -*-
;;
;; Copyright © David Edmondson
;;
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
+;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>.
;;
;; Authors: David Edmondson <dme@dme.org>
-(eval-when-compile (require 'cl))
+;;; Code:
+
(require 'widget)
(require 'wid-edit) ; For `widget-forward'.
(require 'notmuch-lib)
(require 'notmuch-mua)
-(declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line continuation))
-(declare-function notmuch-poll "notmuch" ())
+(declare-function notmuch-search "notmuch"
+ (&optional query oldest-first target-thread target-line
+ no-display))
+(declare-function notmuch-poll "notmuch-lib" ())
+(declare-function notmuch-tree "notmuch-tree"
+ (&optional query query-context target buffer-name
+ open-target unthreaded parent-buffer
+ oldest-first hide-excluded))
+(declare-function notmuch-unthreaded "notmuch-tree"
+ (&optional query query-context target buffer-name
+ open-target oldest-first hide-excluded))
+
+
+;;; Options
+
+(defun notmuch-saved-search-get (saved-search field)
+ "Get FIELD from SAVED-SEARCH.
+
+If SAVED-SEARCH is a plist, this is just `plist-get', but for
+backwards compatibility, this also deals with the two other
+possible formats for SAVED-SEARCH: cons cells (NAME . QUERY) and
+lists (NAME QUERY COUNT-QUERY)."
+ (cond
+ ((keywordp (car saved-search))
+ (plist-get saved-search field))
+ ;; It is not a plist so it is an old-style entry.
+ ((consp (cdr saved-search))
+ (pcase-let ((`(,name ,query ,count-query) saved-search))
+ (cl-case field
+ (:name name)
+ (:query query)
+ (:count-query count-query)
+ (t nil))))
+ (t
+ (pcase-let ((`(,name . ,query) saved-search))
+ (cl-case field
+ (:name name)
+ (:query query)
+ (t nil))))))
+
+(defun notmuch-hello-saved-search-to-plist (saved-search)
+ "Return a copy of SAVED-SEARCH in plist form.
+
+If saved search is a plist then just return a copy. In other
+cases, for backwards compatibility, convert to plist form and
+return that."
+ (if (keywordp (car saved-search))
+ (copy-sequence saved-search)
+ (let ((fields (list :name :query :count-query))
+ plist-search)
+ (dolist (field fields plist-search)
+ (let ((string (notmuch-saved-search-get saved-search field)))
+ (when string
+ (setq plist-search (append plist-search (list field string)))))))))
+
+(defun notmuch-hello--saved-searches-to-plist (symbol)
+ "Extract a saved-search variable into plist form.
+
+The new style saved search is just a plist, but for backwards
+compatibility we use this function to extract old style saved
+searches so they still work in customize."
+ (let ((saved-searches (default-value symbol)))
+ (mapcar #'notmuch-hello-saved-search-to-plist saved-searches)))
+
+(define-widget 'notmuch-saved-search-plist 'list
+ "A single saved search property list."
+ :tag "Saved Search"
+ :args '((list :inline t
+ :format "%v"
+ (group :format "%v" :inline t
+ (const :format " Name: " :name)
+ (string :format "%v"))
+ (group :format "%v" :inline t
+ (const :format " Query: " :query)
+ (string :format "%v")))
+ (checklist :inline t
+ :format "%v"
+ (group :format "%v" :inline t
+ (const :format "Shortcut key: " :key)
+ (key-sequence :format "%v"))
+ (group :format "%v" :inline t
+ (const :format "Count-Query: " :count-query)
+ (string :format "%v"))
+ (group :format "%v" :inline t
+ (const :format "" :sort-order)
+ (choice :tag " Sort Order"
+ (const :tag "Default" nil)
+ (const :tag "Oldest-first" oldest-first)
+ (const :tag "Newest-first" newest-first)))
+ (group :format "%v" :inline t
+ (const :format "" :search-type)
+ (choice :tag " Search Type"
+ (const :tag "Search mode" nil)
+ (const :tag "Tree mode" tree)
+ (const :tag "Unthreaded mode" unthreaded))))))
+
+(defcustom notmuch-saved-searches
+ `((:name "inbox" :query "tag:inbox" :key ,(kbd "i"))
+ (:name "unread" :query "tag:unread" :key ,(kbd "u"))
+ (:name "flagged" :query "tag:flagged" :key ,(kbd "f"))
+ (:name "sent" :query "tag:sent" :key ,(kbd "t"))
+ (:name "drafts" :query "tag:draft" :key ,(kbd "d"))
+ (:name "all mail" :query "*" :key ,(kbd "a")))
+ "A list of saved searches to display.
+
+The saved search can be given in 3 forms. The preferred way is as
+a plist. Supported properties are
+
+ :name Name of the search (required).
+ :query Search to run (required).
+ :key Optional shortcut key for `notmuch-jump-search'.
+ :count-query Optional extra query to generate the count
+ shown. If not present then the :query property
+ is used.
+ :sort-order Specify the sort order to be used for the search.
+ Possible values are `oldest-first', `newest-first'
+ or nil. Nil means use the default sort order.
+ :excluded Whether to show mail with excluded tags in the
+ search. Possible values are `hide', `show',
+ or nil. Nil means use the default value of
+ `notmuch-search-hide-excluded'.
+ :search-type Specify whether to run the search in search-mode,
+ tree mode or unthreaded mode. Set to `tree' to
+ specify tree mode, \\='unthreaded to specify
+ unthreaded mode, and set to nil (or anything
+ except tree and unthreaded) to specify search
+ mode.
+
+Other accepted forms are a cons cell of the form (NAME . QUERY)
+or a list of the form (NAME QUERY COUNT-QUERY)."
+ ;; The saved-search format is also used by the all-tags notmuch-hello
+ ;; section. This section generates its own saved-search list in one of
+ ;; the latter two forms.
+ :get 'notmuch-hello--saved-searches-to-plist
+ :type '(repeat notmuch-saved-search-plist)
+ :tag "List of Saved Searches"
+ :group 'notmuch-hello)
(defcustom notmuch-hello-recent-searches-max 10
"The number of recent searches to display."
:type 'boolean
:group 'notmuch-hello)
-(defun notmuch-sort-saved-searches (alist)
- "Generate an alphabetically sorted saved searches alist."
- (sort alist (lambda (a b) (string< (car a) (car b)))))
+(defun notmuch-sort-saved-searches (saved-searches)
+ "Generate an alphabetically sorted saved searches list."
+ (sort (copy-sequence saved-searches)
+ (lambda (a b)
+ (string< (notmuch-saved-search-get a :name)
+ (notmuch-saved-search-get b :name)))))
(defcustom notmuch-saved-search-sort-function nil
"Function used to sort the saved searches for the notmuch-hello view.
stored in `notmuch-saved-searches'. Sort alphabetically sorts the
saved searches in alphabetical order. Custom sort function should
be a function or a lambda expression that takes the saved
-searches alist as a parameter, and returns a new saved searches
-alist to be used."
+searches list as a parameter, and returns a new saved searches
+list to be used. For compatibility with the various saved-search
+formats it should use notmuch-saved-search-get to access the
+fields of the search."
:type '(choice (const :tag "No sorting" nil)
(const :tag "Sort alphabetically" notmuch-sort-saved-searches)
(function :tag "Custom sort function"
(defvar notmuch-hello-indent 4
"How much to indent non-headers.")
+(defimage notmuch-hello-logo ((:type svg :file "notmuch-logo.svg")))
+
(defcustom notmuch-show-logo t
"Should the notmuch logo be shown?"
:type 'boolean
:group 'notmuch-hello
:group 'notmuch-hooks)
-(defvar notmuch-hello-url "http://notmuchmail.org"
+(defconst notmuch-hello-url "https://notmuchmail.org"
"The `notmuch' web site.")
-(defun notmuch-hello-nice-number (n)
- (let (result)
- (while (> n 0)
- (push (% n 1000) result)
- (setq n (/ n 1000)))
- (setq result (or result '(0)))
- (apply #'concat
- (number-to-string (car result))
- (mapcar (lambda (elem)
- (format "%s%03d" notmuch-hello-thousands-separator elem))
- (cdr result)))))
-
-(defun notmuch-hello-trim (search)
- "Trim whitespace."
- (if (string-match "^[[:space:]]*\\(.*[^[:space:]]\\)[[:space:]]*$" search)
- (match-string 1 search)
- search))
-
-(defun notmuch-hello-search (&optional search)
- (interactive)
- (unless (null search)
- (setq search (notmuch-hello-trim search))
- (let ((history-delete-duplicates t))
- (add-to-history 'notmuch-search-history search)))
- (notmuch-search search notmuch-search-oldest-first nil nil
- #'notmuch-hello-search-continuation))
-
-(defun notmuch-hello-add-saved-search (widget)
- (interactive)
- (let ((search (widget-value
- (symbol-value
- (widget-get widget :notmuch-saved-search-widget))))
+(defvar notmuch-hello-custom-section-options
+ '((:filter (string :tag "Filter for each tag"))
+ (:filter-count (string :tag "Different filter to generate message counts"))
+ (:initially-hidden (const :tag "Hide this section on startup" t))
+ (:show-empty-searches (const :tag "Show queries with no matching messages" t))
+ (:hide-if-empty (const :tag "Hide this section if all queries are empty
+\(and not shown by show-empty-searches)" t)))
+ "Various customization-options for notmuch-hello-tags/query-section.")
+
+(define-widget 'notmuch-hello-tags-section 'lazy
+ "Customize-type for notmuch-hello tag-list sections."
+ :tag "Customized tag-list section (see docstring for details)"
+ :type
+ `(list :tag ""
+ (const :tag "" notmuch-hello-insert-tags-section)
+ (string :tag "Title for this section")
+ (plist
+ :inline t
+ :options
+ ,(append notmuch-hello-custom-section-options
+ '((:hide-tags (repeat :tag "Tags that will be hidden"
+ string)))))))
+
+(define-widget 'notmuch-hello-query-section 'lazy
+ "Customize-type for custom saved-search-like sections"
+ :tag "Customized queries section (see docstring for details)"
+ :type
+ `(list :tag ""
+ (const :tag "" notmuch-hello-insert-searches)
+ (string :tag "Title for this section")
+ (repeat :tag "Queries"
+ (cons (string :tag "Name") (string :tag "Query")))
+ (plist :inline t :options ,notmuch-hello-custom-section-options)))
+
+(defcustom notmuch-hello-sections
+ (list #'notmuch-hello-insert-header
+ #'notmuch-hello-insert-saved-searches
+ #'notmuch-hello-insert-search
+ #'notmuch-hello-insert-recent-searches
+ #'notmuch-hello-insert-alltags
+ #'notmuch-hello-insert-footer)
+ "Sections for notmuch-hello.
+
+The list contains functions which are used to construct sections in
+notmuch-hello buffer. When notmuch-hello buffer is constructed,
+these functions are run in the order they appear in this list. Each
+function produces a section simply by adding content to the current
+buffer. A section should not end with an empty line, because a
+newline will be inserted after each section by `notmuch-hello'.
+
+Each function should take no arguments. The return value is
+ignored.
+
+For convenience an element can also be a list of the form (FUNC ARG1
+ARG2 .. ARGN) in which case FUNC will be applied to the rest of the
+list.
+
+A \"Customized tag-list section\" item in the customize-interface
+displays a list of all tags, optionally hiding some of them. It
+is also possible to filter the list of messages matching each tag
+by an additional filter query. Similarly, the count of messages
+displayed next to the buttons can be generated by applying a
+different filter to the tag query. These filters are also
+supported for \"Customized queries section\" items."
+ :group 'notmuch-hello
+ :type
+ '(repeat
+ (choice (function-item notmuch-hello-insert-header)
+ (function-item notmuch-hello-insert-saved-searches)
+ (function-item notmuch-hello-insert-search)
+ (function-item notmuch-hello-insert-recent-searches)
+ (function-item notmuch-hello-insert-alltags)
+ (function-item notmuch-hello-insert-footer)
+ (function-item notmuch-hello-insert-inbox)
+ notmuch-hello-tags-section
+ notmuch-hello-query-section
+ (function :tag "Custom section"))))
+
+(defcustom notmuch-hello-auto-refresh t
+ "Automatically refresh when returning to the notmuch-hello buffer."
+ :group 'notmuch-hello
+ :type 'boolean)
+
+;;; Internal variables
+
+(defvar notmuch-hello-hidden-sections nil
+ "List of sections titles whose contents are hidden.")
+
+(defvar notmuch-hello-first-run t
+ "True if `notmuch-hello' is run for the first time, set to nil afterwards.")
+
+;;; Widgets for inserters
+
+(define-widget 'notmuch-search-item 'item
+ "A recent search."
+ :format "%v\n"
+ :value-create 'notmuch-search-item-value-create)
+
+(defun notmuch-search-item-value-create (widget)
+ (let ((value (widget-get widget :value)))
+ (widget-insert (make-string notmuch-hello-indent ?\s))
+ (widget-create 'editable-field
+ :size (widget-get widget :size)
+ :parent widget
+ :action #'notmuch-hello-search
+ value)
+ (widget-insert " ")
+ (widget-create 'push-button
+ :parent widget
+ :notify #'notmuch-hello-add-saved-search
+ "save")
+ (widget-insert " ")
+ (widget-create 'push-button
+ :parent widget
+ :notify #'notmuch-hello-delete-search-from-history
+ "del")))
+
+(defun notmuch-search-item-field-width ()
+ (max 8 ; Don't let the search boxes be less than 8 characters wide.
+ (- (window-width)
+ notmuch-hello-indent ; space at bol
+ notmuch-hello-indent ; space at eol
+ 1 ; for the space before the [save] button
+ 6 ; for the [save] button
+ 1 ; for the space before the [del] button
+ 5))) ; for the [del] button
+
+;;; Widget actions
+
+(defun notmuch-hello-search (widget &rest _event)
+ (let ((search (widget-value widget)))
+ (when search
+ (setq search (string-trim search))
+ (let ((history-delete-duplicates t))
+ (add-to-history 'notmuch-search-history search)))
+ (notmuch-search search notmuch-search-oldest-first)))
+
+(defun notmuch-hello-add-saved-search (widget &rest _event)
+ (let ((search (widget-value (widget-get widget :parent)))
(name (completing-read "Name for saved search: "
notmuch-saved-searches)))
;; If an existing saved search with this name exists, remove it.
(setq notmuch-saved-searches
- (loop for elem in notmuch-saved-searches
- if (not (equal name
- (car elem)))
- collect elem))
+ (cl-loop for elem in notmuch-saved-searches
+ unless (equal name (notmuch-saved-search-get elem :name))
+ collect elem))
;; Add the new one.
(customize-save-variable 'notmuch-saved-searches
(add-to-list 'notmuch-saved-searches
- (cons name search) t))
+ (list :name name :query search) t))
(message "Saved '%s' as '%s'." search name)
(notmuch-hello-update)))
-(defun notmuch-hello-longest-label (tag-alist)
- (or (loop for elem in tag-alist
- maximize (length (car elem)))
+(defun notmuch-hello-delete-search-from-history (widget &rest _event)
+ (when (y-or-n-p "Are you sure you want to delete this search? ")
+ (let ((search (widget-value (widget-get widget :parent))))
+ (setq notmuch-search-history
+ (delete search notmuch-search-history)))
+ (notmuch-hello-update)))
+
+;;; Button utilities
+
+;; `notmuch-hello-query-counts', `notmuch-hello-nice-number' and
+;; `notmuch-hello-insert-buttons' are used outside this section.
+;; All other functions that are defined in this section are only
+;; used by these two functions.
+
+(defun notmuch-hello-longest-label (searches-alist)
+ (or (cl-loop for elem in searches-alist
+ maximize (length (notmuch-saved-search-get elem :name)))
0))
(defun notmuch-hello-reflect-generate-row (ncols nrows row list)
(let ((len (length list)))
- (loop for col from 0 to (- ncols 1)
- collect (let ((offset (+ (* nrows col) row)))
- (if (< offset len)
- (nth offset list)
- ;; Don't forget to insert an empty slot in the
- ;; output matrix if there is no corresponding
- ;; value in the input matrix.
- nil)))))
+ (cl-loop for col from 0 to (- ncols 1)
+ collect (let ((offset (+ (* nrows col) row)))
+ (if (< offset len)
+ (nth offset list)
+ ;; Don't forget to insert an empty slot in the
+ ;; output matrix if there is no corresponding
+ ;; value in the input matrix.
+ nil)))))
(defun notmuch-hello-reflect (list ncols)
"Reflect a `ncols' wide matrix represented by `list' along the
diagonal."
;; Not very lispy...
(let ((nrows (ceiling (length list) ncols)))
- (loop for row from 0 to (- nrows 1)
- append (notmuch-hello-reflect-generate-row ncols nrows row list))))
-
-(defun notmuch-hello-widget-search (widget &rest ignore)
- (notmuch-search (widget-get widget
- :notmuch-search-terms)
- notmuch-search-oldest-first
- nil nil #'notmuch-hello-search-continuation))
+ (cl-loop for row from 0 to (- nrows 1)
+ append (notmuch-hello-reflect-generate-row ncols nrows row list))))
+
+(defun notmuch-hello-widget-search (widget &rest _ignore)
+ (let ((search-terms (widget-get widget :notmuch-search-terms))
+ (oldest-first (widget-get widget :notmuch-search-oldest-first))
+ (exclude (widget-get widget :notmuch-search-hide-excluded)))
+ (cl-case (widget-get widget :notmuch-search-type)
+ (tree
+ (let ((n (notmuch-search-format-buffer-name (widget-value widget) "tree" t)))
+ (notmuch-tree search-terms nil nil n nil nil nil oldest-first exclude)))
+ (unthreaded
+ (let ((n (notmuch-search-format-buffer-name (widget-value widget)
+ "unthreaded" t)))
+ (notmuch-unthreaded search-terms nil nil n nil oldest-first exclude)))
+ (t
+ (notmuch-search search-terms oldest-first exclude)))))
(defun notmuch-saved-search-count (search)
- (car (process-lines notmuch-command "count" search)))
+ (car (notmuch--process-lines notmuch-command "count" search)))
(defun notmuch-hello-tags-per-line (widest)
"Determine how many tags to show per line and how wide they
;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name.
(+ 9 1 (max notmuch-column-control widest)))))
-
((floatp notmuch-column-control)
(let* ((available-width (- (window-width) notmuch-hello-indent))
- (proposed-width (max (* available-width notmuch-column-control) widest)))
+ (proposed-width (max (* available-width notmuch-column-control)
+ widest)))
(floor available-width proposed-width)))
-
(t
(max 1
(/ (- (window-width) notmuch-hello-indent)
;; Count is 9 wide (8 digits plus space), 1 for the space
;; after the name.
(+ 9 1 widest)))))))
-
(cons tags-per-line (/ (max 1
(- (window-width) notmuch-hello-indent
;; Count is 9 wide (8 digits plus
(* tags-per-line (+ 9 1))))
tags-per-line))))
-(defun notmuch-hello-insert-tags (tag-alist widest target)
- (let* ((tags-and-width (notmuch-hello-tags-per-line widest))
+(defun notmuch-hello-filtered-query (query filter)
+ "Constructs a query to search all messages matching QUERY and FILTER.
+
+If FILTER is a string, it is directly used in the returned query.
+
+If FILTER is a function, it is called with QUERY as a parameter and
+the string it returns is used as the query. If nil is returned,
+the entry is hidden.
+
+Otherwise, FILTER is ignored."
+ (cond
+ ((functionp filter) (funcall filter query))
+ ((stringp filter)
+ (concat "(" query ") and (" filter ")"))
+ (t query)))
+
+(defun notmuch-hello-query-counts (query-list &rest options)
+ "Compute list of counts of matched messages from QUERY-LIST.
+
+QUERY-LIST must be a list of saved-searches. Ideally each of
+these is a plist but other options are available for backwards
+compatibility: see `notmuch-saved-searches' for details.
+
+The result is a list of plists each of which includes the
+properties :name NAME, :query QUERY and :count COUNT, together
+with any properties in the original saved-search.
+
+The values :show-empty-searches, :filter and :filter-count from
+options will be handled as specified for
+`notmuch-hello-insert-searches'. :disable-includes can be used to
+turn off the default exclude processing in `notmuch-count(1)'"
+ (with-temp-buffer
+ (dolist (elem query-list nil)
+ (let ((count-query (or (notmuch-saved-search-get elem :count-query)
+ (notmuch-saved-search-get elem :query))))
+ (insert
+ (replace-regexp-in-string
+ "\n" " "
+ (notmuch-hello-filtered-query count-query
+ (or (plist-get options :filter-count)
+ (plist-get options :filter))))
+ "\n")))
+ (unless (= (notmuch--call-process-region (point-min) (point-max) notmuch-command
+ t t nil "count"
+ (if (plist-get options :disable-excludes)
+ "--exclude=false"
+ "--exclude=true")
+ "--batch") 0)
+ (notmuch-logged-error
+ "notmuch count --batch failed"
+ "Please check that the notmuch CLI is new enough to support `count
+--batch'. In general we recommend running matching versions of
+the CLI and emacs interface."))
+ (goto-char (point-min))
+ (cl-mapcan
+ (lambda (elem)
+ (let* ((elem-plist (notmuch-hello-saved-search-to-plist elem))
+ (search-query (plist-get elem-plist :query))
+ (filtered-query (notmuch-hello-filtered-query
+ search-query (plist-get options :filter)))
+ (message-count (prog1 (read (current-buffer))
+ (forward-line 1))))
+ (when (and filtered-query (or (plist-get options :show-empty-searches)
+ (> message-count 0)))
+ (setq elem-plist (plist-put elem-plist :query filtered-query))
+ (list (plist-put elem-plist :count message-count)))))
+ query-list)))
+
+(defun notmuch-hello-nice-number (n)
+ (let (result)
+ (while (> n 0)
+ (push (% n 1000) result)
+ (setq n (/ n 1000)))
+ (setq result (or result '(0)))
+ (apply #'concat
+ (number-to-string (car result))
+ (mapcar (lambda (elem)
+ (format "%s%03d" notmuch-hello-thousands-separator elem))
+ (cdr result)))))
+
+(defun notmuch-hello-insert-buttons (searches)
+ "Insert buttons for SEARCHES.
+
+SEARCHES must be a list of plists each of which should contain at
+least the properties :name NAME :query QUERY and :count COUNT,
+where QUERY is the query to start when the button for the
+corresponding entry is activated, and COUNT should be the number
+of messages matching the query. Such a plist can be computed
+with `notmuch-hello-query-counts'."
+ (let* ((widest (notmuch-hello-longest-label searches))
+ (tags-and-width (notmuch-hello-tags-per-line widest))
(tags-per-line (car tags-and-width))
- (widest (cdr tags-and-width))
+ (column-width (cdr tags-and-width))
+ (column-indent 0)
(count 0)
- (reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
+ (reordered-list (notmuch-hello-reflect searches tags-per-line))
;; Hack the display of the buttons used.
(widget-push-button-prefix "")
- (widget-push-button-suffix "")
- (found-target-pos nil))
+ (widget-push-button-suffix ""))
;; dme: It feels as though there should be a better way to
;; implement this loop than using an incrementing counter.
(mapc (lambda (elem)
;; (not elem) indicates an empty slot in the matrix.
(when elem
- (let* ((name (car elem))
- (query (cdr elem))
- (formatted-name (format "%s " name)))
+ (when (> column-indent 0)
+ (widget-insert (make-string column-indent ? )))
+ (let* ((name (plist-get elem :name))
+ (query (plist-get elem :query))
+ (oldest-first (cl-case (plist-get elem :sort-order)
+ (newest-first nil)
+ (oldest-first t)
+ (otherwise notmuch-search-oldest-first)))
+ (exclude (cl-case (plist-get elem :excluded)
+ (hide t)
+ (show nil)
+ (otherwise notmuch-search-hide-excluded)))
+ (search-type (plist-get elem :search-type))
+ (msg-count (plist-get elem :count)))
(widget-insert (format "%8s "
- (notmuch-hello-nice-number
- (string-to-number (notmuch-saved-search-count query)))))
- (if (string= formatted-name target)
- (setq found-target-pos (point-marker)))
+ (notmuch-hello-nice-number msg-count)))
(widget-create 'push-button
:notify #'notmuch-hello-widget-search
:notmuch-search-terms query
- formatted-name)
- (unless (eq (% count tags-per-line) (1- tags-per-line))
- ;; If this is not the last tag on the line, insert
- ;; enough space to consume the rest of the column.
- ;; Because the button for the name is `(1+ (length
- ;; name))' long (due to the trailing space) we can
- ;; just insert `(- widest (length name))' spaces - the
- ;; column separator is included in the button if
- ;; `(equal widest (length name)'.
- (widget-insert (make-string (max 1
- (- widest (length name)))
- ? )))))
- (setq count (1+ count))
- (if (eq (% count tags-per-line) 0)
- (widget-insert "\n")))
+ :notmuch-search-oldest-first oldest-first
+ :notmuch-search-type search-type
+ :notmuch-search-hide-excluded exclude
+ name)
+ (setq column-indent
+ (1+ (max 0 (- column-width (length name)))))))
+ (cl-incf count)
+ (when (eq (% count tags-per-line) 0)
+ (setq column-indent 0)
+ (widget-insert "\n")))
reordered-list)
-
;; If the last line was not full (and hence did not include a
;; carriage return), insert one now.
(unless (eq (% count tags-per-line) 0)
- (widget-insert "\n"))
- found-target-pos))
+ (widget-insert "\n"))))
-(defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png")))
+;;; Mode
-(defun notmuch-hello-search-continuation()
- (notmuch-hello-update t))
-
-(defun notmuch-hello-update (&optional no-display)
- "Update the current notmuch view."
+(defun notmuch-hello-update ()
+ "Update the notmuch-hello buffer."
;; Lazy - rebuild everything.
(interactive)
- (notmuch-hello no-display))
-
-(defun notmuch-hello-poll-and-update ()
- "Invoke `notmuch-poll' to import mail, then refresh the current view."
- (interactive)
- (notmuch-poll)
- (notmuch-hello-update))
-
+ (notmuch-hello t))
+
+(defun notmuch-hello-window-configuration-change ()
+ "Hook function to update the hello buffer when it is switched to."
+ (let ((hello-buf (get-buffer "*notmuch-hello*"))
+ (do-refresh nil))
+ ;; Consider all windows in the currently selected frame, since
+ ;; that's where the configuration change happened. This also
+ ;; refreshes our snapshot of all windows, so we have to do this
+ ;; even if we know we won't refresh (e.g., hello-buf is null).
+ (dolist (window (window-list))
+ (let ((last-buf (window-parameter window 'notmuch-hello-last-buffer))
+ (cur-buf (window-buffer window)))
+ (unless (eq last-buf cur-buf)
+ ;; This window changed or is new. Update recorded buffer
+ ;; for next time.
+ (set-window-parameter window 'notmuch-hello-last-buffer cur-buf)
+ (when (and (eq cur-buf hello-buf) last-buf)
+ ;; The user just switched to hello in this window (hello
+ ;; is currently visible, was not visible on the last
+ ;; configuration change, and this is not a new window)
+ (setq do-refresh t)))))
+ (when (and do-refresh notmuch-hello-auto-refresh)
+ ;; Refresh hello as soon as we get back to redisplay. On Emacs
+ ;; 24, we can't do it right here because something in this
+ ;; hook's call stack overrides hello's point placement.
+ ;; FIXME And on Emacs releases that we still support?
+ (run-at-time nil nil #'notmuch-hello t))
+ (unless hello-buf
+ ;; Clean up hook
+ (remove-hook 'window-configuration-change-hook
+ #'notmuch-hello-window-configuration-change))))
(defvar notmuch-hello-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map "v" (lambda () "Display the notmuch version" (interactive)
- (message "notmuch version %s" (notmuch-version))))
- (define-key map "?" 'notmuch-help)
- (define-key map "q" 'notmuch-kill-this-buffer)
- (define-key map "=" 'notmuch-hello-update)
- (define-key map "G" 'notmuch-hello-poll-and-update)
- (define-key map (kbd "<C-tab>") 'widget-backward)
- (define-key map "m" 'notmuch-mua-new-mail)
- (define-key map "s" 'notmuch-hello-search)
+ ;; Inherit both widget-keymap and notmuch-common-keymap. We have
+ ;; to use make-sparse-keymap to force this to be a new keymap (so
+ ;; that when we modify map it does not modify widget-keymap).
+ (let ((map (make-composed-keymap (list (make-sparse-keymap) widget-keymap))))
+ (set-keymap-parent map notmuch-common-keymap)
+ ;; Currently notmuch-hello-mode supports free text entry, but not
+ ;; tagging operations, so provide standard undo.
+ (define-key map [remap notmuch-tag-undo] #'undo)
map)
"Keymap for \"notmuch hello\" buffers.")
-(fset 'notmuch-hello-mode-map notmuch-hello-mode-map)
-(defun notmuch-hello-mode ()
- "Major mode for convenient notmuch navigation. This is your entry portal into notmuch.
+(define-derived-mode notmuch-hello-mode fundamental-mode "notmuch-hello"
+ "Major mode for convenient notmuch navigation. This is your entry
+portal into notmuch.
+
+Saved searches are \"bookmarks\" for arbitrary queries. Hit RET
+or click on a saved search to view matching threads. Edit saved
+searches with the `edit' button. Type `\\[notmuch-jump-search]'
+in any Notmuch screen for quick access to saved searches that
+have shortcut keys.
+
+Type new searches in the search box and hit RET to view matching
+threads. Hit RET in a recent search box to re-submit a previous
+search. Edit it first if you like. Save a recent search to saved
+searches with the `save' button.
+
+Hit `\\[notmuch-search]' or `\\[notmuch-tree]' in any Notmuch
+screen to search for messages and view matching threads or
+messages, respectively. Recent searches are available in the
+minibuffer history.
+
+Expand the all tags view with the `show' button (and collapse
+again with the `hide' button). Hit RET or click on a tag name to
+view matching threads.
+
+Hit `\\[notmuch-refresh-this-buffer]' to refresh the screen and
+`\\[notmuch-bury-or-kill-this-buffer]' to quit.
+
+The screen may be customized via `\\[customize]'.
Complete list of currently available key bindings:
\\{notmuch-hello-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map notmuch-hello-mode-map)
- (setq major-mode 'notmuch-hello-mode
- mode-name "notmuch-hello")
- (run-mode-hooks 'notmuch-hello-mode-hook)
- ;;(setq buffer-read-only t)
-)
-
-(defun notmuch-hello-generate-tag-alist ()
+ (setq notmuch-buffer-refresh-function #'notmuch-hello-update))
+
+;;; Inserters
+
+(defun notmuch-hello-generate-tag-alist (&optional hide-tags)
"Return an alist from tags to queries to display in the all-tags section."
- (notmuch-remove-if-not
- #'cdr
- (mapcar (lambda (tag)
- (cons tag
- (cond
- ((functionp notmuch-hello-tag-list-make-query)
- (concat "tag:" tag " and ("
- (funcall notmuch-hello-tag-list-make-query tag) ")"))
- ((stringp notmuch-hello-tag-list-make-query)
- (concat "tag:" tag " and ("
- notmuch-hello-tag-list-make-query ")"))
- (t (concat "tag:" tag)))))
- (notmuch-remove-if-not
- (lambda (tag)
- (not (member tag notmuch-hello-hide-tags)))
- (process-lines notmuch-command "search-tags")))))
+ (cl-mapcan (lambda (tag)
+ (and (not (member tag hide-tags))
+ (list (cons tag
+ (concat "tag:"
+ (notmuch-escape-boolean-term tag))))))
+ (notmuch--process-lines notmuch-command "search" "--output=tags" "*")))
+
+(defun notmuch-hello-insert-header ()
+ "Insert the default notmuch-hello header."
+ (when notmuch-show-logo
+ (let ((image notmuch-hello-logo))
+ ;; The notmuch logo uses transparency. That can display poorly
+ ;; when inserting the image into an emacs buffer (black logo on
+ ;; a black background), so force the background colour of the
+ ;; image. We use a face to represent the colour so that
+ ;; `defface' can be used to declare the different possible
+ ;; colours, which depend on whether the frame has a light or
+ ;; dark background.
+ (setq image (cons 'image
+ (append (cdr image)
+ (list :background
+ (face-background
+ 'notmuch-hello-logo-background)))))
+ (insert-image image))
+ (widget-insert " "))
+
+ (widget-insert "Welcome to ")
+ ;; Hack the display of the links used.
+ (let ((widget-link-prefix "")
+ (widget-link-suffix ""))
+ (widget-create 'link
+ :notify (lambda (&rest _ignore)
+ (browse-url notmuch-hello-url))
+ :help-echo "Visit the notmuch website."
+ "notmuch")
+ (widget-insert ". ")
+ (widget-insert "You have ")
+ (widget-create 'link
+ :notify (lambda (&rest _ignore)
+ (notmuch-hello-update))
+ :help-echo "Refresh"
+ (notmuch-hello-nice-number
+ (string-to-number
+ (car (notmuch--process-lines notmuch-command "count" "--exclude=false")))))
+ (widget-insert " messages.\n")))
+
+(defun notmuch-hello-insert-saved-searches ()
+ "Insert the saved-searches section."
+ (let ((searches (notmuch-hello-query-counts
+ (if notmuch-saved-search-sort-function
+ (funcall notmuch-saved-search-sort-function
+ notmuch-saved-searches)
+ notmuch-saved-searches)
+ :show-empty-searches notmuch-show-empty-saved-searches)))
+ (when searches
+ (widget-insert "Saved searches: ")
+ (widget-create 'push-button
+ :notify (lambda (&rest _ignore)
+ (customize-variable 'notmuch-saved-searches))
+ "edit")
+ (widget-insert "\n\n")
+ (let ((start (point)))
+ (notmuch-hello-insert-buttons searches)
+ (indent-rigidly start (point) notmuch-hello-indent)))))
+
+(defun notmuch-hello-insert-search ()
+ "Insert a search widget."
+ (widget-insert "Search: ")
+ (widget-create 'editable-field
+ ;; Leave some space at the start and end of the
+ ;; search boxes.
+ :size (max 8 (- (window-width) notmuch-hello-indent
+ (length "Search: ")))
+ :action #'notmuch-hello-search)
+ ;; Add an invisible dot to make `widget-end-of-line' ignore
+ ;; trailing spaces in the search widget field. A dot is used
+ ;; instead of a space to make `show-trailing-whitespace'
+ ;; happy, i.e. avoid it marking the whole line as trailing
+ ;; spaces.
+ (widget-insert (propertize "." 'invisible t))
+ (widget-insert "\n"))
+
+(defun notmuch-hello-insert-recent-searches ()
+ "Insert recent searches."
+ (when notmuch-search-history
+ (widget-insert "Recent searches: ")
+ (widget-create
+ 'push-button
+ :notify (lambda (&rest _ignore)
+ (when (y-or-n-p "Are you sure you want to clear the searches? ")
+ (setq notmuch-search-history nil)
+ (notmuch-hello-update)))
+ "clear")
+ (widget-insert "\n\n")
+ (let ((width (notmuch-search-item-field-width)))
+ (dolist (search (seq-take notmuch-search-history
+ notmuch-hello-recent-searches-max))
+ (widget-create 'notmuch-search-item :value search :size width)))))
+
+(defun notmuch-hello-insert-searches (title query-list &rest options)
+ "Insert a section with TITLE showing a list of buttons made from
+QUERY-LIST.
+
+QUERY-LIST should ideally be a plist but for backwards
+compatibility other forms are also accepted (see
+`notmuch-saved-searches' for details). The plist should
+contain keys :name and :query; if :count-query is also present
+then it specifies an alternate query to be used to generate the
+count for the associated search.
+
+Supports the following entries in OPTIONS as a plist:
+:initially-hidden - if non-nil, section will be hidden on startup
+:show-empty-searches - show buttons with no matching messages
+:hide-if-empty - hide if no buttons would be shown
+ (only makes sense without :show-empty-searches)
+:filter - This can be a function that takes the search query as
+ its argument and returns a filter to be used in conjunction
+ with the query for that search or nil to hide the
+ element. This can also be a string that is used as a combined
+ with each query using \"and\".
+:filter-count - Separate filter to generate the count displayed
+ each search. Accepts the same values as :filter. If :filter
+ and :filter-count are specified, this will be used instead of
+ :filter, not in conjunction with it."
+
+ (widget-insert title ": ")
+ (when (and notmuch-hello-first-run (plist-get options :initially-hidden))
+ (add-to-list 'notmuch-hello-hidden-sections title))
+ (let ((is-hidden (member title notmuch-hello-hidden-sections))
+ (start (point)))
+ (if is-hidden
+ (widget-create 'push-button
+ :notify (lambda (&rest _ignore)
+ (setq notmuch-hello-hidden-sections
+ (delete title notmuch-hello-hidden-sections))
+ (notmuch-hello-update))
+ "show")
+ (widget-create 'push-button
+ :notify (lambda (&rest _ignore)
+ (add-to-list 'notmuch-hello-hidden-sections
+ title)
+ (notmuch-hello-update))
+ "hide"))
+ (widget-insert "\n")
+ (unless is-hidden
+ (let ((searches (apply 'notmuch-hello-query-counts query-list options)))
+ (when (or (not (plist-get options :hide-if-empty))
+ searches)
+ (widget-insert "\n")
+ (notmuch-hello-insert-buttons searches)
+ (indent-rigidly start (point) notmuch-hello-indent))))))
+
+(defun notmuch-hello-insert-tags-section (&optional title &rest options)
+ "Insert a section displaying all tags with message counts.
+
+TITLE defaults to \"All tags\".
+Allowed options are those accepted by `notmuch-hello-insert-searches' and the
+following:
+
+:hide-tags - List of tags that should be excluded."
+ (apply 'notmuch-hello-insert-searches
+ (or title "All tags")
+ (notmuch-hello-generate-tag-alist (plist-get options :hide-tags))
+ options))
+
+(defun notmuch-hello-insert-inbox ()
+ "Show an entry for each saved search and inboxed messages for each tag."
+ (notmuch-hello-insert-searches "What's in your inbox"
+ (append
+ notmuch-saved-searches
+ (notmuch-hello-generate-tag-alist))
+ :filter "tag:inbox"))
+
+(defun notmuch-hello-insert-alltags ()
+ "Insert a section displaying all tags and associated message counts."
+ (notmuch-hello-insert-tags-section
+ nil
+ :initially-hidden (not notmuch-show-all-tags-list)
+ :hide-tags notmuch-hello-hide-tags
+ :filter notmuch-hello-tag-list-make-query
+ :disable-excludes t))
+
+(defun notmuch-hello-insert-footer ()
+ "Insert the notmuch-hello footer."
+ (let ((start (point)))
+ (widget-insert "Hit `?' for context-sensitive help in any Notmuch screen.\n")
+ (widget-insert "Customize ")
+ (widget-create 'link
+ :notify (lambda (&rest _ignore)
+ (customize-group 'notmuch))
+ :button-prefix "" :button-suffix ""
+ "Notmuch")
+ (widget-insert " or ")
+ (widget-create 'link
+ :notify (lambda (&rest _ignore)
+ (customize-variable 'notmuch-hello-sections))
+ :button-prefix "" :button-suffix ""
+ "this page.")
+ (let ((fill-column (- (window-width) notmuch-hello-indent)))
+ (center-region start (point)))))
+
+;;; Hello!
;;;###autoload
(defun notmuch-hello (&optional no-display)
"Run notmuch and display saved searches, known tags, etc."
(interactive)
-
- ;; Jump through a hoop to get this value from the deprecated variable
- ;; name (`notmuch-folders') or from the default value.
- (unless notmuch-saved-searches
- (setq notmuch-saved-searches (notmuch-saved-searches)))
-
- (if no-display
- (set-buffer "*notmuch-hello*")
- (switch-to-buffer "*notmuch-hello*"))
-
- (let ((target (if (widget-at)
- (widget-value (widget-at))
- (condition-case nil
- (progn
- (widget-forward 1)
- (widget-value (widget-at)))
- (error nil))))
+ (notmuch-assert-cli-sane)
+ ;; This may cause a window configuration change, so if the
+ ;; auto-refresh hook is already installed, avoid recursive refresh.
+ (let ((notmuch-hello-auto-refresh nil))
+ (if no-display
+ (set-buffer "*notmuch-hello*")
+ (pop-to-buffer-same-window "*notmuch-hello*")))
+ ;; Install auto-refresh hook
+ (when notmuch-hello-auto-refresh
+ (add-hook 'window-configuration-change-hook
+ #'notmuch-hello-window-configuration-change))
+ (let ((target-line (line-number-at-pos))
+ (target-column (current-column))
(inhibit-read-only t))
-
;; Delete all editable widget fields. Editable widget fields are
;; tracked in a buffer local variable `widget-field-list' (and
;; others). If we do `erase-buffer' without properly deleting the
;; widgets, some widget-related functions are confused later.
(mapc 'widget-delete widget-field-list)
-
(erase-buffer)
-
(unless (eq major-mode 'notmuch-hello-mode)
(notmuch-hello-mode))
-
(let ((all (overlay-lists)))
;; Delete all the overlays.
(mapc 'delete-overlay (car all))
(mapc 'delete-overlay (cdr all)))
-
- (when notmuch-show-logo
- (let ((image notmuch-hello-logo))
- ;; The notmuch logo uses transparency. That can display poorly
- ;; when inserting the image into an emacs buffer (black logo on
- ;; a black background), so force the background colour of the
- ;; image. We use a face to represent the colour so that
- ;; `defface' can be used to declare the different possible
- ;; colours, which depend on whether the frame has a light or
- ;; dark background.
- (setq image (cons 'image
- (append (cdr image)
- (list :background (face-background 'notmuch-hello-logo-background)))))
- (insert-image image))
- (widget-insert " "))
-
- (widget-insert "Welcome to ")
- ;; Hack the display of the links used.
- (let ((widget-link-prefix "")
- (widget-link-suffix ""))
- (widget-create 'link
- :notify (lambda (&rest ignore)
- (browse-url notmuch-hello-url))
- :help-echo "Visit the notmuch website."
- "notmuch")
- (widget-insert ". ")
- (widget-insert "You have ")
- (widget-create 'link
- :notify (lambda (&rest ignore)
- (notmuch-hello-update))
- :help-echo "Refresh"
- (notmuch-hello-nice-number
- (string-to-number (car (process-lines notmuch-command "count")))))
- (widget-insert " messages.\n"))
-
- (let ((found-target-pos nil)
- (final-target-pos nil)
- (default-pos))
- (let* ((saved-alist
- ;; Filter out empty saved searches if required.
- (if notmuch-show-empty-saved-searches
- notmuch-saved-searches
- (loop for elem in notmuch-saved-searches
- if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)
- collect elem)))
- (saved-widest (notmuch-hello-longest-label saved-alist))
- (alltags-alist (if notmuch-show-all-tags-list (notmuch-hello-generate-tag-alist)))
- (alltags-widest (notmuch-hello-longest-label alltags-alist))
- (widest (max saved-widest alltags-widest)))
-
- (when saved-alist
- ;; Sort saved searches if required.
- (when notmuch-saved-search-sort-function
- (setq saved-alist
- (funcall notmuch-saved-search-sort-function saved-alist)))
- (widget-insert "\nSaved searches: ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-variable 'notmuch-saved-searches))
- "edit")
- (widget-insert "\n\n")
- (setq final-target-pos (point-marker))
- (let ((start (point)))
- (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))
- (if found-target-pos
- (setq final-target-pos found-target-pos))
- (indent-rigidly start (point) notmuch-hello-indent)))
-
- (widget-insert "\nSearch: ")
- (setq default-pos (point-marker))
- (widget-create 'editable-field
- ;; Leave some space at the start and end of the
- ;; search boxes.
- :size (max 8 (- (window-width) notmuch-hello-indent
- (length "Search: ")))
- :action (lambda (widget &rest ignore)
- (notmuch-hello-search (widget-value widget))))
- ;; Add an invisible dot to make `widget-end-of-line' ignore
- ;; trailing spaces in the search widget field. A dot is used
- ;; instead of a space to make `show-trailing-whitespace'
- ;; happy, i.e. avoid it marking the whole line as trailing
- ;; spaces.
- (widget-insert ".")
- (put-text-property (1- (point)) (point) 'invisible t)
- (widget-insert "\n")
-
- (when notmuch-search-history
- (widget-insert "\nRecent searches: ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (setq notmuch-search-history nil)
- (notmuch-hello-update))
- "clear")
- (widget-insert "\n\n")
- (let ((start (point)))
- (loop for i from 1 to notmuch-hello-recent-searches-max
- for search in notmuch-search-history do
- (let ((widget-symbol (intern (format "notmuch-hello-search-%d" i))))
- (set widget-symbol
- (widget-create 'editable-field
- ;; Don't let the search boxes be
- ;; less than 8 characters wide.
- :size (max 8
- (- (window-width)
- ;; Leave some space
- ;; at the start and
- ;; end of the
- ;; boxes.
- (* 2 notmuch-hello-indent)
- ;; 1 for the space
- ;; before the
- ;; `[save]' button. 6
- ;; for the `[save]'
- ;; button.
- 1 6))
- :action (lambda (widget &rest ignore)
- (notmuch-hello-search (widget-value widget)))
- search))
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (notmuch-hello-add-saved-search widget))
- :notmuch-saved-search-widget widget-symbol
- "save"))
- (widget-insert "\n"))
- (indent-rigidly start (point) notmuch-hello-indent)))
-
- (when alltags-alist
- (widget-insert "\nAll tags: ")
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (setq notmuch-show-all-tags-list nil)
- (notmuch-hello-update))
- "hide")
- (widget-insert "\n\n")
- (let ((start (point)))
- (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))
- (unless final-target-pos
- (setq final-target-pos found-target-pos))
- (indent-rigidly start (point) notmuch-hello-indent)))
-
- (widget-insert "\n")
-
- (unless notmuch-show-all-tags-list
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (setq notmuch-show-all-tags-list t)
- (notmuch-hello-update))
- "Show all tags")))
-
- (let ((start (point)))
- (widget-insert "\n\n")
- (widget-insert "Type a search query and hit RET to view matching threads.\n")
- (when notmuch-search-history
- (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
- (widget-insert "Save recent searches with the `save' button.\n"))
- (when notmuch-saved-searches
- (widget-insert "Edit saved searches with the `edit' button.\n"))
- (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
- (widget-insert "`=' to refresh this screen. `s' to search messages. `q' to quit.\n")
- (let ((fill-column (- (window-width) notmuch-hello-indent)))
- (center-region start (point))))
-
- (widget-setup)
-
- (when final-target-pos
- (goto-char final-target-pos)
- (unless (widget-at)
- (widget-forward 1)))
-
- (unless (widget-at)
- (goto-char default-pos))))
-
- (run-hooks 'notmuch-hello-refresh-hook))
-
-(defun notmuch-folder ()
- "Deprecated function for invoking notmuch---calling `notmuch' is preferred now."
- (interactive)
- (notmuch-hello))
-
-;;
+ (mapc
+ (lambda (section)
+ (let ((point-before (point)))
+ (if (functionp section)
+ (funcall section)
+ (apply (car section) (cdr section)))
+ ;; don't insert a newline when the previous section didn't
+ ;; show anything.
+ (unless (eq (point) point-before)
+ (widget-insert "\n"))))
+ notmuch-hello-sections)
+ (widget-setup)
+ ;; Move point back to where it was before refresh. Use line and
+ ;; column instead of point directly to be insensitive to additions
+ ;; and removals of text within earlier lines.
+ (goto-char (point-min))
+ (forward-line (1- target-line))
+ (move-to-column target-column))
+ (run-hooks 'notmuch-hello-refresh-hook)
+ (setq notmuch-hello-first-run nil))
+
+;;; _
(provide 'notmuch-hello)
+
+;;; notmuch-hello.el ends here
projects / notmuch / blobdiff