X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-hello.el;h=fa31694ff0f79a7f2781849394390a673f75aade;hb=b4ee80dcbdd6702a693110321ad69c380967846d;hp=0ff5aaff80e533c4c21cf230ee73ce0ab6b8939e;hpb=ed40579ad3882e6f9bbe9b1ba5e707ab289ca203;p=notmuch diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index 0ff5aaff..fa31694f 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -21,15 +21,15 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - +(require 'cl-lib) (require 'widget) (require 'wid-edit) ; For `widget-forward'. (require 'notmuch-lib) (require 'notmuch-mua) -(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line continuation)) +(declare-function notmuch-search "notmuch" + (&optional query oldest-first target-thread target-line continuation)) (declare-function notmuch-poll "notmuch" ()) (declare-function notmuch-tree "notmuch-tree" (&optional query query-context target buffer-name open-target unthreaded)) @@ -91,18 +91,28 @@ searches so they still work in customize." :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"))) + (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) + (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) + (group :format "%v" :inline t + (const :format "" :search-type) (choice :tag " Search Type" (const :tag "Search mode" nil) (const :tag "Tree mode" tree) @@ -127,8 +137,8 @@ a plist. Supported properties are 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 @@ -136,10 +146,9 @@ a plist. Supported properties are 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. - + ;; 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" @@ -272,7 +281,7 @@ International Bureau of Weights and Measures." :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 @@ -362,8 +371,7 @@ supported for \"Customized queries section\" items." "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.") + "True if `notmuch-hello' is run for the first time, set to nil afterwards.") (defun notmuch-hello-nice-number (n) (let (result) @@ -372,20 +380,14 @@ afterwards.") (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)) + (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 (notmuch-hello-trim 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)) @@ -471,19 +473,17 @@ should be. Returns a cons cell `(tags-per-line width)'." ;; 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 @@ -532,31 +532,28 @@ options will be handled as specified for (notmuch-hello-filtered-query count-query (or (plist-get options :filter-count) (plist-get options :filter)))) - "\n"))) - + "\n"))) (unless (= (call-process-region (point-min) (point-max) notmuch-command t t nil "count" "--batch") 0) - (notmuch-logged-error "notmuch count --batch failed" - "Please check that the notmuch CLI is new enough to support `count + (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-insert-buttons (searches) "Insert buttons for SEARCHES. @@ -582,8 +579,8 @@ with `notmuch-hello-query-counts'." (mapc (lambda (elem) ;; (not elem) indicates an empty slot in the matrix. (when elem - (if (> column-indent 0) - (widget-insert (make-string column-indent ? ))) + (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) @@ -602,12 +599,11 @@ with `notmuch-hello-query-counts'." name) (setq column-indent (1+ (max 0 (- column-width (length name))))))) - (setq count (1+ count)) + (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) @@ -632,7 +628,7 @@ with `notmuch-hello-query-counts'." (dolist (window (window-list)) (let ((last-buf (window-parameter window 'notmuch-hello-last-buffer)) (cur-buf (window-buffer window))) - (when (not (eq last-buf cur-buf)) + (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) @@ -645,46 +641,25 @@ with `notmuch-hello-query-counts'." ;; 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)) - (when (null hello-buf) + (unless hello-buf ;; Clean up hook (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 - (let ((map (if (fboundp 'make-composed-keymap) - ;; 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). - (make-composed-keymap (list (make-sparse-keymap) widget-keymap)) - ;; Before Emacs 24, keymaps didn't support multiple - ;; inheritance,, so just copy the widget keymap since - ;; it's unlikely to change. - (copy-keymap widget-keymap)))) + ;; 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 "") 'widget-backward) map) "Keymap for \"notmuch hello\" buffers.") -(fset 'notmuch-hello-mode-map notmuch-hello-mode-map) (define-derived-mode notmuch-hello-mode fundamental-mode "notmuch-hello" - "Major mode for convenient notmuch navigation. This is your entry portal into notmuch. + "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 @@ -714,18 +689,18 @@ 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) + ;;(setq buffer-read-only t) + ) (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)))))) + (process-lines notmuch-command "search" "--output=tags" "*"))) (defun notmuch-hello-insert-header () "Insert the default notmuch-hello header." @@ -740,7 +715,9 @@ Complete list of currently available key bindings: ;; dark background. (setq image (cons 'image (append (cdr image) - (list :background (face-background 'notmuch-hello-logo-background))))) + (list :background + (face-background + 'notmuch-hello-logo-background))))) (insert-image image)) (widget-insert " ")) @@ -760,10 +737,10 @@ Complete list of currently available key bindings: (notmuch-hello-update)) :help-echo "Refresh" (notmuch-hello-nice-number - (string-to-number (car (process-lines notmuch-command "count"))))) + (string-to-number + (car (process-lines notmuch-command "count"))))) (widget-insert " messages.\n"))) - (defun notmuch-hello-insert-saved-searches () "Insert the saved-searches section." (let ((searches (notmuch-hello-query-counts @@ -882,8 +859,8 @@ Supports the following entries in OPTIONS as a plist: 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 ": ") - (if (and notmuch-hello-first-run (plist-get options :initially-hidden)) - (add-to-list 'notmuch-hello-hidden-sections 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 @@ -900,7 +877,7 @@ Supports the following entries in OPTIONS as a plist: (notmuch-hello-update)) "hide")) (widget-insert "\n") - (when (not is-hidden) + (unless is-hidden (let ((searches (apply 'notmuch-hello-query-counts query-list options))) (when (or (not (plist-get options :hide-if-empty)) searches) @@ -960,40 +937,32 @@ following: (defun notmuch-hello (&optional no-display) "Run notmuch and display saved searches, known tags, etc." (interactive) - (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*") - (switch-to-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))) - (mapc (lambda (section) (let ((point-before (point))) @@ -1006,7 +975,6 @@ following: (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. @@ -1016,11 +984,6 @@ following: (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)