mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-11-21 18:38:08 +01:00
emacs: Take prompt and current tags in `notmuch-read-tag-changes'
This modifies the interface of `notmuch-read-tag-changes' to take an optional prompt string as well as a list of existing tags instead of a query. This list of tags is used to populate the tag removal completions and lets the caller compute these in a more efficient/consistent manner than performing a potentially large or complex query. This patch also updates the sole current caller of `notmuch-read-tag-changes'.
This commit is contained in:
parent
440b8065c9
commit
0f8d5b6b0e
1 changed files with 20 additions and 9 deletions
|
@ -189,7 +189,10 @@ the messages that were tagged"
|
||||||
"Variable to store minibuffer history for
|
"Variable to store minibuffer history for
|
||||||
`notmuch-read-tag-changes' function.")
|
`notmuch-read-tag-changes' function.")
|
||||||
|
|
||||||
(defun notmuch-tag-completions (&optional search-terms)
|
(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."
|
||||||
(if (null search-terms)
|
(if (null search-terms)
|
||||||
(setq search-terms (list "*")))
|
(setq search-terms (list "*")))
|
||||||
(split-string
|
(split-string
|
||||||
|
@ -200,17 +203,24 @@ the messages that were tagged"
|
||||||
"\n+" t))
|
"\n+" t))
|
||||||
|
|
||||||
(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
|
(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
|
||||||
(let ((tag-list (notmuch-tag-completions 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 tag-list nil nil nil 'notmuch-select-tag-history)))
|
||||||
|
|
||||||
(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)
|
(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
|
||||||
|
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
|
||||||
|
initial input in the minibuffer."
|
||||||
|
|
||||||
(let* ((all-tag-list (notmuch-tag-completions))
|
(let* ((all-tag-list (notmuch-tag-completions))
|
||||||
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
|
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
|
||||||
(remove-tag-list (mapcar (apply-partially 'concat "-")
|
(remove-tag-list (mapcar (apply-partially 'concat "-") current-tags))
|
||||||
(if (null search-terms)
|
|
||||||
all-tag-list
|
|
||||||
(notmuch-tag-completions search-terms))))
|
|
||||||
(tag-list (append add-tag-list remove-tag-list))
|
(tag-list (append add-tag-list remove-tag-list))
|
||||||
|
(prompt (concat (or prompt "Tags") " (+add -drop): "))
|
||||||
(crm-separator " ")
|
(crm-separator " ")
|
||||||
;; By default, space is bound to "complete word" function.
|
;; By default, space is bound to "complete word" function.
|
||||||
;; Re-bind it to insert a space instead. Note that <tab>
|
;; Re-bind it to insert a space instead. Note that <tab>
|
||||||
|
@ -220,7 +230,7 @@ the messages that were tagged"
|
||||||
(set-keymap-parent map crm-local-completion-map)
|
(set-keymap-parent map crm-local-completion-map)
|
||||||
(define-key map " " 'self-insert-command)
|
(define-key map " " 'self-insert-command)
|
||||||
map)))
|
map)))
|
||||||
(delete "" (completing-read-multiple "Tags (+add -drop): "
|
(delete "" (completing-read-multiple prompt
|
||||||
tag-list nil nil initial-input
|
tag-list nil nil initial-input
|
||||||
'notmuch-read-tag-changes-history))))
|
'notmuch-read-tag-changes-history))))
|
||||||
|
|
||||||
|
@ -261,7 +271,8 @@ notmuch-after-tag-hook will be run."
|
||||||
;; Perform some validation
|
;; Perform some validation
|
||||||
(if (string-or-null-p tag-changes)
|
(if (string-or-null-p tag-changes)
|
||||||
(if (or (string= tag-changes "-") (string= tag-changes "+") (null tag-changes))
|
(if (or (string= tag-changes "-") (string= tag-changes "+") (null tag-changes))
|
||||||
(setq tag-changes (notmuch-read-tag-changes tag-changes query))
|
(setq tag-changes (notmuch-read-tag-changes
|
||||||
|
(notmuch-tag-completions query) nil tag-changes))
|
||||||
(setq tag-changes (list tag-changes))))
|
(setq tag-changes (list tag-changes))))
|
||||||
(mapc (lambda (tag-change)
|
(mapc (lambda (tag-change)
|
||||||
(unless (string-match-p "^[-+]\\S-+$" tag-change)
|
(unless (string-match-p "^[-+]\\S-+$" tag-change)
|
||||||
|
|
Loading…
Reference in a new issue