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