X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-hello.el;h=9ac52c11bcc5ac716e7fab6feb67517c152f5eb8;hp=767c68743e19cf31bc92ec223ef506779f98237c;hb=cc180507b03d9826c92d48ee91dbd9bb5f15cd56;hpb=d7b83385af20c11730603d351527cb422c82cf0b diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index 767c6874..9ac52c11 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -1,4 +1,4 @@ -;;; notmuch-hello.el --- welcome to notmuch, a frontend +;;; notmuch-hello.el --- welcome to notmuch, a frontend -*- lexical-binding: t -*- ;; ;; Copyright © David Edmondson ;; @@ -21,7 +21,6 @@ ;;; Code: -(require 'cl-lib) (require 'widget) (require 'wid-edit) ; For `widget-forward'. @@ -29,14 +28,19 @@ (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. @@ -140,9 +144,11 @@ a plist. Supported properties are 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)." @@ -192,6 +198,8 @@ fields of the search." (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 @@ -367,23 +375,51 @@ supported for \"Customized queries section\" items." :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))))) +;;; 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))) @@ -400,8 +436,7 @@ supported for \"Customized queries section\" items." ;; 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 @@ -417,6 +452,13 @@ supported for \"Customized queries section\" items." (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))) @@ -441,22 +483,20 @@ diagonal." (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 + (notmuch-tree (widget-get widget :notmuch-search-terms) + nil nil nil nil nil nil + (widget-get widget :notmuch-search-oldest-first))) + (unthreaded + (notmuch-unthreaded (widget-get widget :notmuch-search-terms))) (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 @@ -529,8 +569,8 @@ options will be handled as specified for (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" "--exclude=false" "--batch") 0) (notmuch-logged-error "notmuch count --batch failed" "Please check that the notmuch CLI is new enough to support `count @@ -551,6 +591,18 @@ the CLI and emacs interface.")) (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. @@ -605,7 +657,7 @@ with `notmuch-hello-query-counts'." (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." @@ -650,7 +702,6 @@ with `notmuch-hello-query-counts'." ;; 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 (kbd "") 'widget-backward) map) "Keymap for \"notmuch hello\" buffers.") @@ -685,9 +736,9 @@ The screen may be customized via `\\[customize]'. 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." @@ -696,7 +747,7 @@ Complete list of currently available key bindings: (list (cons tag (concat "tag:" (notmuch-escape-boolean-term tag)))))) - (process-lines notmuch-command "search" "--output=tags" "*"))) + (notmuch--process-lines notmuch-command "search" "--output=tags" "*"))) (defun notmuch-hello-insert-header () "Insert the default notmuch-hello header." @@ -722,19 +773,19 @@ Complete list of currently available key bindings: (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 () @@ -748,7 +799,7 @@ Complete list of currently available key bindings: (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") @@ -770,62 +821,25 @@ Complete list of currently available key bindings: ;; 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 #'notmuch-hello-search - search)) - (widget-insert " ") - (widget-create 'push-button - :notify #'notmuch-hello-add-saved-search - :notmuch-saved-search-widget widget-symbol - "save") - (widget-insert " ") - (widget-create 'push-button - :notify #'notmuch-hello-delete-search-from-history - :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. @@ -856,16 +870,16 @@ Supports the following entries in OPTIONS as a plist: (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 @@ -911,19 +925,21 @@ following: (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." @@ -975,7 +991,7 @@ following: (run-hooks 'notmuch-hello-refresh-hook) (setq notmuch-hello-first-run nil)) -;; +;;; _ (provide 'notmuch-hello)