blob: 0c0fc87583ad3439c04984b8879310d72062c1ed (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
;; notmuch-tag.el --- tag messages within emacs
;;
;; Copyright © Carl Worth
;;
;; This file is part of Notmuch.
;;
;; Notmuch is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Notmuch is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
;;
;; Authors: Carl Worth <cworth@cworth.org>
(eval-when-compile (require 'cl))
(require 'crm)
(require 'notmuch-lib)
(defcustom notmuch-before-tag-hook nil
"Hooks that are run before tags of a message are modified.
'tags' will contain the tags that are about to be added or removed as
a list of strings of the form \"+TAG\" or \"-TAG\".
'query' will be a string containing the search query that determines
the messages that are about to be tagged"
:type 'hook
:options '(notmuch-hl-line-mode)
:group 'notmuch-hooks)
(defcustom notmuch-after-tag-hook nil
"Hooks that are run after tags of a message are modified.
'tags' will contain the tags that were added or removed as
a list of strings of the form \"+TAG\" or \"-TAG\".
'query' will be a string containing the search query that determines
the messages that were tagged"
:type 'hook
:options '(notmuch-hl-line-mode)
:group 'notmuch-hooks)
(defvar notmuch-select-tag-history nil
"Variable to store minibuffer history for
`notmuch-select-tag-with-completion' function.")
(defvar notmuch-read-tag-changes-history nil
"Variable to store minibuffer history for
`notmuch-read-tag-changes' function.")
(defun notmuch-tag-completions (&optional search-terms)
(if (null search-terms)
(setq search-terms (list "*")))
(split-string
(with-output-to-string
(with-current-buffer standard-output
(apply '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 (notmuch-tag-completions search-terms)))
(completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)
(let* ((all-tag-list (notmuch-tag-completions))
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
(remove-tag-list (mapcar (apply-partially 'concat "-")
(if (null search-terms)
all-tag-list
(notmuch-tag-completions search-terms))))
(tag-list (append add-tag-list remove-tag-list))
(crm-separator " ")
;; By default, space is bound to "complete word" function.
;; Re-bind it to insert a space instead. Note that <tab>
;; still does the completion.
(crm-local-completion-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map crm-local-completion-map)
(define-key map " " 'self-insert-command)
map)))
(delete "" (completing-read-multiple "Tags (+add -drop): "
tag-list nil nil initial-input
'notmuch-read-tag-changes-history))))
(defun notmuch-update-tags (tags tag-changes)
"Return a copy of TAGS with additions and removals from TAG-CHANGES.
TAG-CHANGES must be a list of tags names, each prefixed with
either a \"+\" to indicate the tag should be added to TAGS if not
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 (string-to-char tag-change))
(tag (unless (string= tag-change "") (substring tag-change 1))))
(case op
(?+ (unless (member tag result-tags)
(push tag result-tags)))
(?- (setq result-tags (delete tag result-tags)))
(otherwise
(error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
(sort result-tags 'string<)))
(defun notmuch-tag (query &optional 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.
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 tag-changes query))
(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)
;;
(provide 'notmuch-tag)
|
