notmuch-jump.el (7535B)
1 ;;; notmuch-jump.el --- User-friendly shortcut keys -*- lexical-binding: t -*- 2 ;; 3 ;; Copyright © Austin Clements 4 ;; 5 ;; This file is part of Notmuch. 6 ;; 7 ;; Notmuch is free software: you can redistribute it and/or modify it 8 ;; under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 ;; 12 ;; Notmuch is distributed in the hope that it will be useful, but 13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; General Public License for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>. 19 ;; 20 ;; Authors: Austin Clements <aclements@csail.mit.edu> 21 ;; David Edmondson <dme@dme.org> 22 23 ;;; Code: 24 25 (require 'notmuch-lib) 26 (require 'notmuch-hello) 27 28 (declare-function notmuch-search "notmuch") 29 (declare-function notmuch-tree "notmuch-tree") 30 (declare-function notmuch-unthreaded "notmuch-tree") 31 32 ;;;###autoload 33 (defun notmuch-jump-search () 34 "Jump to a saved search by shortcut key. 35 36 This prompts for and performs a saved search using the shortcut 37 keys configured in the :key property of `notmuch-saved-searches'. 38 Typically these shortcuts are a single key long, so this is a 39 fast way to jump to a saved search from anywhere in Notmuch." 40 (interactive) 41 ;; Build the action map 42 (let (action-map) 43 (dolist (saved-search notmuch-saved-searches) 44 (let* ((saved-search (notmuch-hello-saved-search-to-plist saved-search)) 45 (key (plist-get saved-search :key))) 46 (when key 47 (let ((name (plist-get saved-search :name)) 48 (query (plist-get saved-search :query)) 49 (oldest-first 50 (cl-case (plist-get saved-search :sort-order) 51 (newest-first nil) 52 (oldest-first t) 53 (otherwise (default-value 'notmuch-search-oldest-first))))) 54 (push (list key name 55 (cond 56 ((eq (plist-get saved-search :search-type) 'tree) 57 (lambda () (notmuch-tree query))) 58 ((eq (plist-get saved-search :search-type) 'unthreaded) 59 (lambda () (notmuch-unthreaded query))) 60 (t 61 (lambda () (notmuch-search query oldest-first))))) 62 action-map))))) 63 (setq action-map (nreverse action-map)) 64 (if action-map 65 (notmuch-jump action-map "Search: ") 66 (error "To use notmuch-jump, %s" 67 "please customize shortcut keys in notmuch-saved-searches.")))) 68 69 (defface notmuch-jump-key 70 '((t :inherit minibuffer-prompt)) 71 "Default face used for keys in `notmuch-jump' and related." 72 :group 'notmuch-faces) 73 74 (defvar notmuch-jump--action nil) 75 76 ;;;###autoload 77 (defun notmuch-jump (action-map prompt) 78 "Interactively prompt for one of the keys in ACTION-MAP. 79 80 Displays a summary of all bindings in ACTION-MAP in the 81 minibuffer, reads a key from the minibuffer, and performs the 82 corresponding action. The prompt can be canceled with C-g or 83 RET. PROMPT must be a string to use for the prompt. PROMPT 84 should include a space at the end. 85 86 ACTION-MAP must be a list of triples of the form 87 (KEY LABEL ACTION) 88 where KEY is a key binding, LABEL is a string label to display in 89 the buffer, and ACTION is a nullary function to call. LABEL may 90 be null, in which case the action will still be bound, but will 91 not appear in the pop-up buffer." 92 (let* ((items (notmuch-jump--format-actions action-map)) 93 ;; Format the table of bindings and the full prompt 94 (table 95 (with-temp-buffer 96 (notmuch-jump--insert-items (window-body-width) items) 97 (buffer-string))) 98 (full-prompt 99 (concat table "\n\n" 100 (propertize prompt 'face 'minibuffer-prompt))) 101 ;; By default, the minibuffer applies the minibuffer face to 102 ;; the entire prompt. However, we want to clearly 103 ;; distinguish bindings (which we put in the prompt face 104 ;; ourselves) from their labels, so disable the minibuffer's 105 ;; own re-face-ing. 106 (minibuffer-prompt-properties 107 (notmuch-plist-delete 108 (copy-sequence minibuffer-prompt-properties) 109 'face)) 110 ;; Build the keymap with our bindings 111 (minibuffer-map (notmuch-jump--make-keymap action-map prompt)) 112 ;; The bindings save the the action in notmuch-jump--action 113 (notmuch-jump--action nil)) 114 ;; Read the action 115 (read-from-minibuffer full-prompt nil minibuffer-map) 116 ;; If we got an action, do it 117 (when notmuch-jump--action 118 (funcall notmuch-jump--action)))) 119 120 (defun notmuch-jump--format-actions (action-map) 121 "Format the actions in ACTION-MAP. 122 123 Returns a list of strings, one for each item with a label in 124 ACTION-MAP. These strings can be inserted into a tabular 125 buffer." 126 ;; Compute the maximum key description width 127 (let ((key-width 1)) 128 (pcase-dolist (`(,key ,_desc) action-map) 129 (setq key-width 130 (max key-width 131 (string-width (format-kbd-macro key))))) 132 ;; Format each action 133 (mapcar (pcase-lambda (`(,key ,desc)) 134 (setq key (format-kbd-macro key)) 135 (concat (propertize key 'face 'notmuch-jump-key) 136 (make-string (- key-width (length key)) ? ) 137 " " desc)) 138 action-map))) 139 140 (defun notmuch-jump--insert-items (width items) 141 "Make a table of ITEMS up to WIDTH wide in the current buffer." 142 (let* ((nitems (length items)) 143 (col-width (+ 3 (apply #'max (mapcar #'string-width items)))) 144 (ncols (if (> (* col-width nitems) width) 145 (max 1 (/ width col-width)) 146 ;; Items fit on one line. Space them out 147 (setq col-width (/ width nitems)) 148 (length items)))) 149 (while items 150 (dotimes (col ncols) 151 (when items 152 (let ((item (pop items))) 153 (insert item) 154 (when (and items (< col (- ncols 1))) 155 (insert (make-string (- col-width (string-width item)) ? )))))) 156 (when items 157 (insert "\n"))))) 158 159 (defvar notmuch-jump-minibuffer-map 160 (let ((map (make-sparse-keymap))) 161 (set-keymap-parent map minibuffer-local-map) 162 ;; Make this like a special-mode keymap, with no self-insert-command 163 (suppress-keymap map) 164 (define-key map (kbd "DEL") 'exit-minibuffer) 165 map) 166 "Base keymap for notmuch-jump's minibuffer keymap.") 167 168 (defun notmuch-jump--make-keymap (action-map prompt) 169 "Translate ACTION-MAP into a minibuffer keymap." 170 (let ((map (make-sparse-keymap))) 171 (set-keymap-parent map notmuch-jump-minibuffer-map) 172 (pcase-dolist (`(,key ,_name ,fn) action-map) 173 (when (= (length key) 1) 174 (define-key map key 175 (lambda () 176 (interactive) 177 (setq notmuch-jump--action fn) 178 (exit-minibuffer))))) 179 ;; By doing this in two passes (and checking if we already have a 180 ;; binding) we avoid problems if the user specifies a binding which 181 ;; is a prefix of another binding. 182 (pcase-dolist (`(,key ,_name ,_fn) action-map) 183 (when (> (length key) 1) 184 (let* ((key (elt key 0)) 185 (keystr (string key)) 186 (new-prompt (concat prompt (format-kbd-macro keystr) " ")) 187 (action-submap nil)) 188 (unless (lookup-key map keystr) 189 (pcase-dolist (`(,k ,n ,f) action-map) 190 (when (= key (elt k 0)) 191 (push (list (substring k 1) n f) action-submap))) 192 ;; We deal with backspace specially 193 (push (list (kbd "DEL") 194 "Backup" 195 (apply-partially #'notmuch-jump action-map prompt)) 196 action-submap) 197 (setq action-submap (nreverse action-submap)) 198 (define-key map keystr 199 (lambda () 200 (interactive) 201 (setq notmuch-jump--action 202 (apply-partially #'notmuch-jump 203 action-submap 204 new-prompt)) 205 (exit-minibuffer))))))) 206 map)) 207 208 (provide 'notmuch-jump) 209 210 ;;; notmuch-jump.el ends here