|
28710
|
1 ;;; crm.el --- read multiple strings with completion
|
|
|
2
|
|
|
3 ;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
|
|
|
4 ;; Free Software Foundation, Inc.
|
|
|
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
|
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
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
|
|
|
44 ;; Continguous strings of non-separator-characters are referred to as
|
|
|
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:
|
|
|
88 ;;
|
|
|
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
|
112 (defvar crm-completion-table nil
|
|
|
113 "An alist whose elements' cars are strings, or an obarray.
|
|
|
114 This is a table used for completion by `completing-read-multiple' and its
|
|
|
115 supporting functions.")
|
|
|
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
|
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
|
176 (all-completions string crm-completion-table predicate)
|
|
28710
|
177 ;; called via (try-completion string 'crm-completion-fn predicate)?
|
|
28741
|
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."
|
|
|
200 (let* ((minibuffer-string (buffer-string))
|
|
|
201 (end-index (or (string-match "," minibuffer-string (1- (point)))
|
|
|
202 (1- (point-max))))
|
|
|
203 (target-string (substring minibuffer-string 0 end-index))
|
|
|
204 (index (or (string-match
|
|
|
205 (concat crm-separator "\\([^" crm-separator "]*\\)$")
|
|
|
206 target-string)
|
|
|
207 (string-match
|
|
|
208 (concat "^\\([^" crm-separator "]*\\)$")
|
|
|
209 target-string))))
|
|
|
210 (if (not (numberp index))
|
|
|
211 ;; no candidate found
|
|
|
212 nil
|
|
|
213 (progn
|
|
|
214 ;;
|
|
|
215 (setq crm-beginning-of-element (match-beginning 1))
|
|
|
216 (setq crm-end-of-element end-index)
|
|
|
217 ;; string to the left of the current element
|
|
|
218 (setq crm-left-of-element (substring target-string 0 (match-beginning 1)))
|
|
|
219 ;; the current element
|
|
|
220 (setq crm-current-element (match-string 1 target-string))
|
|
|
221 ;; string to the right of the current element
|
|
|
222 (setq crm-right-of-element (substring minibuffer-string end-index))
|
|
|
223 t))))
|
|
|
224
|
|
|
225 (defun crm-test-completion (candidate)
|
|
|
226 "Return t if CANDIDATE is an exact match for a valid completion."
|
|
|
227 (let ((completions
|
|
|
228 ;; TODO: verify whether the arguments are appropriate
|
|
28741
|
229 (all-completions
|
|
|
230 candidate crm-completion-table minibuffer-completion-predicate)))
|
|
28710
|
231 (if (member candidate completions)
|
|
|
232 t
|
|
|
233 nil)))
|
|
|
234
|
|
|
235 (defun crm-minibuffer-completion-help ()
|
|
|
236 "Display a list of possible completions of the current minibuffer element."
|
|
|
237 (interactive)
|
|
|
238 (message "Making completion list...")
|
|
|
239 (if (not (crm-find-current-element))
|
|
|
240 nil
|
|
|
241 (let ((completions (all-completions crm-current-element
|
|
|
242 minibuffer-completion-table
|
|
|
243 minibuffer-completion-predicate)))
|
|
|
244 (message nil)
|
|
|
245 (if (null completions)
|
|
|
246 (crm-temp-echo-area-glyphs " [No completions]")
|
|
|
247 (with-output-to-temp-buffer "*Completions*"
|
|
|
248 (display-completion-list (sort completions 'string-lessp))))))
|
|
|
249 nil)
|
|
|
250
|
|
|
251 (defun crm-do-completion ()
|
|
|
252 "This is the internal completion engine.
|
|
|
253 This function updates the text in the minibuffer
|
|
|
254 to complete the current string, and returns a number between 0 and 6.
|
|
|
255 The meanings of the return values are:
|
|
|
256
|
|
|
257 0 - the string has no possible completion
|
|
|
258 1 - the string is already a valid and unique match
|
|
|
259 2 - not used
|
|
|
260 3 - the string is already a valid match (but longer matches exist too)
|
|
|
261 4 - the string was completed to a valid match
|
|
|
262 5 - some completion has been done, but the result is not a match
|
|
|
263 6 - no completion was done, and the string is not an exact match"
|
|
|
264
|
|
|
265 (if (not (crm-find-current-element))
|
|
|
266 nil
|
|
|
267 (let (last completion completedp)
|
|
|
268 (setq completion
|
|
|
269 (try-completion crm-current-element
|
|
|
270 minibuffer-completion-table
|
|
|
271 minibuffer-completion-predicate))
|
|
|
272 (setq last crm-last-exact-completion)
|
|
|
273 (setq crm-last-exact-completion nil)
|
|
|
274
|
|
|
275 (catch 'crm-exit
|
|
|
276
|
|
|
277 (if (null completion) ; no possible completion
|
|
|
278 (progn
|
|
|
279 (crm-temp-echo-area-glyphs " [No match]")
|
|
|
280 (throw 'crm-exit 0)))
|
|
|
281
|
|
|
282 (if (eq completion t) ; was already an exact and unique completion
|
|
|
283 (throw 'crm-exit 1))
|
|
|
284
|
|
|
285 (setq completedp
|
|
|
286 (null (string-equal completion crm-current-element)))
|
|
|
287
|
|
|
288 (if completedp
|
|
|
289 (progn
|
|
|
290 (erase-buffer)
|
|
|
291 (insert crm-left-of-element completion)
|
|
|
292 ;; (if crm-complete-up-to-point
|
|
|
293 ;; (insert crm-separator))
|
|
|
294 (insert crm-right-of-element)
|
|
|
295 (backward-char (length crm-right-of-element))
|
|
|
296 ;; TODO: is this correct?
|
|
|
297 (setq crm-current-element completion)))
|
|
|
298
|
|
|
299 (if (null (crm-test-completion crm-current-element))
|
|
|
300 (progn
|
|
|
301 (if completedp ; some completion happened
|
|
|
302 (throw 'crm-exit 5)
|
|
|
303 (if completion-auto-help
|
|
|
304 (crm-minibuffer-completion-help)
|
|
|
305 (crm-temp-echo-area-glyphs " [Next char not unique]")))
|
|
|
306 (throw 'crm-exit 6))
|
|
|
307 (if completedp
|
|
|
308 (throw 'crm-exit 4)))
|
|
|
309
|
|
|
310 (setq crm-last-exact-completion completion)
|
|
|
311 (if (not (null last))
|
|
|
312 (progn
|
|
|
313 (if (not (null (equal crm-current-element last)))
|
|
|
314 (crm-minibuffer-completion-help))))
|
|
|
315
|
|
|
316 ;; returning -- was already an exact completion
|
|
|
317 (throw 'crm-exit 3)))))
|
|
|
318
|
|
|
319 (defun crm-minibuffer-complete ()
|
|
|
320 "Complete the current element.
|
|
|
321 If no characters can be completed, display a list of possible completions.
|
|
|
322
|
|
|
323 Return t if the current element is now a valid match; otherwise return nil."
|
|
|
324 (interactive)
|
|
|
325 ;; take care of scrolling if necessary -- completely cribbed from minibuf.c
|
|
|
326 (if (not (eq last-command this-command))
|
|
|
327 ;; ok?
|
|
|
328 (setq minibuffer-scroll-window nil))
|
|
|
329 (let ((window minibuffer-scroll-window))
|
|
|
330 (if (and (not (null window))
|
|
|
331 ;; ok?
|
|
|
332 (not (null (window-buffer window))))
|
|
|
333 (let (tem)
|
|
|
334 (set-buffer (window-buffer window))
|
|
|
335 ;; ok?
|
|
|
336 (setq tem (pos-visible-in-window-p (point-max) window))
|
|
|
337 (if (not (null tem))
|
|
|
338 ;; ok?
|
|
|
339 (set-window-start window (point-min) nil)
|
|
|
340 (scroll-other-window nil))
|
|
|
341 ;; reaching here means exiting the function w/ return value of nil
|
|
|
342 nil)
|
|
|
343
|
|
|
344 (let* (
|
|
|
345 ;(crm-end-of-element nil)
|
|
|
346 (result (crm-do-completion)))
|
|
|
347 (cond
|
|
|
348 ((eq 0 result)
|
|
|
349 nil)
|
|
|
350 ((eq 1 result)
|
|
|
351 ;; adapted from Emacs 21
|
|
|
352 (if (not (eq (point) crm-end-of-element))
|
|
|
353 (goto-char (+ 1 crm-end-of-element)))
|
|
|
354 (crm-temp-echo-area-glyphs " [Sole completion]")
|
|
|
355 t)
|
|
|
356 ((eq 3 result)
|
|
|
357 ;; adapted from Emacs 21
|
|
|
358 (if (not (eq (point) crm-end-of-element))
|
|
|
359 (goto-char (+ 1 crm-end-of-element)))
|
|
|
360 (crm-temp-echo-area-glyphs " [Complete, but not unique]")
|
|
|
361 t))))))
|
|
|
362
|
|
|
363 ;; i love traffic lights...but only when they're green
|
|
|
364 (defun crm-find-longest-completable-substring (string)
|
|
|
365 "Determine the longest completable (left-anchored) substring of STRING.
|
|
|
366 The description \"left-anchored\" means the positions of the characters
|
|
|
367 in the substring must be the same as those of the corresponding characters
|
|
|
368 in STRING. Anchoring is what `^' does in a regular expression.
|
|
|
369
|
|
|
370 The table and predicate used for completion are
|
|
|
371 `minibuffer-completion-table' and `minibuffer-completion-predicate',
|
|
|
372 respectively.
|
|
|
373
|
|
|
374 A non-nil return value means that there is some substring which is
|
|
|
375 completable. A return value of t means that STRING itself is
|
|
|
376 completable. If a string value is returned it is the longest
|
|
|
377 completable proper substring of STRING. If nil is returned, STRING
|
|
|
378 does not have any non-empty completable substrings.
|
|
|
379
|
|
|
380 Remember: \"left-anchored\" substring"
|
|
|
381 (let* ((length-of-string (length string))
|
|
|
382 (index length-of-string)
|
|
|
383 (done (if (> length-of-string 0)
|
|
|
384 nil
|
|
|
385 t))
|
|
|
386 (first t) ; ugh, special handling for first time through...
|
|
|
387 goal-string
|
|
|
388 result)
|
|
|
389 ;; loop through left-anchored substrings in order of descending length,
|
|
|
390 ;; find the first substring that is completable
|
|
|
391 (while (not done)
|
|
|
392 (setq result (try-completion (substring string 0 index)
|
|
|
393 minibuffer-completion-table
|
|
|
394 minibuffer-completion-predicate))
|
|
|
395 (if result
|
|
|
396 ;; found completable substring
|
|
|
397 (progn
|
|
|
398 (setq done t)
|
|
|
399 (if (and (eq result t) first)
|
|
|
400 ;; exactly matching string first time through
|
|
|
401 (setq goal-string t)
|
|
|
402 ;; fully-completed proper substring
|
|
|
403 (setq goal-string (substring string 0 index)))))
|
|
|
404 (setq index (1- index))
|
|
|
405 (if first
|
|
|
406 (setq first nil))
|
|
|
407 (if (<= index 0)
|
|
|
408 (setq done t)))
|
|
|
409 ;; possible values include: t, nil, some string
|
|
|
410 goal-string))
|
|
|
411
|
|
|
412 ;; TODO: decide whether trailing separator is allowed. current
|
|
|
413 ;; implementation appears to allow it
|
|
|
414 (defun crm-strings-completed-p (separated-string)
|
|
|
415 "Verify that strings in SEPARATED-STRING are completed strings.
|
|
|
416 A return value of t means that all strings were verified. A number is
|
|
|
417 returned if verification was unsuccessful. This number represents the
|
|
|
418 position in SEPARATED-STRING up to where completion was successful."
|
|
|
419 (let ((strings (split-string separated-string crm-separator))
|
|
|
420 ;; buffers start at 1, not 0
|
|
|
421 (current-position 1)
|
|
|
422 current-string
|
|
|
423 result
|
|
|
424 done)
|
|
|
425 (while (and strings (not done))
|
|
|
426 (setq current-string (car strings)
|
|
|
427 result (try-completion current-string
|
|
|
428 minibuffer-completion-table
|
|
|
429 minibuffer-completion-predicate))
|
|
|
430 (if (eq result t)
|
|
|
431 (setq strings (cdr strings)
|
|
|
432 current-position (+ current-position
|
|
|
433 (length current-string)
|
|
|
434 ;; automatically adding 1 for separator
|
|
|
435 ;; character
|
|
|
436 1))
|
|
|
437 ;; still one more case of a match
|
|
|
438 (if (stringp result)
|
|
|
439 (let ((string-list
|
|
|
440 (all-completions result
|
|
|
441 minibuffer-completion-table
|
|
|
442 minibuffer-completion-predicate)))
|
|
|
443 (if (member result string-list)
|
|
|
444 ;; ho ho, code duplication...
|
|
|
445 (setq strings (cdr strings)
|
|
|
446 current-position (+ current-position
|
|
|
447 (length current-string)
|
|
|
448 1))
|
|
|
449 (progn
|
|
|
450 (setq done t)
|
|
|
451 ;; current-string is a partially-completed string
|
|
|
452 (setq current-position (+ current-position
|
|
|
453 (length current-string))))))
|
|
|
454 ;; current-string cannot be completed
|
|
|
455 (let ((completable-substring
|
|
|
456 (crm-find-longest-completable-substring current-string)))
|
|
|
457 (setq done t)
|
|
|
458 (setq current-position (+ current-position
|
|
|
459 (length completable-substring)))))))
|
|
|
460 ;; return our result
|
|
|
461 (if (null strings)
|
|
|
462 t
|
|
|
463 current-position)))
|
|
|
464
|
|
|
465 ;; try to complete candidate, then check all separated strings. move
|
|
|
466 ;; point to problem position if checking fails for some string. if
|
|
|
467 ;; checking succeeds for all strings, exit.
|
|
|
468 (defun crm-minibuffer-complete-and-exit ()
|
|
|
469 "If all of the minibuffer elements are valid completions then exit.
|
|
|
470 All elements in the minibuffer must match. If there is a mismatch, move point
|
|
|
471 to the location of mismatch and do not exit.
|
|
|
472
|
|
|
473 This function is modeled after `minibuffer_complete_and_exit' in src/minibuf.c"
|
|
|
474 (interactive)
|
|
|
475
|
|
|
476 (if (not (crm-find-current-element))
|
|
|
477 nil
|
|
|
478 (let (result)
|
|
|
479
|
|
|
480 (setq result
|
|
|
481 (catch 'crm-exit
|
|
|
482
|
|
|
483 (if (eq (point-min) (point-max))
|
|
|
484 (throw 'crm-exit t))
|
|
|
485
|
|
|
486 ;; TODO: this test is suspect?
|
|
|
487 (if (not (null (crm-test-completion crm-current-element)))
|
|
|
488 (throw 'crm-exit "check"))
|
|
|
489
|
|
|
490 ;; TODO: determine how to detect errors
|
|
|
491 (let ((result (crm-do-completion)))
|
|
|
492
|
|
|
493 (cond
|
|
|
494 ((or (eq 1 result)
|
|
|
495 (eq 3 result))
|
|
|
496 (throw 'crm-exit "check"))
|
|
|
497 ((eq 4 result)
|
|
|
498 (if (not (null minibuffer-completion-confirm))
|
|
|
499 (progn
|
|
|
500 (crm-temp-echo-area-glyphs " [Confirm]")
|
|
|
501 nil)
|
|
|
502 (throw 'crm-exit "check")))
|
|
|
503 (nil)))))
|
|
|
504
|
|
|
505 (if (null result)
|
|
|
506 nil
|
|
|
507 (if (equal result "check")
|
|
|
508 (let ((check-strings
|
|
|
509 (crm-strings-completed-p (buffer-string))))
|
|
|
510 ;; check all of minibuffer
|
|
|
511 (if (eq check-strings t)
|
|
|
512 (throw 'exit nil)
|
|
|
513 (if (numberp check-strings)
|
|
|
514 (progn
|
|
|
515 (goto-char check-strings)
|
|
|
516 (crm-temp-echo-area-glyphs " [An element did not match]"))
|
|
|
517 (message "Unexpected error"))))
|
|
|
518 (if (eq result t)
|
|
|
519 (throw 'exit nil)
|
|
|
520 (message "Unexpected error")))))))
|
|
|
521
|
|
|
522 (defun crm-init-keymaps ()
|
|
|
523 "Initialize the keymaps used by `completing-read-multiple'.
|
|
|
524 Two keymaps are used depending on the value of the REQUIRE-MATCH
|
|
|
525 argument of the function `completing-read-multiple'.
|
|
|
526
|
|
|
527 If REQUIRE-MATCH is nil, the keymap `crm-local-completion-map' is used.
|
|
|
528 This keymap inherits from the keymap named `minibuffer-local-completion-map'.
|
|
|
529 The only difference is that TAB is bound to `crm-minibuffer-complete' in
|
|
|
530 the inheriting keymap.
|
|
|
531
|
|
|
532 If REQUIRE-MACTH is non-nil, the keymap `crm-local-must-match-map' is used.
|
|
|
533 This keymap inherits from the keymap named `minibuffer-local-must-match-map'.
|
|
|
534 The inheriting keymap binds RET to `crm-minibuffer-complete-and-exit'
|
|
|
535 and TAB to `crm-minibuffer-complete'."
|
|
|
536 (unless crm-local-completion-map
|
|
|
537 (setq crm-local-completion-map (make-sparse-keymap))
|
|
|
538 (set-keymap-parent crm-local-completion-map
|
|
|
539 minibuffer-local-completion-map)
|
|
|
540 ;; key definitions
|
|
|
541 (define-key crm-local-completion-map
|
|
|
542 (kbd "TAB")
|
|
|
543 (function crm-minibuffer-complete)))
|
|
|
544
|
|
|
545 (unless crm-local-must-match-map
|
|
|
546 (setq crm-local-must-match-map (make-sparse-keymap))
|
|
|
547 (set-keymap-parent crm-local-must-match-map
|
|
|
548 minibuffer-local-must-match-map)
|
|
|
549 ;; key definitions
|
|
|
550 (define-key crm-local-must-match-map
|
|
|
551 (kbd "RET")
|
|
|
552 (function crm-minibuffer-complete-and-exit))
|
|
|
553 (define-key crm-local-must-match-map
|
|
|
554 (kbd "TAB")
|
|
|
555 (function crm-minibuffer-complete))))
|
|
|
556
|
|
|
557 (crm-init-keymaps)
|
|
|
558
|
|
|
559 ;; superemulates behavior of completing_read in src/minibuf.c
|
|
|
560 ;;;###autoload
|
|
|
561 (defun completing-read-multiple
|
|
|
562 (prompt table &optional predicate require-match initial-input
|
|
|
563 hist def inherit-input-method)
|
|
|
564 "Read multiple strings in the minibuffer, with completion.
|
|
|
565 By using this functionality, a user may specify multiple strings at a
|
|
|
566 single prompt, optionally using completion.
|
|
|
567
|
|
|
568 Multiple strings are specified by separating each of the strings with
|
|
|
569 a prespecified separator character. For example, if the separator
|
|
|
570 character is a comma, the strings 'alice', 'bob', and 'eve' would be
|
|
|
571 specified as 'alice,bob,eve'.
|
|
|
572
|
|
|
573 The default value for the separator character is the value of
|
|
|
574 `crm-default-separator' (comma). The separator character may be
|
|
|
575 changed by modifying the value of `crm-separator'.
|
|
|
576
|
|
|
577 Continguous strings of non-separator-characters are referred to as
|
|
|
578 'elements'. In the aforementioned example, the elements are: 'alice',
|
|
|
579 'bob', and 'eve'.
|
|
|
580
|
|
|
581 Completion is available on a per-element basis. For example, if the
|
|
|
582 contents of the minibuffer are 'alice,bob,eve' and point is between
|
|
|
583 'l' and 'i', pressing TAB operates on the element 'alice'.
|
|
|
584
|
|
|
585 The return value of this function is a list of the read strings.
|
|
|
586
|
|
|
587 See the documentation for `completing-read' for details on the arguments:
|
|
|
588 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
|
|
|
589 INHERIT-INPUT-METHOD."
|
|
|
590 (let ((minibuffer-completion-table (function crm-collection-fn))
|
|
|
591 (minibuffer-completion-predicate predicate)
|
|
|
592 ;; see completing_read in src/minibuf.c
|
|
|
593 (minibuffer-completion-confirm (if (eq require-match t)
|
|
|
594 nil
|
|
|
595 t))
|
|
28741
|
596 (crm-completion-table table)
|
|
28710
|
597 crm-last-exact-completion
|
|
|
598 crm-current-element
|
|
|
599 crm-left-of-element
|
|
|
600 crm-right-of-element
|
|
|
601 crm-beginning-of-element
|
|
|
602 crm-end-of-element
|
|
|
603 map)
|
|
|
604 (if require-match
|
|
|
605 ;; use `crm-local-must-match-map'
|
|
|
606 (setq map crm-local-must-match-map)
|
|
|
607 ;; use `minibuffer-local-completion-map'
|
|
|
608 (setq map minibuffer-local-completion-map))
|
|
|
609 (split-string (read-from-minibuffer
|
|
|
610 prompt initial-input map
|
|
|
611 nil hist def inherit-input-method)
|
|
|
612 crm-separator)))
|
|
|
613
|
|
|
614 ;; testing and debugging
|
|
|
615 ;;; (defun crm-init-test-environ ()
|
|
|
616 ;;; "Set up some variables for testing."
|
|
|
617 ;;; (interactive)
|
|
|
618 ;;; (setq my-prompt "Prompt: ")
|
|
|
619 ;;; (setq my-table
|
|
|
620 ;;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma")
|
|
|
621 ;;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb")
|
|
|
622 ;;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb")
|
|
|
623 ;;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb")
|
|
|
624 ;;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb")
|
|
|
625 ;;; ))
|
|
|
626 ;;; (setq my-separator ","))
|
|
|
627
|
|
|
628 ;(completing-read-multiple my-prompt my-table)
|
|
|
629 ;(completing-read-multiple my-prompt my-table nil t)
|
|
|
630 ;(completing-read-multiple my-prompt my-table nil "match")
|
|
|
631 ;(completing-read my-prompt my-table nil t)
|
|
|
632 ;(completing-read my-prompt my-table nil "match")
|
|
|
633
|
|
|
634 (provide 'crm)
|
|
|
635
|
|
|
636 ;;; crm.el ends here
|
