]> code.delx.au - gnu-emacs/blob - src/minibuf.c
(XMISCTYPE): New macro.
[gnu-emacs] / src / minibuf.c
1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 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 2, 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 "frame.h"
27 #include "window.h"
28 #include "syntax.h"
29
30 #define min(a, b) ((a) < (b) ? (a) : (b))
31
32 extern int quit_char;
33
34 /* List of buffers for use as minibuffers.
35 The first element of the list is used for the outermost minibuffer
36 invocation, the next element is used for a recursive minibuffer
37 invocation, etc. The list is extended at the end as deeper
38 minibuffer recursions are encountered. */
39 Lisp_Object Vminibuffer_list;
40
41 /* Data to remember during recursive minibuffer invocations */
42 Lisp_Object minibuf_save_list;
43
44 /* Depth in minibuffer invocations. */
45 int minibuf_level;
46
47 /* Nonzero means display completion help for invalid input */
48 int auto_help;
49
50 /* Fread_minibuffer leaves the input here as a string. */
51 Lisp_Object last_minibuf_string;
52
53 /* Nonzero means let functions called when within a minibuffer
54 invoke recursive minibuffers (to read arguments, or whatever) */
55 int enable_recursive_minibuffers;
56
57 /* help-form is bound to this while in the minibuffer. */
58
59 Lisp_Object Vminibuffer_help_form;
60
61 /* Variable which is the history list to add minibuffer values to. */
62
63 Lisp_Object Vminibuffer_history_variable;
64
65 /* Current position in the history list (adjusted by M-n and M-p). */
66
67 Lisp_Object Vminibuffer_history_position;
68
69 Lisp_Object Qminibuffer_history;
70
71 Lisp_Object Qread_file_name_internal;
72
73 /* Normal hooks for entry to and exit from minibuffer. */
74
75 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
76 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
77
78 /* Nonzero means completion ignores case. */
79
80 int completion_ignore_case;
81
82 /* List of regexps that should restrict possible completions. */
83
84 Lisp_Object Vcompletion_regexp_list;
85
86 /* Nonzero means raise the minibuffer frame when the minibuffer
87 is entered. */
88
89 int minibuffer_auto_raise;
90
91 /* If last completion attempt reported "Complete but not unique"
92 then this is the string completed then; otherwise this is nil. */
93
94 static Lisp_Object last_exact_completion;
95
96 Lisp_Object Quser_variable_p;
97
98 /* Non-nil means it is the window for C-M-v to scroll
99 when the minibuffer is selected. */
100 extern Lisp_Object Vminibuf_scroll_window;
101
102 extern Lisp_Object Voverriding_local_map;
103 \f
104 /* Actual minibuffer invocation. */
105
106 void read_minibuf_unwind ();
107 Lisp_Object get_minibuffer ();
108 Lisp_Object read_minibuf ();
109
110 /* Read from the minibuffer using keymap MAP, initial contents INITIAL
111 (a string), putting point minus BACKUP_N chars from the end of INITIAL,
112 prompting with PROMPT (a string), using history list HISTVAR
113 with initial position HISTPOS. (BACKUP_N should be <= 0.)
114
115 Normally return the result as a string (the text that was read),
116 but if EXPFLAG is nonzero, read it and return the object read.
117 If HISTVAR is given, save the value read on that history only if it doesn't
118 match the front of that history list exactly. The value is pushed onto
119 the list as the string that was read. */
120
121 Lisp_Object
122 read_minibuf (map, initial, prompt, backup_n, expflag, histvar, histpos)
123 Lisp_Object map;
124 Lisp_Object initial;
125 Lisp_Object prompt;
126 Lisp_Object backup_n;
127 int expflag;
128 Lisp_Object histvar;
129 Lisp_Object histpos;
130 {
131 Lisp_Object val;
132 int count = specpdl_ptr - specpdl;
133 Lisp_Object mini_frame;
134 struct gcpro gcpro1, gcpro2, gcpro3;
135
136 #ifdef MULTI_KBOARD
137 kboard_locked = 1;
138 #endif
139
140 val = Qnil;
141 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
142 store them away before we can GC. Don't need to protect
143 BACKUP_N because we use the value only if it is an integer. */
144 GCPRO3 (map, initial, val);
145
146 if (!STRINGP (prompt))
147 prompt = build_string ("");
148
149 if (!enable_recursive_minibuffers
150 && minibuf_level > 0
151 && (EQ (selected_window, minibuf_window)))
152 #if 0
153 || selected_frame != XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))
154 #endif
155 error ("Command attempted to use minibuffer while in minibuffer");
156
157 /* Could we simply bind these variables instead? */
158 minibuf_save_list
159 = Fcons (minibuf_prompt,
160 Fcons (make_number (minibuf_prompt_width),
161 Fcons (Vhelp_form,
162 Fcons (Vcurrent_prefix_arg,
163 Fcons (Vminibuffer_history_position,
164 Fcons (Vminibuffer_history_variable,
165 Fcons (Voverriding_local_map,
166 minibuf_save_list)))))));
167 minibuf_prompt_width = 0; /* xdisp.c puts in the right value. */
168 minibuf_prompt = Fcopy_sequence (prompt);
169 Vminibuffer_history_position = histpos;
170 Vminibuffer_history_variable = histvar;
171
172 record_unwind_protect (Fset_window_configuration,
173 Fcurrent_window_configuration (Qnil));
174
175 /* If the minibuffer window is on a different frame, save that
176 frame's configuration too. */
177 #ifdef MULTI_FRAME
178 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
179 if (XFRAME (mini_frame) != selected_frame)
180 record_unwind_protect (Fset_window_configuration,
181 Fcurrent_window_configuration (mini_frame));
182
183 /* If the minibuffer is on an iconified or invisible frame,
184 make it visible now. */
185 Fmake_frame_visible (mini_frame);
186
187 if (minibuffer_auto_raise)
188 Fraise_frame (mini_frame);
189 #endif
190
191 val = current_buffer->directory;
192 Fset_buffer (get_minibuffer (minibuf_level));
193
194 /* The current buffer's default directory is usually the right thing
195 for our minibuffer here. However, if you're typing a command at
196 a minibuffer-only frame when minibuf_level is zero, then buf IS
197 the current_buffer, so reset_buffer leaves buf's default
198 directory unchanged. This is a bummer when you've just started
199 up Emacs and buf's default directory is Qnil. Here's a hack; can
200 you think of something better to do? Find another buffer with a
201 better directory, and use that one instead. */
202 if (STRINGP (val))
203 current_buffer->directory = val;
204 else
205 {
206 Lisp_Object buf_list;
207
208 for (buf_list = Vbuffer_alist;
209 CONSP (buf_list);
210 buf_list = XCONS (buf_list)->cdr)
211 {
212 Lisp_Object other_buf;
213
214 other_buf = XCONS (XCONS (buf_list)->car)->cdr;
215 if (STRINGP (XBUFFER (other_buf)->directory))
216 {
217 current_buffer->directory = XBUFFER (other_buf)->directory;
218 break;
219 }
220 }
221 }
222
223 #ifdef MULTI_FRAME
224 if (XFRAME (mini_frame) != selected_frame)
225 Fredirect_frame_focus (Fselected_frame (), mini_frame);
226 #endif
227 Fmake_local_variable (Qprint_escape_newlines);
228 print_escape_newlines = 1;
229
230 record_unwind_protect (read_minibuf_unwind, Qnil);
231
232 Vminibuf_scroll_window = selected_window;
233 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
234 Fselect_window (minibuf_window);
235 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
236
237 Ferase_buffer ();
238 minibuf_level++;
239
240 if (!NILP (initial))
241 {
242 Finsert (1, &initial);
243 if (!NILP (backup_n) && INTEGERP (backup_n))
244 Fforward_char (backup_n);
245 }
246
247 echo_area_glyphs = 0;
248 /* This is in case the minibuffer-setup-hook calls Fsit_for. */
249 previous_echo_glyphs = 0;
250
251 Vhelp_form = Vminibuffer_help_form;
252 current_buffer->keymap = map;
253
254 /* Run our hook, but not if it is empty.
255 (run-hooks would do nothing if it is empty,
256 but it's important to save time here in the usual case. */
257 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
258 && !NILP (Vrun_hooks))
259 call1 (Vrun_hooks, Qminibuffer_setup_hook);
260
261 /* ??? MCC did redraw_screen here if switching screens. */
262 recursive_edit_1 ();
263
264 /* If cursor is on the minibuffer line,
265 show the user we have exited by putting it in column 0. */
266 if ((FRAME_CURSOR_Y (selected_frame)
267 >= XFASTINT (XWINDOW (minibuf_window)->top))
268 && !noninteractive)
269 {
270 FRAME_CURSOR_X (selected_frame) = 0;
271 update_frame (selected_frame, 1, 1);
272 }
273
274 /* Make minibuffer contents into a string */
275 val = make_buffer_string (1, Z);
276 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
277
278 /* VAL is the string of minibuffer text. */
279 last_minibuf_string = val;
280
281 /* Add the value to the appropriate history list unless it is empty. */
282 if (XSTRING (val)->size != 0
283 && SYMBOLP (Vminibuffer_history_variable)
284 && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound))
285 {
286 /* If the caller wanted to save the value read on a history list,
287 then do so if the value is not already the front of the list. */
288 Lisp_Object histval;
289 histval = Fsymbol_value (Vminibuffer_history_variable);
290
291 /* The value of the history variable must be a cons or nil. Other
292 values are unacceptable. We silently ignore these values. */
293 if (NILP (histval)
294 || (CONSP (histval)
295 && NILP (Fequal (last_minibuf_string, Fcar (histval)))))
296 Fset (Vminibuffer_history_variable,
297 Fcons (last_minibuf_string, histval));
298 }
299
300 /* If Lisp form desired instead of string, parse it. */
301 if (expflag)
302 {
303 Lisp_Object expr_and_pos;
304 unsigned char *p;
305
306 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
307 /* Ignore trailing whitespace; any other trailing junk is an error. */
308 for (p = XSTRING (val)->data + XINT (Fcdr (expr_and_pos)); *p; p++)
309 if (*p != ' ' && *p != '\t' && *p != '\n')
310 error ("Trailing garbage following expression");
311 val = Fcar (expr_and_pos);
312 }
313
314 /* The appropriate frame will get selected
315 in set-window-configuration. */
316 RETURN_UNGCPRO (unbind_to (count, val));
317 }
318
319 /* Return a buffer to be used as the minibuffer at depth `depth'.
320 depth = 0 is the lowest allowed argument, and that is the value
321 used for nonrecursive minibuffer invocations */
322
323 Lisp_Object
324 get_minibuffer (depth)
325 int depth;
326 {
327 Lisp_Object tail, num, buf;
328 char name[24];
329 extern Lisp_Object nconc2 ();
330
331 XSETFASTINT (num, depth);
332 tail = Fnthcdr (num, Vminibuffer_list);
333 if (NILP (tail))
334 {
335 tail = Fcons (Qnil, Qnil);
336 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
337 }
338 buf = Fcar (tail);
339 if (NILP (buf) || NILP (XBUFFER (buf)->name))
340 {
341 sprintf (name, " *Minibuf-%d*", depth);
342 buf = Fget_buffer_create (build_string (name));
343
344 /* Although the buffer's name starts with a space, undo should be
345 enabled in it. */
346 Fbuffer_enable_undo (buf);
347
348 XCONS (tail)->car = buf;
349 }
350 else
351 {
352 int count = specpdl_ptr - specpdl;
353
354 reset_buffer (XBUFFER (buf));
355 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
356 Fset_buffer (buf);
357 Fkill_all_local_variables ();
358 unbind_to (count, Qnil);
359 }
360
361 return buf;
362 }
363
364 /* This function is called on exiting minibuffer, whether normally or not,
365 and it restores the current window, buffer, etc. */
366
367 void
368 read_minibuf_unwind (data)
369 Lisp_Object data;
370 {
371 Lisp_Object old_deactivate_mark;
372
373 /* We are exiting the minibuffer one way or the other,
374 so run the hook. */
375 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
376 && !NILP (Vrun_hooks))
377 call1 (Vrun_hooks, Qminibuffer_exit_hook);
378
379 /* Erase the minibuffer we were using at this level. */
380 Fset_buffer (XWINDOW (minibuf_window)->buffer);
381
382 /* Prevent error in erase-buffer. */
383 current_buffer->read_only = Qnil;
384
385 old_deactivate_mark = Vdeactivate_mark;
386 Ferase_buffer ();
387 Vdeactivate_mark = old_deactivate_mark;
388
389 /* If this was a recursive minibuffer,
390 tie the minibuffer window back to the outer level minibuffer buffer */
391 minibuf_level--;
392 /* Make sure minibuffer window is erased, not ignored */
393 windows_or_buffers_changed++;
394 XSETFASTINT (XWINDOW (minibuf_window)->last_modified, 0);
395
396 /* Restore prompt, etc from outer minibuffer */
397 minibuf_prompt = Fcar (minibuf_save_list);
398 minibuf_save_list = Fcdr (minibuf_save_list);
399 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
400 minibuf_save_list = Fcdr (minibuf_save_list);
401 Vhelp_form = Fcar (minibuf_save_list);
402 minibuf_save_list = Fcdr (minibuf_save_list);
403 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
404 minibuf_save_list = Fcdr (minibuf_save_list);
405 Vminibuffer_history_position = Fcar (minibuf_save_list);
406 minibuf_save_list = Fcdr (minibuf_save_list);
407 Vminibuffer_history_variable = Fcar (minibuf_save_list);
408 minibuf_save_list = Fcdr (minibuf_save_list);
409 Voverriding_local_map = Fcar (minibuf_save_list);
410 minibuf_save_list = Fcdr (minibuf_save_list);
411 }
412 \f
413
414 /* This comment supplies the doc string for read-from-minibuffer,
415 for make-docfile to see. We cannot put this in the real DEFUN
416 due to limits in the Unix cpp.
417
418 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
419 "Read a string from the minibuffer, prompting with string PROMPT.\n\
420 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
421 to be inserted into the minibuffer before reading input.\n\
422 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
423 is STRING, but point is placed POSITION characters into the string.\n\
424 Third arg KEYMAP is a keymap to use whilst reading;\n\
425 if omitted or nil, the default is `minibuffer-local-map'.\n\
426 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
427 and return that object:\n\
428 in other words, do `(car (read-from-string INPUT-STRING))'\n\
429 Fifth arg HIST, if non-nil, specifies a history list\n\
430 and optionally the initial position in the list.\n\
431 It can be a symbol, which is the history list variable to use,\n\
432 or it can be a cons cell (HISTVAR . HISTPOS).\n\
433 In that case, HISTVAR is the history list variable to use,\n\
434 and HISTPOS is the initial position (the position in the list\n\
435 which INITIAL-CONTENTS corresponds to).\n\
436 Positions are counted starting from 1 at the beginning of the list."
437 */
438
439 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
440 0 /* See immediately above */)
441 (prompt, initial_contents, keymap, read, hist)
442 Lisp_Object prompt, initial_contents, keymap, read, hist;
443 {
444 int pos = 0;
445 Lisp_Object histvar, histpos, position;
446 position = Qnil;
447
448 CHECK_STRING (prompt, 0);
449 if (!NILP (initial_contents))
450 {
451 if (CONSP (initial_contents))
452 {
453 position = Fcdr (initial_contents);
454 initial_contents = Fcar (initial_contents);
455 }
456 CHECK_STRING (initial_contents, 1);
457 if (!NILP (position))
458 {
459 CHECK_NUMBER (position, 0);
460 /* Convert to distance from end of input. */
461 pos = XINT (position) - 1 - XSTRING (initial_contents)->size;
462 }
463 }
464
465 if (NILP (keymap))
466 keymap = Vminibuffer_local_map;
467 else
468 keymap = get_keymap (keymap,2);
469
470 if (SYMBOLP (hist))
471 {
472 histvar = hist;
473 histpos = Qnil;
474 }
475 else
476 {
477 histvar = Fcar_safe (hist);
478 histpos = Fcdr_safe (hist);
479 }
480 if (NILP (histvar))
481 histvar = Qminibuffer_history;
482 if (NILP (histpos))
483 XSETFASTINT (histpos, 0);
484
485 return read_minibuf (keymap, initial_contents, prompt,
486 make_number (pos), !NILP (read), histvar, histpos);
487 }
488
489 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
490 "Return a Lisp object read using the minibuffer.\n\
491 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
492 is a string to insert in the minibuffer before reading.")
493 (prompt, initial_contents)
494 Lisp_Object prompt, initial_contents;
495 {
496 CHECK_STRING (prompt, 0);
497 if (!NILP (initial_contents))
498 CHECK_STRING (initial_contents, 1);
499 return read_minibuf (Vminibuffer_local_map, initial_contents,
500 prompt, Qnil, 1, Qminibuffer_history, make_number (0));
501 }
502
503 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
504 "Return value of Lisp expression read using the minibuffer.\n\
505 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
506 is a string to insert in the minibuffer before reading.")
507 (prompt, initial_contents)
508 Lisp_Object prompt, initial_contents;
509 {
510 return Feval (Fread_minibuffer (prompt, initial_contents));
511 }
512
513 /* Functions that use the minibuffer to read various things. */
514
515 DEFUN ("read-string", Fread_string, Sread_string, 1, 3, 0,
516 "Read a string from the minibuffer, prompting with string PROMPT.\n\
517 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.\n\
518 The third arg HISTORY, if non-nil, specifies a history list\n\
519 and optionally the initial position in the list.\n\
520 See `read-from-minibuffer' for details of HISTORY argument.")
521 (prompt, initial_input, history)
522 Lisp_Object prompt, initial_input, history;
523 {
524 return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, history);
525 }
526
527 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 2, 0,
528 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
529 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
530 (prompt, init)
531 Lisp_Object prompt, init;
532 {
533 CHECK_STRING (prompt, 0);
534 if (! NILP (init))
535 CHECK_STRING (init, 1);
536
537 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0,
538 Qminibuffer_history, make_number (0));
539 }
540
541 DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
542 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
543 Prompts with PROMPT.")
544 (prompt)
545 Lisp_Object prompt;
546 {
547 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil),
548 Qnil);
549 }
550
551 #ifdef NOTDEF
552 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
553 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
554 Prompts with PROMPT.")
555 (prompt)
556 Lisp_Object prompt;
557 {
558 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil),
559 Qnil);
560 }
561 #endif /* NOTDEF */
562
563 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
564 "One arg PROMPT, a string. Read the name of a user variable and return\n\
565 it as a symbol. Prompts with PROMPT.\n\
566 A user variable is one whose documentation starts with a `*' character.")
567 (prompt)
568 Lisp_Object prompt;
569 {
570 return Fintern (Fcompleting_read (prompt, Vobarray,
571 Quser_variable_p, Qt, Qnil, Qnil),
572 Qnil);
573 }
574
575 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
576 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
577 Prompts with PROMPT.\n\
578 Optional second arg is value to return if user enters an empty line.\n\
579 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
580 (prompt, def, require_match)
581 Lisp_Object prompt, def, require_match;
582 {
583 Lisp_Object tem;
584 Lisp_Object args[3];
585 struct gcpro gcpro1;
586
587 if (BUFFERP (def))
588 def = XBUFFER (def)->name;
589 if (!NILP (def))
590 {
591 args[0] = build_string ("%s(default %s) ");
592 args[1] = prompt;
593 args[2] = def;
594 prompt = Fformat (3, args);
595 }
596 GCPRO1 (def);
597 tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil);
598 UNGCPRO;
599 if (XSTRING (tem)->size)
600 return tem;
601 return def;
602 }
603 \f
604 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
605 "Return common substring of all completions of STRING in ALIST.\n\
606 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
607 All that match are compared together; the longest initial sequence\n\
608 common to all matches is returned as a string.\n\
609 If there is no match at all, nil is returned.\n\
610 For an exact match, t is returned.\n\
611 \n\
612 ALIST can be an obarray instead of an alist.\n\
613 Then the print names of all symbols in the obarray are the possible matches.\n\
614 \n\
615 ALIST can also be a function to do the completion itself.\n\
616 It receives three arguments: the values STRING, PREDICATE and nil.\n\
617 Whatever it returns becomes the value of `try-completion'.\n\
618 \n\
619 If optional third argument PREDICATE is non-nil,\n\
620 it is used to test each possible match.\n\
621 The match is a candidate only if PREDICATE returns non-nil.\n\
622 The argument given to PREDICATE is the alist element\n\
623 or the symbol from the obarray.")
624 (string, alist, pred)
625 Lisp_Object string, alist, pred;
626 {
627 Lisp_Object bestmatch, tail, elt, eltstring;
628 int bestmatchsize;
629 int compare, matchsize;
630 int list = CONSP (alist) || NILP (alist);
631 int index, obsize;
632 int matchcount = 0;
633 Lisp_Object bucket, zero, end, tem;
634 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
635
636 CHECK_STRING (string, 0);
637 if (!list && !VECTORP (alist))
638 return call3 (alist, string, pred, Qnil);
639
640 bestmatch = Qnil;
641
642 /* If ALIST is not a list, set TAIL just for gc pro. */
643 tail = alist;
644 if (! list)
645 {
646 index = 0;
647 obsize = XVECTOR (alist)->size;
648 bucket = XVECTOR (alist)->contents[index];
649 }
650
651 while (1)
652 {
653 /* Get the next element of the alist or obarray. */
654 /* Exit the loop if the elements are all used up. */
655 /* elt gets the alist element or symbol.
656 eltstring gets the name to check as a completion. */
657
658 if (list)
659 {
660 if (NILP (tail))
661 break;
662 elt = Fcar (tail);
663 eltstring = Fcar (elt);
664 tail = Fcdr (tail);
665 }
666 else
667 {
668 if (XFASTINT (bucket) != 0)
669 {
670 elt = bucket;
671 eltstring = Fsymbol_name (elt);
672 if (XSYMBOL (bucket)->next)
673 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
674 else
675 XSETFASTINT (bucket, 0);
676 }
677 else if (++index >= obsize)
678 break;
679 else
680 {
681 bucket = XVECTOR (alist)->contents[index];
682 continue;
683 }
684 }
685
686 /* Is this element a possible completion? */
687
688 if (STRINGP (eltstring)
689 && XSTRING (string)->size <= XSTRING (eltstring)->size
690 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
691 XSTRING (string)->size))
692 {
693 /* Yes. */
694 Lisp_Object regexps;
695 Lisp_Object zero;
696 XSETFASTINT (zero, 0);
697
698 /* Ignore this element if it fails to match all the regexps. */
699 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
700 regexps = XCONS (regexps)->cdr)
701 {
702 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
703 if (NILP (tem))
704 break;
705 }
706 if (CONSP (regexps))
707 continue;
708
709 /* Ignore this element if there is a predicate
710 and the predicate doesn't like it. */
711
712 if (!NILP (pred))
713 {
714 if (EQ (pred, Qcommandp))
715 tem = Fcommandp (elt);
716 else
717 {
718 GCPRO4 (tail, string, eltstring, bestmatch);
719 tem = call1 (pred, elt);
720 UNGCPRO;
721 }
722 if (NILP (tem)) continue;
723 }
724
725 /* Update computation of how much all possible completions match */
726
727 matchcount++;
728 if (NILP (bestmatch))
729 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
730 else
731 {
732 compare = min (bestmatchsize, XSTRING (eltstring)->size);
733 matchsize = scmp (XSTRING (bestmatch)->data,
734 XSTRING (eltstring)->data,
735 compare);
736 if (matchsize < 0)
737 matchsize = compare;
738 if (completion_ignore_case)
739 {
740 /* If this is an exact match except for case,
741 use it as the best match rather than one that is not an
742 exact match. This way, we get the case pattern
743 of the actual match. */
744 if ((matchsize == XSTRING (eltstring)->size
745 && matchsize < XSTRING (bestmatch)->size)
746 ||
747 /* If there is more than one exact match ignoring case,
748 and one of them is exact including case,
749 prefer that one. */
750 /* If there is no exact match ignoring case,
751 prefer a match that does not change the case
752 of the input. */
753 ((matchsize == XSTRING (eltstring)->size)
754 ==
755 (matchsize == XSTRING (bestmatch)->size)
756 && !bcmp (XSTRING (eltstring)->data,
757 XSTRING (string)->data, XSTRING (string)->size)
758 && bcmp (XSTRING (bestmatch)->data,
759 XSTRING (string)->data, XSTRING (string)->size)))
760 bestmatch = eltstring;
761 }
762 bestmatchsize = matchsize;
763 }
764 }
765 }
766
767 if (NILP (bestmatch))
768 return Qnil; /* No completions found */
769 /* If we are ignoring case, and there is no exact match,
770 and no additional text was supplied,
771 don't change the case of what the user typed. */
772 if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
773 && XSTRING (bestmatch)->size > bestmatchsize)
774 return string;
775
776 /* Return t if the supplied string is an exact match (counting case);
777 it does not require any change to be made. */
778 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
779 && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data,
780 bestmatchsize))
781 return Qt;
782
783 XSETFASTINT (zero, 0); /* Else extract the part in which */
784 XSETFASTINT (end, bestmatchsize); /* all completions agree */
785 return Fsubstring (bestmatch, zero, end);
786 }
787
788 /* Compare exactly LEN chars of strings at S1 and S2,
789 ignoring case if appropriate.
790 Return -1 if strings match,
791 else number of chars that match at the beginning. */
792
793 int
794 scmp (s1, s2, len)
795 register unsigned char *s1, *s2;
796 int len;
797 {
798 register int l = len;
799
800 if (completion_ignore_case)
801 {
802 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
803 l--;
804 }
805 else
806 {
807 while (l && *s1++ == *s2++)
808 l--;
809 }
810 if (l == 0)
811 return -1;
812 else
813 return len - l;
814 }
815 \f
816 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
817 "Search for partial matches to STRING in ALIST.\n\
818 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
819 The value is a list of all the strings from ALIST that match.\n\
820 \n\
821 ALIST can be an obarray instead of an alist.\n\
822 Then the print names of all symbols in the obarray are the possible matches.\n\
823 \n\
824 ALIST can also be a function to do the completion itself.\n\
825 It receives three arguments: the values STRING, PREDICATE and t.\n\
826 Whatever it returns becomes the value of `all-completion'.\n\
827 \n\
828 If optional third argument PREDICATE is non-nil,\n\
829 it is used to test each possible match.\n\
830 The match is a candidate only if PREDICATE returns non-nil.\n\
831 The argument given to PREDICATE is the alist element\n\
832 or the symbol from the obarray.\n\
833 \n\
834 If the optional fourth argument HIDE-SPACES is non-nil,\n\
835 strings in ALIST that start with a space\n\
836 are ignored unless STRING itself starts with a space.")
837 (string, alist, pred, hide_spaces)
838 Lisp_Object string, alist, pred, hide_spaces;
839 {
840 Lisp_Object tail, elt, eltstring;
841 Lisp_Object allmatches;
842 int list = CONSP (alist) || NILP (alist);
843 int index, obsize;
844 Lisp_Object bucket, tem;
845 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
846
847 CHECK_STRING (string, 0);
848 if (!list && !VECTORP (alist))
849 {
850 return call3 (alist, string, pred, Qt);
851 }
852 allmatches = Qnil;
853
854 /* If ALIST is not a list, set TAIL just for gc pro. */
855 tail = alist;
856 if (! list)
857 {
858 index = 0;
859 obsize = XVECTOR (alist)->size;
860 bucket = XVECTOR (alist)->contents[index];
861 }
862
863 while (1)
864 {
865 /* Get the next element of the alist or obarray. */
866 /* Exit the loop if the elements are all used up. */
867 /* elt gets the alist element or symbol.
868 eltstring gets the name to check as a completion. */
869
870 if (list)
871 {
872 if (NILP (tail))
873 break;
874 elt = Fcar (tail);
875 eltstring = Fcar (elt);
876 tail = Fcdr (tail);
877 }
878 else
879 {
880 if (XFASTINT (bucket) != 0)
881 {
882 elt = bucket;
883 eltstring = Fsymbol_name (elt);
884 if (XSYMBOL (bucket)->next)
885 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
886 else
887 XSETFASTINT (bucket, 0);
888 }
889 else if (++index >= obsize)
890 break;
891 else
892 {
893 bucket = XVECTOR (alist)->contents[index];
894 continue;
895 }
896 }
897
898 /* Is this element a possible completion? */
899
900 if (STRINGP (eltstring)
901 && XSTRING (string)->size <= XSTRING (eltstring)->size
902 /* If HIDE_SPACES, reject alternatives that start with space
903 unless the input starts with space. */
904 && ((XSTRING (string)->size > 0 && XSTRING (string)->data[0] == ' ')
905 || XSTRING (eltstring)->data[0] != ' '
906 || NILP (hide_spaces))
907 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
908 XSTRING (string)->size))
909 {
910 /* Yes. */
911 Lisp_Object regexps;
912 Lisp_Object zero;
913 XSETFASTINT (zero, 0);
914
915 /* Ignore this element if it fails to match all the regexps. */
916 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
917 regexps = XCONS (regexps)->cdr)
918 {
919 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
920 if (NILP (tem))
921 break;
922 }
923 if (CONSP (regexps))
924 continue;
925
926 /* Ignore this element if there is a predicate
927 and the predicate doesn't like it. */
928
929 if (!NILP (pred))
930 {
931 if (EQ (pred, Qcommandp))
932 tem = Fcommandp (elt);
933 else
934 {
935 GCPRO4 (tail, eltstring, allmatches, string);
936 tem = call1 (pred, elt);
937 UNGCPRO;
938 }
939 if (NILP (tem)) continue;
940 }
941 /* Ok => put it on the list. */
942 allmatches = Fcons (eltstring, allmatches);
943 }
944 }
945
946 return Fnreverse (allmatches);
947 }
948 \f
949 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
950 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
951 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
952
953 /* This comment supplies the doc string for completing-read,
954 for make-docfile to see. We cannot put this in the real DEFUN
955 due to limits in the Unix cpp.
956
957 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
958 "Read a string in the minibuffer, with completion.\n\
959 Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST.\n\
960 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
961 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
962 PREDICATE limits completion to a subset of TABLE.\n\
963 See `try-completion' and `all-completions' for more details
964 on completion, TABLE, and PREDICATE.\n\
965 \n\
966 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
967 the input is (or completes to) an element of TABLE or is null.\n\
968 If it is also not t, Return does not exit if it does non-null completion.\n\
969 If the input is null, `completing-read' returns nil,\n\
970 regardless of the value of REQUIRE-MATCH.\n\
971 \n\
972 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
973 If it is (STRING . POSITION), the initial input\n\
974 is STRING, but point is placed POSITION characters into the string.\n\
975 HIST, if non-nil, specifies a history list\n\
976 and optionally the initial position in the list.\n\
977 It can be a symbol, which is the history list variable to use,\n\
978 or it can be a cons cell (HISTVAR . HISTPOS).\n\
979 In that case, HISTVAR is the history list variable to use,\n\
980 and HISTPOS is the initial position (the position in the list\n\
981 which INITIAL-CONTENTS corresponds to).\n\
982 Positions are counted starting from 1 at the beginning of the list.\n\
983 Completion ignores case if the ambient value of\n\
984 `completion-ignore-case' is non-nil."
985 */
986 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
987 0 /* See immediately above */)
988 (prompt, table, pred, require_match, init, hist)
989 Lisp_Object prompt, table, pred, require_match, init, hist;
990 {
991 Lisp_Object val, histvar, histpos, position;
992 int pos = 0;
993 int count = specpdl_ptr - specpdl;
994 specbind (Qminibuffer_completion_table, table);
995 specbind (Qminibuffer_completion_predicate, pred);
996 specbind (Qminibuffer_completion_confirm,
997 EQ (require_match, Qt) ? Qnil : Qt);
998 last_exact_completion = Qnil;
999
1000 position = Qnil;
1001 if (!NILP (init))
1002 {
1003 if (CONSP (init))
1004 {
1005 position = Fcdr (init);
1006 init = Fcar (init);
1007 }
1008 CHECK_STRING (init, 0);
1009 if (!NILP (position))
1010 {
1011 CHECK_NUMBER (position, 0);
1012 /* Convert to distance from end of input. */
1013 pos = XINT (position) - XSTRING (init)->size;
1014 }
1015 }
1016
1017 if (SYMBOLP (hist))
1018 {
1019 histvar = hist;
1020 histpos = Qnil;
1021 }
1022 else
1023 {
1024 histvar = Fcar_safe (hist);
1025 histpos = Fcdr_safe (hist);
1026 }
1027 if (NILP (histvar))
1028 histvar = Qminibuffer_history;
1029 if (NILP (histpos))
1030 XSETFASTINT (histpos, 0);
1031
1032 val = read_minibuf (NILP (require_match)
1033 ? Vminibuffer_local_completion_map
1034 : Vminibuffer_local_must_match_map,
1035 init, prompt, make_number (pos), 0,
1036 histvar, histpos);
1037 return unbind_to (count, val);
1038 }
1039 \f
1040 /* Temporarily display the string M at the end of the current
1041 minibuffer contents. This is used to display things like
1042 "[No Match]" when the user requests a completion for a prefix
1043 that has no possible completions, and other quick, unobtrusive
1044 messages. */
1045
1046 temp_echo_area_glyphs (m)
1047 char *m;
1048 {
1049 int osize = ZV;
1050 Lisp_Object oinhibit;
1051 oinhibit = Vinhibit_quit;
1052
1053 /* Clear out any old echo-area message to make way for our new thing. */
1054 message (0);
1055
1056 SET_PT (osize);
1057 insert_string (m);
1058 SET_PT (osize);
1059 Vinhibit_quit = Qt;
1060 Fsit_for (make_number (2), Qnil, Qnil);
1061 del_range (PT, ZV);
1062 if (!NILP (Vquit_flag))
1063 {
1064 Vquit_flag = Qnil;
1065 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1066 }
1067 Vinhibit_quit = oinhibit;
1068 }
1069
1070 Lisp_Object Fminibuffer_completion_help ();
1071 Lisp_Object assoc_for_completion ();
1072 /* A subroutine of Fintern_soft. */
1073 extern Lisp_Object oblookup ();
1074
1075
1076 /* Test whether TXT is an exact completion. */
1077 Lisp_Object
1078 test_completion (txt)
1079 Lisp_Object txt;
1080 {
1081 Lisp_Object tem;
1082
1083 if (CONSP (Vminibuffer_completion_table)
1084 || NILP (Vminibuffer_completion_table))
1085 return assoc_for_completion (txt, Vminibuffer_completion_table);
1086 else if (VECTORP (Vminibuffer_completion_table))
1087 {
1088 /* Bypass intern-soft as that loses for nil */
1089 tem = oblookup (Vminibuffer_completion_table,
1090 XSTRING (txt)->data, XSTRING (txt)->size);
1091 if (!SYMBOLP (tem))
1092 return Qnil;
1093 else if (!NILP (Vminibuffer_completion_predicate))
1094 return call1 (Vminibuffer_completion_predicate, tem);
1095 else
1096 return Qt;
1097 }
1098 else
1099 return call3 (Vminibuffer_completion_table, txt,
1100 Vminibuffer_completion_predicate, Qlambda);
1101 }
1102
1103 /* returns:
1104 * 0 no possible completion
1105 * 1 was already an exact and unique completion
1106 * 3 was already an exact completion
1107 * 4 completed to an exact completion
1108 * 5 some completion happened
1109 * 6 no completion happened
1110 */
1111 int
1112 do_completion ()
1113 {
1114 Lisp_Object completion, tem;
1115 int completedp;
1116 Lisp_Object last;
1117 struct gcpro gcpro1, gcpro2;
1118
1119 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
1120 Vminibuffer_completion_predicate);
1121 last = last_exact_completion;
1122 last_exact_completion = Qnil;
1123
1124 GCPRO2 (completion, last);
1125
1126 if (NILP (completion))
1127 {
1128 bitch_at_user ();
1129 temp_echo_area_glyphs (" [No match]");
1130 UNGCPRO;
1131 return 0;
1132 }
1133
1134 if (EQ (completion, Qt)) /* exact and unique match */
1135 {
1136 UNGCPRO;
1137 return 1;
1138 }
1139
1140 /* compiler bug */
1141 tem = Fstring_equal (completion, Fbuffer_string());
1142 if (completedp = NILP (tem))
1143 {
1144 Ferase_buffer (); /* Some completion happened */
1145 Finsert (1, &completion);
1146 }
1147
1148 /* It did find a match. Do we match some possibility exactly now? */
1149 tem = test_completion (Fbuffer_string ());
1150 if (NILP (tem))
1151 {
1152 /* not an exact match */
1153 UNGCPRO;
1154 if (completedp)
1155 return 5;
1156 else if (auto_help)
1157 Fminibuffer_completion_help ();
1158 else
1159 temp_echo_area_glyphs (" [Next char not unique]");
1160 return 6;
1161 }
1162 else if (completedp)
1163 {
1164 UNGCPRO;
1165 return 4;
1166 }
1167 /* If the last exact completion and this one were the same,
1168 it means we've already given a "Complete but not unique"
1169 message and the user's hit TAB again, so now we give him help. */
1170 last_exact_completion = completion;
1171 if (!NILP (last))
1172 {
1173 tem = Fbuffer_string ();
1174 if (!NILP (Fequal (tem, last)))
1175 Fminibuffer_completion_help ();
1176 }
1177 UNGCPRO;
1178 return 3;
1179 }
1180
1181 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1182
1183 Lisp_Object
1184 assoc_for_completion (key, list)
1185 register Lisp_Object key;
1186 Lisp_Object list;
1187 {
1188 register Lisp_Object tail;
1189
1190 if (completion_ignore_case)
1191 key = Fupcase (key);
1192
1193 for (tail = list; !NILP (tail); tail = Fcdr (tail))
1194 {
1195 register Lisp_Object elt, tem, thiscar;
1196 elt = Fcar (tail);
1197 if (!CONSP (elt)) continue;
1198 thiscar = Fcar (elt);
1199 if (!STRINGP (thiscar))
1200 continue;
1201 if (completion_ignore_case)
1202 thiscar = Fupcase (thiscar);
1203 tem = Fequal (thiscar, key);
1204 if (!NILP (tem)) return elt;
1205 QUIT;
1206 }
1207 return Qnil;
1208 }
1209
1210 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
1211 "Complete the minibuffer contents as far as possible.\n\
1212 Return nil if there is no valid completion, else t.\n\
1213 If no characters can be completed, display a list of possible completions.\n\
1214 If you repeat this command after it displayed such a list,\n\
1215 scroll the window of possible completions.")
1216 ()
1217 {
1218 register int i;
1219 Lisp_Object window, tem;
1220
1221 /* If the previous command was not this, then mark the completion
1222 buffer obsolete. */
1223 if (! EQ (last_command, this_command))
1224 Vminibuf_scroll_window = Qnil;
1225
1226 window = Vminibuf_scroll_window;
1227 /* If there's a fresh completion window with a live buffer,
1228 and this command is repeated, scroll that window. */
1229 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
1230 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
1231 {
1232 struct buffer *obuf = current_buffer;
1233
1234 Fset_buffer (XWINDOW (window)->buffer);
1235 tem = Fpos_visible_in_window_p (make_number (ZV), window);
1236 if (! NILP (tem))
1237 /* If end is in view, scroll up to the beginning. */
1238 Fset_window_start (window, BEGV, Qnil);
1239 else
1240 /* Else scroll down one screen. */
1241 Fscroll_other_window (Qnil);
1242
1243 set_buffer_internal (obuf);
1244 return Qnil;
1245 }
1246
1247 i = do_completion ();
1248 switch (i)
1249 {
1250 case 0:
1251 return Qnil;
1252
1253 case 1:
1254 temp_echo_area_glyphs (" [Sole completion]");
1255 break;
1256
1257 case 3:
1258 temp_echo_area_glyphs (" [Complete, but not unique]");
1259 break;
1260 }
1261
1262 return Qt;
1263 }
1264 \f
1265 /* Subroutines of Fminibuffer_complete_and_exit. */
1266
1267 /* This one is called by internal_condition_case to do the real work. */
1268
1269 Lisp_Object
1270 complete_and_exit_1 ()
1271 {
1272 return make_number (do_completion ());
1273 }
1274
1275 /* This one is called by internal_condition_case if an error happens.
1276 Pretend the current value is an exact match. */
1277
1278 Lisp_Object
1279 complete_and_exit_2 (ignore)
1280 Lisp_Object ignore;
1281 {
1282 return make_number (1);
1283 }
1284
1285 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
1286 Sminibuffer_complete_and_exit, 0, 0, "",
1287 "If the minibuffer contents is a valid completion then exit.\n\
1288 Otherwise try to complete it. If completion leads to a valid completion,\n\
1289 a repetition of this command will exit.")
1290 ()
1291 {
1292 register int i;
1293 Lisp_Object val;
1294
1295 /* Allow user to specify null string */
1296 if (BEGV == ZV)
1297 goto exit;
1298
1299 if (!NILP (test_completion (Fbuffer_string ())))
1300 goto exit;
1301
1302 /* Call do_completion, but ignore errors. */
1303 val = internal_condition_case (complete_and_exit_1, Qerror,
1304 complete_and_exit_2);
1305
1306 i = XFASTINT (val);
1307 switch (i)
1308 {
1309 case 1:
1310 case 3:
1311 goto exit;
1312
1313 case 4:
1314 if (!NILP (Vminibuffer_completion_confirm))
1315 {
1316 temp_echo_area_glyphs (" [Confirm]");
1317 return Qnil;
1318 }
1319 else
1320 goto exit;
1321
1322 default:
1323 return Qnil;
1324 }
1325 exit:
1326 Fthrow (Qexit, Qnil);
1327 /* NOTREACHED */
1328 }
1329
1330 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
1331 0, 0, "",
1332 "Complete the minibuffer contents at most a single word.\n\
1333 After one word is completed as much as possible, a space or hyphen\n\
1334 is added, provided that matches some possible completion.\n\
1335 Return nil if there is no valid completion, else t.")
1336 ()
1337 {
1338 Lisp_Object completion, tem;
1339 register int i;
1340 register unsigned char *completion_string;
1341 struct gcpro gcpro1, gcpro2;
1342
1343 /* We keep calling Fbuffer_string rather than arrange for GC to
1344 hold onto a pointer to one of the strings thus made. */
1345
1346 completion = Ftry_completion (Fbuffer_string (),
1347 Vminibuffer_completion_table,
1348 Vminibuffer_completion_predicate);
1349 if (NILP (completion))
1350 {
1351 bitch_at_user ();
1352 temp_echo_area_glyphs (" [No match]");
1353 return Qnil;
1354 }
1355 if (EQ (completion, Qt))
1356 return Qnil;
1357
1358 #if 0 /* How the below code used to look, for reference. */
1359 tem = Fbuffer_string ();
1360 b = XSTRING (tem)->data;
1361 i = ZV - 1 - XSTRING (completion)->size;
1362 p = XSTRING (completion)->data;
1363 if (i > 0 ||
1364 0 <= scmp (b, p, ZV - 1))
1365 {
1366 i = 1;
1367 /* Set buffer to longest match of buffer tail and completion head. */
1368 while (0 <= scmp (b + i, p, ZV - 1 - i))
1369 i++;
1370 del_range (1, i + 1);
1371 SET_PT (ZV);
1372 }
1373 #else /* Rewritten code */
1374 {
1375 register unsigned char *buffer_string;
1376 int buffer_length, completion_length;
1377
1378 tem = Fbuffer_string ();
1379 GCPRO2 (completion, tem);
1380 /* If reading a file name,
1381 expand any $ENVVAR refs in the buffer and in TEM. */
1382 if (EQ (Vminibuffer_completion_table, Qread_file_name_internal))
1383 {
1384 Lisp_Object substituted;
1385 substituted = Fsubstitute_in_file_name (tem);
1386 if (! EQ (substituted, tem))
1387 {
1388 tem = substituted;
1389 Ferase_buffer ();
1390 insert_from_string (tem, 0, XSTRING (tem)->size, 0);
1391 }
1392 }
1393 buffer_string = XSTRING (tem)->data;
1394 completion_string = XSTRING (completion)->data;
1395 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
1396 completion_length = XSTRING (completion)->size;
1397 i = buffer_length - completion_length;
1398 /* Mly: I don't understand what this is supposed to do AT ALL */
1399 if (i > 0 ||
1400 0 <= scmp (buffer_string, completion_string, buffer_length))
1401 {
1402 /* Set buffer to longest match of buffer tail and completion head. */
1403 if (i <= 0) i = 1;
1404 buffer_string += i;
1405 buffer_length -= i;
1406 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
1407 i++;
1408 del_range (1, i + 1);
1409 SET_PT (ZV);
1410 }
1411 UNGCPRO;
1412 }
1413 #endif /* Rewritten code */
1414 i = ZV - BEGV;
1415
1416 /* If completion finds next char not unique,
1417 consider adding a space or a hyphen. */
1418 if (i == XSTRING (completion)->size)
1419 {
1420 GCPRO1 (completion);
1421 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1422 Vminibuffer_completion_table,
1423 Vminibuffer_completion_predicate);
1424 UNGCPRO;
1425
1426 if (STRINGP (tem))
1427 completion = tem;
1428 else
1429 {
1430 GCPRO1 (completion);
1431 tem =
1432 Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1433 Vminibuffer_completion_table,
1434 Vminibuffer_completion_predicate);
1435 UNGCPRO;
1436
1437 if (STRINGP (tem))
1438 completion = tem;
1439 }
1440 }
1441
1442 /* Now find first word-break in the stuff found by completion.
1443 i gets index in string of where to stop completing. */
1444
1445 completion_string = XSTRING (completion)->data;
1446
1447 for (; i < XSTRING (completion)->size; i++)
1448 if (SYNTAX (completion_string[i]) != Sword) break;
1449 if (i < XSTRING (completion)->size)
1450 i = i + 1;
1451
1452 /* If got no characters, print help for user. */
1453
1454 if (i == ZV - BEGV)
1455 {
1456 if (auto_help)
1457 Fminibuffer_completion_help ();
1458 return Qnil;
1459 }
1460
1461 /* Otherwise insert in minibuffer the chars we got */
1462
1463 Ferase_buffer ();
1464 insert_from_string (completion, 0, i, 1);
1465 return Qt;
1466 }
1467 \f
1468 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
1469 1, 1, 0,
1470 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
1471 Each element may be just a symbol or string\n\
1472 or may be a list of two strings to be printed as if concatenated.\n\
1473 `standard-output' must be a buffer.\n\
1474 At the end, run the normal hook `completion-setup-hook'.\n\
1475 It can find the completion buffer in `standard-output'.")
1476 (completions)
1477 Lisp_Object completions;
1478 {
1479 register Lisp_Object tail, elt;
1480 register int i;
1481 int column = 0;
1482 struct gcpro gcpro1;
1483 struct buffer *old = current_buffer;
1484 int first = 1;
1485
1486 /* Note that (when it matters) every variable
1487 points to a non-string that is pointed to by COMPLETIONS. */
1488 GCPRO1 (completions);
1489
1490 if (BUFFERP (Vstandard_output))
1491 set_buffer_internal (XBUFFER (Vstandard_output));
1492
1493 if (NILP (completions))
1494 write_string ("There are no possible completions of what you have typed.",
1495 -1);
1496 else
1497 {
1498 write_string ("Possible completions are:", -1);
1499 for (tail = completions, i = 0; !NILP (tail); tail = Fcdr (tail), i++)
1500 {
1501 Lisp_Object tem;
1502 int length;
1503
1504 elt = Fcar (tail);
1505 /* Compute the length of this element. */
1506 if (CONSP (elt))
1507 {
1508 tem = Fcar (elt);
1509 CHECK_STRING (tem, 0);
1510 length = XINT (XSTRING (tem)->size);
1511
1512 tem = Fcar (Fcdr (elt));
1513 CHECK_STRING (tem, 0);
1514 length += XINT (XSTRING (tem)->size);
1515 }
1516 else
1517 {
1518 CHECK_STRING (elt, 0);
1519 length = XINT (XSTRING (elt)->size);
1520 }
1521
1522 /* This does a bad job for narrower than usual windows.
1523 Sadly, the window it will appear in is not known
1524 until after the text has been made. */
1525
1526 /* If the previous completion was very wide,
1527 or we have two on this line already,
1528 don't put another on the same line. */
1529 if (column > 33 || first
1530 /* If this is really wide, don't put it second on a line. */
1531 || column > 0 && length > 45)
1532 {
1533 Fterpri (Qnil);
1534 column = 0;
1535 }
1536 /* Otherwise advance to column 35. */
1537 else
1538 {
1539 if (BUFFERP (Vstandard_output))
1540 {
1541 tem = Findent_to (make_number (35), make_number (2));
1542 column = XINT (tem);
1543 }
1544 else
1545 {
1546 do
1547 {
1548 write_string (" ", -1);
1549 column++;
1550 }
1551 while (column < 35);
1552 }
1553 }
1554
1555 /* Output this element and update COLUMN. */
1556 if (CONSP (elt))
1557 {
1558 Fprinc (Fcar (elt), Qnil);
1559 Fprinc (Fcar (Fcdr (elt)), Qnil);
1560 }
1561 else
1562 Fprinc (elt, Qnil);
1563
1564 column += length;
1565
1566 /* If output is to a buffer, recompute COLUMN in a way
1567 that takes account of character widths. */
1568 if (BUFFERP (Vstandard_output))
1569 {
1570 tem = Fcurrent_column ();
1571 column = XINT (tem);
1572 }
1573
1574 first = 0;
1575 }
1576 }
1577
1578 UNGCPRO;
1579
1580 if (BUFFERP (Vstandard_output))
1581 set_buffer_internal (old);
1582
1583 if (!NILP (Vrun_hooks))
1584 call1 (Vrun_hooks, intern ("completion-setup-hook"));
1585
1586 return Qnil;
1587 }
1588
1589 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
1590 0, 0, "",
1591 "Display a list of possible completions of the current minibuffer contents.")
1592 ()
1593 {
1594 Lisp_Object completions;
1595
1596 message ("Making completion list...");
1597 completions = Fall_completions (Fbuffer_string (),
1598 Vminibuffer_completion_table,
1599 Vminibuffer_completion_predicate,
1600 Qt);
1601 echo_area_glyphs = 0;
1602
1603 if (NILP (completions))
1604 {
1605 bitch_at_user ();
1606 temp_echo_area_glyphs (" [No completions]");
1607 }
1608 else
1609 internal_with_output_to_temp_buffer ("*Completions*",
1610 Fdisplay_completion_list,
1611 Fsort (completions, Qstring_lessp));
1612 return Qnil;
1613 }
1614 \f
1615 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
1616 "Terminate minibuffer input.")
1617 ()
1618 {
1619 if (INTEGERP (last_command_char))
1620 internal_self_insert (last_command_char, 0);
1621 else
1622 bitch_at_user ();
1623
1624 Fthrow (Qexit, Qnil);
1625 }
1626
1627 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
1628 "Terminate this minibuffer argument.")
1629 ()
1630 {
1631 Fthrow (Qexit, Qnil);
1632 }
1633
1634 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1635 "Return current depth of activations of minibuffer, a nonnegative integer.")
1636 ()
1637 {
1638 return make_number (minibuf_level);
1639 }
1640
1641 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
1642 "Return the prompt string of the currently-active minibuffer.\n\
1643 If no minibuffer is active, return nil.")
1644 ()
1645 {
1646 return Fcopy_sequence (minibuf_prompt);
1647 }
1648
1649 DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width,
1650 Sminibuffer_prompt_width, 0, 0, 0,
1651 "Return the display width of the minibuffer prompt.")
1652 ()
1653 {
1654 Lisp_Object width;
1655 XSETFASTINT (width, minibuf_prompt_width);
1656 return width;
1657 }
1658 \f
1659 init_minibuf_once ()
1660 {
1661 Vminibuffer_list = Qnil;
1662 staticpro (&Vminibuffer_list);
1663 }
1664
1665 syms_of_minibuf ()
1666 {
1667 minibuf_level = 0;
1668 minibuf_prompt = Qnil;
1669 staticpro (&minibuf_prompt);
1670
1671 minibuf_save_list = Qnil;
1672 staticpro (&minibuf_save_list);
1673
1674 Qread_file_name_internal = intern ("read-file-name-internal");
1675 staticpro (&Qread_file_name_internal);
1676
1677 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
1678 staticpro (&Qminibuffer_completion_table);
1679
1680 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
1681 staticpro (&Qminibuffer_completion_confirm);
1682
1683 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
1684 staticpro (&Qminibuffer_completion_predicate);
1685
1686 staticpro (&last_exact_completion);
1687 last_exact_completion = Qnil;
1688
1689 staticpro (&last_minibuf_string);
1690 last_minibuf_string = Qnil;
1691
1692 Quser_variable_p = intern ("user-variable-p");
1693 staticpro (&Quser_variable_p);
1694
1695 Qminibuffer_history = intern ("minibuffer-history");
1696 staticpro (&Qminibuffer_history);
1697
1698 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
1699 staticpro (&Qminibuffer_setup_hook);
1700
1701 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
1702 staticpro (&Qminibuffer_exit_hook);
1703
1704 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
1705 "Normal hook run just after entry to minibuffer.");
1706 Vminibuffer_setup_hook = Qnil;
1707
1708 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
1709 "Normal hook run just after exit from minibuffer.");
1710 Vminibuffer_exit_hook = Qnil;
1711
1712 DEFVAR_BOOL ("completion-auto-help", &auto_help,
1713 "*Non-nil means automatically provide help for invalid completion input.");
1714 auto_help = 1;
1715
1716 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
1717 "Non-nil means don't consider case significant in completion.");
1718 completion_ignore_case = 0;
1719
1720 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
1721 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1722 More precisely, this variable makes a difference when the minibuffer window\n\
1723 is the selected window. If you are in some other window, minibuffer commands\n\
1724 are allowed even if a minibuffer is active.");
1725 enable_recursive_minibuffers = 0;
1726
1727 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
1728 "Alist or obarray used for completion in the minibuffer.\n\
1729 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1730 \n\
1731 The value may alternatively be a function, which is given three arguments:\n\
1732 STRING, the current buffer contents;\n\
1733 PREDICATE, the predicate for filtering possible matches;\n\
1734 CODE, which says what kind of things to do.\n\
1735 CODE can be nil, t or `lambda'.\n\
1736 nil means to return the best completion of STRING, or nil if there is none.\n\
1737 t means to return a list of all possible completions of STRING.\n\
1738 `lambda' means to return t if STRING is a valid completion as it stands.");
1739 Vminibuffer_completion_table = Qnil;
1740
1741 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
1742 "Within call to `completing-read', this holds the PREDICATE argument.");
1743 Vminibuffer_completion_predicate = Qnil;
1744
1745 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
1746 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1747 Vminibuffer_completion_confirm = Qnil;
1748
1749 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
1750 "Value that `help-form' takes on inside the minibuffer.");
1751 Vminibuffer_help_form = Qnil;
1752
1753 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
1754 "History list symbol to add minibuffer values to.\n\
1755 Each minibuffer output is added with\n\
1756 (set minibuffer-history-variable\n\
1757 (cons STRING (symbol-value minibuffer-history-variable)))");
1758 XSETFASTINT (Vminibuffer_history_variable, 0);
1759
1760 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
1761 "Current position of redoing in the history list.");
1762 Vminibuffer_history_position = Qnil;
1763
1764 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
1765 "*Non-nil means entering the minibuffer raises the minibuffer's frame.");
1766 minibuffer_auto_raise = 0;
1767
1768 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
1769 "List of regexps that should restrict possible completions.");
1770 Vcompletion_regexp_list = Qnil;
1771
1772 defsubr (&Sread_from_minibuffer);
1773 defsubr (&Seval_minibuffer);
1774 defsubr (&Sread_minibuffer);
1775 defsubr (&Sread_string);
1776 defsubr (&Sread_command);
1777 defsubr (&Sread_variable);
1778 defsubr (&Sread_buffer);
1779 defsubr (&Sread_no_blanks_input);
1780 defsubr (&Sminibuffer_depth);
1781 defsubr (&Sminibuffer_prompt);
1782 defsubr (&Sminibuffer_prompt_width);
1783
1784 defsubr (&Stry_completion);
1785 defsubr (&Sall_completions);
1786 defsubr (&Scompleting_read);
1787 defsubr (&Sminibuffer_complete);
1788 defsubr (&Sminibuffer_complete_word);
1789 defsubr (&Sminibuffer_complete_and_exit);
1790 defsubr (&Sdisplay_completion_list);
1791 defsubr (&Sminibuffer_completion_help);
1792
1793 defsubr (&Sself_insert_and_exit);
1794 defsubr (&Sexit_minibuffer);
1795
1796 }
1797
1798 keys_of_minibuf ()
1799 {
1800 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
1801 "abort-recursive-edit");
1802 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
1803 "exit-minibuffer");
1804 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
1805 "exit-minibuffer");
1806
1807 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
1808 "abort-recursive-edit");
1809 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
1810 "exit-minibuffer");
1811 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
1812 "exit-minibuffer");
1813
1814 initial_define_key (Vminibuffer_local_ns_map, ' ',
1815 "exit-minibuffer");
1816 initial_define_key (Vminibuffer_local_ns_map, '\t',
1817 "exit-minibuffer");
1818 initial_define_key (Vminibuffer_local_ns_map, '?',
1819 "self-insert-and-exit");
1820
1821 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
1822 "abort-recursive-edit");
1823 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
1824 "exit-minibuffer");
1825 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
1826 "exit-minibuffer");
1827
1828 initial_define_key (Vminibuffer_local_completion_map, '\t',
1829 "minibuffer-complete");
1830 initial_define_key (Vminibuffer_local_completion_map, ' ',
1831 "minibuffer-complete-word");
1832 initial_define_key (Vminibuffer_local_completion_map, '?',
1833 "minibuffer-completion-help");
1834
1835 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
1836 "abort-recursive-edit");
1837 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
1838 "minibuffer-complete-and-exit");
1839 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
1840 "minibuffer-complete-and-exit");
1841 initial_define_key (Vminibuffer_local_must_match_map, '\t',
1842 "minibuffer-complete");
1843 initial_define_key (Vminibuffer_local_must_match_map, ' ',
1844 "minibuffer-complete-word");
1845 initial_define_key (Vminibuffer_local_must_match_map, '?',
1846 "minibuffer-completion-help");
1847 }