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