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