(notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
"Custom formats for individual tags.
-This gives a list that maps from tag names to lists of formatting
-expressions. The car of each element gives a tag name and the
-cdr gives a list of Elisp expressions that modify the tag. If
-the list is empty, the tag will simply be hidden. Otherwise,
-each expression will be evaluated in order: for the first
-expression, the variable `tag' will be bound to the tag name; for
-each later expression, the variable `tag' will be bound to the
-result of the previous expression. In this way, each expression
-can build on the formatting performed by the previous expression.
-The result of the last expression will displayed in place of the
-tag.
+This is an association list that maps from tag name regexps to
+lists of formatting expressions. The first entry whose car
+regexp-matches a tag will be used to format that tag. The regexp
+is implicitly anchored, so to match a literal tag name, just use
+that tag name (if it contains special regexp characters like
+\".\" or \"*\", these have to be escaped). The cdr of the
+matching entry gives a list of Elisp expressions that modify the
+tag. If the list is empty, the tag will simply be hidden.
+Otherwise, each expression will be evaluated in order: for the
+first expression, the variable `tag' will be bound to the tag
+name; for each later expression, the variable `tag' will be bound
+to the result of the previous expression. In this way, each
+expression can build on the formatting performed by the previous
+expression. The result of the last expression will displayed in
+place of the tag.
For example, to replace a tag with another string, simply use
that string as a formatting expression. To change the foreground
:group 'notmuch-search
:group 'notmuch-show
- :type '(alist :key-type (string :tag "Tag")
+ :type '(alist :key-type (regexp :tag "Tag")
:extra-offset -3
:value-type
(radio :format "%v"
</g>
</svg>")
+(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
+ "Cache of tag format lookup. Internal to `notmuch-tag-format-tag'.")
+
+(defun notmuch-tag-clear-cache ()
+ "Clear the internal cache of tag formats."
+ (clrhash notmuch-tag--format-cache))
+
(defun notmuch-tag-format-tag (tag)
- "Format TAG by looking into `notmuch-tag-formats'."
- (let ((formats (assoc tag notmuch-tag-formats)))
- (cond
- ((null formats) ;; - Tag not in `notmuch-tag-formats',
- tag) ;; the format is the tag itself.
- ((null (cdr formats)) ;; - Tag was deliberately hidden,
- nil) ;; no format must be returned
- (t ;; - Tag was found and has formats,
- (let ((tag tag)) ;; we must apply all the formats.
- (dolist (format (cdr formats) tag)
- (setq tag (eval format))))))))
-
-(defun notmuch-tag-format-tags (tags)
+ "Format TAG by according to `notmuch-tag-formats'.
+
+Callers must ensure that the tag format cache has been recently cleared
+via `notmuch-tag-clear-cache' before using this function. For example,
+it would be appropriate to clear the cache just prior to filling a
+buffer that uses formatted tags."
+
+ (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))
+ (when (eq formatted 'missing)
+ (let* ((formats
+ (save-match-data
+ ;; Don't use assoc-default since there's no way to
+ ;; distinguish a missing key from a present key with a
+ ;; null cdr:.
+ (assoc* tag notmuch-tag-formats
+ :test (lambda (tag key)
+ (and (eq (string-match key tag) 0)
+ (= (match-end 0) (length tag))))))))
+ (setq formatted
+ (cond
+ ((null formats) ;; - Tag not in `notmuch-tag-formats',
+ tag) ;; the format is the tag itself.
+ ((null (cdr formats)) ;; - Tag was deliberately hidden,
+ nil) ;; no format must be returned
+ (t ;; - Tag was found and has formats,
+ (let ((tag tag)) ;; we must apply all the formats.
+ (dolist (format (cdr formats) tag)
+ (setq tag (eval format)))))))
+ (puthash tag formatted notmuch-tag--format-cache)))
+ formatted))
+
+(defun notmuch-tag-format-tags (tags &optional face)
"Return a string representing formatted TAGS."
- (notmuch-combine-face-text-property-string
- (mapconcat #'identity
- ;; nil indicated that the tag was deliberately hidden
- (delq nil (mapcar #'notmuch-tag-format-tag tags))
- " ")
- 'notmuch-tag-face
- t))
+ (let ((face (or face 'notmuch-tag-face)))
+ (notmuch-apply-face
+ (mapconcat #'identity
+ ;; nil indicated that the tag was deliberately hidden
+ (delq nil (mapcar #'notmuch-tag-format-tag tags))
+ " ")
+ face
+ t)))
(defcustom notmuch-before-tag-hook nil
"Hooks that are run before tags of a message are modified.
(set-keymap-parent map crm-local-completion-map)
(define-key map " " 'self-insert-command)
map)))
- (delete "" (completing-read-multiple prompt
- tag-list nil nil initial-input
+ (delete "" (completing-read-multiple
+ prompt
+ ;; Append the separator to each completion so when the
+ ;; user completes a tag they can immediately begin
+ ;; entering another. `completing-read-multiple'
+ ;; ultimately splits the input on crm-separator, so we
+ ;; don't need to strip this back off (we just need to
+ ;; delete "empty" entries caused by trailing spaces).
+ (mapcar (lambda (tag-op) (concat tag-op crm-separator)) tag-list)
+ nil nil initial-input
'notmuch-read-tag-changes-history))))
(defun notmuch-update-tags (tags tag-changes)
(error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
(sort result-tags 'string<)))
-(defun notmuch-tag (query &optional tag-changes)
+(defconst notmuch-tag-argument-limit 1000
+ "Use batch tagging if the tagging query is longer than this.
+
+This limits the length of arguments passed to the notmuch CLI to
+avoid system argument length limits and performance problems.")
+
+(defun notmuch-tag (query tag-changes)
"Add/remove tags in TAG-CHANGES to messages matching QUERY.
QUERY should be a string containing the search-terms.
-TAG-CHANGES can take multiple forms. If TAG-CHANGES is a list of
-strings of the form \"+tag\" or \"-tag\" then those are the tag
-changes applied. If TAG-CHANGES is a string then it is
-interpreted as a single tag change. If TAG-CHANGES is the string
-\"-\" or \"+\", or null, then the user is prompted to enter the
-tag changes.
+TAG-CHANGES is a list of strings of the form \"+tag\" or
+\"-tag\" to add or remove tags, respectively.
Note: Other code should always use this function alter tags of
messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
directly, so that hooks specified in notmuch-before-tag-hook and
notmuch-after-tag-hook will be run."
;; Perform some validation
- (if (string-or-null-p tag-changes)
- (if (or (string= tag-changes "-") (string= tag-changes "+") (null tag-changes))
- (setq tag-changes (notmuch-read-tag-changes
- (notmuch-tag-completions query) nil tag-changes))
- (setq tag-changes (list tag-changes))))
(mapc (lambda (tag-change)
(unless (string-match-p "^[-+]\\S-+$" tag-change)
(error "Tag must be of the form `+this_tag' or `-that_tag'")))
tag-changes)
(unless (null tag-changes)
(run-hooks 'notmuch-before-tag-hook)
- (apply 'notmuch-call-notmuch-process "tag"
- (append tag-changes (list "--" query)))
- (run-hooks 'notmuch-after-tag-hook))
- ;; in all cases we return tag-changes as a list
- tag-changes)
+ (if (<= (length query) notmuch-tag-argument-limit)
+ (apply 'notmuch-call-notmuch-process "tag"
+ (append tag-changes (list "--" query)))
+ ;; Use batch tag mode to avoid argument length limitations
+ (let ((batch-op (concat (mapconcat #'notmuch-hex-encode tag-changes " ")
+ " -- " query)))
+ (notmuch-call-notmuch-process :stdin-string batch-op "tag" "--batch")))
+ (run-hooks 'notmuch-after-tag-hook)))
(defun notmuch-tag-change-list (tags &optional reverse)
"Convert TAGS into a list of tag changes.
projects / notmuch / blobdiff