git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-tag.el

   1 ;;; notmuch-tag.el --- tag messages within emacs
   2 ;;
   3 ;; Copyright © Damien Cassou
   4 ;; Copyright © Carl Worth
   5 ;;
   6 ;; This file is part of Notmuch.
   7 ;;
   8 ;; Notmuch is free software: you can redistribute it and/or modify it
   9 ;; under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12 ;;
  13 ;; Notmuch is distributed in the hope that it will be useful, but
  14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 ;; General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with Notmuch.  If not, see <https://www.gnu.org/licenses/>.
  20 ;;
  21 ;; Authors: Carl Worth <cworth@cworth.org>
  22 ;;          Damien Cassou <damien.cassou@gmail.com>
  23 ;;
  24 ;;; Code:
  25 ;;
  26
  27 (require 'cl-lib)
  28 (eval-when-compile
  29   (require 'pcase))
  30
  31 (require 'crm)
  32
  33 (require 'notmuch-lib)
  34
  35 (declare-function notmuch-search-tag "notmuch" tag-changes)
  36 (declare-function notmuch-show-tag "notmuch-show" tag-changes)
  37 (declare-function notmuch-tree-tag "notmuch-tree" tag-changes)
  38
  39 (autoload 'notmuch-jump "notmuch-jump")
  40
  41 (define-widget 'notmuch-tag-key-type 'list
  42   "A single key tagging binding."
  43   :format "%v"
  44   :args '((list :inline t
  45                 :format "%v"
  46                 (key-sequence :tag "Key")
  47                 (radio :tag "Tag operations" (repeat :tag "Tag list" (string :format "%v" :tag "change"))
  48                        (variable :tag "Tag variable"))
  49                 (string :tag "Name"))))
  50
  51 (defcustom notmuch-tagging-keys
  52   `((,(kbd "a") notmuch-archive-tags "Archive")
  53     (,(kbd "u") notmuch-show-mark-read-tags "Mark read")
  54     (,(kbd "f") ("+flagged") "Flag")
  55     (,(kbd "s") ("+spam" "-inbox") "Mark as spam")
  56     (,(kbd "d") ("+deleted" "-inbox") "Delete"))
  57   "A list of keys and corresponding tagging operations.
  58
  59 For each key (or key sequence) you can specify a sequence of
  60 tagging operations to apply, or a variable which contains a list
  61 of tagging operations such as `notmuch-archive-tags'. The final
  62 element is a name for this tagging operation. If the name is
  63 omitted or empty then the list of tag changes, or the variable
  64 name is used as the name.
  65
  66 The key `notmuch-tag-jump-reverse-key' (k by default) should not
  67 be used (either as a key, or as the start of a key sequence) as
  68 it is already bound: it switches the menu to a menu of the
  69 reverse tagging operations. The reverse of a tagging operation is
  70 the same list of individual tag-ops but with `+tag` replaced by
  71 `-tag` and vice versa.
  72
  73 If setting this variable outside of customize then it should be a
  74 list of triples (lists of three elements). Each triple should be
  75 of the form (key-binding tagging-operations name). KEY-BINDING
  76 can be a single character or a key sequence; TAGGING-OPERATIONS
  77 should either be a list of individual tag operations each of the
  78 form `+tag` or `-tag`, or the variable name of a variable that is
  79 a list of tagging operations; NAME should be a name for the
  80 tagging operation, if omitted or empty than then name is taken
  81 from TAGGING-OPERATIONS."
  82   :tag "List of tagging bindings"
  83   :type '(repeat notmuch-tag-key-type)
  84   :group 'notmuch-tag)
  85
  86 (define-widget 'notmuch-tag-format-type 'lazy
  87   "Customize widget for notmuch-tag-format and friends"
  88   :type '(alist :key-type (regexp :tag "Tag")
  89                 :extra-offset -3
  90                 :value-type
  91                 (radio :format "%v"
  92                        (const :tag "Hidden" nil)
  93                        (set :tag "Modified"
  94                             (string :tag "Display as")
  95                             (list :tag "Face" :extra-offset -4
  96                                   (const :format "" :inline t
  97                                          (notmuch-apply-face tag))
  98                                   (list :format "%v"
  99                                         (const :format "" quote)
 100                                         custom-face-edit))
 101                             (list :format "%v" :extra-offset -4
 102                                   (const :format "" :inline t
 103                                          (notmuch-tag-format-image-data tag))
 104                                   (choice :tag "Image"
 105                                           (const :tag "Star"
 106                                                  (notmuch-tag-star-icon))
 107                                           (const :tag "Empty star"
 108                                                  (notmuch-tag-star-empty-icon))
 109                                           (const :tag "Tag"
 110                                                  (notmuch-tag-tag-icon))
 111                                           (string :tag "Custom")))
 112                             (sexp :tag "Custom")))))
 113
 114 (defface notmuch-tag-unread
 115   '((t :foreground "red"))
 116   "Default face used for the unread tag.
 117
 118 Used in the default value of `notmuch-tag-formats`."
 119   :group 'notmuch-faces)
 120
 121 (defface notmuch-tag-flagged
 122   '((((class color)
 123       (background dark))
 124      (:foreground "LightBlue1"))
 125     (((class color)
 126       (background light))
 127      (:foreground "blue")))
 128   "Face used for the flagged tag.
 129
 130 Used in the default value of `notmuch-tag-formats`."
 131   :group 'notmuch-faces)
 132
 133 (defcustom notmuch-tag-formats
 134   '(("unread" (propertize tag 'face 'notmuch-tag-unread))
 135     ("flagged" (propertize tag 'face 'notmuch-tag-flagged)
 136      (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
 137   "Custom formats for individual tags.
 138
 139 This is an association list that maps from tag name regexps to
 140 lists of formatting expressions.  The first entry whose car
 141 regexp-matches a tag will be used to format that tag.  The regexp
 142 is implicitly anchored, so to match a literal tag name, just use
 143 that tag name (if it contains special regexp characters like
 144 \".\" or \"*\", these have to be escaped).  The cdr of the
 145 matching entry gives a list of Elisp expressions that modify the
 146 tag.  If the list is empty, the tag will simply be hidden.
 147 Otherwise, each expression will be evaluated in order: for the
 148 first expression, the variable `tag' will be bound to the tag
 149 name; for each later expression, the variable `tag' will be bound
 150 to the result of the previous expression.  In this way, each
 151 expression can build on the formatting performed by the previous
 152 expression.  The result of the last expression will displayed in
 153 place of the tag.
 154
 155 For example, to replace a tag with another string, simply use
 156 that string as a formatting expression.  To change the foreground
 157 of a tag to red, use the expression
 158   (propertize tag 'face '(:foreground \"red\"))
 159
 160 See also `notmuch-tag-format-image', which can help replace tags
 161 with images."
 162   :group 'notmuch-search
 163   :group 'notmuch-show
 164   :group 'notmuch-faces
 165   :type 'notmuch-tag-format-type)
 166
 167 (defface notmuch-tag-deleted
 168   '((((class color) (supports :strike-through "red")) :strike-through "red")
 169     (t :inverse-video t))
 170   "Face used to display deleted tags.
 171
 172 Used in the default value of `notmuch-tag-deleted-formats`."
 173   :group 'notmuch-faces)
 174
 175 (defcustom notmuch-tag-deleted-formats
 176   '(("unread" (notmuch-apply-face bare-tag `notmuch-tag-deleted))
 177     (".*" (notmuch-apply-face tag `notmuch-tag-deleted)))
 178   "Custom formats for tags when deleted.
 179
 180 For deleted tags the formats in `notmuch-tag-formats` are applied
 181 first and then these formats are applied on top; that is `tag'
 182 passed to the function is the tag with all these previous
 183 formattings applied. The formatted can access the original
 184 unformatted tag as `bare-tag'.
 185
 186 By default this shows deleted tags with strike-through in red,
 187 unless strike-through is not available (e.g., emacs is running in
 188 a terminal) in which case it uses inverse video. To hide deleted
 189 tags completely set this to
 190   '((\".*\" nil))
 191
 192 See `notmuch-tag-formats' for full documentation."
 193   :group 'notmuch-show
 194   :group 'notmuch-faces
 195   :type 'notmuch-tag-format-type)
 196
 197 (defface notmuch-tag-added
 198   '((t :underline "green"))
 199   "Default face used for added tags.
 200
 201 Used in the default value for `notmuch-tag-added-formats`."
 202   :group 'notmuch-faces)
 203
 204 (defcustom notmuch-tag-added-formats
 205   '((".*" (notmuch-apply-face tag 'notmuch-tag-added)))
 206   "Custom formats for tags when added.
 207
 208 For added tags the formats in `notmuch-tag-formats` are applied
 209 first and then these formats are applied on top.
 210
 211 To disable special formatting of added tags, set this variable to
 212 nil.
 213
 214 See `notmuch-tag-formats' for full documentation."
 215   :group 'notmuch-show
 216   :group 'notmuch-faces
 217   :type 'notmuch-tag-format-type)
 218
 219 (defun notmuch-tag-format-image-data (tag data)
 220   "Replace TAG with image DATA, if available.
 221
 222 This function returns a propertized string that will display image
 223 DATA in place of TAG.This is designed for use in
 224 `notmuch-tag-formats'.
 225
 226 DATA is the content of an SVG picture (e.g., as returned by
 227 `notmuch-tag-star-icon')."
 228   (propertize tag 'display
 229               `(image :type svg
 230                       :data ,data
 231                       :ascent center
 232                       :mask heuristic)))
 233
 234 (defun notmuch-tag-star-icon ()
 235   "Return SVG data representing a star icon.
 236 This can be used with `notmuch-tag-format-image-data'."
 237 "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
 238 <svg version=\"1.1\" width=\"16\" height=\"16\">
 239   <g transform=\"translate(-242.81601,-315.59635)\">
 240     <path
 241        d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\"
 242        transform=\"matrix(0.2484147,-0.02623394,0.02623394,0.2484147,174.63605,255.37691)\"
 243        style=\"fill:#ffff00;fill-rule:evenodd;stroke:#000000;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1\" />
 244   </g>
 245 </svg>")
 246
 247 (defun notmuch-tag-star-empty-icon ()
 248   "Return SVG data representing an empty star icon.
 249 This can be used with `notmuch-tag-format-image-data'."
 250   "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
 251 <svg version=\"1.1\" width=\"16\" height=\"16\">
 252   <g transform=\"translate(-242.81601,-315.59635)\">
 253     <path
 254        d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\"
 255        transform=\"matrix(0.2484147,-0.02623394,0.02623394,0.2484147,174.63605,255.37691)\"
 256        style=\"fill:#d6d6d1;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1\" />
 257   </g>
 258 </svg>")
 259
 260 (defun notmuch-tag-tag-icon ()
 261   "Return SVG data representing a tag icon.
 262 This can be used with `notmuch-tag-format-image-data'."
 263   "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
 264 <svg version=\"1.1\" width=\"16\" height=\"16\">
 265   <g transform=\"translate(0,-1036.3622)\">
 266     <path
 267        d=\"m 0.44642857,1040.9336 12.50000043,0 2.700893,3.6161 -2.700893,3.616 -12.50000043,0 z\"
 268        style=\"fill:#ffff00;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:0.25;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1\" />
 269   </g>
 270 </svg>")
 271
 272 (defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
 273   "Cache of tag format lookup.  Internal to `notmuch-tag-format-tag'.")
 274
 275 (defun notmuch-tag-clear-cache ()
 276   "Clear the internal cache of tag formats."
 277   (clrhash notmuch-tag--format-cache))
 278
 279 (defun notmuch-tag--get-formats (tag format-alist)
 280   "Find the first item whose car regexp-matches TAG."
 281   (save-match-data
 282     ;; Don't use assoc-default since there's no way to distinguish a
 283     ;; missing key from a present key with a null cdr.
 284     (cl-assoc tag format-alist
 285               :test (lambda (tag key)
 286                       (and (eq (string-match key tag) 0)
 287                            (= (match-end 0) (length tag)))))))
 288
 289 (defun notmuch-tag--do-format (tag formatted-tag formats)
 290   "Apply a tag-formats entry to TAG."
 291   (cond ((null formats)         ;; - Tag not in `formats',
 292          formatted-tag)         ;;   the format is the tag itself.
 293         ((null (cdr formats))   ;; - Tag was deliberately hidden,
 294          nil)                   ;;   no format must be returned
 295         (t
 296          ;; Tag was found and has formats, we must apply all the
 297          ;; formats.  TAG may be null so treat that as a special case.
 298          (let ((bare-tag tag)
 299                (tag (copy-sequence (or formatted-tag ""))))
 300            (dolist (format (cdr formats))
 301              (setq tag (eval format)))
 302            (if (and (null formatted-tag) (equal tag ""))
 303                nil
 304              tag)))))
 305
 306 (defun notmuch-tag-format-tag (tags orig-tags tag)
 307   "Format TAG according to `notmuch-tag-formats'.
 308
 309 TAGS and ORIG-TAGS are lists of the current tags and the original
 310 tags; tags which have been deleted (i.e., are in ORIG-TAGS but
 311 are not in TAGS) are shown using formats from
 312 `notmuch-tag-deleted-formats'; tags which have been added (i.e.,
 313 are in TAGS but are not in ORIG-TAGS) are shown using formats
 314 from `notmuch-tag-added-formats' and tags which have not been
 315 changed (the normal case) are shown using formats from
 316 `notmuch-tag-formats'"
 317   (let* ((tag-state (cond ((not (member tag tags)) 'deleted)
 318                           ((not (member tag orig-tags)) 'added)))
 319          (formatted-tag (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))
 320     (when (eq formatted-tag 'missing)
 321       (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))
 322             (over (cl-case tag-state
 323                     (deleted (notmuch-tag--get-formats
 324                               tag notmuch-tag-deleted-formats))
 325                     (added (notmuch-tag--get-formats
 326                             tag notmuch-tag-added-formats))
 327                     (otherwise nil))))
 328         (setq formatted-tag (notmuch-tag--do-format tag tag base))
 329         (setq formatted-tag (notmuch-tag--do-format tag formatted-tag over))
 330
 331         (puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache)))
 332     formatted-tag))
 333
 334 (defun notmuch-tag-format-tags (tags orig-tags &optional face)
 335   "Return a string representing formatted TAGS."
 336   (let ((face (or face 'notmuch-tag-face))
 337         (all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))
 338     (notmuch-apply-face
 339      (mapconcat #'identity
 340                 ;; nil indicated that the tag was deliberately hidden
 341                 (delq nil (mapcar
 342                            (apply-partially #'notmuch-tag-format-tag tags orig-tags)
 343                            all-tags))
 344                 " ")
 345      face
 346      t)))
 347
 348 (defcustom notmuch-before-tag-hook nil
 349   "Hooks that are run before tags of a message are modified.
 350
 351 'tag-changes' will contain the tags that are about to be added or removed as
 352 a list of strings of the form \"+TAG\" or \"-TAG\".
 353 'query' will be a string containing the search query that determines
 354 the messages that are about to be tagged"
 355
 356   :type 'hook
 357   :options '(notmuch-hl-line-mode)
 358   :group 'notmuch-hooks)
 359
 360 (defcustom notmuch-after-tag-hook nil
 361   "Hooks that are run after tags of a message are modified.
 362
 363 'tag-changes' will contain the tags that were added or removed as
 364 a list of strings of the form \"+TAG\" or \"-TAG\".
 365 'query' will be a string containing the search query that determines
 366 the messages that were tagged"
 367   :type 'hook
 368   :options '(notmuch-hl-line-mode)
 369   :group 'notmuch-hooks)
 370
 371 (defvar notmuch-select-tag-history nil
 372   "Variable to store minibuffer history for
 373 `notmuch-select-tag-with-completion' function.")
 374
 375 (defvar notmuch-read-tag-changes-history nil
 376   "Variable to store minibuffer history for
 377 `notmuch-read-tag-changes' function.")
 378
 379 (defun notmuch-tag-completions (&rest search-terms)
 380   "Return a list of tags for messages matching SEARCH-TERMS.
 381
 382 Returns all tags if no search terms are given."
 383   (if (null search-terms)
 384       (setq search-terms (list "*")))
 385   (split-string
 386    (with-output-to-string
 387      (with-current-buffer standard-output
 388        (apply 'call-process notmuch-command nil t
 389               nil "search" "--output=tags" "--exclude=false" search-terms)))
 390    "\n+" t))
 391
 392 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
 393   (let ((tag-list (apply #'notmuch-tag-completions search-terms)))
 394     (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
 395
 396 (defun notmuch-read-tag-changes (current-tags &optional prompt initial-input)
 397   "Prompt for tag changes in the minibuffer.
 398
 399 CURRENT-TAGS is a list of tags that are present on the message or
 400 messages to be changed.  These are offered as tag removal
 401 completions.  CURRENT-TAGS may contain duplicates.  PROMPT, if
 402 non-nil, is the query string to present in the minibuffer.  It
 403 defaults to \"Tags\".  INITIAL-INPUT, if non-nil, will be the
 404 initial input in the minibuffer."
 405
 406   (let* ((all-tag-list (notmuch-tag-completions))
 407          (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
 408          (remove-tag-list (mapcar (apply-partially 'concat "-") current-tags))
 409          (tag-list (append add-tag-list remove-tag-list))
 410          (prompt (concat (or prompt "Tags") " (+add -drop): "))
 411          (crm-separator " ")
 412          ;; By default, space is bound to "complete word" function.
 413          ;; Re-bind it to insert a space instead.  Note that <tab>
 414          ;; still does the completion.
 415          (crm-local-completion-map
 416           (let ((map (make-sparse-keymap)))
 417             (set-keymap-parent map crm-local-completion-map)
 418             (define-key map " " 'self-insert-command)
 419             map)))
 420     (delete "" (completing-read-multiple
 421                 prompt
 422                 ;; Append the separator to each completion so when the
 423                 ;; user completes a tag they can immediately begin
 424                 ;; entering another.  `completing-read-multiple'
 425                 ;; ultimately splits the input on crm-separator, so we
 426                 ;; don't need to strip this back off (we just need to
 427                 ;; delete "empty" entries caused by trailing spaces).
 428                 (mapcar (lambda (tag-op) (concat tag-op crm-separator)) tag-list)
 429                 nil nil initial-input
 430                 'notmuch-read-tag-changes-history))))
 431
 432 (defun notmuch-update-tags (tags tag-changes)
 433   "Return a copy of TAGS with additions and removals from TAG-CHANGES.
 434
 435 TAG-CHANGES must be a list of tags names, each prefixed with
 436 either a \"+\" to indicate the tag should be added to TAGS if not
 437 present or a \"-\" to indicate that the tag should be removed
 438 from TAGS if present."
 439   (let ((result-tags (copy-sequence tags)))
 440     (dolist (tag-change tag-changes)
 441       (let ((op (string-to-char tag-change))
 442             (tag (unless (string= tag-change "") (substring tag-change 1))))
 443         (cl-case op
 444           (?+ (unless (member tag result-tags)
 445                 (push tag result-tags)))
 446           (?- (setq result-tags (delete tag result-tags)))
 447           (otherwise
 448            (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
 449     (sort result-tags 'string<)))
 450
 451 (defconst notmuch-tag-argument-limit 1000
 452   "Use batch tagging if the tagging query is longer than this.
 453
 454 This limits the length of arguments passed to the notmuch CLI to
 455 avoid system argument length limits and performance problems.")
 456
 457 (defun notmuch-tag (query tag-changes)
 458   "Add/remove tags in TAG-CHANGES to messages matching QUERY.
 459
 460 QUERY should be a string containing the search-terms.
 461 TAG-CHANGES is a list of strings of the form \"+tag\" or
 462 \"-tag\" to add or remove tags, respectively.
 463
 464 Note: Other code should always use this function to alter tags of
 465 messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
 466 directly, so that hooks specified in notmuch-before-tag-hook and
 467 notmuch-after-tag-hook will be run."
 468   ;; Perform some validation
 469   (mapc (lambda (tag-change)
 470           (unless (string-match-p "^[-+]\\S-+$" tag-change)
 471             (error "Tag must be of the form `+this_tag' or `-that_tag'")))
 472         tag-changes)
 473   (unless query
 474     (error "Nothing to tag!"))
 475   (unless (null tag-changes)
 476     (run-hooks 'notmuch-before-tag-hook)
 477     (if (<= (length query) notmuch-tag-argument-limit)
 478         (apply 'notmuch-call-notmuch-process "tag"
 479                (append tag-changes (list "--" query)))
 480       ;; Use batch tag mode to avoid argument length limitations
 481       (let ((batch-op (concat (mapconcat #'notmuch-hex-encode tag-changes " ")
 482                               " -- " query)))
 483         (notmuch-call-notmuch-process :stdin-string batch-op "tag" "--batch")))
 484     (run-hooks 'notmuch-after-tag-hook)))
 485
 486 (defun notmuch-tag-change-list (tags &optional reverse)
 487   "Convert TAGS into a list of tag changes.
 488
 489 Add a \"+\" prefix to any tag in TAGS list that doesn't already
 490 begin with a \"+\" or a \"-\". If REVERSE is non-nil, replace all
 491 \"+\" prefixes with \"-\" and vice versa in the result."
 492   (mapcar (lambda (str)
 493             (let ((s (if (string-match "^[+-]" str) str (concat "+" str))))
 494               (if reverse
 495                   (concat (if (= (string-to-char s) ?-) "+" "-")
 496                           (substring s 1))
 497                 s)))
 498           tags))
 499
 500 (defvar notmuch-tag-jump-reverse-key "k"
 501   "The key in tag-jump to switch to the reverse tag changes.")
 502
 503 (defun notmuch-tag-jump (reverse)
 504   "Create a jump menu for tagging operations.
 505
 506 Creates and displays a jump menu for the tagging operations
 507 specified in `notmuch-tagging-keys'. If REVERSE is set then it
 508 offers a menu of the reverses of the operations specified in
 509 `notmuch-tagging-keys'; i.e. each `+tag` is replaced by `-tag`
 510 and vice versa."
 511   ;; In principle this function is simple, but it has to deal with
 512   ;; lots of cases: different modes (search/show/tree), whether a name
 513   ;; is specified, whether the tagging operations is a list of
 514   ;; tag-ops, or a symbol that evaluates to such a list, and whether
 515   ;; REVERSE is specified.
 516   (interactive "P")
 517   (let (action-map)
 518     (pcase-dolist (`(,key ,tag ,name) notmuch-tagging-keys)
 519       (let* ((tag-function (cl-case major-mode
 520                              (notmuch-search-mode #'notmuch-search-tag)
 521                              (notmuch-show-mode #'notmuch-show-tag)
 522                              (notmuch-tree-mode #'notmuch-tree-tag)))
 523              (tag (if (symbolp tag)
 524                       (symbol-value tag)
 525                     tag))
 526              (tag-change (if reverse
 527                              (notmuch-tag-change-list tag 't)
 528                            tag))
 529              (name (or (and (not (string= name ""))
 530                             name)
 531                        (and (symbolp name)
 532                             (symbol-name name))))
 533              (name-string (if name
 534                               (if reverse (concat "Reverse " name)
 535                                 name)
 536                             (mapconcat #'identity tag-change " "))))
 537         (push (list key name-string
 538                      `(lambda () (,tag-function ',tag-change)))
 539               action-map)))
 540     (push (list notmuch-tag-jump-reverse-key
 541                 (if reverse
 542                     "Forward tag changes "
 543                   "Reverse tag changes")
 544                 (apply-partially 'notmuch-tag-jump (not reverse)))
 545           action-map)
 546     (setq action-map (nreverse action-map))
 547     (notmuch-jump action-map "Tag: ")))
 548
 549 ;;
 550
 551 (provide 'notmuch-tag)