Add a customisable "jump" style menu for doing tagging operations.

The previous version of this patch set is at

This is just an updated version of the first patch of the previous
set: i.e., it doesn't include the non-reversible tag-operations. The
only change from the previous is that the tag-jump function and
defcustom are documented.

I think the main thing left is to decide which keybinding to
use. There was some discussion on irc about taking "t" -- this is
currently mapped to "filter-by-tag" in search mode, and
toggle-trucate-lines in show mode. These are relatively uncommon
functions so the remapping might be acceptable: shout now if you

Best wishes


emacs/notmuch-lib.el  |  4 +++
 emacs/notmuch-show.el |  1 +
 emacs/notmuch-tag.el  | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch-tree.el |  1 +
 emacs/notmuch.el      |  1 +
 5 files changed, 100 insertions(+)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 2f015b0..b2cdace 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -57,6 +57,10 @@
 (custom-add-to-group 'notmuch-send 'message 'custom-group)
+(defgroup notmuch-tag nil
+  "Tags and tagging in Notmuch."
+  :group 'notmuch)
 (defgroup notmuch-crypto nil
   "Processing and display of cryptographic MIME parts."
   :group 'notmuch)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 641398d..f2487ab 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1431,6 +1431,7 @@ reset based on the original query."
     (define-key map "V" 'notmuch-show-view-raw-message)
     (define-key map "c" 'notmuch-show-stash-map)
     (define-key map "h" 'notmuch-show-toggle-visibility-headers)
+    (define-key map "k" 'notmuch-tag-jump)
     (define-key map "*" 'notmuch-show-tag-all)
     (define-key map "-" 'notmuch-show-remove-tag)
     (define-key map "+" 'notmuch-show-add-tag)
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index ec3c964..157aa17 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -28,6 +28,54 @@
 (require 'crm)
 (require 'notmuch-lib)
+(declare-function notmuch-search-tag "notmuch" tag-changes)
+(declare-function notmuch-show-tag "notmuch-show" tag-changes)
+(declare-function notmuch-tree-tag "notmuch-tree" tag-changes)
+(autoload 'notmuch-jump "notmuch-jump")
+(define-widget 'notmuch-tag-key-type 'list
+  "A single key tagging binding."
+  :format "%v"
+  :args '((list :inline t
+               :format "%v"
+               (key-sequence :tag "Key")
+               (radio :tag "Tag operations" (repeat :tag "Tag list" (string 
:format "%v" :tag "change"))
+                      (variable :tag "Tag variable"))
+               (string :tag "Name"))))
+(defcustom notmuch-tagging-keys
+  `((,(kbd "a") notmuch-archive-tags "Archive")
+    (,(kbd "u") notmuch-show-mark-read-tags "Mark read")
+    (,(kbd "f") ("+flagged") "Flag")
+    (,(kbd "s") ("+spam" "-inbox") "Mark as spam")
+    (,(kbd "d") ("+deleted" "-inbox") "Delete"))
+  "A list of keys and corresponding tagging operations.
+For each key (or key sequence) you can specify a sequence of
+tagging operations to apply, or a variable which contains a list
+of tagging operations such as `notmuch-archive-tags'. The final
+element is a name for this tagging operation. If the name is
+omitted or empty then the list of tag changes, or the variable
+name is used as the name. The key `r` should not be used as that
+is already bound: it switches the menu to a menu of the reverse
+tagging operations. The reverse of a tagging operation is the
+same list of individual tag-ops but with `+tag` replaced by
+`-tag` and vice versa.
+If setting this variable outside of customize then it should be a
+list of triples (lists of three elements). Each triple should be
+of the form (key-binding tagging-operations name). KEY-BINDING
+can be a single character or a key sequence; TAGGING-OPERATIONS
+should either be a list of individual tag operations each of the
+form `+tag` or `-tag`, or the variable name of a variable that is
+a list of tagging operations; NAME should be a name for the
+tagging operation, if omitted or empty than then name is taken
+  :tag "List of tagging bindings"
+  :type '(repeat notmuch-tag-key-type)
+  :group 'notmuch-tag)
 (define-widget 'notmuch-tag-format-type 'lazy
   "Customize widget for notmuch-tag-format and friends"
   :type '(alist :key-type (regexp :tag "Tag")
@@ -437,6 +485,51 @@ begin with a \"+\" or a \"-\". If REVERSE is non-nil, 
replace all
+(defun notmuch-tag-jump (reverse)
+  "Create a jump menu for tagging operations.
+Creates and displays a jump menu for the tagging operations
+specified in `notmuch-tagging-keys'. If REVERSE is set then it
+offers a menu of the reverses of the operations specified in
+`notmuch-tagging-keys'; i.e. each `+tag` is replaced by `-tag`
+and vice versa."
+  ;; In principle this function is simple, but it has to deal with
+  ;; lots of cases: different modes (search/show/tree), whether a name
+  ;; is specified, whether the tagging operations is a list of
+  ;; tag-ops, or a symbol that evaluates to such a list, and whether
+  ;; REVERSE is specified.
+  (interactive "P")
+  (let (action-map)
+    (dolist (binding notmuch-tagging-keys)
+      (let* ((tag-function (case major-mode
+                            (notmuch-search-mode #'notmuch-search-tag)
+                            (notmuch-show-mode #'notmuch-show-tag)
+                            (notmuch-tree-mode #'notmuch-tree-tag)))
+            (key (first binding))
+            (forward-tag-change (if (symbolp (second binding))
+                                    (symbol-value (second binding))
+                                  (second binding)))
+            (tag-change (if reverse
+                            (notmuch-tag-change-list forward-tag-change 't)
+                          forward-tag-change))
+            (name (or (and (not (string= (third binding) ""))
+                           (third binding))
+                      (and (symbolp (second binding))
+                           (symbol-name (second binding)))))
+            (name-string (if name
+                             (if reverse (concat "Reverse " name)
+                               name)
+                           (mapconcat #'identity tag-change " "))))
+       (push (list key name-string
+                    `(lambda () (,tag-function ',tag-change)))
+             action-map)))
+    (push (list "r" (if reverse
+                       "Forward tag changes "
+                     "Reverse tag changes")
+               (apply-partially 'notmuch-tag-jump (not reverse)))
+         action-map)
+    (setq action-map (nreverse action-map))
+    (notmuch-jump action-map "Tag: ")))
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index d864e6d..5431384 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -276,6 +276,7 @@ FUNC."
     (define-key map "P" 'notmuch-tree-prev-message)
     (define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
     (define-key map (kbd "M-n") 'notmuch-tree-next-thread)
+    (define-key map "k" 'notmuch-tag-jump)
     (define-key map "-" 'notmuch-tree-remove-tag)
     (define-key map "+" 'notmuch-tree-add-tag)
     (define-key map "*" 'notmuch-tree-tag-thread)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 8e14692..888672b 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -169,6 +169,7 @@ there will be called at other points of notmuch execution."
     (define-key map "t" 'notmuch-search-filter-by-tag)
     (define-key map "l" 'notmuch-search-filter)
     (define-key map [mouse-1] 'notmuch-search-show-thread)
+    (define-key map "k" 'notmuch-tag-jump)
     (define-key map "*" 'notmuch-search-tag-all)
     (define-key map "a" 'notmuch-search-archive-thread)
     (define-key map "-" 'notmuch-search-remove-tag)

notmuch mailing list

Reply via email to