From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 94C5E431FBD for ; Tue, 15 Jul 2014 07:06:28 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -0.7 X-Spam-Level: X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5 tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id w1OZPwhtRhFj for ; Tue, 15 Jul 2014 07:06:18 -0700 (PDT) Received: from dmz-mailsec-scanner-1.mit.edu (dmz-mailsec-scanner-1.mit.edu [18.9.25.12]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by olra.theworths.org (Postfix) with ESMTPS id 58DA7431FC0 for ; Tue, 15 Jul 2014 07:06:18 -0700 (PDT) X-AuditID: 1209190c-f79ef6d000005dd6-27-53c535595cbd Received: from mailhub-auth-2.mit.edu ( [18.7.62.36]) (using TLS with cipher AES256-SHA (256/256 bits)) (Client did not present a certificate) by dmz-mailsec-scanner-1.mit.edu (Symantec Messaging Gateway) with SMTP id 34.F3.24022.95535C35; Tue, 15 Jul 2014 10:06:17 -0400 (EDT) Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11]) by mailhub-auth-2.mit.edu (8.13.8/8.9.2) with ESMTP id s6FE6Eha014243; Tue, 15 Jul 2014 10:06:15 -0400 Received: from drake.dyndns.org (216-15-114-40.c3-0.arl-ubr1.sbo-arl.ma.cable.rcn.com [216.15.114.40]) (authenticated bits=0) (User authenticated as amdragon@ATHENA.MIT.EDU) by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id s6FE6C7Z008834 (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT); Tue, 15 Jul 2014 10:06:13 -0400 Received: from amthrax by drake.dyndns.org with local (Exim 4.77) (envelope-from ) id 1X73Mx-0000h0-34; Tue, 15 Jul 2014 10:06:11 -0400 From: Austin Clements To: notmuch@notmuchmail.org Subject: [PATCH v2 1/2] emacs: Introduce notmuch-jump: shortcut keys to saved searches Date: Tue, 15 Jul 2014 10:06:05 -0400 Message-Id: <1405433166-2198-2-git-send-email-amdragon@mit.edu> X-Mailer: git-send-email 2.0.0 In-Reply-To: <1405433166-2198-1-git-send-email-amdragon@mit.edu> References: <1405353735-26244-1-git-send-email-amdragon@mit.edu> <1405433166-2198-1-git-send-email-amdragon@mit.edu> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Brightmail-Tracker: H4sIAAAAAAAAA+NgFlrEKsWRmVeSWpSXmKPExsUixG6nohtpejTY4N8/NYsbrd2MFvvubGGy WD2Xx+L6zZnMDiweu57/ZfLYOesuu8ezVbeYPbYces8cwBLFZZOSmpNZllqkb5fAlfHrxSL2 gnN+FZu+/WZtYDxr18XIwSEhYCKx92NmFyMnkCkmceHeerYuRi4OIYHZTBK/L9xkgnA2Mkq8 vnYCyrnDJHH89zWosrmMEt8efmAB6WcT0JDYtn85I4gtIiAtsfPubFYQm1kgS2LDy4PMILaw QJjE7d+vmUBsFgFViTNTF4PV8ArYS3x8+IYR4g45iYYbn9hAbE4BB4mPW3+D2UICZRJP9h2E qheUODnzCQvIC8wC6hLr5wlBrJKXaN46m3kCo9AsJFWzEKpmIalawMi8ilE2JbdKNzcxM6c4 NVm3ODkxLy+1SNdQLzezRC81pXQTIyj4OSV5djC+Oah0iFGAg1GJh1fi3eFgIdbEsuLK3EOM khxMSqK8xWxHg4X4kvJTKjMSizPii0pzUosPMUpwMCuJ8EqaAOV4UxIrq1KL8mFS0hwsSuK8 b62tgoUE0hNLUrNTUwtSi2CyMhwcShK8eSCNgkWp6akVaZk5JQhpJg5OkOE8QMO7wIYXFyTm FmemQ+RPMepydF0/1sYkxJKXn5cqJc57whioSACkKKM0D24OLGm9YhQHekuYtx1kFA8w4cFN egW0hAloSXnNYZAlJYkIKakGxmUmEhkn6/796j+itbbk2n/xp1suZ7Dkv7JLCei88dXJViLP hS/YakPbWjGT19wNS5aqb13z9klrwpZs5pwZv+ODT9XuF8vc5Pvqyb4QiTqj1fVXyyN2sBYk bnjQrL/ff9cBwYxa8TUin5W4k26aifSx71waYtOjXOK9puDT5ek/xW/drEzpUGIpzkg01GIu Kk4EAAJEXQY1AwAA X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 15 Jul 2014 14:06:28 -0000 This introduces notmuch-jump, which is like a user-friendly, user-configurable global prefix map for saved searches. This provides a non-modal and much faster way to access saved searches than notmuch-hello. A user configures shortcut keys in notmuch-saved-searches, which are immediately accessible from anywhere in Notmuch under the "j" key (for "jump"). When the user hits "j", the minibuffer immediately shows a helpful table of bindings reminiscent of a completions buffer. This code is a combination of work from myself (originally, "notmuch-go"), David Edmondson, and modifications from Mark Walters. --- emacs/Makefile.local | 3 +- emacs/notmuch-hello.el | 2 + emacs/notmuch-jump.el | 181 +++++++++++++++++++++++++++++++++++++++++++++++++ emacs/notmuch-lib.el | 4 ++ 4 files changed, 189 insertions(+), 1 deletion(-) create mode 100644 emacs/notmuch-jump.el diff --git a/emacs/Makefile.local b/emacs/Makefile.local index c0d6b19..1109cfa 100644 --- a/emacs/Makefile.local +++ b/emacs/Makefile.local @@ -18,7 +18,8 @@ emacs_sources := \ $(dir)/notmuch-tag.el \ $(dir)/coolj.el \ $(dir)/notmuch-print.el \ - $(dir)/notmuch-version.el + $(dir)/notmuch-version.el \ + $(dir)/notmuch-jump.el \ $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index 3de5238..061b27d 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -85,6 +85,7 @@ (define-widget 'notmuch-saved-search-plist 'list (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) (choice :tag " Sort Order" @@ -101,6 +102,7 @@ (defcustom notmuch-saved-searches '((:name "inbox" :query "tag:inbox") :name Name of the search (required). :query Search to run (required). + :key Optional shortcut key for `notmuch-jump-search'. :count-query Optional extra query to generate the count shown. If not present then the :query property is used. diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el new file mode 100644 index 0000000..9cb1e6a --- /dev/null +++ b/emacs/notmuch-jump.el @@ -0,0 +1,181 @@ +;; notmuch-jump.el --- User-friendly shortcut keys +;; +;; 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 . +;; +;; Authors: Austin Clements +;; David Edmondson + +(eval-when-compile (require 'cl)) + +(require 'notmuch-hello) + +;;;###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 + (case (plist-get saved-search :sort-order) + (newest-first nil) + (oldest-first t) + (otherwise (default-value notmuch-search-oldest-first))))) + (push (list key name + `(lambda () (notmuch-search ',query ',oldest-first))) + 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.")))) + +(defvar notmuch-jump--action nil) + +(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-jump--plist-delete + (copy-sequence minibuffer-prompt-properties) + 'face)) + ;; Build the keymap with our bindings + (minibuffer-map (notmuch-jump--make-keymap action-map)) + ;; 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)) + (dolist (entry action-map) + (setq key-width + (max key-width + (string-width (format-kbd-macro (first entry)))))) + ;; 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))) + 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) + map) + "Base keymap for notmuch-jump's minibuffer keymap.") + +(defun notmuch-jump--make-keymap (action-map) + "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)))) + map)) + +(defun notmuch-jump--plist-delete (plist property) + (let* ((xplist (cons nil plist)) + (pred xplist)) + (while (cdr pred) + (when (eq (cadr pred) property) + (setcdr pred (cdddr pred))) + (setq pred (cddr pred))) + (cdr xplist))) + +(unless (fboundp 'window-body-width) + ;; Compatibility for Emacs pre-24 + (defun window-body-width (&optional window) + (let ((edges (window-inside-edges window))) + (- (caddr edges) (car edges))))) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 2941da3..b338aaa 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -25,6 +25,9 @@ (require 'mm-decode) (require 'cl) +(autoload 'notmuch-jump-search "notmuch-jump" + "Jump to a saved search by shortcut key." t) + (defvar notmuch-command "notmuch" "Command to run the notmuch binary.") @@ -130,6 +133,7 @@ (defvar notmuch-common-keymap (define-key map "m" 'notmuch-mua-new-mail) (define-key map "=" 'notmuch-refresh-this-buffer) (define-key map "G" 'notmuch-poll-and-refresh-this-buffer) + (define-key map "j" 'notmuch-jump-search) map) "Keymap shared by all notmuch modes.") -- 2.0.0