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