unofficial mirror of notmuch@notmuchmail.org
 help / color / mirror / code / Atom feed
blob e98c9c1d5f5f44ca2e7ebe78837e9686084b3944 7698 bytes (raw)
name: emacs/notmuch-jump.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
 
;;; notmuch-jump.el --- User-friendly shortcut keys  -*- lexical-binding: t -*-
;;
;; Copyright © Austin Clements
;;
;; This file is part of Notmuch.
;;
;; Notmuch is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Notmuch is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Notmuch.  If not, see <https://www.gnu.org/licenses/>.
;;
;; Authors: Austin Clements <aclements@csail.mit.edu>
;;          David Edmondson <dme@dme.org>

;;; Code:

(require 'notmuch-lib)
(require 'notmuch-hello)

(declare-function notmuch-search "notmuch")
(declare-function notmuch-tree "notmuch-tree")
(declare-function notmuch-unthreaded "notmuch-tree")

;;;###autoload
(defun notmuch-jump-search ()
  "Jump to a saved search by shortcut key.

This prompts for and performs a saved search using the shortcut
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)
      (let* ((saved-search (notmuch-hello-saved-search-to-plist saved-search))
	     (key (plist-get saved-search :key)))
	(when key
	  (let ((name (plist-get saved-search :name))
		(query (plist-get saved-search :query))
		(oldest-first
		 (cl-case (plist-get saved-search :sort-order)
		   (newest-first nil)
		   (oldest-first t)
		   (otherwise (default-value 'notmuch-search-oldest-first))))
		(exclude (default-value 'notmuch-search-exclude)))
	    (push (list key name
			(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, %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.

Displays a summary of all bindings in ACTION-MAP in the
minibuffer, reads a key from the minibuffer, and performs the
corresponding action.  The prompt can be canceled with C-g or
RET.  PROMPT must be a string to use for the prompt.  PROMPT
should include a space at the end.

ACTION-MAP must be a list of triples of the form
  (KEY LABEL ACTION)
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."
  (let* ((items (notmuch-jump--format-actions action-map))
	 ;; Format the table of bindings and the full prompt
	 (table
	  (with-temp-buffer
	    (notmuch-jump--insert-items (window-body-width) items)
	    (buffer-string)))
	 (full-prompt
	  (concat table "\n\n"
		  (propertize prompt 'face 'minibuffer-prompt)))
	 ;; By default, the minibuffer applies the minibuffer face to
	 ;; the entire prompt.  However, we want to clearly
	 ;; distinguish bindings (which we put in the prompt face
	 ;; ourselves) from their labels, so disable the minibuffer's
	 ;; own re-face-ing.
	 (minibuffer-prompt-properties
	  (notmuch-plist-delete
	   (copy-sequence minibuffer-prompt-properties)
	   'face))
	 ;; Build the keymap with our bindings
	 (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))))

(defun notmuch-jump--format-actions (action-map)
  "Format the actions in ACTION-MAP.

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))
    (pcase-dolist (`(,key ,_desc) action-map)
      (setq key-width
	    (max key-width
		 (string-width (format-kbd-macro key)))))
    ;; Format each action
    (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)
  "Make a table of ITEMS up to WIDTH wide in the current buffer."
  (let* ((nitems (length items))
	 (col-width (+ 3 (apply #'max (mapcar #'string-width items))))
	 (ncols (if (> (* col-width nitems) width)
		    (max 1 (/ width col-width))
		  ;; Items fit on one line.  Space them out
		  (setq col-width (/ width nitems))
		  (length items))))
    (while items
      (dotimes (col ncols)
	(when items
	  (let ((item (pop items)))
	    (insert item)
	    (when (and items (< col (- ncols 1)))
	      (insert (make-string (- col-width (string-width item)) ? ))))))
      (when items
	(insert "\n")))))

(defvar notmuch-jump-minibuffer-map
  (let ((map (make-sparse-keymap)))
    (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 prompt)
  "Translate ACTION-MAP into a minibuffer keymap."
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map notmuch-jump-minibuffer-map)
    (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

debug log:

solving e98c9c1d ...
found e98c9c1d in https://yhetil.org/notmuch/20211128200207.3455217-1-mohkale@kisara.moe/ ||
	https://yhetil.org/notmuch/87pmme86cm.fsf@kisara.moe/ ||
	https://yhetil.org/notmuch/20220807145733.129867-1-mohkale@kisara.moe/ ||
	https://yhetil.org/notmuch/87o865xut1.fsf@kisara.moe/ ||
	https://yhetil.org/notmuch/87ilnmw7kf.fsf@kisara.moe/
found 6a276928 in https://yhetil.org/notmuch.git/
preparing index
index prepared:
100644 6a2769282ec666190b1a7cdeea8364782389977f	emacs/notmuch-jump.el

applying [1/1] https://yhetil.org/notmuch/20211128200207.3455217-1-mohkale@kisara.moe/
diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el
index 6a276928..e98c9c1d 100644

Checking patch emacs/notmuch-jump.el...
Applied patch emacs/notmuch-jump.el cleanly.

skipping https://yhetil.org/notmuch/87pmme86cm.fsf@kisara.moe/ for e98c9c1d
skipping https://yhetil.org/notmuch/20220807145733.129867-1-mohkale@kisara.moe/ for e98c9c1d
skipping https://yhetil.org/notmuch/87o865xut1.fsf@kisara.moe/ for e98c9c1d
skipping https://yhetil.org/notmuch/87ilnmw7kf.fsf@kisara.moe/ for e98c9c1d
skipping https://yhetil.org/notmuch/87ilnmw7kf.fsf@kisara.moe/ for e98c9c1d
index at:
100644 e98c9c1d5f5f44ca2e7ebe78837e9686084b3944	emacs/notmuch-jump.el

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://yhetil.org/notmuch.git/

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).