X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-jump.el;h=3e20b8c7afc68e6b9d56a709ecc74283b173ae38;hp=05ec57ec5e13aeb2071f5a2a9282ad63bb3af793;hb=HEAD;hpb=f5db7ad7d243785c274a99734c681e69d13313d0 diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el index 05ec57ec..3161ed95 100644 --- a/emacs/notmuch-jump.el +++ b/emacs/notmuch-jump.el @@ -1,4 +1,4 @@ -;; notmuch-jump.el --- User-friendly shortcut keys +;;; notmuch-jump.el --- User-friendly shortcut keys -*- lexical-binding: t -*- ;; ;; Copyright © Austin Clements ;; @@ -15,20 +15,19 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with Notmuch. If not, see . +;; along with Notmuch. If not, see . ;; ;; Authors: Austin Clements ;; David Edmondson -(eval-when-compile (require 'cl)) +;;; Code: (require 'notmuch-lib) (require 'notmuch-hello) -(eval-and-compile - (unless (fboundp 'window-body-width) - ;; Compatibility for Emacs pre-24 - (defalias 'window-body-width 'window-width))) +(declare-function notmuch-search "notmuch") +(declare-function notmuch-tree "notmuch-tree") +(declare-function notmuch-unthreaded "notmuch-tree") ;;;###autoload (defun notmuch-jump-search () @@ -39,7 +38,6 @@ keys configured in the :key property of `notmuch-saved-searches'. Typically these shortcuts are a single key long, so this is a fast way to jump to a saved search from anywhere in Notmuch." (interactive) - ;; Build the action map (let (action-map) (dolist (saved-search notmuch-saved-searches) @@ -49,21 +47,39 @@ fast way to jump to a saved search from anywhere in Notmuch." (let ((name (plist-get saved-search :name)) (query (plist-get saved-search :query)) (oldest-first - (case (plist-get saved-search :sort-order) + (cl-case (plist-get saved-search :sort-order) (newest-first nil) (oldest-first t) - (otherwise (default-value 'notmuch-search-oldest-first))))) + (otherwise (default-value 'notmuch-search-oldest-first)))) + (exclude (cl-case (plist-get saved-search :excluded) + (hide t) + (show nil) + (otherwise notmuch-search-hide-excluded)))) (push (list key name - `(lambda () (notmuch-search ',query ',oldest-first))) + (cond + ((eq (plist-get saved-search :search-type) 'tree) + (lambda () (notmuch-tree query nil nil nil nil nil nil + oldest-first exclude))) + ((eq (plist-get saved-search :search-type) 'unthreaded) + (lambda () (notmuch-unthreaded query nil nil nil nil + oldest-first exclude))) + (t + (lambda () (notmuch-search query oldest-first exclude))))) action-map))))) (setq action-map (nreverse action-map)) - (if action-map (notmuch-jump action-map "Search: ") - (error "To use notmuch-jump, please customize shortcut keys in notmuch-saved-searches.")))) + (error "To use notmuch-jump, %s" + "please customize shortcut keys in notmuch-saved-searches.")))) + +(defface notmuch-jump-key + '((t :inherit minibuffer-prompt)) + "Default face used for keys in `notmuch-jump' and related." + :group 'notmuch-faces) (defvar notmuch-jump--action nil) +;;;###autoload (defun notmuch-jump (action-map prompt) "Interactively prompt for one of the keys in ACTION-MAP. @@ -78,9 +94,7 @@ ACTION-MAP must be a list of triples of the form where KEY is a key binding, LABEL is a string label to display in the buffer, and ACTION is a nullary function to call. LABEL may be null, in which case the action will still be bound, but will -not appear in the pop-up buffer. -" - +not appear in the pop-up buffer." (let* ((items (notmuch-jump--format-actions action-map)) ;; Format the table of bindings and the full prompt (table @@ -100,12 +114,11 @@ not appear in the pop-up buffer. (copy-sequence minibuffer-prompt-properties) 'face)) ;; Build the keymap with our bindings - (minibuffer-map (notmuch-jump--make-keymap action-map)) + (minibuffer-map (notmuch-jump--make-keymap action-map prompt)) ;; The bindings save the the action in notmuch-jump--action (notmuch-jump--action nil)) ;; Read the action (read-from-minibuffer full-prompt nil minibuffer-map) - ;; If we got an action, do it (when notmuch-jump--action (funcall notmuch-jump--action)))) @@ -116,21 +129,18 @@ not appear in the pop-up buffer. Returns a list of strings, one for each item with a label in ACTION-MAP. These strings can be inserted into a tabular buffer." - ;; Compute the maximum key description width (let ((key-width 1)) - (dolist (entry action-map) + (pcase-dolist (`(,key ,_desc) action-map) (setq key-width (max key-width - (string-width (format-kbd-macro (first entry)))))) + (string-width (format-kbd-macro key))))) ;; Format each action - (mapcar (lambda (entry) - (let ((key (format-kbd-macro (first entry))) - (desc (second entry))) - (concat - (propertize key 'face 'minibuffer-prompt) - (make-string (- key-width (length key)) ? ) - " " desc))) + (mapcar (pcase-lambda (`(,key ,desc)) + (setq key (format-kbd-macro key)) + (concat (propertize key 'face 'notmuch-jump-key) + (make-string (- key-width (length key)) ? ) + " " desc)) action-map))) (defun notmuch-jump--insert-items (width items) @@ -157,16 +167,50 @@ buffer." (set-keymap-parent map minibuffer-local-map) ;; Make this like a special-mode keymap, with no self-insert-command (suppress-keymap map) + (define-key map (kbd "DEL") 'exit-minibuffer) map) "Base keymap for notmuch-jump's minibuffer keymap.") -(defun notmuch-jump--make-keymap (action-map) +(defun notmuch-jump--make-keymap (action-map prompt) "Translate ACTION-MAP into a minibuffer keymap." (let ((map (make-sparse-keymap))) (set-keymap-parent map notmuch-jump-minibuffer-map) - (dolist (action action-map) - (define-key map (first action) - `(lambda () (interactive) - (setq notmuch-jump--action ',(third action)) - (exit-minibuffer)))) + (pcase-dolist (`(,key ,_name ,fn) action-map) + (when (= (length key) 1) + (define-key map key + (lambda () + (interactive) + (setq notmuch-jump--action fn) + (exit-minibuffer))))) + ;; By doing this in two passes (and checking if we already have a + ;; binding) we avoid problems if the user specifies a binding which + ;; is a prefix of another binding. + (pcase-dolist (`(,key ,_name ,_fn) action-map) + (when (> (length key) 1) + (let* ((key (elt key 0)) + (keystr (string key)) + (new-prompt (concat prompt (format-kbd-macro keystr) " ")) + (action-submap nil)) + (unless (lookup-key map keystr) + (pcase-dolist (`(,k ,n ,f) action-map) + (when (= key (elt k 0)) + (push (list (substring k 1) n f) action-submap))) + ;; We deal with backspace specially + (push (list (kbd "DEL") + "Backup" + (apply-partially #'notmuch-jump action-map prompt)) + action-submap) + (setq action-submap (nreverse action-submap)) + (define-key map keystr + (lambda () + (interactive) + (setq notmuch-jump--action + (apply-partially #'notmuch-jump + action-submap + new-prompt)) + (exit-minibuffer))))))) map)) + +(provide 'notmuch-jump) + +;;; notmuch-jump.el ends here