Mercurial > emacs
annotate lisp/emacs-lisp/crm.el @ 30408:e3e2c9051c5f
Got rid of all byte-compiler warnings on Emacs.
Add to the menu when the file is loaded, not in ada-mode-hook.
Add -toolbar to the default ddd command Switches moved from
ada-prj-default-comp-cmd and ada-prj-default-make-cmd to
ada-prj-default-comp-opt
(ada-add-ada-menu): Remove the map and name parameters Add the Ada
Reference Manual to the menu
(ada-check-current): rewritten as a call to ada-compile-current
(ada-compile): Removed.
(ada-compile-application, ada-compile-current, ada-check-current):
Set the compilation-search-path so that compile.el automatically
finds the sources in src_dir. Automatic scrollong of the
compilation buffer. C-uC-cC-c asks for confirmation before
compiling
(ada-compile-current): New parameter, prj-field
(ada-complete-identifier): Load the .ali file before doing
processing
(ada-find-ali-file-in-dir): prepend build_dir to obj_dir to
conform to gnatmake's behavior.
(ada-find-file-in-dir): New function
(ada-find-references): Set the environment variables for gnatfind
(ada-find-src-file-in-dir): New function.
(ada-first-non-nil): Removed
(ada-gdb-application): Add support for jdb, the java debugger.
(ada-get-ada-file-name): Load the original-file first if not done
yet.
(ada-get-all-references): Handles the new ali syntax (parent types
are found between <>).
(ada-initialize-runtime-library): New function
(ada-mode-hook): Always load a project file when a file is opened,
so that the casing exceptions are correctly read.
(ada-operator-re): Add all missing operators ("abs", "rem", "**").
(ada-parse-prj-file): Use find-file-noselect instead of find-file
to open the project file, since the latter does not work with
speedbar Get default values before loading the prj file, or the
default executable file name is wrong. Use the absolute value of
src_dir to initialize ada-search-directories and
compilation-search-path,... Add the standard runtime library to
the search path for find-file.
(ada-prj-default-debugger): Was missing an opening '{'
(ada-prj-default-bind-opt, ada-prj-default-link-opt): New
variables.
(ada-prj-default-gnatmake-opt): New variable
(ada-prj-find-prj-file): Handles non-file buffers For non-Ada
buffers, the project file is the default one Save the windows
configuration before displaying the menu.
(ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Removed
(ada-read-identifier): Fix xrefs on operators (for "mod", "and",
...) regexp-quote identifiers names to support operators +,
-,... in regexps.
(ada-remote): New function.
(ada-run-application): Erase the output buffer before starting the
run Support remote execution of the application. Use
call-process, or the arguments are incorrectly parsed
(ada-set-default-project-file): Reread the content of the active
project file, not the one from the current buffer When a project
file is set as the default project, all directories are
automatically associated with it.
(ada-set-environment): New function
(ada-treat-cmd-string): New special variable ${current}
(ada-treat-cmd-string): Revised. The substitution is now done for
any ${...} substring
(ada-xref-current): If no body was found, compiles the spec
instead. Setup ADA_{SOURCE,OBJECTS}_PATH before running the
compiler to get rid of command line length limitations.
(ada-xref-get-project-field): New function
(ada-xref-project-files): New variable
(ada-xref-runtime-library-specs-path)
(ada-xref-runtime-library-ali-path): New variables
(ada-xref-set-default-prj-values): Default run command now does a
cd to the build directory. New field: main_unit Provide a default
file name even if the current buffer has no prj file.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Mon, 24 Jul 2000 11:13:11 +0000 |
parents | efa45c683e9a |
children | 835717f56bf2 |
rev | line source |
---|---|
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
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." | |
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
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
229 (all-completions |
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
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
efa45c683e9a
(crm-completion-table): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
28710
diff
changeset
|
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 |