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:
Austin Clements 2013-10-22 20:21:55 -04:00 committed by David Bremner
parent 440b8065c9
commit 0f8d5b6b0e

View file

@ -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)