From 3c1ad5bfa0039191f1202b0542eb3af7afd16c5c Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Mon, 4 Aug 2014 21:45:20 -0400 Subject: [PATCH] emacs: Introduce notmuch-jump: shortcut keys to saved searches 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 | 173 +++++++++++++++++++++++++++++++++++++++++ emacs/notmuch-lib.el | 13 ++++ 4 files changed, 190 insertions(+), 1 deletion(-) create mode 100644 emacs/notmuch-jump.el diff --git a/emacs/Makefile.local b/emacs/Makefile.local index c0d6b190..1109cfa6 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 3de52386..061b27d0 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -85,6 +85,7 @@ searches so they still work in customize." (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 @@ a plist. Supported properties are :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 00000000..05bbce5e --- /dev/null +++ b/emacs/notmuch-jump.el @@ -0,0 +1,173 @@ +;; 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-lib) +(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-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)) + +(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 c06baac0..19269e3c 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) + (defgroup notmuch nil "Notmuch mail reader for Emacs." :group 'mail) @@ -138,6 +141,7 @@ For example, if you wanted to remove an \"inbox\" tag and add an (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.") @@ -472,6 +476,15 @@ This replaces spaces, percents, and double quotes in STR with (setq list (cdr list))) (nreverse out))) +(defun notmuch-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))) + (defun notmuch-split-content-type (content-type) "Split content/type into 'content' and 'type'" (split-string content-type "/")) -- 2.26.2