1 Return-Path: <amdragon@mit.edu>
\r
2 X-Original-To: notmuch@notmuchmail.org
\r
3 Delivered-To: notmuch@notmuchmail.org
\r
4 Received: from localhost (localhost [127.0.0.1])
\r
5 by olra.theworths.org (Postfix) with ESMTP id 94C5E431FBD
\r
6 for <notmuch@notmuchmail.org>; Tue, 15 Jul 2014 07:06:28 -0700 (PDT)
\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org
\r
11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5
\r
12 tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled
\r
13 Received: from olra.theworths.org ([127.0.0.1])
\r
14 by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)
\r
15 with ESMTP id w1OZPwhtRhFj for <notmuch@notmuchmail.org>;
\r
16 Tue, 15 Jul 2014 07:06:18 -0700 (PDT)
\r
17 Received: from dmz-mailsec-scanner-1.mit.edu (dmz-mailsec-scanner-1.mit.edu
\r
19 (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits))
\r
20 (No client certificate requested)
\r
21 by olra.theworths.org (Postfix) with ESMTPS id 58DA7431FC0
\r
22 for <notmuch@notmuchmail.org>; Tue, 15 Jul 2014 07:06:18 -0700 (PDT)
\r
23 X-AuditID: 1209190c-f79ef6d000005dd6-27-53c535595cbd
\r
24 Received: from mailhub-auth-2.mit.edu ( [18.7.62.36])
\r
25 (using TLS with cipher AES256-SHA (256/256 bits))
\r
26 (Client did not present a certificate)
\r
27 by dmz-mailsec-scanner-1.mit.edu (Symantec Messaging Gateway) with SMTP
\r
28 id 34.F3.24022.95535C35; Tue, 15 Jul 2014 10:06:17 -0400 (EDT)
\r
29 Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11])
\r
30 by mailhub-auth-2.mit.edu (8.13.8/8.9.2) with ESMTP id s6FE6Eha014243;
\r
31 Tue, 15 Jul 2014 10:06:15 -0400
\r
32 Received: from drake.dyndns.org
\r
33 (216-15-114-40.c3-0.arl-ubr1.sbo-arl.ma.cable.rcn.com
\r
34 [216.15.114.40]) (authenticated bits=0)
\r
35 (User authenticated as amdragon@ATHENA.MIT.EDU)
\r
36 by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id s6FE6C7Z008834
\r
37 (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);
\r
38 Tue, 15 Jul 2014 10:06:13 -0400
\r
39 Received: from amthrax by drake.dyndns.org with local (Exim 4.77)
\r
40 (envelope-from <amdragon@mit.edu>)
\r
41 id 1X73Mx-0000h0-34; Tue, 15 Jul 2014 10:06:11 -0400
\r
42 From: Austin Clements <amdragon@MIT.EDU>
\r
43 To: notmuch@notmuchmail.org
\r
44 Subject: [PATCH v2 1/2] emacs: Introduce notmuch-jump: shortcut keys to saved
\r
46 Date: Tue, 15 Jul 2014 10:06:05 -0400
\r
47 Message-Id: <1405433166-2198-2-git-send-email-amdragon@mit.edu>
\r
48 X-Mailer: git-send-email 2.0.0
\r
49 In-Reply-To: <1405433166-2198-1-git-send-email-amdragon@mit.edu>
\r
50 References: <1405353735-26244-1-git-send-email-amdragon@mit.edu>
\r
51 <1405433166-2198-1-git-send-email-amdragon@mit.edu>
\r
53 Content-Type: text/plain; charset=UTF-8
\r
54 Content-Transfer-Encoding: 8bit
\r
55 X-Brightmail-Tracker:
\r
56 H4sIAAAAAAAAA+NgFlrEKsWRmVeSWpSXmKPExsUixG6nohtpejTY4N8/NYsbrd2MFvvubGGy
\r
57 WD2Xx+L6zZnMDiweu57/ZfLYOesuu8ezVbeYPbYces8cwBLFZZOSmpNZllqkb5fAlfHrxSL2
\r
58 gnN+FZu+/WZtYDxr18XIwSEhYCKx92NmFyMnkCkmceHeerYuRi4OIYHZTBK/L9xkgnA2Mkq8
\r
59 vnYCyrnDJHH89zWosrmMEt8efmAB6WcT0JDYtn85I4gtIiAtsfPubFYQm1kgS2LDy4PMILaw
\r
60 QJjE7d+vmUBsFgFViTNTF4PV8ArYS3x8+IYR4g45iYYbn9hAbE4BB4mPW3+D2UICZRJP9h2E
\r
61 qheUODnzCQvIC8wC6hLr5wlBrJKXaN46m3kCo9AsJFWzEKpmIalawMi8ilE2JbdKNzcxM6c4
\r
62 NVm3ODkxLy+1SNdQLzezRC81pXQTIyj4OSV5djC+Oah0iFGAg1GJh1fi3eFgIdbEsuLK3EOM
\r
63 khxMSqK8xWxHg4X4kvJTKjMSizPii0pzUosPMUpwMCuJ8EqaAOV4UxIrq1KL8mFS0hwsSuK8
\r
64 b62tgoUE0hNLUrNTUwtSi2CyMhwcShK8eSCNgkWp6akVaZk5JQhpJg5OkOE8QMO7wIYXFyTm
\r
65 FmemQ+RPMepydF0/1sYkxJKXn5cqJc57whioSACkKKM0D24OLGm9YhQHekuYtx1kFA8w4cFN
\r
66 egW0hAloSXnNYZAlJYkIKakGxmUmEhkn6/796j+itbbk2n/xp1suZ7Dkv7JLCei88dXJViLP
\r
67 hS/YakPbWjGT19wNS5aqb13z9klrwpZs5pwZv+ODT9XuF8vc5Pvqyb4QiTqj1fVXyyN2sBYk
\r
68 bnjQrL/ff9cBwYxa8TUin5W4k26aifSx71waYtOjXOK9puDT5ek/xW/drEzpUGIpzkg01GIu
\r
70 X-BeenThere: notmuch@notmuchmail.org
\r
71 X-Mailman-Version: 2.1.13
\r
73 List-Id: "Use and development of the notmuch mail system."
\r
74 <notmuch.notmuchmail.org>
\r
75 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
76 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
77 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
78 List-Post: <mailto:notmuch@notmuchmail.org>
\r
79 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
80 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
81 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
82 X-List-Received-Date: Tue, 15 Jul 2014 14:06:28 -0000
\r
84 This introduces notmuch-jump, which is like a user-friendly,
\r
85 user-configurable global prefix map for saved searches. This provides
\r
86 a non-modal and much faster way to access saved searches than
\r
89 A user configures shortcut keys in notmuch-saved-searches, which are
\r
90 immediately accessible from anywhere in Notmuch under the "j" key (for
\r
91 "jump"). When the user hits "j", the minibuffer immediately shows a
\r
92 helpful table of bindings reminiscent of a completions buffer.
\r
94 This code is a combination of work from myself (originally,
\r
95 "notmuch-go"), David Edmondson, and modifications from Mark Walters.
\r
97 emacs/Makefile.local | 3 +-
\r
98 emacs/notmuch-hello.el | 2 +
\r
99 emacs/notmuch-jump.el | 181 +++++++++++++++++++++++++++++++++++++++++++++++++
\r
100 emacs/notmuch-lib.el | 4 ++
\r
101 4 files changed, 189 insertions(+), 1 deletion(-)
\r
102 create mode 100644 emacs/notmuch-jump.el
\r
104 diff --git a/emacs/Makefile.local b/emacs/Makefile.local
\r
105 index c0d6b19..1109cfa 100644
\r
106 --- a/emacs/Makefile.local
\r
107 +++ b/emacs/Makefile.local
\r
108 @@ -18,7 +18,8 @@ emacs_sources := \
\r
109 $(dir)/notmuch-tag.el \
\r
111 $(dir)/notmuch-print.el \
\r
112 - $(dir)/notmuch-version.el
\r
113 + $(dir)/notmuch-version.el \
\r
114 + $(dir)/notmuch-jump.el \
\r
116 $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp
\r
117 $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl
\r
118 diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
\r
119 index 3de5238..061b27d 100644
\r
120 --- a/emacs/notmuch-hello.el
\r
121 +++ b/emacs/notmuch-hello.el
\r
122 @@ -85,6 +85,7 @@ (define-widget 'notmuch-saved-search-plist 'list
\r
123 (group :format "%v" :inline t (const :format " Query: " :query) (string :format "%v")))
\r
124 (checklist :inline t
\r
126 + (group :format "%v" :inline t (const :format "Shortcut key: " :key) (key-sequence :format "%v"))
\r
127 (group :format "%v" :inline t (const :format "Count-Query: " :count-query) (string :format "%v"))
\r
128 (group :format "%v" :inline t (const :format "" :sort-order)
\r
129 (choice :tag " Sort Order"
\r
130 @@ -101,6 +102,7 @@ (defcustom notmuch-saved-searches '((:name "inbox" :query "tag:inbox")
\r
132 :name Name of the search (required).
\r
133 :query Search to run (required).
\r
134 + :key Optional shortcut key for `notmuch-jump-search'.
\r
135 :count-query Optional extra query to generate the count
\r
136 shown. If not present then the :query property
\r
138 diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el
\r
139 new file mode 100644
\r
140 index 0000000..9cb1e6a
\r
142 +++ b/emacs/notmuch-jump.el
\r
144 +;; notmuch-jump.el --- User-friendly shortcut keys
\r
146 +;; Copyright © Austin Clements
\r
148 +;; This file is part of Notmuch.
\r
150 +;; Notmuch is free software: you can redistribute it and/or modify it
\r
151 +;; under the terms of the GNU General Public License as published by
\r
152 +;; the Free Software Foundation, either version 3 of the License, or
\r
153 +;; (at your option) any later version.
\r
155 +;; Notmuch is distributed in the hope that it will be useful, but
\r
156 +;; WITHOUT ANY WARRANTY; without even the implied warranty of
\r
157 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\r
158 +;; General Public License for more details.
\r
160 +;; You should have received a copy of the GNU General Public License
\r
161 +;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
\r
163 +;; Authors: Austin Clements <aclements@csail.mit.edu>
\r
164 +;; David Edmondson <dme@dme.org>
\r
166 +(eval-when-compile (require 'cl))
\r
168 +(require 'notmuch-hello)
\r
171 +(defun notmuch-jump-search ()
\r
172 + "Jump to a saved search by shortcut key.
\r
174 +This prompts for and performs a saved search using the shortcut
\r
175 +keys configured in the :key property of `notmuch-saved-searches'.
\r
176 +Typically these shortcuts are a single key long, so this is a
\r
177 +fast way to jump to a saved search from anywhere in Notmuch."
\r
180 + ;; Build the action map
\r
181 + (let (action-map)
\r
182 + (dolist (saved-search notmuch-saved-searches)
\r
183 + (let* ((saved-search (notmuch-hello-saved-search-to-plist saved-search))
\r
184 + (key (plist-get saved-search :key)))
\r
186 + (let ((name (plist-get saved-search :name))
\r
187 + (query (plist-get saved-search :query))
\r
189 + (case (plist-get saved-search :sort-order)
\r
190 + (newest-first nil)
\r
192 + (otherwise (default-value notmuch-search-oldest-first)))))
\r
193 + (push (list key name
\r
194 + `(lambda () (notmuch-search ',query ',oldest-first)))
\r
196 + (setq action-map (nreverse action-map))
\r
199 + (notmuch-jump action-map "Search: ")
\r
200 + (error "To use notmuch-jump, please customize shortcut keys in notmuch-saved-searches."))))
\r
202 +(defvar notmuch-jump--action nil)
\r
204 +(defun notmuch-jump (action-map prompt)
\r
205 + "Interactively prompt for one of the keys in ACTION-MAP.
\r
207 +Displays a summary of all bindings in ACTION-MAP in the
\r
208 +minibuffer, reads a key from the minibuffer, and performs the
\r
209 +corresponding action. The prompt can be canceled with C-g or
\r
210 +RET. PROMPT must be a string to use for the prompt. PROMPT
\r
211 +should include a space at the end.
\r
213 +ACTION-MAP must be a list of triples of the form
\r
214 + (KEY LABEL ACTION)
\r
215 +where KEY is a key binding, LABEL is a string label to display in
\r
216 +the buffer, and ACTION is a nullary function to call. LABEL may
\r
217 +be null, in which case the action will still be bound, but will
\r
218 +not appear in the pop-up buffer.
\r
221 + (let* ((items (notmuch-jump--format-actions action-map))
\r
222 + ;; Format the table of bindings and the full prompt
\r
224 + (with-temp-buffer
\r
225 + (notmuch-jump--insert-items (window-body-width) items)
\r
226 + (buffer-string)))
\r
228 + (concat table "\n\n"
\r
229 + (propertize prompt 'face 'minibuffer-prompt)))
\r
230 + ;; By default, the minibuffer applies the minibuffer face to
\r
231 + ;; the entire prompt. However, we want to clearly
\r
232 + ;; distinguish bindings (which we put in the prompt face
\r
233 + ;; ourselves) from their labels, so disable the minibuffer's
\r
234 + ;; own re-face-ing.
\r
235 + (minibuffer-prompt-properties
\r
236 + (notmuch-jump--plist-delete
\r
237 + (copy-sequence minibuffer-prompt-properties)
\r
239 + ;; Build the keymap with our bindings
\r
240 + (minibuffer-map (notmuch-jump--make-keymap action-map))
\r
241 + ;; The bindings save the the action in notmuch-jump--action
\r
242 + (notmuch-jump--action nil))
\r
243 + ;; Read the action
\r
244 + (read-from-minibuffer full-prompt nil minibuffer-map)
\r
246 + ;; If we got an action, do it
\r
247 + (when notmuch-jump--action
\r
248 + (funcall notmuch-jump--action))))
\r
250 +(defun notmuch-jump--format-actions (action-map)
\r
251 + "Format the actions in ACTION-MAP.
\r
253 +Returns a list of strings, one for each item with a label in
\r
254 +ACTION-MAP. These strings can be inserted into a tabular
\r
257 + ;; Compute the maximum key description width
\r
258 + (let ((key-width 1))
\r
259 + (dolist (entry action-map)
\r
262 + (string-width (format-kbd-macro (first entry))))))
\r
263 + ;; Format each action
\r
264 + (mapcar (lambda (entry)
\r
265 + (let ((key (format-kbd-macro (first entry)))
\r
266 + (desc (second entry)))
\r
268 + (propertize key 'face 'minibuffer-prompt)
\r
269 + (make-string (- key-width (length key)) ? )
\r
273 +(defun notmuch-jump--insert-items (width items)
\r
274 + "Make a table of ITEMS up to WIDTH wide in the current buffer."
\r
275 + (let* ((nitems (length items))
\r
276 + (col-width (+ 3 (apply #'max (mapcar #'string-width items))))
\r
277 + (ncols (if (> (* col-width nitems) width)
\r
278 + (max 1 (/ width col-width))
\r
279 + ;; Items fit on one line. Space them out
\r
280 + (setq col-width (/ width nitems))
\r
281 + (length items))))
\r
283 + (dotimes (col ncols)
\r
285 + (let ((item (pop items)))
\r
287 + (when (and items (< col (- ncols 1)))
\r
288 + (insert (make-string (- col-width (string-width item)) ? ))))))
\r
290 + (insert "\n")))))
\r
292 +(defvar notmuch-jump-minibuffer-map
\r
293 + (let ((map (make-sparse-keymap)))
\r
294 + (set-keymap-parent map minibuffer-local-map)
\r
295 + ;; Make this like a special-mode keymap, with no self-insert-command
\r
296 + (suppress-keymap map)
\r
298 + "Base keymap for notmuch-jump's minibuffer keymap.")
\r
300 +(defun notmuch-jump--make-keymap (action-map)
\r
301 + "Translate ACTION-MAP into a minibuffer keymap."
\r
302 + (let ((map (make-sparse-keymap)))
\r
303 + (set-keymap-parent map notmuch-jump-minibuffer-map)
\r
304 + (dolist (action action-map)
\r
305 + (define-key map (first action)
\r
306 + `(lambda () (interactive)
\r
307 + (setq notmuch-jump--action ',(third action))
\r
308 + (exit-minibuffer))))
\r
311 +(defun notmuch-jump--plist-delete (plist property)
\r
312 + (let* ((xplist (cons nil plist))
\r
314 + (while (cdr pred)
\r
315 + (when (eq (cadr pred) property)
\r
316 + (setcdr pred (cdddr pred)))
\r
317 + (setq pred (cddr pred)))
\r
320 +(unless (fboundp 'window-body-width)
\r
321 + ;; Compatibility for Emacs pre-24
\r
322 + (defun window-body-width (&optional window)
\r
323 + (let ((edges (window-inside-edges window)))
\r
324 + (- (caddr edges) (car edges)))))
\r
325 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
\r
326 index 2941da3..b338aaa 100644
\r
327 --- a/emacs/notmuch-lib.el
\r
328 +++ b/emacs/notmuch-lib.el
\r
330 (require 'mm-decode)
\r
333 +(autoload 'notmuch-jump-search "notmuch-jump"
\r
334 + "Jump to a saved search by shortcut key." t)
\r
336 (defvar notmuch-command "notmuch"
\r
337 "Command to run the notmuch binary.")
\r
339 @@ -130,6 +133,7 @@ (defvar notmuch-common-keymap
\r
340 (define-key map "m" 'notmuch-mua-new-mail)
\r
341 (define-key map "=" 'notmuch-refresh-this-buffer)
\r
342 (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
\r
343 + (define-key map "j" 'notmuch-jump-search)
\r
345 "Keymap shared by all notmuch modes.")
\r