-;;; notmuch-hello.el --- welcome to notmuch, a frontend
+;;; notmuch-hello.el --- welcome to notmuch, a frontend -*- lexical-binding: t -*-
;;
;; Copyright © David Edmondson
;;
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'widget)
(require 'wid-edit) ; For `widget-forward'.
(require 'notmuch-mua)
(declare-function notmuch-search "notmuch"
- (&optional query oldest-first target-thread target-line continuation))
-(declare-function notmuch-poll "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))
-(declare-function notmuch-unthreaded
- (&optional query query-context target buffer-name open-target))
+ (&optional query query-context target buffer-name
+ open-target unthreaded parent-buffer oldest-first))
+(declare-function notmuch-unthreaded "notmuch-tree"
+ (&optional query query-context target buffer-name
+ open-target))
+
+;;; Options
(defun notmuch-saved-search-get (saved-search field)
"Get FIELD from SAVED-SEARCH.
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.
+ Possible values are `oldest-first', `newest-first'
+ or nil. Nil means use the default sort order.
: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.
+ 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)."
(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 "https://notmuchmail.org"
+(defconst notmuch-hello-url "https://notmuchmail.org"
"The `notmuch' web site.")
(defvar notmuch-hello-custom-section-options
: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.")
-
-(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-search (&optional search)
- (unless (null 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)
- (interactive)
- (let ((search (widget-value
- (symbol-value
- (widget-get widget :notmuch-saved-search-widget))))
+ "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
(cl-loop for elem in notmuch-saved-searches
- if (not (equal name
- (notmuch-saved-search-get elem :name)))
+ unless (equal name (notmuch-saved-search-get elem :name))
collect elem))
;; Add the new one.
(customize-save-variable 'notmuch-saved-searches
(message "Saved '%s' as '%s'." search name)
(notmuch-hello-update)))
-(defun notmuch-hello-delete-search-from-history (widget)
- (interactive)
- (let ((search (widget-value
- (symbol-value
- (widget-get widget :notmuch-saved-search-widget)))))
- (setq notmuch-search-history (delete search
- notmuch-search-history))
+(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)))
(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)
- (cond
- ((eq (widget-get widget :notmuch-search-type) 'tree)
- (notmuch-tree (widget-get widget
- :notmuch-search-terms)))
- ((eq (widget-get widget :notmuch-search-type) 'unthreaded)
- (notmuch-unthreaded (widget-get widget
- :notmuch-search-terms)))
+(defun notmuch-hello-widget-search (widget &rest _ignore)
+ (cl-case (widget-get widget :notmuch-search-type)
+ (tree
+ (let ((n (notmuch-search-format-buffer-name (widget-value widget) "tree" t)))
+ (notmuch-tree (widget-get widget :notmuch-search-terms)
+ nil nil n nil nil nil
+ (widget-get widget :notmuch-search-oldest-first))))
+ (unthreaded
+ (let ((n (notmuch-search-format-buffer-name (widget-value widget)
+ "unthreaded" t)))
+ (notmuch-unthreaded (widget-get widget :notmuch-search-terms) nil nil n)))
(t
- (notmuch-search (widget-get widget
- :notmuch-search-terms)
- (widget-get widget
- :notmuch-search-oldest-first)))))
+ (notmuch-search (widget-get widget :notmuch-search-terms)
+ (widget-get widget :notmuch-search-oldest-first)))))
(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
The values :show-empty-searches, :filter and :filter-count from
options will be handled as specified for
-`notmuch-hello-insert-searches'."
+`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)
(or (plist-get options :filter-count)
(plist-get options :filter))))
"\n")))
- (unless (= (call-process-region (point-min) (point-max) notmuch-command
- t t nil "count" "--batch") 0)
+ (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))
- (notmuch-remove-if-not
- #'identity
- (mapcar
- (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))
- (plist-put elem-plist :count message-count))))
- query-list))))
+ (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.
(unless (eq (% count tags-per-line) 0)
(widget-insert "\n"))))
-(defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png")))
+;;; Mode
(defun notmuch-hello-update ()
"Update the notmuch-hello buffer."
(remove-hook 'window-configuration-change-hook
#'notmuch-hello-window-configuration-change))))
-;; the following variable is defined as being defconst in notmuch-version.el
-(defvar notmuch-emacs-version)
-
-(defun notmuch-hello-versions ()
- "Display the notmuch version(s)."
- (interactive)
- (let ((notmuch-cli-version (notmuch-cli-version)))
- (message "notmuch version %s"
- (if (string= notmuch-emacs-version notmuch-cli-version)
- notmuch-cli-version
- (concat notmuch-cli-version
- " (emacs mua version " notmuch-emacs-version ")")))))
-
(defvar notmuch-hello-mode-map
;; 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)
- (define-key map "v" 'notmuch-hello-versions)
- (define-key map (kbd "<C-tab>") 'widget-backward)
map)
"Keymap for \"notmuch hello\" buffers.")
Complete list of currently available key bindings:
\\{notmuch-hello-mode-map}"
- (setq notmuch-buffer-refresh-function #'notmuch-hello-update)
- ;;(setq buffer-read-only t)
- )
+ (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."
- (mapcar (lambda (tag)
- (cons tag (concat "tag:" (notmuch-escape-boolean-term tag))))
- (notmuch-remove-if-not
- (lambda (tag)
- (not (member tag hide-tags)))
- (process-lines notmuch-command "search" "--output=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."
(let ((widget-link-prefix "")
(widget-link-suffix ""))
(widget-create 'link
- :notify (lambda (&rest ignore)
+ :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)
+ :notify (lambda (&rest _ignore)
(notmuch-hello-update))
:help-echo "Refresh"
(notmuch-hello-nice-number
(string-to-number
- (car (process-lines notmuch-command "count")))))
+ (car (notmuch--process-lines notmuch-command "count" "--exclude=false")))))
(widget-insert " messages.\n")))
(defun notmuch-hello-insert-saved-searches ()
(when searches
(widget-insert "Saved searches: ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(customize-variable 'notmuch-saved-searches))
"edit")
(widget-insert "\n\n")
;; search boxes.
:size (max 8 (- (window-width) notmuch-hello-indent
(length "Search: ")))
- :action (lambda (widget &rest ignore)
- (notmuch-hello-search (widget-value widget))))
+ :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 ".")
- (put-text-property (1- (point)) (point) 'invisible t)
+ (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-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 ((start (point)))
- (cl-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
- ;; 1 for the space
- ;; before the `[del]'
- ;; button. 5 for the
- ;; `[del]' button.
- 1 5))
- :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 " ")
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (when (y-or-n-p "Are you sure you want to delete this search? ")
- (notmuch-hello-delete-search-from-history widget)))
- :notmuch-saved-search-widget widget-symbol
- "del"))
- (widget-insert "\n"))
- (indent-rigidly start (point) notmuch-hello-indent))
- nil))
+ (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.
(start (point)))
(if is-hidden
(widget-create 'push-button
- :notify `(lambda (widget &rest ignore)
- (setq notmuch-hello-hidden-sections
- (delete ,title notmuch-hello-hidden-sections))
- (notmuch-hello-update))
+ :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 (widget &rest ignore)
- (add-to-list 'notmuch-hello-hidden-sections
- ,title)
- (notmuch-hello-update))
+ :notify (lambda (&rest _ignore)
+ (add-to-list 'notmuch-hello-hidden-sections
+ title)
+ (notmuch-hello-update))
"hide"))
(widget-insert "\n")
(unless is-hidden
nil
:initially-hidden (not notmuch-show-all-tags-list)
:hide-tags notmuch-hello-hide-tags
- :filter notmuch-hello-tag-list-make-query))
+ :filter notmuch-hello-tag-list-make-query
+ :disable-excludes t))
(defun notmuch-hello-insert-footer ()
"Insert the notmuch-hello footer."
(widget-insert "Hit `?' for context-sensitive help in any Notmuch screen.\n")
(widget-insert "Customize ")
(widget-create 'link
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(customize-group 'notmuch))
:button-prefix "" :button-suffix ""
"Notmuch")
(widget-insert " or ")
(widget-create 'link
- :notify (lambda (&rest ignore)
+ :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."
(run-hooks 'notmuch-hello-refresh-hook)
(setq notmuch-hello-first-run nil))
-(defun notmuch-folder ()
- "Deprecated function for invoking notmuch---calling `notmuch' is preferred now."
- (interactive)
- (notmuch-hello))
-
-;;
+;;; _
(provide 'notmuch-hello)