28/6311e05d5a194dce955cb141f6ab11560f849f

   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 1A5B5431FC3\r
   6         for <notmuch@notmuchmail.org>; Mon,  4 Aug 2014 18:45:38 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -2.3\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_MED=-2.3] 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 jb0gjxB9W6zX for <notmuch@notmuchmail.org>;\r
  16         Mon,  4 Aug 2014 18:45:30 -0700 (PDT)\r
  17 Received: from dmz-mailsec-scanner-8.mit.edu (dmz-mailsec-scanner-8.mit.edu\r
  18         [18.7.68.37])\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 BE719431FBC\r
  22         for <notmuch@notmuchmail.org>; Mon,  4 Aug 2014 18:45:29 -0700 (PDT)\r
  23 X-AuditID: 12074425-f79766d000006da8-df-53e037399fd3\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-8.mit.edu (Symantec Messaging Gateway) with SMTP\r
  28         id 6F.BA.28072.93730E35; Mon,  4 Aug 2014 21:45:29 -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 s751jQAU005688; \r
  31         Mon, 4 Aug 2014 21:45:26 -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 s751jOL3005237\r
  37         (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
  38         Mon, 4 Aug 2014 21:45:25 -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 1XEToa-0004b8-Ie; Mon, 04 Aug 2014 21:45:24 -0400\r
  42 From: Austin Clements <amdragon@MIT.EDU>\r
  43 To: notmuch@notmuchmail.org\r
  44 Subject: [PATCH v3 1/2] emacs: Introduce notmuch-jump: shortcut keys to saved\r
  45         searches\r
  46 Date: Mon,  4 Aug 2014 21:45:20 -0400\r
  47 Message-Id: <1407203121-17640-1-git-send-email-amdragon@mit.edu>\r
  48 X-Mailer: git-send-email 2.0.0\r
  49 In-Reply-To: <20140805014403.GX13893@mit.edu>\r
  50 References: <20140805014403.GX13893@mit.edu>\r
  51 MIME-Version: 1.0\r
  52 Content-Type: text/plain; charset=UTF-8\r
  53 Content-Transfer-Encoding: 8bit\r
  54 X-Brightmail-Tracker:\r
  55  H4sIAAAAAAAAA+NgFlrAKsWRmVeSWpSXmKPExsUixG6nomtp/iDYoHkSu8WN1m5Gi313tjBZ\r
  56         rJ7LY3H95kxmBxaPXc//MnnsnHWX3ePZqlvMHlsOvWcOYInisklJzcksSy3St0vgynhzW7rg\r
  57         SUDFp433mBoYVzp0MXJySAiYSBw7coQRwhaTuHBvPVsXIxeHkMBsJolFnQvYIZwNjBKz3x5l\r
  58         hHBuM0lMvX8GypnLKPF142V2kH42AQ2JbfuXg80SEZCW2Hl3NiuIzSyQJbHh5UFmEFtYIExi\r
  59         76ypLF2MHBwsAqoS0xZJgYR5BRwklp5sZIU4Q06i4cYnNpASTgFdicZFgSBhIQEdiVntEBN5\r
  60         BQQlTs58AjaFWUBdYv08IYhF8hLNW2czT2AUmoWkahZC1SwkVQsYmVcxyqbkVunmJmbmFKcm\r
  61         6xYnJ+blpRbpWujlZpbopaaUbmIEB76L6g7GCYeUDjEKcDAq8fAKqN0PFmJNLCuuzD3EKMnB\r
  62         pCTKG6r3IFiILyk/pTIjsTgjvqg0J7X4EKMEB7OSCG++IFCONyWxsiq1KB8mJc3BoiTO+9ba\r
  63         KlhIID2xJDU7NbUgtQgmK8PBoSTBO88MqFGwKDU9tSItM6cEIc3EwQkynAdo+G6QGt7igsTc\r
  64         4sx0iPwpRl2OruvH2piEWPLy81KlxHkzTYGKBECKMkrz4ObAEtYrRnGgt4R5m0BG8QCTHdyk\r
  65         V0BLmICWmOncB1lSkoiQkmpgjNO1Fn0SEm40w6MutfSIX2KUS3Dc6aD6XRcnrDY0m8ypkzhX\r
  66         8NjUQrvKM6Gr+XkOyrQaK1xSkrMsLNon1/J31VvlrnqrnTa7jpoKX/8/cfPStL/Jj7l0o0VY\r
  67         7m9mb6z+lqt81ObJwjYbU+3M6W6ZixSWfPjWepapLGztw2UWZYIl8zZPPb1WiaU4I9FQi7mo\r
  68         OBEAqFpy2DMDAAA=\r
  69 X-BeenThere: notmuch@notmuchmail.org\r
  70 X-Mailman-Version: 2.1.13\r
  71 Precedence: list\r
  72 List-Id: "Use and development of the notmuch mail system."\r
  73         <notmuch.notmuchmail.org>\r
  74 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  75         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  76 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  77 List-Post: <mailto:notmuch@notmuchmail.org>\r
  78 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  79 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  80         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  81 X-List-Received-Date: Tue, 05 Aug 2014 01:45:38 -0000\r
  82 \r
  83 This introduces notmuch-jump, which is like a user-friendly,\r
  84 user-configurable global prefix map for saved searches.  This provides\r
  85 a non-modal and much faster way to access saved searches than\r
  86 notmuch-hello.\r
  87 \r
  88 A user configures shortcut keys in notmuch-saved-searches, which are\r
  89 immediately accessible from anywhere in Notmuch under the "j" key (for\r
  90 "jump").  When the user hits "j", the minibuffer immediately shows a\r
  91 helpful table of bindings reminiscent of a completions buffer.\r
  92 \r
  93 This code is a combination of work from myself (originally,\r
  94 "notmuch-go"), David Edmondson, and modifications from Mark Walters.\r
  95 ---\r
  96  emacs/Makefile.local   |   3 +-\r
  97  emacs/notmuch-hello.el |   2 +\r
  98  emacs/notmuch-jump.el  | 173 +++++++++++++++++++++++++++++++++++++++++++++++++\r
  99  emacs/notmuch-lib.el   |  13 ++++\r
 100  4 files changed, 190 insertions(+), 1 deletion(-)\r
 101  create mode 100644 emacs/notmuch-jump.el\r
 102 \r
 103 diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
 104 index c0d6b19..1109cfa 100644\r
 105 --- a/emacs/Makefile.local\r
 106 +++ b/emacs/Makefile.local\r
 107 @@ -18,7 +18,8 @@ emacs_sources := \\r
 108         $(dir)/notmuch-tag.el \\r
 109         $(dir)/coolj.el \\r
 110         $(dir)/notmuch-print.el \\r
 111 -       $(dir)/notmuch-version.el\r
 112 +       $(dir)/notmuch-version.el \\r
 113 +       $(dir)/notmuch-jump.el \\r
 114  \r
 115  $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp\r
 116  $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl\r
 117 diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el\r
 118 index 3de5238..061b27d 100644\r
 119 --- a/emacs/notmuch-hello.el\r
 120 +++ b/emacs/notmuch-hello.el\r
 121 @@ -85,6 +85,7 @@ (define-widget 'notmuch-saved-search-plist 'list\r
 122                 (group :format "%v" :inline t (const :format "  Query: " :query) (string :format "%v")))\r
 123           (checklist :inline t\r
 124                      :format "%v"\r
 125 +                    (group :format "%v" :inline t (const :format "Shortcut key: " :key) (key-sequence :format "%v"))\r
 126                      (group :format "%v" :inline t (const :format "Count-Query: " :count-query) (string :format "%v"))\r
 127                      (group :format "%v" :inline t (const :format "" :sort-order)\r
 128                             (choice :tag " Sort Order"\r
 129 @@ -101,6 +102,7 @@ (defcustom notmuch-saved-searches '((:name "inbox" :query "tag:inbox")\r
 130  \r
 131    :name            Name of the search (required).\r
 132    :query           Search to run (required).\r
 133 +  :key             Optional shortcut key for `notmuch-jump-search'.\r
 134    :count-query     Optional extra query to generate the count\r
 135                     shown. If not present then the :query property\r
 136                     is used.\r
 137 diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el\r
 138 new file mode 100644\r
 139 index 0000000..05bbce5\r
 140 --- /dev/null\r
 141 +++ b/emacs/notmuch-jump.el\r
 142 @@ -0,0 +1,173 @@\r
 143 +;; notmuch-jump.el --- User-friendly shortcut keys\r
 144 +;;\r
 145 +;; Copyright © Austin Clements\r
 146 +;;\r
 147 +;; This file is part of Notmuch.\r
 148 +;;\r
 149 +;; Notmuch is free software: you can redistribute it and/or modify it\r
 150 +;; under the terms of the GNU General Public License as published by\r
 151 +;; the Free Software Foundation, either version 3 of the License, or\r
 152 +;; (at your option) any later version.\r
 153 +;;\r
 154 +;; Notmuch is distributed in the hope that it will be useful, but\r
 155 +;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
 156 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\r
 157 +;; General Public License for more details.\r
 158 +;;\r
 159 +;; You should have received a copy of the GNU General Public License\r
 160 +;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.\r
 161 +;;\r
 162 +;; Authors: Austin Clements <aclements@csail.mit.edu>\r
 163 +;;          David Edmondson <dme@dme.org>\r
 164 +\r
 165 +(eval-when-compile (require 'cl))\r
 166 +\r
 167 +(require 'notmuch-lib)\r
 168 +(require 'notmuch-hello)\r
 169 +\r
 170 +;;;###autoload\r
 171 +(defun notmuch-jump-search ()\r
 172 +  "Jump to a saved search by shortcut key.\r
 173 +\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
 178 +  (interactive)\r
 179 +\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
 185 +       (when key\r
 186 +         (let ((name (plist-get saved-search :name))\r
 187 +               (query (plist-get saved-search :query))\r
 188 +               (oldest-first\r
 189 +                (case (plist-get saved-search :sort-order)\r
 190 +                  (newest-first nil)\r
 191 +                  (oldest-first t)\r
 192 +                  (otherwise (default-value notmuch-search-oldest-first)))))\r
 193 +           (push (list key name\r
 194 +                       `(lambda () (notmuch-search ',query ',oldest-first)))\r
 195 +                 action-map)))))\r
 196 +    (setq action-map (nreverse action-map))\r
 197 +\r
 198 +    (if 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
 201 +\r
 202 +(defvar notmuch-jump--action nil)\r
 203 +\r
 204 +(defun notmuch-jump (action-map prompt)\r
 205 +  "Interactively prompt for one of the keys in ACTION-MAP.\r
 206 +\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
 212 +\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
 219 +"\r
 220 +\r
 221 +  (let* ((items (notmuch-jump--format-actions action-map))\r
 222 +        ;; Format the table of bindings and the full prompt\r
 223 +        (table\r
 224 +         (with-temp-buffer\r
 225 +           (notmuch-jump--insert-items (window-body-width) items)\r
 226 +           (buffer-string)))\r
 227 +        (full-prompt\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-plist-delete\r
 237 +          (copy-sequence minibuffer-prompt-properties)\r
 238 +          'face))\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
 245 +\r
 246 +    ;; If we got an action, do it\r
 247 +    (when notmuch-jump--action\r
 248 +      (funcall notmuch-jump--action))))\r
 249 +\r
 250 +(defun notmuch-jump--format-actions (action-map)\r
 251 +  "Format the actions in ACTION-MAP.\r
 252 +\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
 255 +buffer."\r
 256 +\r
 257 +  ;; Compute the maximum key description width\r
 258 +  (let ((key-width 1))\r
 259 +    (dolist (entry action-map)\r
 260 +      (setq key-width\r
 261 +           (max key-width\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
 267 +               (concat\r
 268 +                (propertize key 'face 'minibuffer-prompt)\r
 269 +                (make-string (- key-width (length key)) ? )\r
 270 +                " " desc)))\r
 271 +           action-map)))\r
 272 +\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
 282 +    (while items\r
 283 +      (dotimes (col ncols)\r
 284 +       (when items\r
 285 +         (let ((item (pop items)))\r
 286 +           (insert item)\r
 287 +           (when (and items (< col (- ncols 1)))\r
 288 +             (insert (make-string (- col-width (string-width item)) ? ))))))\r
 289 +      (when items\r
 290 +       (insert "\n")))))\r
 291 +\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
 297 +    map)\r
 298 +  "Base keymap for notmuch-jump's minibuffer keymap.")\r
 299 +\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
 309 +    map))\r
 310 +\r
 311 +(unless (fboundp 'window-body-width)\r
 312 +  ;; Compatibility for Emacs pre-24\r
 313 +  (defun window-body-width (&optional window)\r
 314 +    (let ((edges (window-inside-edges window)))\r
 315 +      (- (caddr edges) (car edges)))))\r
 316 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
 317 index c06baac..19269e3 100644\r
 318 --- a/emacs/notmuch-lib.el\r
 319 +++ b/emacs/notmuch-lib.el\r
 320 @@ -25,6 +25,9 @@\r
 321  (require 'mm-decode)\r
 322  (require 'cl)\r
 323  \r
 324 +(autoload 'notmuch-jump-search "notmuch-jump"\r
 325 +  "Jump to a saved search by shortcut key." t)\r
 326 +\r
 327  (defgroup notmuch nil\r
 328    "Notmuch mail reader for Emacs."\r
 329    :group 'mail)\r
 330 @@ -138,6 +141,7 @@ (defvar notmuch-common-keymap\r
 331      (define-key map "m" 'notmuch-mua-new-mail)\r
 332      (define-key map "=" 'notmuch-refresh-this-buffer)\r
 333      (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)\r
 334 +    (define-key map "j" 'notmuch-jump-search)\r
 335      map)\r
 336    "Keymap shared by all notmuch modes.")\r
 337  \r
 338 @@ -472,6 +476,15 @@ (defun notmuch-remove-if-not (predicate list)\r
 339        (setq list (cdr list)))\r
 340      (nreverse out)))\r
 341  \r
 342 +(defun notmuch-plist-delete (plist property)\r
 343 +  (let* ((xplist (cons nil plist))\r
 344 +        (pred xplist))\r
 345 +    (while (cdr pred)\r
 346 +      (when (eq (cadr pred) property)\r
 347 +       (setcdr pred (cdddr pred)))\r
 348 +      (setq pred (cddr pred)))\r
 349 +    (cdr xplist)))\r
 350 +\r
 351  (defun notmuch-split-content-type (content-type)\r
 352    "Split content/type into 'content' and 'type'"\r
 353    (split-string content-type "/"))\r
 354 -- \r
 355 2.0.0\r
 356 \r