284
|
1 /* Minibuffer input and completion.
|
|
2 Copyright (C) 1985, 1986 Free Software Foundation, Inc.
|
|
3
|
|
4 This file is part of GNU Emacs.
|
|
5
|
|
6 GNU Emacs is free software; you can redistribute it and/or modify
|
|
7 it under the terms of the GNU General Public License as published by
|
|
8 the Free Software Foundation; either version 1, or (at your option)
|
|
9 any later version.
|
|
10
|
|
11 GNU Emacs is distributed in the hope that it will be useful,
|
|
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
14 GNU General Public License for more details.
|
|
15
|
|
16 You should have received a copy of the GNU General Public License
|
|
17 along with GNU Emacs; see the file COPYING. If not, write to
|
|
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
|
|
19
|
|
20
|
|
21 #include "config.h"
|
|
22 #include "lisp.h"
|
|
23 #include "commands.h"
|
|
24 #include "buffer.h"
|
|
25 #include "dispextern.h"
|
|
26 #include "screen.h"
|
|
27 #include "window.h"
|
|
28 #include "syntax.h"
|
|
29
|
|
30 #define min(a, b) ((a) < (b) ? (a) : (b))
|
|
31
|
|
32 /* List of buffers for use as minibuffers.
|
|
33 The first element of the list is used for the outermost minibuffer invocation,
|
|
34 the next element is used for a recursive minibuffer invocation, etc.
|
|
35 The list is extended at the end as deeped minibuffer recursions are encountered. */
|
|
36 Lisp_Object Vminibuffer_list;
|
|
37
|
|
38 struct minibuf_save_data
|
|
39 {
|
|
40 char *prompt;
|
|
41 int prompt_width;
|
|
42 Lisp_Object help_form;
|
|
43 Lisp_Object current_prefix_arg;
|
|
44 };
|
|
45
|
|
46 int minibuf_save_vector_size;
|
|
47 struct minibuf_save_data *minibuf_save_vector;
|
|
48
|
|
49 /* Depth in minibuffer invocations. */
|
|
50 int minibuf_level;
|
|
51
|
|
52 /* Nonzero means display completion help for invalid input */
|
|
53 int auto_help;
|
|
54
|
|
55 /* Fread_minibuffer leaves the input, as a string, here */
|
|
56 Lisp_Object last_minibuf_string;
|
|
57
|
|
58 /* Nonzero means let functions called when within a minibuffer
|
|
59 invoke recursive minibuffers (to read arguments, or whatever) */
|
|
60 int enable_recursive_minibuffers;
|
|
61
|
|
62 /* help-form is bound to this while in the minibuffer. */
|
|
63
|
|
64 Lisp_Object Vminibuffer_help_form;
|
|
65
|
|
66 /* Nonzero means completion ignores case. */
|
|
67
|
|
68 int completion_ignore_case;
|
|
69
|
|
70 /* If last completion attempt reported "Complete but not unique"
|
|
71 then this is the string completed then; otherwise this is nil. */
|
|
72
|
|
73 static Lisp_Object last_exact_completion;
|
|
74
|
|
75 Lisp_Object Quser_variable_p;
|
|
76
|
|
77 /* Width in columns of current minibuffer prompt. */
|
|
78
|
|
79 extern int minibuf_prompt_width;
|
|
80
|
|
81
|
|
82 /* Actual minibuffer invocation. */
|
|
83
|
|
84 void read_minibuf_unwind ();
|
|
85 Lisp_Object get_minibuffer ();
|
|
86 Lisp_Object read_minibuf ();
|
|
87
|
|
88 Lisp_Object
|
|
89 read_minibuf (map, initial, prompt, backup_n, expflag)
|
|
90 Lisp_Object map;
|
|
91 Lisp_Object initial;
|
|
92 Lisp_Object prompt;
|
|
93 Lisp_Object backup_n;
|
|
94 int expflag;
|
|
95 {
|
|
96 register Lisp_Object val;
|
|
97 int count = specpdl_ptr - specpdl;
|
358
|
98 Lisp_Object mini_screen = WINDOW_SCREEN (XWINDOW (minibuf_window));
|
284
|
99 struct gcpro gcpro1, gcpro2;
|
|
100
|
|
101 if (XTYPE (prompt) != Lisp_String)
|
|
102 prompt = build_string ("");
|
|
103
|
|
104 /* Emacs in -batch mode calls minibuffer: print the prompt. */
|
|
105 if (noninteractive && XTYPE (prompt) == Lisp_String)
|
|
106 printf ("%s", XSTRING (prompt)->data);
|
|
107
|
|
108 if (!enable_recursive_minibuffers
|
|
109 && minibuf_level > 0
|
|
110 && (EQ (selected_window, minibuf_window)))
|
|
111 #if 0
|
|
112 || selected_screen != XSCREEN (WINDOW_SCREEN (XWINDOW (minibuf_window)))
|
|
113 #endif
|
|
114 error ("Command attempted to use minibuffer while in minibuffer");
|
|
115
|
|
116 if (minibuf_level == minibuf_save_vector_size)
|
|
117 minibuf_save_vector =
|
|
118 (struct minibuf_save_data *)
|
|
119 xrealloc (minibuf_save_vector,
|
|
120 (minibuf_save_vector_size *= 2)
|
|
121 * sizeof (struct minibuf_save_data));
|
|
122 minibuf_save_vector[minibuf_level].prompt = minibuf_prompt;
|
|
123 minibuf_save_vector[minibuf_level].prompt_width = minibuf_prompt_width;
|
|
124 minibuf_prompt_width = 0;
|
|
125 /* >> Why is this done this way rather than binding these variables? */
|
|
126 minibuf_save_vector[minibuf_level].help_form = Vhelp_form;
|
|
127 minibuf_save_vector[minibuf_level].current_prefix_arg = Vcurrent_prefix_arg;
|
|
128 GCPRO2 (minibuf_save_vector[minibuf_level].help_form,
|
|
129 minibuf_save_vector[minibuf_level].current_prefix_arg);
|
|
130
|
|
131 record_unwind_protect (Fset_window_configuration,
|
345
|
132 Fcurrent_window_configuration (Qnil));
|
|
133
|
|
134 /* If the minibuffer window is on a different screen, save that
|
|
135 screen's configuration too. */
|
358
|
136 if (XSCREEN (mini_screen) != selected_screen)
|
|
137 {
|
|
138 record_unwind_protect (Fset_window_configuration,
|
|
139 Fcurrent_window_configuration (mini_screen));
|
|
140 }
|
284
|
141
|
|
142 val = current_buffer->directory;
|
|
143 Fset_buffer (get_minibuffer (minibuf_level));
|
|
144 current_buffer->directory = val;
|
|
145 Fmake_local_variable (Qprint_escape_newlines);
|
|
146 print_escape_newlines = 1;
|
|
147
|
358
|
148 #ifdef MULTI_SCREEN
|
|
149 /* If the minibuffer window is on another screen, shift this screen's
|
|
150 focus to that window, and arrange to put it back later. */
|
|
151 if (XSCREEN (WINDOW_SCREEN (XWINDOW (minibuf_window)))
|
|
152 != selected_screen)
|
|
153 {
|
|
154 record_unwind_protect (read_minibuf_unwind,
|
|
155 Fcons (Fselected_screen (),
|
|
156 SCREEN_FOCUS_SCREEN (selected_screen)));
|
|
157
|
|
158 Fredirect_screen_focus (Fselected_screen (), mini_screen);
|
|
159 }
|
|
160 else
|
|
161 record_unwind_protect (read_minibuf_unwind, Qnil);
|
|
162 #else
|
|
163 record_unwind_protect (read_minibuf_unwind, Qnil);
|
|
164 #endif
|
|
165
|
284
|
166 Vminibuf_scroll_window = selected_window;
|
|
167 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
|
|
168 Fselect_window (minibuf_window);
|
|
169 XFASTINT (XWINDOW (minibuf_window)->hscroll) = 0;
|
|
170
|
|
171 Ferase_buffer ();
|
|
172 minibuf_level++;
|
|
173
|
|
174 if (!NULL (initial))
|
|
175 {
|
|
176 Finsert (1, &initial);
|
|
177 if (!NULL (backup_n) && XTYPE (backup_n) == Lisp_Int)
|
|
178 Fforward_char (backup_n);
|
|
179 }
|
|
180
|
|
181 minibuf_prompt = (char *) alloca (XSTRING (prompt)->size + 1);
|
|
182 bcopy (XSTRING (prompt)->data, minibuf_prompt, XSTRING (prompt)->size + 1);
|
|
183 echo_area_glyphs = 0;
|
|
184
|
|
185 Vhelp_form = Vminibuffer_help_form;
|
|
186 current_buffer->keymap = map;
|
|
187
|
|
188 /* ??? MCC did redraw_screen here if switching screens. */
|
|
189 recursive_edit_1 ();
|
|
190
|
|
191 /* If cursor is on the minibuffer line,
|
|
192 show the user we have exited by putting it in column 0. */
|
|
193 if ((SCREEN_CURSOR_Y (selected_screen)
|
|
194 >= XFASTINT (XWINDOW (minibuf_window)->top))
|
|
195 && !noninteractive)
|
|
196 {
|
|
197 SCREEN_CURSOR_X (selected_screen) = 0;
|
|
198 update_screen (selected_screen, 1, 1);
|
|
199 }
|
|
200
|
|
201 /* Make minibuffer contents into a string */
|
|
202 val = make_string (BEG_ADDR, Z - BEG);
|
|
203 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
|
|
204 unbind_to (count, Qnil); /* The appropriate screen will get selected
|
358
|
205 in set-window-configuration. */
|
284
|
206
|
|
207 UNGCPRO;
|
|
208
|
|
209 /* VAL is the string of minibuffer text. */
|
|
210
|
|
211 last_minibuf_string = val;
|
|
212
|
|
213 /* If Lisp form desired instead of string, parse it */
|
|
214 if (expflag)
|
|
215 val = Fread (val);
|
|
216
|
|
217 return val;
|
|
218 }
|
|
219
|
|
220 /* Return a buffer to be used as the minibuffer at depth `depth'.
|
|
221 depth = 0 is the lowest allowed argument, and that is the value
|
|
222 used for nonrecursive minibuffer invocations */
|
|
223
|
|
224 Lisp_Object
|
|
225 get_minibuffer (depth)
|
|
226 int depth;
|
|
227 {
|
|
228 Lisp_Object tail, num, buf;
|
|
229 char name[14];
|
|
230 extern Lisp_Object nconc2 ();
|
|
231
|
|
232 XFASTINT (num) = depth;
|
|
233 tail = Fnthcdr (num, Vminibuffer_list);
|
|
234 if (NULL (tail))
|
|
235 {
|
|
236 tail = Fcons (Qnil, Qnil);
|
|
237 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
|
|
238 }
|
|
239 buf = Fcar (tail);
|
|
240 if (NULL (buf) || NULL (XBUFFER (buf)->name))
|
|
241 {
|
|
242 sprintf (name, " *Minibuf-%d*", depth);
|
|
243 buf = Fget_buffer_create (build_string (name));
|
|
244 XCONS (tail)->car = buf;
|
|
245 }
|
|
246 else
|
|
247 reset_buffer (XBUFFER (buf));
|
|
248 return buf;
|
|
249 }
|
|
250
|
|
251 /* This function is called on exiting minibuffer, whether normally or not,
|
|
252 and it restores the current window, buffer, etc. */
|
|
253
|
|
254 void
|
358
|
255 read_minibuf_unwind (data)
|
|
256 Lisp_Object data;
|
284
|
257 {
|
|
258 /* Erase the minibuffer we were using at this level. */
|
|
259 Fset_buffer (XWINDOW (minibuf_window)->buffer);
|
|
260
|
|
261 /* Prevent error in erase-buffer. */
|
|
262 current_buffer->read_only = Qnil;
|
|
263 Ferase_buffer ();
|
|
264
|
|
265 /* If this was a recursive minibuffer,
|
|
266 tie the minibuffer window back to the outer level minibuffer buffer */
|
|
267 minibuf_level--;
|
|
268 /* Make sure minibuffer window is erased, not ignored */
|
|
269 windows_or_buffers_changed++;
|
|
270 XFASTINT (XWINDOW (minibuf_window)->last_modified) = 0;
|
|
271
|
|
272 /* Restore prompt from outer minibuffer */
|
|
273 minibuf_prompt = minibuf_save_vector[minibuf_level].prompt;
|
|
274 minibuf_prompt_width = minibuf_save_vector[minibuf_level].prompt_width;
|
|
275 Vhelp_form = minibuf_save_vector[minibuf_level].help_form;
|
|
276 Vcurrent_prefix_arg = minibuf_save_vector[minibuf_level].current_prefix_arg;
|
358
|
277
|
|
278 #ifdef MULTI_SCREEN
|
|
279 /* Redirect the focus of the screen that called the minibuffer. */
|
|
280 if (CONSP (data))
|
|
281 Fredirect_screen_focus (XCONS (data)->car, XCONS (data)->cdr);
|
|
282 #endif
|
284
|
283 }
|
|
284
|
|
285 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
|
|
286 "Read a string from the minibuffer, prompting with string PROMPT.\n\
|
|
287 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
|
|
288 to be inserted into the minibuffer before reading input.\n\
|
|
289 Third arg KEYMAP is a keymap to use whilst reading;\n\
|
|
290 if omitted or nil, the default is `minibuffer-local-map'.\n\
|
|
291 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
|
|
292 and return that object:\n\
|
|
293 in other words, do `(car (read-from-string INPUT-STRING))'\n\
|
|
294 Fifth arg POSITION, if non-nil, is where to put point\n\
|
|
295 in the minibuffer after inserting INITIAL-CONTENTS.")
|
|
296 (prompt, initial_input, keymap, read, position)
|
|
297 Lisp_Object prompt, initial_input, keymap, read, position;
|
|
298 {
|
|
299 int pos = 0;
|
|
300
|
|
301 CHECK_STRING (prompt, 0);
|
|
302 if (!NULL (initial_input))
|
|
303 {
|
|
304 CHECK_STRING (initial_input, 1);
|
|
305 if (!NULL (position))
|
|
306 {
|
|
307 CHECK_NUMBER (position, 0);
|
|
308 /* Convert to distance from end of input. */
|
|
309 pos = XINT (position) - 1 - XSTRING (initial_input)->size;
|
|
310 }
|
|
311 }
|
|
312
|
|
313 if (NULL (keymap))
|
|
314 keymap = Vminibuffer_local_map;
|
|
315 else
|
|
316 keymap = get_keymap (keymap,2);
|
|
317 return read_minibuf (keymap, initial_input, prompt,
|
|
318 pos, !NULL (read));
|
|
319 }
|
|
320
|
|
321 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
|
|
322 "Return a Lisp object read using the minibuffer.\n\
|
|
323 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
|
|
324 is a string to insert in the minibuffer before reading.")
|
|
325 (prompt, initial_contents)
|
|
326 Lisp_Object prompt, initial_contents;
|
|
327 {
|
|
328 CHECK_STRING (prompt, 0);
|
|
329 if (!NULL (initial_contents))
|
|
330 CHECK_STRING (initial_contents, 1)
|
|
331 return read_minibuf (Vminibuffer_local_map, initial_contents, prompt, Qnil, 1);
|
|
332 }
|
|
333
|
|
334 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
|
|
335 "Return value of Lisp expression read using the minibuffer.\n\
|
|
336 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
|
|
337 is a string to insert in the minibuffer before reading.")
|
|
338 (prompt, initial_contents)
|
|
339 Lisp_Object prompt, initial_contents;
|
|
340 {
|
|
341 return Feval (Fread_minibuffer (prompt, initial_contents));
|
|
342 }
|
|
343
|
|
344 /* Functions that use the minibuffer to read various things. */
|
|
345
|
|
346 DEFUN ("read-string", Fread_string, Sread_string, 1, 2, 0,
|
|
347 "Read a string from the minibuffer, prompting with string PROMPT.\n\
|
|
348 If non-nil second arg INITIAL-INPUT is a string to insert before reading.")
|
|
349 (prompt, initial_input)
|
|
350 Lisp_Object prompt, initial_input;
|
|
351 {
|
|
352 return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, Qnil);
|
|
353 }
|
|
354
|
|
355 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 2, 1, 0,
|
|
356 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
|
|
357 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
|
|
358 (prompt, init)
|
|
359 Lisp_Object prompt, init;
|
|
360 {
|
|
361 CHECK_STRING (prompt, 0);
|
|
362 if (! NULL (init))
|
|
363 CHECK_STRING (init, 1);
|
|
364
|
|
365 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0);
|
|
366 }
|
|
367
|
|
368 DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
|
|
369 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
|
|
370 Prompts with PROMPT.")
|
|
371 (prompt)
|
|
372 Lisp_Object prompt;
|
|
373 {
|
|
374 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil),
|
|
375 Qnil);
|
|
376 }
|
|
377
|
|
378 #ifdef NOTDEF
|
|
379 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
|
|
380 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
|
|
381 Prompts with PROMPT.")
|
|
382 (prompt)
|
|
383 Lisp_Object prompt;
|
|
384 {
|
|
385 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil),
|
|
386 Qnil);
|
|
387 }
|
|
388 #endif /* NOTDEF */
|
|
389
|
|
390 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
|
|
391 "One arg PROMPT, a string. Read the name of a user variable and return\n\
|
|
392 it as a symbol. Prompts with PROMPT.\n\
|
|
393 A user variable is one whose documentation starts with a `*' character.")
|
|
394 (prompt)
|
|
395 Lisp_Object prompt;
|
|
396 {
|
|
397 return Fintern (Fcompleting_read (prompt, Vobarray,
|
|
398 Quser_variable_p, Qt, Qnil, Qnil),
|
|
399 Qnil);
|
|
400 }
|
|
401
|
|
402 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
|
|
403 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
|
|
404 Prompts with PROMPT.\n\
|
|
405 Optional second arg is value to return if user enters an empty line.\n\
|
|
406 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
|
|
407 (prompt, def, require_match)
|
|
408 Lisp_Object prompt, def, require_match;
|
|
409 {
|
|
410 Lisp_Object tem;
|
|
411 Lisp_Object args[3];
|
|
412 struct gcpro gcpro1;
|
|
413
|
|
414 if (XTYPE (def) == Lisp_Buffer)
|
|
415 def = XBUFFER (def)->name;
|
|
416 if (!NULL (def))
|
|
417 {
|
|
418 args[0] = build_string ("%s(default %s) ");
|
|
419 args[1] = prompt;
|
|
420 args[2] = def;
|
|
421 prompt = Fformat (3, args);
|
|
422 }
|
|
423 GCPRO1 (def);
|
|
424 tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil);
|
|
425 UNGCPRO;
|
|
426 if (XSTRING (tem)->size)
|
|
427 return tem;
|
|
428 return def;
|
|
429 }
|
|
430
|
|
431 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
|
|
432 "Return common substring of all completions of STRING in ALIST.\n\
|
|
433 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
|
|
434 All that match are compared together; the longest initial sequence\n\
|
|
435 common to all matches is returned as a string.\n\
|
|
436 If there is no match at all, nil is returned.\n\
|
|
437 For an exact match, t is returned.\n\
|
|
438 \n\
|
|
439 ALIST can be an obarray instead of an alist.\n\
|
|
440 Then the print names of all symbols in the obarray are the possible matches.\n\
|
|
441 \n\
|
|
442 ALIST can also be a function to do the completion itself.\n\
|
|
443 It receives three arguments: the values STRING, PREDICATE and nil.\n\
|
|
444 Whatever it returns becomes the value of `try-completion'.\n\
|
|
445 \n\
|
|
446 If optional third argument PREDICATE is non-nil,\n\
|
|
447 it is used to test each possible match.\n\
|
|
448 The match is a candidate only if PREDICATE returns non-nil.\n\
|
|
449 The argument given to PREDICATE is the alist element or the symbol from the obarray.")
|
|
450 (string, alist, pred)
|
|
451 Lisp_Object string, alist, pred;
|
|
452 {
|
|
453 Lisp_Object bestmatch, tail, elt, eltstring;
|
|
454 int bestmatchsize;
|
|
455 int compare, matchsize;
|
|
456 int list = CONSP (alist) || NULL (alist);
|
|
457 int index, obsize;
|
|
458 int matchcount = 0;
|
|
459 Lisp_Object bucket, zero, end, tem;
|
|
460 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
461
|
|
462 CHECK_STRING (string, 0);
|
|
463 if (!list && XTYPE (alist) != Lisp_Vector)
|
|
464 return call3 (alist, string, pred, Qnil);
|
|
465
|
|
466 bestmatch = Qnil;
|
|
467
|
|
468 /* If ALIST is not a list, set TAIL just for gc pro. */
|
|
469 tail = alist;
|
|
470 if (! list)
|
|
471 {
|
|
472 index = 0;
|
|
473 obsize = XVECTOR (alist)->size;
|
|
474 bucket = XVECTOR (alist)->contents[index];
|
|
475 }
|
|
476
|
|
477 while (1)
|
|
478 {
|
|
479 /* Get the next element of the alist or obarray. */
|
|
480 /* Exit the loop if the elements are all used up. */
|
|
481 /* elt gets the alist element or symbol.
|
|
482 eltstring gets the name to check as a completion. */
|
|
483
|
|
484 if (list)
|
|
485 {
|
|
486 if (NULL (tail))
|
|
487 break;
|
|
488 elt = Fcar (tail);
|
|
489 eltstring = Fcar (elt);
|
|
490 tail = Fcdr (tail);
|
|
491 }
|
|
492 else
|
|
493 {
|
|
494 if (XFASTINT (bucket) != 0)
|
|
495 {
|
|
496 elt = bucket;
|
|
497 eltstring = Fsymbol_name (elt);
|
|
498 if (XSYMBOL (bucket)->next)
|
|
499 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
|
|
500 else
|
|
501 XFASTINT (bucket) = 0;
|
|
502 }
|
|
503 else if (++index >= obsize)
|
|
504 break;
|
|
505 else
|
|
506 {
|
|
507 bucket = XVECTOR (alist)->contents[index];
|
|
508 continue;
|
|
509 }
|
|
510 }
|
|
511
|
|
512 /* Is this element a possible completion? */
|
|
513
|
|
514 if (XTYPE (eltstring) == Lisp_String &&
|
|
515 XSTRING (string)->size <= XSTRING (eltstring)->size &&
|
|
516 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
|
|
517 XSTRING (string)->size))
|
|
518 {
|
|
519 /* Yes. */
|
|
520 /* Ignore this element if there is a predicate
|
|
521 and the predicate doesn't like it. */
|
|
522
|
|
523 if (!NULL (pred))
|
|
524 {
|
|
525 if (EQ (pred, Qcommandp))
|
|
526 tem = Fcommandp (elt);
|
|
527 else
|
|
528 {
|
|
529 GCPRO4 (tail, string, eltstring, bestmatch);
|
|
530 tem = call1 (pred, elt);
|
|
531 UNGCPRO;
|
|
532 }
|
|
533 if (NULL (tem)) continue;
|
|
534 }
|
|
535
|
|
536 /* Update computation of how much all possible completions match */
|
|
537
|
|
538 matchcount++;
|
|
539 if (NULL (bestmatch))
|
|
540 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
|
|
541 else
|
|
542 {
|
|
543 compare = min (bestmatchsize, XSTRING (eltstring)->size);
|
|
544 matchsize = scmp (XSTRING (bestmatch)->data,
|
|
545 XSTRING (eltstring)->data,
|
|
546 compare);
|
330
|
547 if (matchsize < 0)
|
|
548 matchsize = compare;
|
|
549 if (completion_ignore_case)
|
|
550 {
|
|
551 /* If this is an exact match except for case,
|
|
552 use it as the best match rather than one that is not an
|
|
553 exact match. This way, we get the case pattern
|
|
554 of the actual match. */
|
|
555 if ((matchsize == XSTRING (eltstring)->size
|
|
556 && matchsize < XSTRING (bestmatch)->size)
|
|
557 ||
|
|
558 /* If there is more than one exact match ignoring case,
|
|
559 and one of them is exact including case,
|
|
560 prefer that one. */
|
|
561 /* If there is no exact match ignoring case,
|
|
562 prefer a match that does not change the case
|
|
563 of the input. */
|
|
564 ((matchsize == XSTRING (eltstring)->size)
|
|
565 ==
|
|
566 (matchsize == XSTRING (bestmatch)->size)
|
|
567 && !bcmp (XSTRING (eltstring)->data,
|
|
568 XSTRING (string)->data, XSTRING (string)->size)
|
|
569 && bcmp (XSTRING (bestmatch)->data,
|
|
570 XSTRING (string)->data, XSTRING (string)->size)))
|
|
571 bestmatch = eltstring;
|
|
572 }
|
|
573 bestmatchsize = matchsize;
|
284
|
574 }
|
|
575 }
|
|
576 }
|
|
577
|
|
578 if (NULL (bestmatch))
|
|
579 return Qnil; /* No completions found */
|
330
|
580 /* If we are ignoring case, and there is no exact match,
|
|
581 and no additional text was supplied,
|
|
582 don't change the case of what the user typed. */
|
|
583 if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
|
|
584 && XSTRING (bestmatch)->size > bestmatchsize)
|
|
585 return string;
|
|
586
|
|
587 /* Return t if the supplied string is an exact match (counting case);
|
|
588 it does not require any change to be made. */
|
|
589 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
|
|
590 && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data,
|
|
591 bestmatchsize))
|
284
|
592 return Qt;
|
|
593
|
|
594 XFASTINT (zero) = 0; /* Else extract the part in which */
|
|
595 XFASTINT (end) = bestmatchsize; /* all completions agree */
|
|
596 return Fsubstring (bestmatch, zero, end);
|
|
597 }
|
|
598
|
|
599 /* Compare exactly LEN chars of strings at S1 and S2,
|
|
600 ignoring case if appropriate.
|
|
601 Return -1 if strings match,
|
|
602 else number of chars that match at the beginning. */
|
|
603
|
|
604 scmp (s1, s2, len)
|
|
605 register char *s1, *s2;
|
|
606 int len;
|
|
607 {
|
|
608 register int l = len;
|
|
609
|
|
610 if (completion_ignore_case)
|
|
611 {
|
|
612 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
|
|
613 l--;
|
|
614 }
|
|
615 else
|
|
616 {
|
|
617 while (l && *s1++ == *s2++)
|
|
618 l--;
|
|
619 }
|
|
620 if (l == 0)
|
|
621 return -1;
|
|
622 else return len - l;
|
|
623 }
|
|
624
|
|
625 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 3, 0,
|
|
626 "Search for partial matches to STRING in ALIST.\n\
|
|
627 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
|
|
628 The value is a list of all the strings from ALIST that match.\n\
|
|
629 ALIST can be an obarray instead of an alist.\n\
|
|
630 Then the print names of all symbols in the obarray are the possible matches.\n\
|
|
631 \n\
|
|
632 ALIST can also be a function to do the completion itself.\n\
|
|
633 It receives three arguments: the values STRING, PREDICATE and t.\n\
|
|
634 Whatever it returns becomes the value of `all-completion'.\n\
|
|
635 \n\
|
|
636 If optional third argument PREDICATE is non-nil,\n\
|
|
637 it is used to test each possible match.\n\
|
|
638 The match is a candidate only if PREDICATE returns non-nil.\n\
|
|
639 The argument given to PREDICATE is the alist element or the symbol from the obarray.")
|
|
640 (string, alist, pred)
|
|
641 Lisp_Object string, alist, pred;
|
|
642 {
|
|
643 Lisp_Object tail, elt, eltstring;
|
|
644 Lisp_Object allmatches;
|
|
645 int list = CONSP (alist) || NULL (alist);
|
|
646 int index, obsize;
|
|
647 Lisp_Object bucket, tem;
|
|
648 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
649
|
|
650 CHECK_STRING (string, 0);
|
|
651 if (!list && XTYPE (alist) != Lisp_Vector)
|
|
652 {
|
|
653 return call3 (alist, string, pred, Qt);
|
|
654 }
|
|
655 allmatches = Qnil;
|
|
656
|
|
657 /* If ALIST is not a list, set TAIL just for gc pro. */
|
|
658 tail = alist;
|
|
659 if (! list)
|
|
660 {
|
|
661 index = 0;
|
|
662 obsize = XVECTOR (alist)->size;
|
|
663 bucket = XVECTOR (alist)->contents[index];
|
|
664 }
|
|
665
|
|
666 while (1)
|
|
667 {
|
|
668 /* Get the next element of the alist or obarray. */
|
|
669 /* Exit the loop if the elements are all used up. */
|
|
670 /* elt gets the alist element or symbol.
|
|
671 eltstring gets the name to check as a completion. */
|
|
672
|
|
673 if (list)
|
|
674 {
|
|
675 if (NULL (tail))
|
|
676 break;
|
|
677 elt = Fcar (tail);
|
|
678 eltstring = Fcar (elt);
|
|
679 tail = Fcdr (tail);
|
|
680 }
|
|
681 else
|
|
682 {
|
|
683 if (XFASTINT (bucket) != 0)
|
|
684 {
|
|
685 elt = bucket;
|
|
686 eltstring = Fsymbol_name (elt);
|
|
687 if (XSYMBOL (bucket)->next)
|
|
688 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
|
|
689 else
|
|
690 XFASTINT (bucket) = 0;
|
|
691 }
|
|
692 else if (++index >= obsize)
|
|
693 break;
|
|
694 else
|
|
695 {
|
|
696 bucket = XVECTOR (alist)->contents[index];
|
|
697 continue;
|
|
698 }
|
|
699 }
|
|
700
|
|
701 /* Is this element a possible completion? */
|
|
702
|
|
703 if (XTYPE (eltstring) == Lisp_String &&
|
|
704 XSTRING (string)->size <= XSTRING (eltstring)->size &&
|
|
705 XSTRING (eltstring)->data[0] != ' ' &&
|
|
706 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
|
|
707 XSTRING (string)->size))
|
|
708 {
|
|
709 /* Yes. */
|
|
710 /* Ignore this element if there is a predicate
|
|
711 and the predicate doesn't like it. */
|
|
712
|
|
713 if (!NULL (pred))
|
|
714 {
|
|
715 if (EQ (pred, Qcommandp))
|
|
716 tem = Fcommandp (elt);
|
|
717 else
|
|
718 {
|
|
719 GCPRO4 (tail, eltstring, allmatches, string);
|
|
720 tem = call1 (pred, elt);
|
|
721 UNGCPRO;
|
|
722 }
|
|
723 if (NULL (tem)) continue;
|
|
724 }
|
|
725 /* Ok => put it on the list. */
|
|
726 allmatches = Fcons (eltstring, allmatches);
|
|
727 }
|
|
728 }
|
|
729
|
|
730 return Fnreverse (allmatches);
|
|
731 }
|
|
732
|
|
733 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
|
|
734 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
|
|
735 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
|
|
736
|
|
737 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
|
|
738 "Read a string in the minibuffer, with completion.\n\
|
|
739 Args are PROMPT, TABLE, PREDICATE, REQUIRE-MATCH and INITIAL-INPUT.\n\
|
|
740 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
|
|
741 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
|
|
742 PREDICATE limits completion to a subset of TABLE.\n\
|
|
743 See `try-completion' for more details on completion, TABLE, and PREDICATE.\n\
|
|
744 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
|
|
745 the input is (or completes to) an element of TABLE.\n\
|
|
746 If it is also not t, Return does not exit if it does non-null completion.\n\
|
|
747 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
|
|
748 Case is ignored if ambient value of `completion-ignore-case' is non-nil.\n\
|
|
749 If BACKUP-N is specified, point should be placed that many spaces from\n\
|
|
750 the end of the buffer. This is useful when providing default values,\n\
|
|
751 because you can put point before the last component of a filename or any\n\
|
|
752 other component that is likely to be deleted.")
|
|
753 (prompt, table, pred, require_match, init, backup_n)
|
|
754 Lisp_Object prompt, table, pred, require_match, init, backup_n;
|
|
755 {
|
|
756 Lisp_Object val;
|
|
757 int count = specpdl_ptr - specpdl;
|
|
758 specbind (Qminibuffer_completion_table, table);
|
|
759 specbind (Qminibuffer_completion_predicate, pred);
|
|
760 specbind (Qminibuffer_completion_confirm,
|
|
761 EQ (require_match, Qt) ? Qnil : Qt);
|
|
762 last_exact_completion = Qnil;
|
|
763 val = read_minibuf (NULL (require_match)
|
|
764 ? Vminibuffer_local_completion_map
|
|
765 : Vminibuffer_local_must_match_map,
|
|
766 init, prompt, backup_n, 0);
|
|
767 return unbind_to (count, val);
|
|
768 }
|
|
769
|
|
770 /* Temporarily display the string M at the end of the current
|
|
771 minibuffer contents. This is used to display things like
|
|
772 "[No Match]" when the user requests a completion for a prefix
|
|
773 that has no possible completions, and other quick, unobtrusive
|
|
774 messages. */
|
|
775
|
|
776 temp_echo_area_glyphs (m)
|
|
777 char *m;
|
|
778 {
|
|
779 /* It's not very modular to do things this way, but then it seems
|
|
780 to me that the whole echo_area_glyphs thing is a hack anyway. */
|
|
781 extern char *previous_echo_glyphs;
|
|
782
|
|
783 int osize = ZV;
|
|
784 Lisp_Object oinhibit;
|
|
785 oinhibit = Vinhibit_quit;
|
|
786
|
|
787 /* Clear out any old echo-area message to make way for our new
|
|
788 thing. */
|
|
789 echo_area_glyphs = previous_echo_glyphs = 0;
|
|
790
|
|
791 SET_PT (osize);
|
|
792 insert_string (m);
|
|
793 SET_PT (osize);
|
|
794 Vinhibit_quit = Qt;
|
|
795 Fsit_for (make_number (2), Qnil, Qnil);
|
|
796 del_range (point, ZV);
|
|
797 if (!NULL (Vquit_flag))
|
|
798 {
|
|
799 Vquit_flag = Qnil;
|
|
800 unread_command_char = Ctl ('g');
|
|
801 }
|
|
802 Vinhibit_quit = oinhibit;
|
|
803 }
|
|
804
|
|
805 Lisp_Object Fminibuffer_completion_help ();
|
330
|
806 Lisp_Object assoc_for_completion ();
|
284
|
807
|
|
808 /* returns:
|
|
809 * 0 no possible completion
|
|
810 * 1 was already an exact and unique completion
|
|
811 * 3 was already an exact completion
|
|
812 * 4 completed to an exact completion
|
|
813 * 5 some completion happened
|
|
814 * 6 no completion happened
|
|
815 */
|
|
816 int
|
|
817 do_completion ()
|
|
818 {
|
|
819 Lisp_Object completion, tem;
|
|
820 int completedp;
|
|
821 Lisp_Object last;
|
|
822
|
|
823 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
|
|
824 Vminibuffer_completion_predicate);
|
|
825 last = last_exact_completion;
|
|
826 last_exact_completion = Qnil;
|
|
827
|
|
828 if (NULL (completion))
|
|
829 {
|
|
830 bitch_at_user ();
|
|
831 temp_echo_area_glyphs (" [No match]");
|
|
832 return 0;
|
|
833 }
|
|
834
|
|
835 if (EQ (completion, Qt)) /* exact and unique match */
|
|
836 return 1;
|
|
837
|
|
838 /* compiler bug */
|
|
839 tem = Fstring_equal (completion, Fbuffer_string());
|
|
840 if (completedp = NULL (tem))
|
|
841 {
|
|
842 Ferase_buffer (); /* Some completion happened */
|
|
843 Finsert (1, &completion);
|
|
844 }
|
|
845
|
|
846 /* It did find a match. Do we match some possibility exactly now? */
|
|
847 if (CONSP (Vminibuffer_completion_table)
|
|
848 || NULL (Vminibuffer_completion_table))
|
330
|
849 tem = assoc_for_completion (Fbuffer_string (),
|
|
850 Vminibuffer_completion_table);
|
284
|
851 else if (XTYPE (Vminibuffer_completion_table) == Lisp_Vector)
|
|
852 {
|
|
853 /* the primitive used by Fintern_soft */
|
|
854 extern Lisp_Object oblookup ();
|
|
855
|
|
856 tem = Fbuffer_string ();
|
|
857 /* Bypass intern-soft as that loses for nil */
|
|
858 tem = oblookup (Vminibuffer_completion_table,
|
|
859 XSTRING (tem)->data, XSTRING (tem)->size);
|
|
860 if (XTYPE (tem) != Lisp_Symbol)
|
|
861 tem = Qnil;
|
|
862 else if (!NULL (Vminibuffer_completion_predicate))
|
|
863 tem = call1 (Vminibuffer_completion_predicate, tem);
|
|
864 else
|
|
865 tem = Qt;
|
|
866 }
|
|
867 else
|
|
868 tem = call3 (Vminibuffer_completion_table,
|
|
869 Fbuffer_string (),
|
|
870 Vminibuffer_completion_predicate,
|
|
871 Qlambda);
|
|
872
|
|
873 if (NULL (tem))
|
|
874 { /* not an exact match */
|
|
875 if (completedp)
|
|
876 return 5;
|
|
877 else if (auto_help)
|
|
878 Fminibuffer_completion_help ();
|
|
879 else
|
|
880 temp_echo_area_glyphs (" [Next char not unique]");
|
|
881 return 6;
|
|
882 }
|
|
883 else if (completedp)
|
|
884 return 4;
|
|
885 /* If the last exact completion and this one were the same,
|
|
886 it means we've already given a "Complete but not unique"
|
330
|
887 message and the user's hit TAB again, so now we give him help. */
|
284
|
888 last_exact_completion = completion;
|
|
889 if (!NULL (last))
|
|
890 {
|
|
891 tem = Fbuffer_string ();
|
|
892 if (!NULL (Fequal (tem, last)))
|
|
893 Fminibuffer_completion_help ();
|
|
894 }
|
|
895 return 3;
|
|
896 }
|
|
897
|
330
|
898 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
|
|
899
|
|
900 Lisp_Object
|
|
901 assoc_for_completion (key, list)
|
|
902 register Lisp_Object key;
|
|
903 Lisp_Object list;
|
|
904 {
|
|
905 register Lisp_Object tail;
|
|
906
|
|
907 if (completion_ignore_case)
|
|
908 key = Fupcase (key);
|
|
909
|
|
910 for (tail = list; !NULL (tail); tail = Fcdr (tail))
|
|
911 {
|
|
912 register Lisp_Object elt, tem, thiscar;
|
|
913 elt = Fcar (tail);
|
|
914 if (!CONSP (elt)) continue;
|
|
915 thiscar = Fcar (elt);
|
|
916 if (XTYPE (thiscar) != Lisp_String)
|
|
917 continue;
|
|
918 if (completion_ignore_case)
|
|
919 thiscar = Fupcase (thiscar);
|
|
920 tem = Fequal (thiscar, key);
|
|
921 if (!NULL (tem)) return elt;
|
|
922 QUIT;
|
|
923 }
|
|
924 return Qnil;
|
|
925 }
|
284
|
926
|
|
927 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
|
|
928 "Complete the minibuffer contents as far as possible.")
|
|
929 ()
|
|
930 {
|
|
931 register int i = do_completion ();
|
|
932 switch (i)
|
|
933 {
|
|
934 case 0:
|
|
935 return Qnil;
|
|
936
|
|
937 case 1:
|
|
938 temp_echo_area_glyphs (" [Sole completion]");
|
|
939 break;
|
|
940
|
|
941 case 3:
|
|
942 temp_echo_area_glyphs (" [Complete, but not unique]");
|
|
943 break;
|
|
944 }
|
|
945
|
|
946 return Qt;
|
|
947 }
|
|
948
|
|
949 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
|
|
950 Sminibuffer_complete_and_exit, 0, 0, "",
|
|
951 "Complete the minibuffer contents, and maybe exit.\n\
|
|
952 Exit if the name is valid with no completion needed.\n\
|
|
953 If name was completed to a valid match,\n\
|
|
954 a repetition of this command will exit.")
|
|
955 ()
|
|
956 {
|
|
957 register int i;
|
|
958
|
|
959 /* Allow user to specify null string */
|
|
960 if (BEGV == ZV)
|
|
961 goto exit;
|
|
962
|
|
963 i = do_completion ();
|
|
964 switch (i)
|
|
965 {
|
|
966 case 1:
|
|
967 case 3:
|
|
968 goto exit;
|
|
969
|
|
970 case 4:
|
|
971 if (!NULL (Vminibuffer_completion_confirm))
|
|
972 {
|
|
973 temp_echo_area_glyphs (" [Confirm]");
|
|
974 return Qnil;
|
|
975 }
|
|
976 else
|
|
977 goto exit;
|
|
978
|
|
979 default:
|
|
980 return Qnil;
|
|
981 }
|
|
982 exit:
|
|
983 Fthrow (Qexit, Qnil);
|
|
984 /* NOTREACHED */
|
|
985 }
|
|
986
|
|
987 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
|
|
988 0, 0, "",
|
|
989 "Complete the minibuffer contents at most a single word.\n\
|
|
990 After one word is completed as much as possible, a space or hyphen\n\
|
|
991 is added, provided that matches some possible completion.")
|
|
992 ()
|
|
993 {
|
|
994 Lisp_Object completion, tem;
|
|
995 register int i;
|
|
996 register unsigned char *completion_string;
|
|
997 /* We keep calling Fbuffer_string
|
|
998 rather than arrange for GC to hold onto a pointer to
|
|
999 one of the strings thus made. */
|
|
1000
|
|
1001 completion = Ftry_completion (Fbuffer_string (),
|
|
1002 Vminibuffer_completion_table,
|
|
1003 Vminibuffer_completion_predicate);
|
|
1004 if (NULL (completion))
|
|
1005 {
|
|
1006 bitch_at_user ();
|
|
1007 temp_echo_area_glyphs (" [No match]");
|
|
1008 return Qnil;
|
|
1009 }
|
|
1010 if (EQ (completion, Qt))
|
|
1011 return Qnil;
|
|
1012
|
|
1013 #if 0 /* How the below code used to look, for reference */
|
|
1014 tem = Fbuffer_string ();
|
|
1015 b = XSTRING (tem)->data;
|
|
1016 i = ZV - 1 - XSTRING (completion)->size;
|
|
1017 p = XSTRING (completion)->data;
|
|
1018 if (i > 0 ||
|
|
1019 0 <= scmp (b, p, ZV - 1))
|
|
1020 {
|
|
1021 i = 1;
|
|
1022 /* Set buffer to longest match of buffer tail and completion head. */
|
|
1023 while (0 <= scmp (b + i, p, ZV - 1 - i))
|
|
1024 i++;
|
|
1025 del_range (1, i + 1);
|
|
1026 SET_PT (ZV);
|
|
1027 }
|
|
1028 #else /* Rewritten code */
|
|
1029 {
|
|
1030 register unsigned char *buffer_string;
|
|
1031 int buffer_length, completion_length;
|
|
1032
|
|
1033 tem = Fbuffer_string ();
|
|
1034 buffer_string = XSTRING (tem)->data;
|
|
1035 completion_string = XSTRING (completion)->data;
|
|
1036 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
|
|
1037 completion_length = XSTRING (completion)->size;
|
|
1038 i = buffer_length - completion_length;
|
|
1039 /* Mly: I don't understand what this is supposed to do AT ALL */
|
|
1040 if (i > 0 ||
|
|
1041 0 <= scmp (buffer_string, completion_string, buffer_length))
|
|
1042 {
|
|
1043 /* Set buffer to longest match of buffer tail and completion head. */
|
|
1044 if (i <= 0) i = 1;
|
|
1045 buffer_string += i;
|
|
1046 buffer_length -= i;
|
|
1047 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
|
|
1048 i++;
|
|
1049 del_range (1, i + 1);
|
|
1050 SET_PT (ZV);
|
|
1051 }
|
|
1052 }
|
|
1053 #endif /* Rewritten code */
|
|
1054 i = ZV - BEGV;
|
|
1055
|
|
1056 /* If completion finds next char not unique,
|
|
1057 consider adding a space or a hyphen */
|
|
1058 if (i == XSTRING (completion)->size)
|
|
1059 {
|
|
1060 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
|
|
1061 Vminibuffer_completion_table,
|
|
1062 Vminibuffer_completion_predicate);
|
|
1063 if (XTYPE (tem) == Lisp_String)
|
|
1064 completion = tem;
|
|
1065 else
|
|
1066 {
|
|
1067 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
|
|
1068 Vminibuffer_completion_table,
|
|
1069 Vminibuffer_completion_predicate);
|
|
1070 if (XTYPE (tem) == Lisp_String)
|
|
1071 completion = tem;
|
|
1072 }
|
|
1073 }
|
|
1074
|
|
1075 /* Now find first word-break in the stuff found by completion.
|
|
1076 i gets index in string of where to stop completing. */
|
|
1077 completion_string = XSTRING (completion)->data;
|
|
1078
|
|
1079 for (; i < XSTRING (completion)->size; i++)
|
|
1080 if (SYNTAX (completion_string[i]) != Sword) break;
|
|
1081 if (i < XSTRING (completion)->size)
|
|
1082 i = i + 1;
|
|
1083
|
|
1084 /* If got no characters, print help for user. */
|
|
1085
|
|
1086 if (i == ZV - BEGV)
|
|
1087 {
|
|
1088 if (auto_help)
|
|
1089 Fminibuffer_completion_help ();
|
|
1090 return Qnil;
|
|
1091 }
|
|
1092
|
|
1093 /* Otherwise insert in minibuffer the chars we got */
|
|
1094
|
|
1095 Ferase_buffer ();
|
|
1096 insert_from_string (completion, 0, i);
|
|
1097 return Qt;
|
|
1098 }
|
|
1099
|
|
1100 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
|
|
1101 1, 1, 0,
|
|
1102 "Display in a buffer the list of completions, COMPLETIONS.\n\
|
|
1103 Each element may be just a symbol or string\n\
|
|
1104 or may be a list of two strings to be printed as if concatenated.")
|
|
1105 (completions)
|
|
1106 Lisp_Object completions;
|
|
1107 {
|
|
1108 register Lisp_Object tail, elt;
|
|
1109 register int i;
|
|
1110 struct buffer *old = current_buffer;
|
|
1111 /* No GCPRO needed, since (when it matters) every variable
|
|
1112 points to a non-string that is pointed to by COMPLETIONS. */
|
|
1113
|
|
1114 set_buffer_internal (XBUFFER (Vstandard_output));
|
|
1115
|
|
1116 if (NULL (completions))
|
|
1117 insert_string ("There are no possible completions of what you have typed.");
|
|
1118 else
|
|
1119 {
|
|
1120 insert_string ("Possible completions are:");
|
|
1121 for (tail = completions, i = 0; !NULL (tail); tail = Fcdr (tail), i++)
|
|
1122 {
|
|
1123 /* this needs fixing for the case of long completions
|
|
1124 and/or narrow windows */
|
|
1125 /* Sadly, the window it will appear in is not known
|
|
1126 until after the text has been made. */
|
|
1127 if (i & 1)
|
|
1128 Findent_to (make_number (35), make_number (1));
|
|
1129 else
|
|
1130 Fterpri (Qnil);
|
|
1131 elt = Fcar (tail);
|
|
1132 if (CONSP (elt))
|
|
1133 {
|
|
1134 Fprinc (Fcar (elt), Qnil);
|
|
1135 Fprinc (Fcar (Fcdr (elt)), Qnil);
|
|
1136 }
|
|
1137 else
|
|
1138 Fprinc (elt, Qnil);
|
|
1139 }
|
|
1140 }
|
|
1141 set_buffer_internal (old);
|
|
1142 return Qnil;
|
|
1143 }
|
|
1144
|
|
1145 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
|
|
1146 0, 0, "",
|
|
1147 "Display a list of possible completions of the current minibuffer contents.")
|
|
1148 ()
|
|
1149 {
|
|
1150 Lisp_Object completions;
|
|
1151
|
|
1152 message ("Making completion list...");
|
|
1153 completions = Fall_completions (Fbuffer_string (),
|
|
1154 Vminibuffer_completion_table,
|
|
1155 Vminibuffer_completion_predicate);
|
|
1156 echo_area_glyphs = 0;
|
|
1157
|
|
1158 if (NULL (completions))
|
|
1159 {
|
|
1160 bitch_at_user ();
|
|
1161 temp_echo_area_glyphs (" [No completions]");
|
|
1162 }
|
|
1163 else
|
|
1164 internal_with_output_to_temp_buffer ("*Completions*",
|
|
1165 Fdisplay_completion_list,
|
|
1166 Fsort (completions, Qstring_lessp));
|
|
1167 return Qnil;
|
|
1168 }
|
|
1169
|
|
1170 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
|
|
1171 "Terminate minibuffer input.")
|
|
1172 ()
|
|
1173 {
|
|
1174 if (XTYPE (last_command_char) == Lisp_Int)
|
|
1175 internal_self_insert (last_command_char, 0);
|
|
1176 else
|
|
1177 bitch_at_user ();
|
|
1178
|
|
1179 Fthrow (Qexit, Qnil);
|
|
1180 }
|
|
1181
|
|
1182 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
|
|
1183 "Terminate this minibuffer argument.")
|
|
1184 ()
|
|
1185 {
|
|
1186 Fthrow (Qexit, Qnil);
|
|
1187 }
|
|
1188
|
|
1189 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
|
|
1190 "Return current depth of activations of minibuffer, a nonnegative integer.")
|
|
1191 ()
|
|
1192 {
|
|
1193 return make_number (minibuf_level);
|
|
1194 }
|
|
1195
|
|
1196
|
|
1197 init_minibuf_once ()
|
|
1198 {
|
|
1199 Vminibuffer_list = Qnil;
|
|
1200 staticpro (&Vminibuffer_list);
|
|
1201 }
|
|
1202
|
|
1203 syms_of_minibuf ()
|
|
1204 {
|
|
1205 minibuf_level = 0;
|
|
1206 minibuf_prompt = 0;
|
|
1207 minibuf_save_vector_size = 5;
|
|
1208 minibuf_save_vector = (struct minibuf_save_data *) malloc (5 * sizeof (struct minibuf_save_data));
|
|
1209
|
|
1210 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
|
|
1211 staticpro (&Qminibuffer_completion_table);
|
|
1212
|
|
1213 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
|
|
1214 staticpro (&Qminibuffer_completion_confirm);
|
|
1215
|
|
1216 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
|
|
1217 staticpro (&Qminibuffer_completion_predicate);
|
|
1218
|
|
1219 staticpro (&last_minibuf_string);
|
|
1220 last_minibuf_string = Qnil;
|
|
1221
|
|
1222 Quser_variable_p = intern ("user-variable-p");
|
|
1223 staticpro (&Quser_variable_p);
|
|
1224
|
|
1225
|
|
1226
|
|
1227 DEFVAR_BOOL ("completion-auto-help", &auto_help,
|
|
1228 "*Non-nil means automatically provide help for invalid completion input.");
|
|
1229 auto_help = 1;
|
|
1230
|
|
1231 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
|
|
1232 "Non-nil means don't consider case significant in completion.");
|
|
1233 completion_ignore_case = 0;
|
|
1234
|
|
1235 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
|
|
1236 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
|
|
1237 More precisely, this variable makes a difference when the minibuffer window\n\
|
|
1238 is the selected window. If you are in some other window, minibuffer commands\n\
|
|
1239 are allowed even if a minibuffer is active.");
|
|
1240 enable_recursive_minibuffers = 0;
|
|
1241
|
|
1242 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
|
|
1243 "Alist or obarray used for completion in the minibuffer.\n\
|
|
1244 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
|
|
1245 \n\
|
|
1246 The value may alternatively be a function, which is given three arguments:\n\
|
|
1247 STRING, the current buffer contents;\n\
|
|
1248 PREDICATE, the predicate for filtering possible matches;\n\
|
|
1249 CODE, which says what kind of things to do.\n\
|
|
1250 CODE can be nil, t or `lambda'.\n\
|
|
1251 nil means to return the best completion of STRING, or nil if there is none.\n\
|
|
1252 t means to return a list of all possible completions of STRING.\n\
|
|
1253 `lambda' means to return t if STRING is a valid completion as it stands.");
|
|
1254 Vminibuffer_completion_table = Qnil;
|
|
1255
|
|
1256 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
|
|
1257 "Within call to `completing-read', this holds the PREDICATE argument.");
|
|
1258 Vminibuffer_completion_predicate = Qnil;
|
|
1259
|
|
1260 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
|
|
1261 "Non-nil => demand confirmation of completion before exiting minibuffer.");
|
|
1262 Vminibuffer_completion_confirm = Qnil;
|
|
1263
|
|
1264 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
|
|
1265 "Value that `help-form' takes on inside the minibuffer.");
|
|
1266 Vminibuffer_help_form = Qnil;
|
|
1267
|
|
1268 defsubr (&Sread_from_minibuffer);
|
|
1269 defsubr (&Seval_minibuffer);
|
|
1270 defsubr (&Sread_minibuffer);
|
|
1271 defsubr (&Sread_string);
|
|
1272 defsubr (&Sread_command);
|
|
1273 defsubr (&Sread_variable);
|
|
1274 defsubr (&Sread_buffer);
|
|
1275 defsubr (&Sread_no_blanks_input);
|
|
1276 defsubr (&Sminibuffer_depth);
|
|
1277
|
|
1278 defsubr (&Stry_completion);
|
|
1279 defsubr (&Sall_completions);
|
|
1280 defsubr (&Scompleting_read);
|
|
1281 defsubr (&Sminibuffer_complete);
|
|
1282 defsubr (&Sminibuffer_complete_word);
|
|
1283 defsubr (&Sminibuffer_complete_and_exit);
|
|
1284 defsubr (&Sdisplay_completion_list);
|
|
1285 defsubr (&Sminibuffer_completion_help);
|
|
1286
|
|
1287 defsubr (&Sself_insert_and_exit);
|
|
1288 defsubr (&Sexit_minibuffer);
|
|
1289
|
|
1290 }
|
|
1291
|
|
1292 keys_of_minibuf ()
|
|
1293 {
|
|
1294 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
|
|
1295 "abort-recursive-edit");
|
|
1296 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
|
|
1297 "exit-minibuffer");
|
|
1298 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
|
|
1299 "exit-minibuffer");
|
|
1300
|
|
1301 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
|
|
1302 "abort-recursive-edit");
|
|
1303 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
|
|
1304 "exit-minibuffer");
|
|
1305 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
|
|
1306 "exit-minibuffer");
|
|
1307
|
|
1308 initial_define_key (Vminibuffer_local_ns_map, ' ',
|
|
1309 "exit-minibuffer");
|
|
1310 initial_define_key (Vminibuffer_local_ns_map, '\t',
|
|
1311 "exit-minibuffer");
|
|
1312 initial_define_key (Vminibuffer_local_ns_map, '?',
|
|
1313 "self-insert-and-exit");
|
|
1314
|
|
1315 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
|
|
1316 "abort-recursive-edit");
|
|
1317 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
|
|
1318 "exit-minibuffer");
|
|
1319 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
|
|
1320 "exit-minibuffer");
|
|
1321
|
|
1322 initial_define_key (Vminibuffer_local_completion_map, '\t',
|
|
1323 "minibuffer-complete");
|
|
1324 initial_define_key (Vminibuffer_local_completion_map, ' ',
|
|
1325 "minibuffer-complete-word");
|
|
1326 initial_define_key (Vminibuffer_local_completion_map, '?',
|
|
1327 "minibuffer-completion-help");
|
|
1328
|
|
1329 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
|
|
1330 "abort-recursive-edit");
|
|
1331 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
|
|
1332 "minibuffer-complete-and-exit");
|
|
1333 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
|
|
1334 "minibuffer-complete-and-exit");
|
|
1335 initial_define_key (Vminibuffer_local_must_match_map, '\t',
|
|
1336 "minibuffer-complete");
|
|
1337 initial_define_key (Vminibuffer_local_must_match_map, ' ',
|
|
1338 "minibuffer-complete-word");
|
|
1339 initial_define_key (Vminibuffer_local_must_match_map, '?',
|
|
1340 "minibuffer-completion-help");
|
|
1341 }
|