Commit | Line | Data |
---|---|---|
612839b6 GM |
1 | ;;; crm.el --- read multiple strings with completion |
2 | ||
ba318903 | 3 | ;; Copyright (C) 1985-1986, 1993-2014 Free Software Foundation, Inc. |
612839b6 GM |
4 | |
5 | ;; Author: Sen Nagata <sen@eccosys.com> | |
6 | ;; Keywords: completion, minibuffer, multiple elements | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
d6cba7ae | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
612839b6 | 11 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
612839b6 GM |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
d6cba7ae | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
612839b6 GM |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This code defines a function, `completing-read-multiple', which | |
26 | ;; provides the ability to read multiple strings in the minibuffer, | |
27 | ;; with completion. | |
28 | ||
29 | ;; By using this functionality, a user may specify multiple strings at | |
30 | ;; a single prompt, optionally using completion. | |
31 | ||
32 | ;; Multiple strings are specified by separating each of the strings | |
b14abca9 RW |
33 | ;; with a prespecified separator regexp. For example, if the |
34 | ;; separator regexp is ",", the strings 'alice', 'bob', and | |
612839b6 GM |
35 | ;; 'eve' would be specified as 'alice,bob,eve'. |
36 | ||
b14abca9 RW |
37 | ;; The default value for the separator regexp is the value of |
38 | ;; `crm-default-separator' (comma). The separator regexp may be | |
612839b6 GM |
39 | ;; changed by modifying the value of `crm-separator'. |
40 | ||
d006d957 | 41 | ;; Contiguous strings of non-separator-characters are referred to as |
612839b6 GM |
42 | ;; 'elements'. In the aforementioned example, the elements are: |
43 | ;; 'alice', 'bob', and 'eve'. | |
44 | ||
45 | ;; Completion is available on a per-element basis. For example, if | |
46 | ;; the contents of the minibuffer are 'alice,bob,eve' and point is | |
47 | ;; between 'l' and 'i', pressing TAB operates on the element 'alice'. | |
48 | ||
49 | ;; For the moment, I have decided to not bind any special behavior to | |
50 | ;; the separator key. In the future, the separator key might be used | |
51 | ;; to provide completion in certain circumstances. One of the reasons | |
52 | ;; why this functionality is not yet provided is that it is unclear to | |
53 | ;; the author what the precise circumstances are, under which | |
54 | ;; separator-invoked completion should be provided. | |
55 | ||
56 | ;; Design note: `completing-read-multiple' is modeled after | |
57 | ;; `completing-read'. They should be similar -- it was intentional. | |
58 | ||
59 | ;; Some of this code started out as translation from C code in | |
66787d51 SM |
60 | ;; src/minibuf.c to Emacs Lisp code. After this code was rewritten in Elisp |
61 | ;; and made to operate on any field, this file was completely rewritten to | |
62 | ;; just reuse that code. | |
63 | ||
64 | ;; Thanks to Sen Nagata <sen@eccosys.com> for the original version of the | |
65 | ;; code, and sorry for throwing it all out. --Stef | |
612839b6 GM |
66 | |
67 | ;; Thanks to Richard Stallman for all of his help (many of the good | |
68 | ;; ideas in here are from him), Gerd Moellmann for his attention, | |
69 | ;; Stefan Monnier for responding with a code sample and comments very | |
70 | ;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback. | |
71 | ||
72 | ;;; Questions and Thoughts: | |
73 | ||
612839b6 GM |
74 | ;; -should `completing-read-multiple' allow a trailing separator in |
75 | ;; a return value when REQUIRE-MATCH is t? if not, should beep when a user | |
76 | ;; tries to exit the minibuffer via RET? | |
77 | ||
612839b6 GM |
78 | ;; -tip: use M-f and M-b for ease of navigation among elements. |
79 | ||
66787d51 SM |
80 | ;; - the difference between minibuffer-completion-table and |
81 | ;; crm-completion-table is just crm--collection-fn. In most cases it | |
82 | ;; shouldn't make any difference. But if a non-CRM completion function | |
83 | ;; happens to be used, it will use minibuffer-completion-table and | |
84 | ;; crm--collection-fn will try to make it do "more or less the right | |
85 | ;; thing" by making it complete on the last element, which is about as | |
86 | ;; good as we can hope for right now. | |
87 | ;; I'm not sure if it's important or not. Maybe we could just throw away | |
88 | ;; crm-completion-table and crm--collection-fn, but there doesn't seem to | |
89 | ;; be a pressing need for it, and since Sen did bother to write it, we may | |
90 | ;; as well keep it, in case it helps. | |
91 | ||
612839b6 | 92 | ;;; History: |
a1506d29 | 93 | ;; |
612839b6 GM |
94 | ;; 2000-04-10: |
95 | ;; | |
96 | ;; first revamped version | |
97 | ||
98 | ;;; Code: | |
b14abca9 RW |
99 | (defconst crm-default-separator "[ \t]*,[ \t]*" |
100 | "Default separator regexp for `completing-read-multiple'.") | |
612839b6 GM |
101 | |
102 | (defvar crm-separator crm-default-separator | |
b14abca9 RW |
103 | "Separator regexp used for separating strings in `completing-read-multiple'. |
104 | It should be a regexp that does not match the list of completion candidates. | |
105 | Modify this value to make `completing-read-multiple' use a separator other | |
106 | than `crm-default-separator'.") | |
612839b6 | 107 | |
66787d51 SM |
108 | (defvar crm-local-completion-map |
109 | (let ((map (make-sparse-keymap))) | |
110 | (set-keymap-parent map minibuffer-local-completion-map) | |
111 | (define-key map [remap minibuffer-complete] #'crm-complete) | |
112 | (define-key map [remap minibuffer-complete-word] #'crm-complete-word) | |
113 | (define-key map [remap minibuffer-completion-help] #'crm-completion-help) | |
114 | map) | |
612839b6 GM |
115 | "Local keymap for minibuffer multiple input with completion. |
116 | Analog of `minibuffer-local-completion-map'.") | |
117 | ||
66787d51 SM |
118 | (defvar crm-local-must-match-map |
119 | (let ((map (make-sparse-keymap))) | |
120 | ;; We'd want to have multiple inheritance here. | |
121 | (set-keymap-parent map minibuffer-local-must-match-map) | |
122 | (define-key map [remap minibuffer-complete] #'crm-complete) | |
123 | (define-key map [remap minibuffer-complete-word] #'crm-complete-word) | |
124 | (define-key map [remap minibuffer-completion-help] #'crm-completion-help) | |
125 | (define-key map [remap minibuffer-complete-and-exit] | |
126 | #'crm-complete-and-exit) | |
127 | map) | |
612839b6 GM |
128 | "Local keymap for minibuffer multiple input with exact match completion. |
129 | Analog of `minibuffer-local-must-match-map' for crm.") | |
130 | ||
ec266158 GM |
131 | (defvar crm-completion-table nil |
132 | "An alist whose elements' cars are strings, or an obarray. | |
133 | This is a table used for completion by `completing-read-multiple' and its | |
134 | supporting functions.") | |
135 | ||
612839b6 | 136 | ;; this function evolved from a posting by Stefan Monnier |
66787d51 | 137 | (defun crm--collection-fn (string predicate flag) |
612839b6 GM |
138 | "Function used by `completing-read-multiple' to compute completion values. |
139 | The value of STRING is the string to be completed. | |
140 | ||
141 | The value of PREDICATE is a function to filter possible matches, or | |
142 | nil if none. | |
143 | ||
144 | The value of FLAG is used to specify the type of completion operation. | |
145 | A value of nil specifies `try-completion'. A value of t specifies | |
22bcf204 | 146 | `all-completions'. A value of lambda specifies a test for an exact match. |
612839b6 GM |
147 | |
148 | For more information on STRING, PREDICATE, and FLAG, see the Elisp | |
149 | Reference sections on 'Programmed Completion' and 'Basic Completion | |
150 | Functions'." | |
66787d51 SM |
151 | (let ((beg 0)) |
152 | (while (string-match crm-separator string beg) | |
153 | (setq beg (match-end 0))) | |
154 | (completion-table-with-context (substring string 0 beg) | |
155 | crm-completion-table | |
156 | (substring string beg) | |
157 | predicate | |
158 | flag))) | |
159 | ||
67982e2b | 160 | (defun crm--current-element () |
612839b6 | 161 | "Parse the minibuffer to find the current element. |
67982e2b SM |
162 | Return the element's boundaries as (START . END)." |
163 | (let ((bob (minibuffer-prompt-end))) | |
164 | (cons (save-excursion | |
66787d51 SM |
165 | (if (re-search-backward crm-separator bob t) |
166 | (match-end 0) | |
67982e2b SM |
167 | bob)) |
168 | (save-excursion | |
66787d51 SM |
169 | (if (re-search-forward crm-separator nil t) |
170 | (match-beginning 0) | |
67982e2b SM |
171 | (point-max)))))) |
172 | ||
173 | (defmacro crm--completion-command (beg end &rest body) | |
174 | "Run BODY with BEG and END bound to the current element's boundaries." | |
175 | (declare (indent 2) (debug (sexp sexp &rest body))) | |
176 | `(let* ((crm--boundaries (crm--current-element)) | |
177 | (,beg (car crm--boundaries)) | |
178 | (,end (cdr crm--boundaries))) | |
179 | ,@body)) | |
b14abca9 | 180 | |
66787d51 | 181 | (defun crm-completion-help () |
612839b6 GM |
182 | "Display a list of possible completions of the current minibuffer element." |
183 | (interactive) | |
67982e2b SM |
184 | (crm--completion-command beg end |
185 | (minibuffer-completion-help beg end)) | |
612839b6 GM |
186 | nil) |
187 | ||
66787d51 | 188 | (defun crm-complete () |
612839b6 GM |
189 | "Complete the current element. |
190 | If no characters can be completed, display a list of possible completions. | |
191 | ||
192 | Return t if the current element is now a valid match; otherwise return nil." | |
193 | (interactive) | |
67982e2b SM |
194 | (crm--completion-command beg end |
195 | (completion-in-region beg end | |
196 | minibuffer-completion-table | |
197 | minibuffer-completion-predicate))) | |
66787d51 SM |
198 | |
199 | (defun crm-complete-word () | |
200 | "Complete the current element at most a single word. | |
201 | Like `minibuffer-complete-word' but for `completing-read-multiple'." | |
202 | (interactive) | |
67982e2b SM |
203 | (crm--completion-command beg end |
204 | (completion-in-region--single-word | |
205 | beg end minibuffer-completion-table minibuffer-completion-predicate))) | |
66787d51 SM |
206 | |
207 | (defun crm-complete-and-exit () | |
612839b6 GM |
208 | "If all of the minibuffer elements are valid completions then exit. |
209 | All elements in the minibuffer must match. If there is a mismatch, move point | |
210 | to the location of mismatch and do not exit. | |
211 | ||
66787d51 | 212 | This function is modeled after `minibuffer-complete-and-exit'." |
612839b6 | 213 | (interactive) |
66787d51 SM |
214 | (let ((doexit t)) |
215 | (goto-char (minibuffer-prompt-end)) | |
216 | (while | |
217 | (and doexit | |
67982e2b SM |
218 | (crm--completion-command beg end |
219 | (let ((end (copy-marker end t))) | |
220 | (goto-char end) | |
221 | (setq doexit nil) | |
222 | (completion-complete-and-exit beg end | |
223 | (lambda () (setq doexit t))) | |
224 | (goto-char end) | |
225 | (not (eobp)))) | |
b14abca9 | 226 | (looking-at crm-separator)) |
66787d51 | 227 | ;; Skip to the next element. |
b14abca9 | 228 | (goto-char (match-end 0))) |
66787d51 | 229 | (if doexit (exit-minibuffer)))) |
612839b6 | 230 | |
d5e63715 SM |
231 | (defun crm--choose-completion-string (choice buffer base-position |
232 | &rest ignored) | |
abb3c752 CY |
233 | "Completion string chooser for `completing-read-multiple'. |
234 | This is called from `choose-completion-string-functions'. | |
235 | It replaces the string that is currently being completed, without | |
236 | exiting the minibuffer." | |
d5e63715 SM |
237 | (let ((completion-no-auto-exit t) |
238 | (choose-completion-string-functions nil)) | |
239 | (choose-completion-string choice buffer base-position) | |
240 | t)) | |
abb3c752 | 241 | |
612839b6 GM |
242 | ;; superemulates behavior of completing_read in src/minibuf.c |
243 | ;;;###autoload | |
244 | (defun completing-read-multiple | |
245 | (prompt table &optional predicate require-match initial-input | |
246 | hist def inherit-input-method) | |
247 | "Read multiple strings in the minibuffer, with completion. | |
248 | By using this functionality, a user may specify multiple strings at a | |
249 | single prompt, optionally using completion. | |
250 | ||
251 | Multiple strings are specified by separating each of the strings with | |
b14abca9 RW |
252 | a prespecified separator regexp. For example, if the separator |
253 | regexp is \",\", the strings 'alice', 'bob', and 'eve' would be | |
612839b6 GM |
254 | specified as 'alice,bob,eve'. |
255 | ||
b14abca9 RW |
256 | The default value for the separator regexp is the value of |
257 | `crm-default-separator' (comma). The separator regexp may be | |
612839b6 GM |
258 | changed by modifying the value of `crm-separator'. |
259 | ||
d006d957 | 260 | Contiguous strings of non-separator-characters are referred to as |
612839b6 GM |
261 | 'elements'. In the aforementioned example, the elements are: 'alice', |
262 | 'bob', and 'eve'. | |
263 | ||
264 | Completion is available on a per-element basis. For example, if the | |
265 | contents of the minibuffer are 'alice,bob,eve' and point is between | |
266 | 'l' and 'i', pressing TAB operates on the element 'alice'. | |
267 | ||
a77e2924 RW |
268 | The return value of this function is a list of the read strings |
269 | with empty strings removed. | |
612839b6 GM |
270 | |
271 | See the documentation for `completing-read' for details on the arguments: | |
272 | PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and | |
273 | INHERIT-INPUT-METHOD." | |
abb3c752 CY |
274 | (unwind-protect |
275 | (progn | |
276 | (add-hook 'choose-completion-string-functions | |
277 | 'crm--choose-completion-string) | |
278 | (let* ((minibuffer-completion-table #'crm--collection-fn) | |
279 | (minibuffer-completion-predicate predicate) | |
280 | ;; see completing_read in src/minibuf.c | |
281 | (minibuffer-completion-confirm | |
282 | (unless (eq require-match t) require-match)) | |
283 | (crm-completion-table table) | |
284 | (map (if require-match | |
285 | crm-local-must-match-map | |
286 | crm-local-completion-map)) | |
b14abca9 RW |
287 | ;; If the user enters empty input, `read-from-minibuffer' |
288 | ;; returns the empty string, not DEF. | |
abb3c752 CY |
289 | (input (read-from-minibuffer |
290 | prompt initial-input map | |
291 | nil hist def inherit-input-method))) | |
292 | (and def (string-equal input "") (setq input def)) | |
a77e2924 | 293 | ;; Remove empty strings in the list of read strings. |
9c44569e | 294 | (split-string input crm-separator t))) |
abb3c752 CY |
295 | (remove-hook 'choose-completion-string-functions |
296 | 'crm--choose-completion-string))) | |
612839b6 | 297 | |
66787d51 SM |
298 | (define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1") |
299 | (define-obsolete-function-alias | |
300 | 'crm-minibuffer-completion-help 'crm-completion-help "23.1") | |
301 | (define-obsolete-function-alias | |
302 | 'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1") | |
303 | ||
612839b6 | 304 | ;; testing and debugging |
d006d957 SM |
305 | ;; (defun crm-init-test-environ () |
306 | ;; "Set up some variables for testing." | |
307 | ;; (interactive) | |
308 | ;; (setq my-prompt "Prompt: ") | |
309 | ;; (setq my-table | |
310 | ;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma") | |
311 | ;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb") | |
312 | ;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb") | |
313 | ;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb") | |
314 | ;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb") | |
315 | ;; )) | |
316 | ;; (setq my-separator ",")) | |
612839b6 GM |
317 | |
318 | ;(completing-read-multiple my-prompt my-table) | |
319 | ;(completing-read-multiple my-prompt my-table nil t) | |
320 | ;(completing-read-multiple my-prompt my-table nil "match") | |
321 | ;(completing-read my-prompt my-table nil t) | |
322 | ;(completing-read my-prompt my-table nil "match") | |
323 | ||
324 | (provide 'crm) | |
325 | ||
326 | ;;; crm.el ends here |