config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

notmuch-tag.el (22318B)


      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