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

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