Mercurial > emacs
annotate lisp/emacs-lisp/crm.el @ 66153:e2fa815b43c1
(Quitting): Minor clarification.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 17 Oct 2005 16:19:56 +0000 |
parents | 5b1a238fcbb4 |
children | e17240315b4a 2d92f5c9d6ae |
rev | line source |
---|---|
28710 | 1 ;;; crm.el --- read multiple strings with completion |
2 | |
64751
5b1a238fcbb4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, |
5b1a238fcbb4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
4 ;; 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
28710 | 5 |
6 ;; Author: Sen Nagata <sen@eccosys.com> | |
7 ;; Keywords: completion, minibuffer, multiple elements | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
28710 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; This code defines a function, `completing-read-multiple', which | |
29 ;; provides the ability to read multiple strings in the minibuffer, | |
30 ;; with completion. | |
31 | |
32 ;; By using this functionality, a user may specify multiple strings at | |
33 ;; a single prompt, optionally using completion. | |
34 | |
35 ;; Multiple strings are specified by separating each of the strings | |
36 ;; with a prespecified separator character. For example, if the | |
37 ;; separator character is a comma, the strings 'alice', 'bob', and | |
38 ;; 'eve' would be specified as 'alice,bob,eve'. | |
39 | |
40 ;; The default value for the separator character is the value of | |
41 ;; `crm-default-separator' (comma). The separator character may be | |
42 ;; changed by modifying the value of `crm-separator'. | |
43 | |
41694
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
44 ;; Contiguous strings of non-separator-characters are referred to as |
28710 | 45 ;; 'elements'. In the aforementioned example, the elements are: |
46 ;; 'alice', 'bob', and 'eve'. | |
47 | |
48 ;; Completion is available on a per-element basis. For example, if | |
49 ;; the contents of the minibuffer are 'alice,bob,eve' and point is | |
50 ;; between 'l' and 'i', pressing TAB operates on the element 'alice'. | |
51 | |
52 ;; For the moment, I have decided to not bind any special behavior to | |
53 ;; the separator key. In the future, the separator key might be used | |
54 ;; to provide completion in certain circumstances. One of the reasons | |
55 ;; why this functionality is not yet provided is that it is unclear to | |
56 ;; the author what the precise circumstances are, under which | |
57 ;; separator-invoked completion should be provided. | |
58 | |
59 ;; Design note: `completing-read-multiple' is modeled after | |
60 ;; `completing-read'. They should be similar -- it was intentional. | |
61 | |
62 ;; Some of this code started out as translation from C code in | |
63 ;; src/minibuf.c to Emacs Lisp code. | |
64 | |
65 ;; Thanks to Richard Stallman for all of his help (many of the good | |
66 ;; ideas in here are from him), Gerd Moellmann for his attention, | |
67 ;; Stefan Monnier for responding with a code sample and comments very | |
68 ;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback. | |
69 | |
70 ;;; Questions and Thoughts: | |
71 | |
72 ;; -the author has gone through a number of test-and-fix cycles w/ | |
73 ;; this code, so it should be usable. please let me know if you find | |
74 ;; any problems. | |
75 | |
76 ;; -should `completing-read-multiple' allow a trailing separator in | |
77 ;; a return value when REQUIRE-MATCH is t? if not, should beep when a user | |
78 ;; tries to exit the minibuffer via RET? | |
79 | |
80 ;; -TODO: possibly make return values from `crm-do-completion' into constants | |
81 | |
82 ;; -TODO: find out whether there is an appropriate way to distinguish between | |
83 ;; functions intended for internal use and those that aren't. | |
84 | |
85 ;; -tip: use M-f and M-b for ease of navigation among elements. | |
86 | |
87 ;;; History: | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
88 ;; |
28710 | 89 ;; 2000-04-10: |
90 ;; | |
91 ;; first revamped version | |
92 | |
93 ;;; Code: | |
94 (defconst crm-default-separator "," | |
95 "Default separator for `completing-read-multiple'.") | |
96 | |
97 (defvar crm-separator crm-default-separator | |
98 "Separator used for separating strings in `completing-read-multiple'. | |
99 It should be a single character string that doesn't appear in the list of | |
100 completion candidates. Modify this value to make `completing-read-multiple' | |
101 use a separator other than `crm-default-separator'.") | |
102 | |
103 ;; actual filling in of these maps occurs below via `crm-init-keymaps' | |
104 (defvar crm-local-completion-map nil | |
105 "Local keymap for minibuffer multiple input with completion. | |
106 Analog of `minibuffer-local-completion-map'.") | |
107 | |
108 (defvar crm-local-must-match-map nil | |
109 "Local keymap for minibuffer multiple input with exact match completion. | |
110 Analog of `minibuffer-local-must-match-map' for crm.") | |
111 | |
28741
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
112 (defvar crm-completion-table nil |
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
113 "An alist whose elements' cars are strings, or an obarray. |
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
114 This is a table used for completion by `completing-read-multiple' and its |
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
115 supporting functions.") |
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
116 |
28710 | 117 ;; this is supposed to be analogous to last_exact_completion in src/minibuf.c |
118 (defvar crm-last-exact-completion nil | |
119 "Completion string if last attempt reported \"Complete, but not unique\".") | |
120 | |
121 (defvar crm-left-of-element nil | |
122 "String to the left of the current element.") | |
123 | |
124 (defvar crm-current-element nil | |
125 "The current element.") | |
126 | |
127 (defvar crm-right-of-element nil | |
128 "String to the right of the current element.") | |
129 | |
130 (defvar crm-beginning-of-element nil | |
131 "Buffer position representing the beginning of the current element.") | |
132 | |
133 (defvar crm-end-of-element nil | |
134 "Buffer position representing the end of the current element.") | |
135 | |
136 ;; emulates temp_echo_area_glyphs from src/minibuf.c | |
137 (defun crm-temp-echo-area-glyphs (message-string) | |
138 "Temporarily display MESSAGE-STRING in echo area. | |
139 After user-input or 2 seconds, erase the displayed string." | |
140 (save-excursion | |
141 (goto-char (point-max)) | |
142 (insert message-string) | |
143 (sit-for 2) | |
144 (backward-char (length message-string)) | |
145 (delete-char (length message-string)))) | |
146 | |
147 ;; this function evolved from a posting by Stefan Monnier | |
148 (defun crm-collection-fn (string predicate flag) | |
149 "Function used by `completing-read-multiple' to compute completion values. | |
150 The value of STRING is the string to be completed. | |
151 | |
152 The value of PREDICATE is a function to filter possible matches, or | |
153 nil if none. | |
154 | |
155 The value of FLAG is used to specify the type of completion operation. | |
156 A value of nil specifies `try-completion'. A value of t specifies | |
157 `all-completions'. A value of lambda specifes a test for an exact match. | |
158 | |
159 For more information on STRING, PREDICATE, and FLAG, see the Elisp | |
160 Reference sections on 'Programmed Completion' and 'Basic Completion | |
161 Functions'." | |
162 (let ((lead "")) | |
163 (when (string-match (concat ".*" crm-separator) string) | |
164 (setq lead (substring string 0 (match-end 0))) | |
165 (setq string (substring string (match-end 0)))) | |
166 (if (eq flag 'lambda) | |
167 ;; return t for exact match, nil otherwise | |
28741
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
168 (let ((result (try-completion string crm-completion-table predicate))) |
28710 | 169 (if (stringp result) |
170 nil | |
171 (if result | |
172 t | |
173 nil)))) | |
174 (if flag | |
175 ;; called via (all-completions string 'crm-completion-fn predicate)? | |
28741
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
176 (all-completions string crm-completion-table predicate) |
28710 | 177 ;; called via (try-completion string 'crm-completion-fn predicate)? |
28741
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
178 (let ((result (try-completion string crm-completion-table predicate))) |
28710 | 179 (if (stringp result) |
180 (concat lead result) | |
181 result))))) | |
182 | |
183 (defun crm-find-current-element () | |
184 "Parse the minibuffer to find the current element. | |
185 If no element can be found, return nil. | |
186 | |
187 If an element is found, bind: | |
188 | |
189 -the variable `crm-current-element' to the current element, | |
190 | |
191 -the variables `crm-left-of-element' and `crm-right-of-element' to | |
192 the strings to the left and right of the current element, | |
193 respectively, and | |
194 | |
195 -the variables `crm-beginning-of-element' and `crm-end-of-element' to | |
196 the buffer positions of the beginning and end of the current element | |
197 respectively, | |
198 | |
199 and return t." | |
63894
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
200 (let* ((prompt-end (minibuffer-prompt-end)) |
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
201 (minibuffer-string (buffer-substring prompt-end (point-max))) |
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
202 (end-index (or (string-match "," minibuffer-string (- (point) prompt-end)) |
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
203 (- (point-max) prompt-end))) |
28710 | 204 (target-string (substring minibuffer-string 0 end-index)) |
205 (index (or (string-match | |
206 (concat crm-separator "\\([^" crm-separator "]*\\)$") | |
207 target-string) | |
208 (string-match | |
209 (concat "^\\([^" crm-separator "]*\\)$") | |
210 target-string)))) | |
211 (if (not (numberp index)) | |
212 ;; no candidate found | |
213 nil | |
214 (progn | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
215 ;; |
28710 | 216 (setq crm-beginning-of-element (match-beginning 1)) |
63985 | 217 (setq crm-end-of-element (+ end-index prompt-end)) |
28710 | 218 ;; string to the left of the current element |
63894
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
219 (setq crm-left-of-element |
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
220 (substring target-string 0 (match-beginning 1))) |
28710 | 221 ;; the current element |
222 (setq crm-current-element (match-string 1 target-string)) | |
223 ;; string to the right of the current element | |
224 (setq crm-right-of-element (substring minibuffer-string end-index)) | |
225 t)))) | |
226 | |
227 (defun crm-test-completion (candidate) | |
228 "Return t if CANDIDATE is an exact match for a valid completion." | |
229 (let ((completions | |
230 ;; TODO: verify whether the arguments are appropriate | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
231 (all-completions |
28741
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
232 candidate crm-completion-table minibuffer-completion-predicate))) |
28710 | 233 (if (member candidate completions) |
234 t | |
235 nil))) | |
236 | |
237 (defun crm-minibuffer-completion-help () | |
238 "Display a list of possible completions of the current minibuffer element." | |
239 (interactive) | |
240 (message "Making completion list...") | |
241 (if (not (crm-find-current-element)) | |
242 nil | |
243 (let ((completions (all-completions crm-current-element | |
244 minibuffer-completion-table | |
245 minibuffer-completion-predicate))) | |
246 (message nil) | |
247 (if (null completions) | |
248 (crm-temp-echo-area-glyphs " [No completions]") | |
249 (with-output-to-temp-buffer "*Completions*" | |
250 (display-completion-list (sort completions 'string-lessp)))))) | |
251 nil) | |
252 | |
253 (defun crm-do-completion () | |
254 "This is the internal completion engine. | |
255 This function updates the text in the minibuffer | |
256 to complete the current string, and returns a number between 0 and 6. | |
257 The meanings of the return values are: | |
258 | |
259 0 - the string has no possible completion | |
260 1 - the string is already a valid and unique match | |
261 2 - not used | |
262 3 - the string is already a valid match (but longer matches exist too) | |
263 4 - the string was completed to a valid match | |
264 5 - some completion has been done, but the result is not a match | |
265 6 - no completion was done, and the string is not an exact match" | |
266 | |
267 (if (not (crm-find-current-element)) | |
268 nil | |
269 (let (last completion completedp) | |
270 (setq completion | |
271 (try-completion crm-current-element | |
272 minibuffer-completion-table | |
273 minibuffer-completion-predicate)) | |
274 (setq last crm-last-exact-completion) | |
275 (setq crm-last-exact-completion nil) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
276 |
28710 | 277 (catch 'crm-exit |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
278 |
28710 | 279 (if (null completion) ; no possible completion |
280 (progn | |
281 (crm-temp-echo-area-glyphs " [No match]") | |
282 (throw 'crm-exit 0))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
283 |
28710 | 284 (if (eq completion t) ; was already an exact and unique completion |
285 (throw 'crm-exit 1)) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
286 |
28710 | 287 (setq completedp |
288 (null (string-equal completion crm-current-element))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
289 |
28710 | 290 (if completedp |
291 (progn | |
63894
e2eed2c9a354
(crm-do-completion): Handle minibuffer prompt.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
292 (delete-region (minibuffer-prompt-end) (point-max)) |
28710 | 293 (insert crm-left-of-element completion) |
294 ;; (if crm-complete-up-to-point | |
295 ;; (insert crm-separator)) | |
296 (insert crm-right-of-element) | |
297 (backward-char (length crm-right-of-element)) | |
298 ;; TODO: is this correct? | |
299 (setq crm-current-element completion))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
300 |
28710 | 301 (if (null (crm-test-completion crm-current-element)) |
302 (progn | |
303 (if completedp ; some completion happened | |
304 (throw 'crm-exit 5) | |
305 (if completion-auto-help | |
306 (crm-minibuffer-completion-help) | |
307 (crm-temp-echo-area-glyphs " [Next char not unique]"))) | |
308 (throw 'crm-exit 6)) | |
309 (if completedp | |
310 (throw 'crm-exit 4))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
311 |
28710 | 312 (setq crm-last-exact-completion completion) |
313 (if (not (null last)) | |
314 (progn | |
315 (if (not (null (equal crm-current-element last))) | |
316 (crm-minibuffer-completion-help)))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
317 |
28710 | 318 ;; returning -- was already an exact completion |
319 (throw 'crm-exit 3))))) | |
320 | |
321 (defun crm-minibuffer-complete () | |
322 "Complete the current element. | |
323 If no characters can be completed, display a list of possible completions. | |
324 | |
325 Return t if the current element is now a valid match; otherwise return nil." | |
326 (interactive) | |
327 ;; take care of scrolling if necessary -- completely cribbed from minibuf.c | |
328 (if (not (eq last-command this-command)) | |
329 ;; ok? | |
330 (setq minibuffer-scroll-window nil)) | |
331 (let ((window minibuffer-scroll-window)) | |
332 (if (and (not (null window)) | |
333 ;; ok? | |
334 (not (null (window-buffer window)))) | |
335 (let (tem) | |
336 (set-buffer (window-buffer window)) | |
337 ;; ok? | |
338 (setq tem (pos-visible-in-window-p (point-max) window)) | |
339 (if (not (null tem)) | |
340 ;; ok? | |
341 (set-window-start window (point-min) nil) | |
342 (scroll-other-window nil)) | |
343 ;; reaching here means exiting the function w/ return value of nil | |
344 nil) | |
345 | |
346 (let* ( | |
347 ;(crm-end-of-element nil) | |
348 (result (crm-do-completion))) | |
349 (cond | |
350 ((eq 0 result) | |
351 nil) | |
352 ((eq 1 result) | |
353 ;; adapted from Emacs 21 | |
354 (if (not (eq (point) crm-end-of-element)) | |
355 (goto-char (+ 1 crm-end-of-element))) | |
356 (crm-temp-echo-area-glyphs " [Sole completion]") | |
357 t) | |
358 ((eq 3 result) | |
359 ;; adapted from Emacs 21 | |
360 (if (not (eq (point) crm-end-of-element)) | |
361 (goto-char (+ 1 crm-end-of-element))) | |
362 (crm-temp-echo-area-glyphs " [Complete, but not unique]") | |
363 t)))))) | |
364 | |
365 ;; i love traffic lights...but only when they're green | |
366 (defun crm-find-longest-completable-substring (string) | |
367 "Determine the longest completable (left-anchored) substring of STRING. | |
368 The description \"left-anchored\" means the positions of the characters | |
369 in the substring must be the same as those of the corresponding characters | |
370 in STRING. Anchoring is what `^' does in a regular expression. | |
371 | |
372 The table and predicate used for completion are | |
373 `minibuffer-completion-table' and `minibuffer-completion-predicate', | |
374 respectively. | |
375 | |
376 A non-nil return value means that there is some substring which is | |
377 completable. A return value of t means that STRING itself is | |
378 completable. If a string value is returned it is the longest | |
379 completable proper substring of STRING. If nil is returned, STRING | |
380 does not have any non-empty completable substrings. | |
381 | |
382 Remember: \"left-anchored\" substring" | |
383 (let* ((length-of-string (length string)) | |
384 (index length-of-string) | |
385 (done (if (> length-of-string 0) | |
386 nil | |
387 t)) | |
388 (first t) ; ugh, special handling for first time through... | |
389 goal-string | |
390 result) | |
391 ;; loop through left-anchored substrings in order of descending length, | |
392 ;; find the first substring that is completable | |
393 (while (not done) | |
394 (setq result (try-completion (substring string 0 index) | |
395 minibuffer-completion-table | |
396 minibuffer-completion-predicate)) | |
397 (if result | |
398 ;; found completable substring | |
399 (progn | |
400 (setq done t) | |
401 (if (and (eq result t) first) | |
402 ;; exactly matching string first time through | |
403 (setq goal-string t) | |
404 ;; fully-completed proper substring | |
405 (setq goal-string (substring string 0 index))))) | |
406 (setq index (1- index)) | |
407 (if first | |
408 (setq first nil)) | |
409 (if (<= index 0) | |
410 (setq done t))) | |
411 ;; possible values include: t, nil, some string | |
412 goal-string)) | |
413 | |
414 ;; TODO: decide whether trailing separator is allowed. current | |
415 ;; implementation appears to allow it | |
416 (defun crm-strings-completed-p (separated-string) | |
417 "Verify that strings in SEPARATED-STRING are completed strings. | |
418 A return value of t means that all strings were verified. A number is | |
419 returned if verification was unsuccessful. This number represents the | |
420 position in SEPARATED-STRING up to where completion was successful." | |
421 (let ((strings (split-string separated-string crm-separator)) | |
422 ;; buffers start at 1, not 0 | |
423 (current-position 1) | |
424 current-string | |
425 result | |
426 done) | |
427 (while (and strings (not done)) | |
428 (setq current-string (car strings) | |
429 result (try-completion current-string | |
430 minibuffer-completion-table | |
431 minibuffer-completion-predicate)) | |
432 (if (eq result t) | |
433 (setq strings (cdr strings) | |
434 current-position (+ current-position | |
435 (length current-string) | |
436 ;; automatically adding 1 for separator | |
437 ;; character | |
438 1)) | |
439 ;; still one more case of a match | |
440 (if (stringp result) | |
441 (let ((string-list | |
442 (all-completions result | |
443 minibuffer-completion-table | |
444 minibuffer-completion-predicate))) | |
445 (if (member result string-list) | |
446 ;; ho ho, code duplication... | |
447 (setq strings (cdr strings) | |
448 current-position (+ current-position | |
449 (length current-string) | |
450 1)) | |
451 (progn | |
452 (setq done t) | |
453 ;; current-string is a partially-completed string | |
454 (setq current-position (+ current-position | |
455 (length current-string)))))) | |
456 ;; current-string cannot be completed | |
457 (let ((completable-substring | |
458 (crm-find-longest-completable-substring current-string))) | |
459 (setq done t) | |
460 (setq current-position (+ current-position | |
461 (length completable-substring))))))) | |
462 ;; return our result | |
463 (if (null strings) | |
464 t | |
465 current-position))) | |
466 | |
467 ;; try to complete candidate, then check all separated strings. move | |
468 ;; point to problem position if checking fails for some string. if | |
469 ;; checking succeeds for all strings, exit. | |
470 (defun crm-minibuffer-complete-and-exit () | |
471 "If all of the minibuffer elements are valid completions then exit. | |
472 All elements in the minibuffer must match. If there is a mismatch, move point | |
473 to the location of mismatch and do not exit. | |
474 | |
475 This function is modeled after `minibuffer_complete_and_exit' in src/minibuf.c" | |
476 (interactive) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
477 |
28710 | 478 (if (not (crm-find-current-element)) |
479 nil | |
480 (let (result) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
481 |
28710 | 482 (setq result |
483 (catch 'crm-exit | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
484 |
63985 | 485 (if (eq (minibuffer-prompt-end) (point-max)) |
28710 | 486 (throw 'crm-exit t)) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
487 |
28710 | 488 ;; TODO: this test is suspect? |
489 (if (not (null (crm-test-completion crm-current-element))) | |
490 (throw 'crm-exit "check")) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
491 |
28710 | 492 ;; TODO: determine how to detect errors |
493 (let ((result (crm-do-completion))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
494 |
28710 | 495 (cond |
496 ((or (eq 1 result) | |
497 (eq 3 result)) | |
498 (throw 'crm-exit "check")) | |
499 ((eq 4 result) | |
500 (if (not (null minibuffer-completion-confirm)) | |
501 (progn | |
502 (crm-temp-echo-area-glyphs " [Confirm]") | |
503 nil) | |
504 (throw 'crm-exit "check"))) | |
505 (nil))))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
506 |
28710 | 507 (if (null result) |
508 nil | |
509 (if (equal result "check") | |
510 (let ((check-strings | |
63985 | 511 (crm-strings-completed-p |
512 (buffer-substring (minibuffer-prompt-end) (point-max))))) | |
28710 | 513 ;; check all of minibuffer |
514 (if (eq check-strings t) | |
515 (throw 'exit nil) | |
516 (if (numberp check-strings) | |
517 (progn | |
518 (goto-char check-strings) | |
519 (crm-temp-echo-area-glyphs " [An element did not match]")) | |
520 (message "Unexpected error")))) | |
521 (if (eq result t) | |
522 (throw 'exit nil) | |
523 (message "Unexpected error"))))))) | |
524 | |
525 (defun crm-init-keymaps () | |
526 "Initialize the keymaps used by `completing-read-multiple'. | |
527 Two keymaps are used depending on the value of the REQUIRE-MATCH | |
528 argument of the function `completing-read-multiple'. | |
529 | |
530 If REQUIRE-MATCH is nil, the keymap `crm-local-completion-map' is used. | |
531 This keymap inherits from the keymap named `minibuffer-local-completion-map'. | |
532 The only difference is that TAB is bound to `crm-minibuffer-complete' in | |
533 the inheriting keymap. | |
534 | |
41694
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
535 If REQUIRE-MATCH is non-nil, the keymap `crm-local-must-match-map' is used. |
28710 | 536 This keymap inherits from the keymap named `minibuffer-local-must-match-map'. |
537 The inheriting keymap binds RET to `crm-minibuffer-complete-and-exit' | |
538 and TAB to `crm-minibuffer-complete'." | |
539 (unless crm-local-completion-map | |
540 (setq crm-local-completion-map (make-sparse-keymap)) | |
541 (set-keymap-parent crm-local-completion-map | |
542 minibuffer-local-completion-map) | |
543 ;; key definitions | |
544 (define-key crm-local-completion-map | |
545 (kbd "TAB") | |
546 (function crm-minibuffer-complete))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
41694
diff
changeset
|
547 |
28710 | 548 (unless crm-local-must-match-map |
549 (setq crm-local-must-match-map (make-sparse-keymap)) | |
550 (set-keymap-parent crm-local-must-match-map | |
551 minibuffer-local-must-match-map) | |
552 ;; key definitions | |
553 (define-key crm-local-must-match-map | |
554 (kbd "RET") | |
555 (function crm-minibuffer-complete-and-exit)) | |
556 (define-key crm-local-must-match-map | |
557 (kbd "TAB") | |
558 (function crm-minibuffer-complete)))) | |
559 | |
560 (crm-init-keymaps) | |
561 | |
562 ;; superemulates behavior of completing_read in src/minibuf.c | |
563 ;;;###autoload | |
564 (defun completing-read-multiple | |
565 (prompt table &optional predicate require-match initial-input | |
566 hist def inherit-input-method) | |
567 "Read multiple strings in the minibuffer, with completion. | |
568 By using this functionality, a user may specify multiple strings at a | |
569 single prompt, optionally using completion. | |
570 | |
571 Multiple strings are specified by separating each of the strings with | |
572 a prespecified separator character. For example, if the separator | |
573 character is a comma, the strings 'alice', 'bob', and 'eve' would be | |
574 specified as 'alice,bob,eve'. | |
575 | |
576 The default value for the separator character is the value of | |
577 `crm-default-separator' (comma). The separator character may be | |
578 changed by modifying the value of `crm-separator'. | |
579 | |
41694
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
580 Contiguous strings of non-separator-characters are referred to as |
28710 | 581 'elements'. In the aforementioned example, the elements are: 'alice', |
582 'bob', and 'eve'. | |
583 | |
584 Completion is available on a per-element basis. For example, if the | |
585 contents of the minibuffer are 'alice,bob,eve' and point is between | |
586 'l' and 'i', pressing TAB operates on the element 'alice'. | |
587 | |
588 The return value of this function is a list of the read strings. | |
589 | |
590 See the documentation for `completing-read' for details on the arguments: | |
591 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and | |
592 INHERIT-INPUT-METHOD." | |
593 (let ((minibuffer-completion-table (function crm-collection-fn)) | |
594 (minibuffer-completion-predicate predicate) | |
595 ;; see completing_read in src/minibuf.c | |
41694
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
596 (minibuffer-completion-confirm |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
597 (unless (eq require-match t) require-match)) |
28741
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
598 (crm-completion-table table) |
28710 | 599 crm-last-exact-completion |
600 crm-current-element | |
601 crm-left-of-element | |
602 crm-right-of-element | |
603 crm-beginning-of-element | |
604 crm-end-of-element | |
41694
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
605 (map (if require-match |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
606 crm-local-must-match-map |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
607 crm-local-completion-map))) |
28710 | 608 (split-string (read-from-minibuffer |
609 prompt initial-input map | |
610 nil hist def inherit-input-method) | |
611 crm-separator))) | |
612 | |
613 ;; testing and debugging | |
41694
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
614 ;; (defun crm-init-test-environ () |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
615 ;; "Set up some variables for testing." |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
616 ;; (interactive) |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
617 ;; (setq my-prompt "Prompt: ") |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
618 ;; (setq my-table |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
619 ;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma") |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
620 ;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb") |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
621 ;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb") |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
622 ;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb") |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
623 ;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb") |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
624 ;; )) |
835717f56bf2
(completing-read-multiple): Better preserve
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28741
diff
changeset
|
625 ;; (setq my-separator ",")) |
28710 | 626 |
627 ;(completing-read-multiple my-prompt my-table) | |
628 ;(completing-read-multiple my-prompt my-table nil t) | |
629 ;(completing-read-multiple my-prompt my-table nil "match") | |
630 ;(completing-read my-prompt my-table nil t) | |
631 ;(completing-read my-prompt my-table nil "match") | |
632 | |
633 (provide 'crm) | |
634 | |
52401 | 635 ;;; arch-tag: db1911d9-86c6-4a42-b32a-4910701b15a6 |
28710 | 636 ;;; crm.el ends here |