X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-tag.el;h=959778819617f9cd23498818b2344103fb008c12;hb=cc2c3a383d12ce421c5ec1bdfb7bfacc60a0f368;hp=0c9a32ac4856a9d78167751da4ebf48e9b7c74db;hpb=16b2db0986ce0ed7c420a69d0a98bb41e9ca4bd8;p=notmuch diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index 0c9a32ac..95977881 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -23,10 +23,6 @@ ;;; Code: -(require 'cl-lib) -(eval-when-compile - (require 'pcase)) - (require 'crm) (require 'notmuch-lib) @@ -141,20 +137,23 @@ Used in the default value of `notmuch-tag-formats'." (notmuch-tag-format-image-data tag (notmuch-tag-star-icon)))) "Custom formats for individual tags. -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 +This is an association list of the form ((MATCH EXPR...)...), +mapping tag name regexps to lists of formatting expressions. + +The first entry whose MATCH regexp-matches a tag is 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 is simply +hidden. Otherwise, each expression EXPR is evaluated in order: +for the first expression, the variable `tag' is bound to the tag +name; for each later expression, the variable `tag' is 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 +expression. The result of the last expression is displayed in place of the tag. For example, to replace a tag with another string, simply use @@ -242,7 +241,7 @@ DATA is the content of an SVG picture (e.g., as returned by "Return SVG data representing a star icon. This can be used with `notmuch-tag-format-image-data'." " - + - + - + ") +;;; track history of tag operations +(defvar-local notmuch-tag-history nil + "Buffer local history of `notmuch-tag' function.") +(put 'notmuch-tag-history 'permanent-local t) + ;;; Format Handling (defvar notmuch-tag--format-cache (make-hash-table :test 'equal) @@ -384,35 +388,34 @@ the messages that were tagged." ;;; User Input (defvar notmuch-select-tag-history nil - "Variable to store minibuffer history for -`notmuch-select-tag-with-completion' function.") + "Minibuffer history of `notmuch-select-tag-with-completion' function.") (defvar notmuch-read-tag-changes-history nil - "Variable to store minibuffer history for -`notmuch-read-tag-changes' function.") + "Minibuffer history of `notmuch-read-tag-changes' function.") (defun notmuch-tag-completions (&rest search-terms) "Return a list of tags for messages matching SEARCH-TERMS. -Returns all tags if no search terms are given." +Return all tags if no search terms are given." (unless search-terms (setq search-terms (list "*"))) (split-string (with-output-to-string (with-current-buffer standard-output - (apply 'call-process notmuch-command nil t + (apply 'notmuch--call-process notmuch-command nil t nil "search" "--output=tags" "--exclude=false" search-terms))) "\n+" t)) (defun notmuch-select-tag-with-completion (prompt &rest search-terms) - (let ((tag-list (apply #'notmuch-tag-completions search-terms))) - (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history))) + (completing-read prompt + (apply #'notmuch-tag-completions search-terms) + nil nil nil 'notmuch-select-tag-history)) (defun notmuch-read-tag-changes (current-tags &optional prompt initial-input) "Prompt for tag changes in the minibuffer. -CURRENT-TAGS is a list of tags that are present on the message or -messages to be changed. These are offered as tag removal +CURRENT-TAGS is a list of tags that are present on the message +or messages to be changed. These are offered as tag removal completions. CURRENT-TAGS may contain duplicates. PROMPT, if non-nil, is the query string to present in the minibuffer. It defaults to \"Tags\". INITIAL-INPUT, if non-nil, will be the @@ -431,17 +434,9 @@ initial input in the minibuffer." (set-keymap-parent map crm-local-completion-map) (define-key map " " 'self-insert-command) map))) - (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)))) + (completing-read-multiple prompt tag-list + nil nil initial-input + 'notmuch-read-tag-changes-history))) ;;; Tagging @@ -454,10 +449,9 @@ present or a \"-\" to indicate that the tag should be removed from TAGS if present." (let ((result-tags (copy-sequence tags))) (dolist (tag-change tag-changes) - (let ((op (aref tag-change 0)) - (tag (and (not (string= tag-change "")) + (let ((tag (and (not (string-empty-p tag-change)) (substring tag-change 1)))) - (cl-case op + (cl-case (aref tag-change 0) (?+ (unless (member tag result-tags) (push tag result-tags))) (?- (setq result-tags (delete tag result-tags))) @@ -469,14 +463,19 @@ from TAGS if present." "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.") +avoid system argument length limits and performance problems. + +NOTE: this variable is no longer used.") -(defun notmuch-tag (query tag-changes) +(make-obsolete-variable 'notmuch-tag-argument-limit nil "notmuch 0.36") + +(defun notmuch-tag (query tag-changes &optional omit-hist) "Add/remove tags in TAG-CHANGES to messages matching QUERY. QUERY should be a string containing the search-terms. -TAG-CHANGES is a list of strings of the form \"+tag\" or -\"-tag\" to add or remove tags, respectively. +TAG-CHANGES is a list of strings of the form \"+tag\" or \"-tag\" +to add or remove tags, respectively. OMIT-HIST disables history +tracking if non-nil. Note: Other code should always use this function to alter tags of messages instead of running (notmuch-call-notmuch-process \"tag\" ..) @@ -489,16 +488,34 @@ notmuch-after-tag-hook will be run." (unless query (error "Nothing to tag!")) (when tag-changes - (run-hooks 'notmuch-before-tag-hook) - (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"))) + (notmuch-dlet ((tag-changes tag-changes) + (query query)) + (run-hooks 'notmuch-before-tag-hook)) + (with-temp-buffer + (insert (concat (mapconcat #'notmuch-hex-encode tag-changes " ") " -- " query)) + (unless (= 0 + (notmuch--call-process-region + (point-min) (point-max) notmuch-command t t nil "tag" "--batch")) + (notmuch-logged-error "notmuch tag failed" (buffer-string)))) + (unless omit-hist + (push (list :query query :tag-changes tag-changes) notmuch-tag-history))) + (notmuch-dlet ((tag-changes tag-changes) + (query query)) (run-hooks 'notmuch-after-tag-hook))) +(defun notmuch-tag-undo () + "Undo the previous tagging operation in the current buffer. Uses +buffer local variable `notmuch-tag-history' to determine what +that operation was." + (interactive) + (when (null notmuch-tag-history) + (error "no further notmuch undo information")) + (let* ((action (pop notmuch-tag-history)) + (query (plist-get action :query)) + (changes (notmuch-tag-change-list (plist-get action :tag-changes) t))) + (notmuch-tag query changes t)) + (notmuch-refresh-this-buffer)) + (defun notmuch-tag-change-list (tags &optional reverse) "Convert TAGS into a list of tag changes. @@ -552,7 +569,7 @@ and vice versa." name) (mapconcat #'identity tag-change " ")))) (push (list key name-string - `(lambda () (,tag-function ',tag-change))) + (lambda () (funcall tag-function tag-change))) action-map))) (push (list notmuch-tag-jump-reverse-key (if reverse