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