new version
[emacs.git] / src / minibuf.c
bloba9ff9b84e70fe40ce95c7a75bda3c31578d5e40f
1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 93, 94, 95, 1996 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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. */
22 #include <config.h>
23 #include "lisp.h"
24 #include "commands.h"
25 #include "buffer.h"
26 #include "charset.h"
27 #include "dispextern.h"
28 #include "frame.h"
29 #include "window.h"
30 #include "syntax.h"
31 #include "keyboard.h"
33 #define min(a, b) ((a) < (b) ? (a) : (b))
35 extern int quit_char;
37 /* List of buffers for use as minibuffers.
38 The first element of the list is used for the outermost minibuffer
39 invocation, the next element is used for a recursive minibuffer
40 invocation, etc. The list is extended at the end as deeper
41 minibuffer recursions are encountered. */
42 Lisp_Object Vminibuffer_list;
44 /* Data to remember during recursive minibuffer invocations */
45 Lisp_Object minibuf_save_list;
47 /* Depth in minibuffer invocations. */
48 int minibuf_level;
50 /* Nonzero means display completion help for invalid input. */
51 int auto_help;
53 /* The maximum length of a minibuffer history. */
54 Lisp_Object Qhistory_length, Vhistory_length;
56 /* Fread_minibuffer leaves the input here as a string. */
57 Lisp_Object last_minibuf_string;
59 /* Nonzero means let functions called when within a minibuffer
60 invoke recursive minibuffers (to read arguments, or whatever) */
61 int enable_recursive_minibuffers;
63 /* Nonzero means don't ignore text properties
64 in Fread_from_minibuffer. */
65 int minibuffer_allow_text_properties;
67 /* help-form is bound to this while in the minibuffer. */
69 Lisp_Object Vminibuffer_help_form;
71 /* Variable which is the history list to add minibuffer values to. */
73 Lisp_Object Vminibuffer_history_variable;
75 /* Current position in the history list (adjusted by M-n and M-p). */
77 Lisp_Object Vminibuffer_history_position;
79 Lisp_Object Qminibuffer_history;
81 Lisp_Object Qread_file_name_internal;
83 /* Normal hooks for entry to and exit from minibuffer. */
85 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
86 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
88 /* Nonzero means completion ignores case. */
90 int completion_ignore_case;
92 /* List of regexps that should restrict possible completions. */
94 Lisp_Object Vcompletion_regexp_list;
96 /* Nonzero means raise the minibuffer frame when the minibuffer
97 is entered. */
99 int minibuffer_auto_raise;
101 /* If last completion attempt reported "Complete but not unique"
102 then this is the string completed then; otherwise this is nil. */
104 static Lisp_Object last_exact_completion;
106 Lisp_Object Quser_variable_p;
108 Lisp_Object Qminibuffer_default;
110 /* Non-nil means it is the window for C-M-v to scroll
111 when the minibuffer is selected. */
112 extern Lisp_Object Vminibuf_scroll_window;
114 extern Lisp_Object Voverriding_local_map;
116 /* Put minibuf on currently selected frame's minibuffer.
117 We do this whenever the user starts a new minibuffer
118 or when a minibuffer exits. */
120 void
121 choose_minibuf_frame ()
123 if (selected_frame != 0
124 && !EQ (minibuf_window, selected_frame->minibuffer_window))
126 /* I don't think that any frames may validly have a null minibuffer
127 window anymore. */
128 if (NILP (selected_frame->minibuffer_window))
129 abort ();
131 Fset_window_buffer (selected_frame->minibuffer_window,
132 XWINDOW (minibuf_window)->buffer);
133 minibuf_window = selected_frame->minibuffer_window;
136 /* Make sure no other frame has a minibuffer as its selected window,
137 because the text would not be displayed in it, and that would be
138 confusing. Only allow the selected frame to do this,
139 and that only if the minibuffer is active. */
141 Lisp_Object tail, frame;
143 FOR_EACH_FRAME (tail, frame)
144 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
145 && !(XFRAME (frame) == selected_frame
146 && minibuf_level > 0))
147 Fset_frame_selected_window (frame, Fframe_first_window (frame));
151 Lisp_Object
152 choose_minibuf_frame_1 (ignore)
153 Lisp_Object ignore;
155 choose_minibuf_frame ();
156 return Qnil;
159 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
160 Sset_minibuffer_window, 1, 1, 0,
161 "Specify which minibuffer window to use for the minibuffer.\n\
162 This effects where the minibuffer is displayed if you put text in it\n\
163 without invoking the usual minibuffer commands.")
164 (window)
165 Lisp_Object window;
167 CHECK_WINDOW (window, 1);
168 if (! MINI_WINDOW_P (XWINDOW (window)))
169 error ("Window is not a minibuffer window");
171 minibuf_window = window;
173 return window;
177 /* Actual minibuffer invocation. */
179 static void read_minibuf_unwind ();
180 Lisp_Object get_minibuffer ();
181 static Lisp_Object read_minibuf ();
183 /* Read from the minibuffer using keymap MAP, initial contents INITIAL
184 (a string), putting point minus BACKUP_N chars from the end of INITIAL,
185 prompting with PROMPT (a string), using history list HISTVAR
186 with initial position HISTPOS. (BACKUP_N should be <= 0.)
188 Normally return the result as a string (the text that was read),
189 but if EXPFLAG is nonzero, read it and return the object read.
190 If HISTVAR is given, save the value read on that history only if it doesn't
191 match the front of that history list exactly. The value is pushed onto
192 the list as the string that was read.
194 DEFALT specifies te default value for the sake of history commands.
196 If ALLOW_PROPS is nonzero, we do not throw away text properties. */
198 static Lisp_Object
199 read_minibuf (map, initial, prompt, backup_n, expflag,
200 histvar, histpos, defalt, allow_props)
201 Lisp_Object map;
202 Lisp_Object initial;
203 Lisp_Object prompt;
204 Lisp_Object backup_n;
205 int expflag;
206 Lisp_Object histvar;
207 Lisp_Object histpos;
208 Lisp_Object defalt;
210 Lisp_Object val;
211 int count = specpdl_ptr - specpdl;
212 Lisp_Object mini_frame, ambient_dir, minibuffer;
213 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
215 specbind (Qminibuffer_default, defalt);
217 single_kboard_state ();
219 val = Qnil;
220 ambient_dir = current_buffer->directory;
222 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
223 store them away before we can GC. Don't need to protect
224 BACKUP_N because we use the value only if it is an integer. */
225 GCPRO4 (map, initial, val, ambient_dir);
227 if (!STRINGP (prompt))
228 prompt = build_string ("");
230 if (!enable_recursive_minibuffers
231 && minibuf_level > 0)
233 if (EQ (selected_window, minibuf_window))
234 error ("Command attempted to use minibuffer while in minibuffer");
235 else
236 /* If we're in another window, cancel the minibuffer that's active. */
237 Fthrow (Qexit,
238 build_string ("Command attempted to use minibuffer while in minibuffer"));
241 /* Choose the minibuffer window and frame, and take action on them. */
243 choose_minibuf_frame ();
245 record_unwind_protect (choose_minibuf_frame_1, Qnil);
247 record_unwind_protect (Fset_window_configuration,
248 Fcurrent_window_configuration (Qnil));
250 /* If the minibuffer window is on a different frame, save that
251 frame's configuration too. */
252 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
253 if (XFRAME (mini_frame) != selected_frame)
254 record_unwind_protect (Fset_window_configuration,
255 Fcurrent_window_configuration (mini_frame));
257 /* If the minibuffer is on an iconified or invisible frame,
258 make it visible now. */
259 Fmake_frame_visible (mini_frame);
261 if (minibuffer_auto_raise)
262 Fraise_frame (mini_frame);
264 /* We have to do this after saving the window configuration
265 since that is what restores the current buffer. */
267 /* Arrange to restore a number of minibuffer-related variables.
268 We could bind each variable separately, but that would use lots of
269 specpdl slots. */
270 minibuf_save_list
271 = Fcons (Voverriding_local_map,
272 Fcons (minibuf_window, minibuf_save_list));
273 minibuf_save_list
274 = Fcons (minibuf_prompt,
275 Fcons (make_number (minibuf_prompt_width),
276 Fcons (Vhelp_form,
277 Fcons (Vcurrent_prefix_arg,
278 Fcons (Vminibuffer_history_position,
279 Fcons (Vminibuffer_history_variable,
280 minibuf_save_list))))));
282 record_unwind_protect (read_minibuf_unwind, Qnil);
283 minibuf_level++;
285 /* Now that we can restore all those variables, start changing them. */
287 minibuf_prompt_width = 0; /* xdisp.c puts in the right value. */
288 minibuf_prompt = Fcopy_sequence (prompt);
289 Vminibuffer_history_position = histpos;
290 Vminibuffer_history_variable = histvar;
291 Vhelp_form = Vminibuffer_help_form;
293 /* Switch to the minibuffer. */
295 minibuffer = get_minibuffer (minibuf_level);
296 Fset_buffer (minibuffer);
298 /* The current buffer's default directory is usually the right thing
299 for our minibuffer here. However, if you're typing a command at
300 a minibuffer-only frame when minibuf_level is zero, then buf IS
301 the current_buffer, so reset_buffer leaves buf's default
302 directory unchanged. This is a bummer when you've just started
303 up Emacs and buf's default directory is Qnil. Here's a hack; can
304 you think of something better to do? Find another buffer with a
305 better directory, and use that one instead. */
306 if (STRINGP (ambient_dir))
307 current_buffer->directory = ambient_dir;
308 else
310 Lisp_Object buf_list;
312 for (buf_list = Vbuffer_alist;
313 CONSP (buf_list);
314 buf_list = XCONS (buf_list)->cdr)
316 Lisp_Object other_buf;
318 other_buf = XCONS (XCONS (buf_list)->car)->cdr;
319 if (STRINGP (XBUFFER (other_buf)->directory))
321 current_buffer->directory = XBUFFER (other_buf)->directory;
322 break;
327 if (XFRAME (mini_frame) != selected_frame)
328 Fredirect_frame_focus (Fselected_frame (), mini_frame);
330 Vminibuf_scroll_window = selected_window;
331 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
332 Fselect_window (minibuf_window);
333 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
335 Fmake_local_variable (Qprint_escape_newlines);
336 print_escape_newlines = 1;
338 /* Erase the buffer. */
340 int count1 = specpdl_ptr - specpdl;
341 specbind (Qinhibit_read_only, Qt);
342 Ferase_buffer ();
343 unbind_to (count1, Qnil);
346 /* Put in the initial input. */
347 if (!NILP (initial))
349 Finsert (1, &initial);
350 if (!NILP (backup_n) && INTEGERP (backup_n))
351 Fgoto_char (make_number (PT + XFASTINT (backup_n)));
354 echo_area_glyphs = 0;
355 /* This is in case the minibuffer-setup-hook calls Fsit_for. */
356 previous_echo_glyphs = 0;
358 current_buffer->keymap = map;
360 /* Run our hook, but not if it is empty.
361 (run-hooks would do nothing if it is empty,
362 but it's important to save time here in the usual case). */
363 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
364 && !NILP (Vrun_hooks))
365 call1 (Vrun_hooks, Qminibuffer_setup_hook);
367 /* ??? MCC did redraw_screen here if switching screens. */
368 recursive_edit_1 ();
370 /* If cursor is on the minibuffer line,
371 show the user we have exited by putting it in column 0. */
372 if ((FRAME_CURSOR_Y (selected_frame)
373 >= XFASTINT (XWINDOW (minibuf_window)->top))
374 && !noninteractive)
376 FRAME_CURSOR_X (selected_frame)
377 = FRAME_LEFT_SCROLL_BAR_WIDTH (selected_frame);
378 update_frame (selected_frame, 1, 1);
381 /* Make minibuffer contents into a string. */
382 Fset_buffer (minibuffer);
383 val = make_buffer_string (1, Z, allow_props);
384 #if 0 /* make_buffer_string should handle the gap. */
385 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
386 #endif
388 /* VAL is the string of minibuffer text. */
389 last_minibuf_string = val;
391 /* Add the value to the appropriate history list unless it is empty. */
392 if (XSTRING (val)->size != 0
393 && SYMBOLP (Vminibuffer_history_variable)
394 && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound))
396 /* If the caller wanted to save the value read on a history list,
397 then do so if the value is not already the front of the list. */
398 Lisp_Object histval;
399 histval = Fsymbol_value (Vminibuffer_history_variable);
401 /* The value of the history variable must be a cons or nil. Other
402 values are unacceptable. We silently ignore these values. */
403 if (NILP (histval)
404 || (CONSP (histval)
405 && NILP (Fequal (last_minibuf_string, Fcar (histval)))))
407 Lisp_Object length;
409 histval = Fcons (last_minibuf_string, histval);
410 Fset (Vminibuffer_history_variable, histval);
412 /* Truncate if requested. */
413 length = Fget (Vminibuffer_history_variable, Qhistory_length);
414 if (NILP (length)) length = Vhistory_length;
415 if (INTEGERP (length))
417 if (XINT (length) <= 0)
418 Fset (Vminibuffer_history_variable, Qnil);
419 else
421 Lisp_Object temp;
423 temp = Fnthcdr (Fsub1 (length), histval);
424 if (CONSP (temp)) Fsetcdr (temp, Qnil);
430 /* If Lisp form desired instead of string, parse it. */
431 if (expflag)
433 Lisp_Object expr_and_pos;
434 unsigned char *p;
436 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
437 /* Ignore trailing whitespace; any other trailing junk is an error. */
438 for (p = XSTRING (val)->data + XINT (Fcdr (expr_and_pos)); *p; p++)
439 if (*p != ' ' && *p != '\t' && *p != '\n')
440 error ("Trailing garbage following expression");
441 val = Fcar (expr_and_pos);
444 /* The appropriate frame will get selected
445 in set-window-configuration. */
446 RETURN_UNGCPRO (unbind_to (count, val));
449 /* Return a buffer to be used as the minibuffer at depth `depth'.
450 depth = 0 is the lowest allowed argument, and that is the value
451 used for nonrecursive minibuffer invocations */
453 Lisp_Object
454 get_minibuffer (depth)
455 int depth;
457 Lisp_Object tail, num, buf;
458 char name[24];
459 extern Lisp_Object nconc2 ();
461 XSETFASTINT (num, depth);
462 tail = Fnthcdr (num, Vminibuffer_list);
463 if (NILP (tail))
465 tail = Fcons (Qnil, Qnil);
466 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
468 buf = Fcar (tail);
469 if (NILP (buf) || NILP (XBUFFER (buf)->name))
471 sprintf (name, " *Minibuf-%d*", depth);
472 buf = Fget_buffer_create (build_string (name));
474 /* Although the buffer's name starts with a space, undo should be
475 enabled in it. */
476 Fbuffer_enable_undo (buf);
478 XCONS (tail)->car = buf;
480 else
482 int count = specpdl_ptr - specpdl;
484 reset_buffer (XBUFFER (buf));
485 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
486 Fset_buffer (buf);
487 Fkill_all_local_variables ();
488 unbind_to (count, Qnil);
491 return buf;
494 /* This function is called on exiting minibuffer, whether normally or not,
495 and it restores the current window, buffer, etc. */
497 static void
498 read_minibuf_unwind (data)
499 Lisp_Object data;
501 Lisp_Object old_deactivate_mark;
502 Lisp_Object window;
504 /* We are exiting the minibuffer one way or the other,
505 so run the hook. */
506 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
507 && !NILP (Vrun_hooks))
508 safe_run_hooks (Qminibuffer_exit_hook);
510 /* If this was a recursive minibuffer,
511 tie the minibuffer window back to the outer level minibuffer buffer. */
512 minibuf_level--;
514 window = minibuf_window;
515 /* To keep things predictable, in case it matters, let's be in the minibuffer
516 when we reset the relevant variables. */
517 Fset_buffer (XWINDOW (window)->buffer);
519 /* Restore prompt, etc, from outer minibuffer level. */
520 minibuf_prompt = Fcar (minibuf_save_list);
521 minibuf_save_list = Fcdr (minibuf_save_list);
522 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
523 minibuf_save_list = Fcdr (minibuf_save_list);
524 Vhelp_form = Fcar (minibuf_save_list);
525 minibuf_save_list = Fcdr (minibuf_save_list);
526 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
527 minibuf_save_list = Fcdr (minibuf_save_list);
528 Vminibuffer_history_position = Fcar (minibuf_save_list);
529 minibuf_save_list = Fcdr (minibuf_save_list);
530 Vminibuffer_history_variable = Fcar (minibuf_save_list);
531 minibuf_save_list = Fcdr (minibuf_save_list);
532 Voverriding_local_map = Fcar (minibuf_save_list);
533 minibuf_save_list = Fcdr (minibuf_save_list);
534 #if 0
535 temp = Fcar (minibuf_save_list);
536 if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
537 minibuf_window = temp;
538 #endif
539 minibuf_save_list = Fcdr (minibuf_save_list);
541 /* Erase the minibuffer we were using at this level. */
543 int count = specpdl_ptr - specpdl;
544 /* Prevent error in erase-buffer. */
545 specbind (Qinhibit_read_only, Qt);
546 old_deactivate_mark = Vdeactivate_mark;
547 Ferase_buffer ();
548 Vdeactivate_mark = old_deactivate_mark;
549 unbind_to (count, Qnil);
552 /* Make sure minibuffer window is erased, not ignored. */
553 windows_or_buffers_changed++;
554 XSETFASTINT (XWINDOW (window)->last_modified, 0);
555 XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
559 /* This comment supplies the doc string for read-from-minibuffer,
560 for make-docfile to see. We cannot put this in the real DEFUN
561 due to limits in the Unix cpp.
563 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 6, 0,
564 "Read a string from the minibuffer, prompting with string PROMPT.\n\
565 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
566 to be inserted into the minibuffer before reading input.\n\
567 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
568 is STRING, but point is placed at position POSITION in the minibuffer.\n\
569 Third arg KEYMAP is a keymap to use whilst reading;\n\
570 if omitted or nil, the default is `minibuffer-local-map'.\n\
571 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
572 and return that object:\n\
573 in other words, do `(car (read-from-string INPUT-STRING))'\n\
574 Fifth arg HIST, if non-nil, specifies a history list\n\
575 and optionally the initial position in the list.\n\
576 It can be a symbol, which is the history list variable to use,\n\
577 or it can be a cons cell (HISTVAR . HISTPOS).\n\
578 In that case, HISTVAR is the history list variable to use,\n\
579 and HISTPOS is the initial position (the position in the list\n\
580 which INITIAL-CONTENTS corresponds to).\n\
581 Positions are counted starting from 1 at the beginning of the list.\n\
582 Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is used\n\
583 for history commands, and as the value to return if the user enters\n\
584 the empty string.\n\
585 If the variable `minibuffer-allow-text-properties is non-nil,\n\
586 then the string which is returned includes whatever text properties\n\
587 were present in the minibuffer. Otherwise the value has no text properties. */
589 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 6, 0,
590 0 /* See immediately above */)
591 (prompt, initial_contents, keymap, read, hist, default_value)
592 Lisp_Object prompt, initial_contents, keymap, read, hist, default_value;
594 int pos = 0;
595 Lisp_Object histvar, histpos, position, val;
596 struct gcpro gcpro1;
598 position = Qnil;
600 CHECK_STRING (prompt, 0);
601 if (!NILP (initial_contents))
603 if (CONSP (initial_contents))
605 position = Fcdr (initial_contents);
606 initial_contents = Fcar (initial_contents);
608 CHECK_STRING (initial_contents, 1);
609 if (!NILP (position))
611 CHECK_NUMBER (position, 0);
612 /* Convert to distance from end of input. */
613 if (XINT (position) < 1)
614 /* A number too small means the beginning of the string. */
615 pos = - XSTRING (initial_contents)->size;
616 else
617 pos = XINT (position) - 1 - XSTRING (initial_contents)->size;
621 if (NILP (keymap))
622 keymap = Vminibuffer_local_map;
623 else
624 keymap = get_keymap (keymap);
626 if (SYMBOLP (hist))
628 histvar = hist;
629 histpos = Qnil;
631 else
633 histvar = Fcar_safe (hist);
634 histpos = Fcdr_safe (hist);
636 if (NILP (histvar))
637 histvar = Qminibuffer_history;
638 if (NILP (histpos))
639 XSETFASTINT (histpos, 0);
641 GCPRO1 (default_value);
642 val = read_minibuf (keymap, initial_contents, prompt,
643 make_number (pos), !NILP (read),
644 histvar, histpos, default_value,
645 minibuffer_allow_text_properties);
646 if (STRINGP (val) && XSTRING (val)->size == 0 && ! NILP (default_value))
647 val = default_value;
648 UNGCPRO;
649 return val;
652 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
653 "Return a Lisp object read using the minibuffer.\n\
654 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
655 is a string to insert in the minibuffer before reading.")
656 (prompt, initial_contents)
657 Lisp_Object prompt, initial_contents;
659 CHECK_STRING (prompt, 0);
660 if (!NILP (initial_contents))
661 CHECK_STRING (initial_contents, 1);
662 return read_minibuf (Vminibuffer_local_map, initial_contents,
663 prompt, Qnil, 1, Qminibuffer_history,
664 make_number (0), Qnil, 0);
667 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
668 "Return value of Lisp expression read using the minibuffer.\n\
669 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
670 is a string to insert in the minibuffer before reading.")
671 (prompt, initial_contents)
672 Lisp_Object prompt, initial_contents;
674 return Feval (Fread_minibuffer (prompt, initial_contents));
677 /* Functions that use the minibuffer to read various things. */
679 DEFUN ("read-string", Fread_string, Sread_string, 1, 4, 0,
680 "Read a string from the minibuffer, prompting with string PROMPT.\n\
681 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.\n\
682 The third arg HISTORY, if non-nil, specifies a history list\n\
683 and optionally the initial position in the list.\n\
684 See `read-from-minibuffer' for details of HISTORY argument.")
685 (prompt, initial_input, history, default_value)
686 Lisp_Object prompt, initial_input, history, default_value;
688 return Fread_from_minibuffer (prompt, initial_input, Qnil,
689 Qnil, history, default_value);
692 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 2, 0,
693 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
694 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
695 (prompt, init)
696 Lisp_Object prompt, init;
698 CHECK_STRING (prompt, 0);
699 if (! NILP (init))
700 CHECK_STRING (init, 1);
702 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil,
703 0, Qminibuffer_history, make_number (0), Qnil, 0);
706 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
707 "Read the name of a command and return as a symbol.\n\
708 Prompts with PROMPT. By default, return DEFAULT-VALUE.")
709 (prompt, default_value)
710 Lisp_Object prompt, default_value;
712 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
713 Qnil, Qnil, default_value),
714 Qnil);
717 #ifdef NOTDEF
718 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
719 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
720 Prompts with PROMPT.")
721 (prompt)
722 Lisp_Object prompt;
724 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil),
725 Qnil);
727 #endif /* NOTDEF */
729 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
730 "Read the name of a user variable and return it as a symbol.\n\
731 Prompts with PROMPT. By default, return DEFAULT-VALUE.\n\
732 A user variable is one whose documentation starts with a `*' character.")
733 (prompt, default_value)
734 Lisp_Object prompt, default_value;
736 return Fintern (Fcompleting_read (prompt, Vobarray,
737 Quser_variable_p, Qt,
738 Qnil, Qnil, default_value),
739 Qnil);
742 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
743 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
744 Prompts with PROMPT.\n\
745 Optional second arg DEF is value to return if user enters an empty line.\n\
746 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
747 (prompt, def, require_match)
748 Lisp_Object prompt, def, require_match;
750 Lisp_Object tem;
751 Lisp_Object args[3];
753 if (BUFFERP (def))
754 def = XBUFFER (def)->name;
755 if (!NILP (def))
757 args[0] = build_string ("%s(default %s) ");
758 args[1] = prompt;
759 args[2] = def;
760 prompt = Fformat (3, args);
762 return Fcompleting_read (prompt, Vbuffer_alist, Qnil,
763 require_match, Qnil, Qnil, def);
766 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
767 "Return common substring of all completions of STRING in ALIST.\n\
768 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
769 All that match are compared together; the longest initial sequence\n\
770 common to all matches is returned as a string.\n\
771 If there is no match at all, nil is returned.\n\
772 For an exact match, t is returned.\n\
774 ALIST can be an obarray instead of an alist.\n\
775 Then the print names of all symbols in the obarray are the possible matches.\n\
777 ALIST can also be a function to do the completion itself.\n\
778 It receives three arguments: the values STRING, PREDICATE and nil.\n\
779 Whatever it returns becomes the value of `try-completion'.\n\
781 If optional third argument PREDICATE is non-nil,\n\
782 it is used to test each possible match.\n\
783 The match is a candidate only if PREDICATE returns non-nil.\n\
784 The argument given to PREDICATE is the alist element\n\
785 or the symbol from the obarray.")
786 (string, alist, predicate)
787 Lisp_Object string, alist, predicate;
789 Lisp_Object bestmatch, tail, elt, eltstring;
790 int bestmatchsize;
791 int compare, matchsize;
792 int list = CONSP (alist) || NILP (alist);
793 int index, obsize;
794 int matchcount = 0;
795 Lisp_Object bucket, zero, end, tem;
796 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
798 CHECK_STRING (string, 0);
799 if (!list && !VECTORP (alist))
800 return call3 (alist, string, predicate, Qnil);
802 bestmatch = Qnil;
804 /* If ALIST is not a list, set TAIL just for gc pro. */
805 tail = alist;
806 if (! list)
808 index = 0;
809 obsize = XVECTOR (alist)->size;
810 bucket = XVECTOR (alist)->contents[index];
813 while (1)
815 /* Get the next element of the alist or obarray. */
816 /* Exit the loop if the elements are all used up. */
817 /* elt gets the alist element or symbol.
818 eltstring gets the name to check as a completion. */
820 if (list)
822 if (NILP (tail))
823 break;
824 elt = Fcar (tail);
825 eltstring = Fcar (elt);
826 tail = Fcdr (tail);
828 else
830 if (XFASTINT (bucket) != 0)
832 elt = bucket;
833 eltstring = Fsymbol_name (elt);
834 if (XSYMBOL (bucket)->next)
835 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
836 else
837 XSETFASTINT (bucket, 0);
839 else if (++index >= obsize)
840 break;
841 else
843 bucket = XVECTOR (alist)->contents[index];
844 continue;
848 /* Is this element a possible completion? */
850 if (STRINGP (eltstring)
851 && XSTRING (string)->size <= XSTRING (eltstring)->size
852 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
853 XSTRING (string)->size))
855 /* Yes. */
856 Lisp_Object regexps;
857 Lisp_Object zero;
858 XSETFASTINT (zero, 0);
860 /* Ignore this element if it fails to match all the regexps. */
861 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
862 regexps = XCONS (regexps)->cdr)
864 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
865 if (NILP (tem))
866 break;
868 if (CONSP (regexps))
869 continue;
871 /* Ignore this element if there is a predicate
872 and the predicate doesn't like it. */
874 if (!NILP (predicate))
876 if (EQ (predicate, Qcommandp))
877 tem = Fcommandp (elt);
878 else
880 GCPRO4 (tail, string, eltstring, bestmatch);
881 tem = call1 (predicate, elt);
882 UNGCPRO;
884 if (NILP (tem)) continue;
887 /* Update computation of how much all possible completions match */
889 matchcount++;
890 if (NILP (bestmatch))
891 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
892 else
894 compare = min (bestmatchsize, XSTRING (eltstring)->size);
895 matchsize = scmp (XSTRING (bestmatch)->data,
896 XSTRING (eltstring)->data,
897 compare);
898 if (matchsize < 0)
899 matchsize = compare;
900 if (completion_ignore_case)
902 /* If this is an exact match except for case,
903 use it as the best match rather than one that is not an
904 exact match. This way, we get the case pattern
905 of the actual match. */
906 if ((matchsize == XSTRING (eltstring)->size
907 && matchsize < XSTRING (bestmatch)->size)
909 /* If there is more than one exact match ignoring case,
910 and one of them is exact including case,
911 prefer that one. */
912 /* If there is no exact match ignoring case,
913 prefer a match that does not change the case
914 of the input. */
915 ((matchsize == XSTRING (eltstring)->size)
917 (matchsize == XSTRING (bestmatch)->size)
918 && !bcmp (XSTRING (eltstring)->data,
919 XSTRING (string)->data, XSTRING (string)->size)
920 && bcmp (XSTRING (bestmatch)->data,
921 XSTRING (string)->data, XSTRING (string)->size)))
922 bestmatch = eltstring;
924 bestmatchsize = matchsize;
929 if (NILP (bestmatch))
930 return Qnil; /* No completions found */
931 /* If we are ignoring case, and there is no exact match,
932 and no additional text was supplied,
933 don't change the case of what the user typed. */
934 if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
935 && XSTRING (bestmatch)->size > bestmatchsize)
936 return string;
938 /* Return t if the supplied string is an exact match (counting case);
939 it does not require any change to be made. */
940 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
941 && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data,
942 bestmatchsize))
943 return Qt;
945 XSETFASTINT (zero, 0); /* Else extract the part in which */
946 XSETFASTINT (end, bestmatchsize); /* all completions agree */
947 return Fsubstring (bestmatch, zero, end);
950 /* Compare exactly LEN chars of strings at S1 and S2,
951 ignoring case if appropriate.
952 Return -1 if strings match,
953 else number of chars that match at the beginning. */
956 scmp (s1, s2, len)
957 register unsigned char *s1, *s2;
958 int len;
960 register int l = len;
961 register unsigned char *start = s1;
963 if (completion_ignore_case)
965 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
966 l--;
968 else
970 while (l && *s1++ == *s2++)
971 l--;
973 if (l == 0)
974 return -1;
975 else
977 int match = len - l;
979 /* Now *--S1 is the unmatching byte. If it is in the middle of
980 multi-byte form, we must say that the multi-byte character
981 there doesn't match. */
982 while (match && *--s1 >= 0xA0) match--;
983 return match;
987 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
988 "Search for partial matches to STRING in ALIST.\n\
989 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
990 The value is a list of all the strings from ALIST that match.\n\
992 ALIST can be an obarray instead of an alist.\n\
993 Then the print names of all symbols in the obarray are the possible matches.\n\
995 ALIST can also be a function to do the completion itself.\n\
996 It receives three arguments: the values STRING, PREDICATE and t.\n\
997 Whatever it returns becomes the value of `all-completion'.\n\
999 If optional third argument PREDICATE is non-nil,\n\
1000 it is used to test each possible match.\n\
1001 The match is a candidate only if PREDICATE returns non-nil.\n\
1002 The argument given to PREDICATE is the alist element\n\
1003 or the symbol from the obarray.\n\
1005 If the optional fourth argument HIDE-SPACES is non-nil,\n\
1006 strings in ALIST that start with a space\n\
1007 are ignored unless STRING itself starts with a space.")
1008 (string, alist, predicate, hide_spaces)
1009 Lisp_Object string, alist, predicate, hide_spaces;
1011 Lisp_Object tail, elt, eltstring;
1012 Lisp_Object allmatches;
1013 int list = CONSP (alist) || NILP (alist);
1014 int index, obsize;
1015 Lisp_Object bucket, tem;
1016 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1018 CHECK_STRING (string, 0);
1019 if (!list && !VECTORP (alist))
1021 return call3 (alist, string, predicate, Qt);
1023 allmatches = Qnil;
1025 /* If ALIST is not a list, set TAIL just for gc pro. */
1026 tail = alist;
1027 if (! list)
1029 index = 0;
1030 obsize = XVECTOR (alist)->size;
1031 bucket = XVECTOR (alist)->contents[index];
1034 while (1)
1036 /* Get the next element of the alist or obarray. */
1037 /* Exit the loop if the elements are all used up. */
1038 /* elt gets the alist element or symbol.
1039 eltstring gets the name to check as a completion. */
1041 if (list)
1043 if (NILP (tail))
1044 break;
1045 elt = Fcar (tail);
1046 eltstring = Fcar (elt);
1047 tail = Fcdr (tail);
1049 else
1051 if (XFASTINT (bucket) != 0)
1053 elt = bucket;
1054 eltstring = Fsymbol_name (elt);
1055 if (XSYMBOL (bucket)->next)
1056 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1057 else
1058 XSETFASTINT (bucket, 0);
1060 else if (++index >= obsize)
1061 break;
1062 else
1064 bucket = XVECTOR (alist)->contents[index];
1065 continue;
1069 /* Is this element a possible completion? */
1071 if (STRINGP (eltstring)
1072 && XSTRING (string)->size <= XSTRING (eltstring)->size
1073 /* If HIDE_SPACES, reject alternatives that start with space
1074 unless the input starts with space. */
1075 && ((XSTRING (string)->size > 0 && XSTRING (string)->data[0] == ' ')
1076 || XSTRING (eltstring)->data[0] != ' '
1077 || NILP (hide_spaces))
1078 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
1079 XSTRING (string)->size))
1081 /* Yes. */
1082 Lisp_Object regexps;
1083 Lisp_Object zero;
1084 XSETFASTINT (zero, 0);
1086 /* Ignore this element if it fails to match all the regexps. */
1087 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1088 regexps = XCONS (regexps)->cdr)
1090 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
1091 if (NILP (tem))
1092 break;
1094 if (CONSP (regexps))
1095 continue;
1097 /* Ignore this element if there is a predicate
1098 and the predicate doesn't like it. */
1100 if (!NILP (predicate))
1102 if (EQ (predicate, Qcommandp))
1103 tem = Fcommandp (elt);
1104 else
1106 GCPRO4 (tail, eltstring, allmatches, string);
1107 tem = call1 (predicate, elt);
1108 UNGCPRO;
1110 if (NILP (tem)) continue;
1112 /* Ok => put it on the list. */
1113 allmatches = Fcons (eltstring, allmatches);
1117 return Fnreverse (allmatches);
1120 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
1121 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
1122 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
1124 /* This comment supplies the doc string for completing-read,
1125 for make-docfile to see. We cannot put this in the real DEFUN
1126 due to limits in the Unix cpp.
1128 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 7, 0,
1129 "Read a string in the minibuffer, with completion.\n\
1130 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
1131 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
1132 PREDICATE limits completion to a subset of TABLE.\n\
1133 See `try-completion' and `all-completions' for more details
1134 on completion, TABLE, and PREDICATE.\n\
1136 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
1137 the input is (or completes to) an element of TABLE or is null.\n\
1138 If it is also not t, Return does not exit if it does non-null completion.\n\
1139 If the input is null, `completing-read' returns an empty string,\n\
1140 regardless of the value of REQUIRE-MATCH.\n\
1142 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
1143 If it is (STRING . POSITION), the initial input\n\
1144 is STRING, but point is placed POSITION characters into the string.\n\
1145 HIST, if non-nil, specifies a history list\n\
1146 and optionally the initial position in the list.\n\
1147 It can be a symbol, which is the history list variable to use,\n\
1148 or it can be a cons cell (HISTVAR . HISTPOS).\n\
1149 In that case, HISTVAR is the history list variable to use,\n\
1150 and HISTPOS is the initial position (the position in the list\n\
1151 which INITIAL-CONTENTS corresponds to).\n\
1152 Positions are counted starting from 1 at the beginning of the list.\n\
1153 DEF, if non-nil, is the default value.
1155 Completion ignores case if the ambient value of\n\
1156 `completion-ignore-case' is non-nil."
1158 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 7, 0,
1159 0 /* See immediately above */)
1160 (prompt, table, predicate, require_match, init, hist, def)
1161 Lisp_Object prompt, table, predicate, require_match, init, hist, def;
1163 Lisp_Object val, histvar, histpos, position;
1164 int pos = 0;
1165 int count = specpdl_ptr - specpdl;
1166 struct gcpro gcpro1;
1168 GCPRO1 (def);
1170 specbind (Qminibuffer_completion_table, table);
1171 specbind (Qminibuffer_completion_predicate, predicate);
1172 specbind (Qminibuffer_completion_confirm,
1173 EQ (require_match, Qt) ? Qnil : Qt);
1174 last_exact_completion = Qnil;
1176 position = Qnil;
1177 if (!NILP (init))
1179 if (CONSP (init))
1181 position = Fcdr (init);
1182 init = Fcar (init);
1184 CHECK_STRING (init, 0);
1185 if (!NILP (position))
1187 CHECK_NUMBER (position, 0);
1188 /* Convert to distance from end of input. */
1189 pos = XINT (position) - XSTRING (init)->size;
1193 if (SYMBOLP (hist))
1195 histvar = hist;
1196 histpos = Qnil;
1198 else
1200 histvar = Fcar_safe (hist);
1201 histpos = Fcdr_safe (hist);
1203 if (NILP (histvar))
1204 histvar = Qminibuffer_history;
1205 if (NILP (histpos))
1206 XSETFASTINT (histpos, 0);
1208 val = read_minibuf (NILP (require_match)
1209 ? Vminibuffer_local_completion_map
1210 : Vminibuffer_local_must_match_map,
1211 init, prompt, make_number (pos), 0,
1212 histvar, histpos, def, 0);
1213 if (STRINGP (val) && XSTRING (val)->size == 0 && ! NILP (def))
1214 val = def;
1215 RETURN_UNGCPRO (unbind_to (count, val));
1218 Lisp_Object Fminibuffer_completion_help ();
1219 Lisp_Object assoc_for_completion ();
1220 /* A subroutine of Fintern_soft. */
1221 extern Lisp_Object oblookup ();
1224 /* Test whether TXT is an exact completion. */
1225 Lisp_Object
1226 test_completion (txt)
1227 Lisp_Object txt;
1229 Lisp_Object tem;
1231 if (CONSP (Vminibuffer_completion_table)
1232 || NILP (Vminibuffer_completion_table))
1233 return assoc_for_completion (txt, Vminibuffer_completion_table);
1234 else if (VECTORP (Vminibuffer_completion_table))
1236 /* Bypass intern-soft as that loses for nil */
1237 tem = oblookup (Vminibuffer_completion_table,
1238 XSTRING (txt)->data, XSTRING (txt)->size);
1239 if (!SYMBOLP (tem))
1240 return Qnil;
1241 else if (!NILP (Vminibuffer_completion_predicate))
1242 return call1 (Vminibuffer_completion_predicate, tem);
1243 else
1244 return Qt;
1246 else
1247 return call3 (Vminibuffer_completion_table, txt,
1248 Vminibuffer_completion_predicate, Qlambda);
1251 /* returns:
1252 * 0 no possible completion
1253 * 1 was already an exact and unique completion
1254 * 3 was already an exact completion
1255 * 4 completed to an exact completion
1256 * 5 some completion happened
1257 * 6 no completion happened
1260 do_completion ()
1262 Lisp_Object completion, tem;
1263 int completedp;
1264 Lisp_Object last;
1265 struct gcpro gcpro1, gcpro2;
1267 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
1268 Vminibuffer_completion_predicate);
1269 last = last_exact_completion;
1270 last_exact_completion = Qnil;
1272 GCPRO2 (completion, last);
1274 if (NILP (completion))
1276 bitch_at_user ();
1277 temp_echo_area_glyphs (" [No match]");
1278 UNGCPRO;
1279 return 0;
1282 if (EQ (completion, Qt)) /* exact and unique match */
1284 UNGCPRO;
1285 return 1;
1288 /* compiler bug */
1289 tem = Fstring_equal (completion, Fbuffer_string());
1290 if (completedp = NILP (tem))
1292 Ferase_buffer (); /* Some completion happened */
1293 Finsert (1, &completion);
1296 /* It did find a match. Do we match some possibility exactly now? */
1297 tem = test_completion (Fbuffer_string ());
1298 if (NILP (tem))
1300 /* not an exact match */
1301 UNGCPRO;
1302 if (completedp)
1303 return 5;
1304 else if (auto_help)
1305 Fminibuffer_completion_help ();
1306 else
1307 temp_echo_area_glyphs (" [Next char not unique]");
1308 return 6;
1310 else if (completedp)
1312 UNGCPRO;
1313 return 4;
1315 /* If the last exact completion and this one were the same,
1316 it means we've already given a "Complete but not unique"
1317 message and the user's hit TAB again, so now we give him help. */
1318 last_exact_completion = completion;
1319 if (!NILP (last))
1321 tem = Fbuffer_string ();
1322 if (!NILP (Fequal (tem, last)))
1323 Fminibuffer_completion_help ();
1325 UNGCPRO;
1326 return 3;
1329 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1331 Lisp_Object
1332 assoc_for_completion (key, list)
1333 register Lisp_Object key;
1334 Lisp_Object list;
1336 register Lisp_Object tail;
1338 if (completion_ignore_case)
1339 key = Fupcase (key);
1341 for (tail = list; !NILP (tail); tail = Fcdr (tail))
1343 register Lisp_Object elt, tem, thiscar;
1344 elt = Fcar (tail);
1345 if (!CONSP (elt)) continue;
1346 thiscar = Fcar (elt);
1347 if (!STRINGP (thiscar))
1348 continue;
1349 if (completion_ignore_case)
1350 thiscar = Fupcase (thiscar);
1351 tem = Fequal (thiscar, key);
1352 if (!NILP (tem)) return elt;
1353 QUIT;
1355 return Qnil;
1358 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
1359 "Complete the minibuffer contents as far as possible.\n\
1360 Return nil if there is no valid completion, else t.\n\
1361 If no characters can be completed, display a list of possible completions.\n\
1362 If you repeat this command after it displayed such a list,\n\
1363 scroll the window of possible completions.")
1366 register int i;
1367 Lisp_Object window, tem;
1369 /* If the previous command was not this, then mark the completion
1370 buffer obsolete. */
1371 if (! EQ (current_kboard->Vlast_command, this_command))
1372 Vminibuf_scroll_window = Qnil;
1374 window = Vminibuf_scroll_window;
1375 /* If there's a fresh completion window with a live buffer,
1376 and this command is repeated, scroll that window. */
1377 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
1378 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
1380 struct buffer *obuf = current_buffer;
1382 Fset_buffer (XWINDOW (window)->buffer);
1383 tem = Fpos_visible_in_window_p (make_number (ZV), window);
1384 if (! NILP (tem))
1385 /* If end is in view, scroll up to the beginning. */
1386 Fset_window_start (window, make_number (BEGV), Qnil);
1387 else
1388 /* Else scroll down one screen. */
1389 Fscroll_other_window (Qnil);
1391 set_buffer_internal (obuf);
1392 return Qnil;
1395 i = do_completion ();
1396 switch (i)
1398 case 0:
1399 return Qnil;
1401 case 1:
1402 temp_echo_area_glyphs (" [Sole completion]");
1403 break;
1405 case 3:
1406 temp_echo_area_glyphs (" [Complete, but not unique]");
1407 break;
1410 return Qt;
1413 /* Subroutines of Fminibuffer_complete_and_exit. */
1415 /* This one is called by internal_condition_case to do the real work. */
1417 Lisp_Object
1418 complete_and_exit_1 ()
1420 return make_number (do_completion ());
1423 /* This one is called by internal_condition_case if an error happens.
1424 Pretend the current value is an exact match. */
1426 Lisp_Object
1427 complete_and_exit_2 (ignore)
1428 Lisp_Object ignore;
1430 return make_number (1);
1433 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
1434 Sminibuffer_complete_and_exit, 0, 0, "",
1435 "If the minibuffer contents is a valid completion then exit.\n\
1436 Otherwise try to complete it. If completion leads to a valid completion,\n\
1437 a repetition of this command will exit.")
1440 register int i;
1441 Lisp_Object val;
1443 /* Allow user to specify null string */
1444 if (BEGV == ZV)
1445 goto exit;
1447 if (!NILP (test_completion (Fbuffer_string ())))
1448 goto exit;
1450 /* Call do_completion, but ignore errors. */
1451 val = internal_condition_case (complete_and_exit_1, Qerror,
1452 complete_and_exit_2);
1454 i = XFASTINT (val);
1455 switch (i)
1457 case 1:
1458 case 3:
1459 goto exit;
1461 case 4:
1462 if (!NILP (Vminibuffer_completion_confirm))
1464 temp_echo_area_glyphs (" [Confirm]");
1465 return Qnil;
1467 else
1468 goto exit;
1470 default:
1471 return Qnil;
1473 exit:
1474 Fthrow (Qexit, Qnil);
1475 /* NOTREACHED */
1478 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
1479 0, 0, "",
1480 "Complete the minibuffer contents at most a single word.\n\
1481 After one word is completed as much as possible, a space or hyphen\n\
1482 is added, provided that matches some possible completion.\n\
1483 Return nil if there is no valid completion, else t.")
1486 Lisp_Object completion, tem;
1487 register int i;
1488 register unsigned char *completion_string;
1489 struct gcpro gcpro1, gcpro2;
1491 /* We keep calling Fbuffer_string rather than arrange for GC to
1492 hold onto a pointer to one of the strings thus made. */
1494 completion = Ftry_completion (Fbuffer_string (),
1495 Vminibuffer_completion_table,
1496 Vminibuffer_completion_predicate);
1497 if (NILP (completion))
1499 bitch_at_user ();
1500 temp_echo_area_glyphs (" [No match]");
1501 return Qnil;
1503 if (EQ (completion, Qt))
1504 return Qnil;
1506 #if 0 /* How the below code used to look, for reference. */
1507 tem = Fbuffer_string ();
1508 b = XSTRING (tem)->data;
1509 i = ZV - 1 - XSTRING (completion)->size;
1510 p = XSTRING (completion)->data;
1511 if (i > 0 ||
1512 0 <= scmp (b, p, ZV - 1))
1514 i = 1;
1515 /* Set buffer to longest match of buffer tail and completion head. */
1516 while (0 <= scmp (b + i, p, ZV - 1 - i))
1517 i++;
1518 del_range (1, i + 1);
1519 SET_PT (ZV);
1521 #else /* Rewritten code */
1523 register unsigned char *buffer_string;
1524 int buffer_length, completion_length;
1526 CHECK_STRING (completion, 0);
1527 tem = Fbuffer_string ();
1528 GCPRO2 (completion, tem);
1529 /* If reading a file name,
1530 expand any $ENVVAR refs in the buffer and in TEM. */
1531 if (EQ (Vminibuffer_completion_table, Qread_file_name_internal))
1533 Lisp_Object substituted;
1534 substituted = Fsubstitute_in_file_name (tem);
1535 if (! EQ (substituted, tem))
1537 tem = substituted;
1538 Ferase_buffer ();
1539 insert_from_string (tem, 0, XSTRING (tem)->size, 0);
1542 buffer_string = XSTRING (tem)->data;
1543 completion_string = XSTRING (completion)->data;
1544 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
1545 completion_length = XSTRING (completion)->size;
1546 i = buffer_length - completion_length;
1547 /* Mly: I don't understand what this is supposed to do AT ALL */
1548 if (i > 0 ||
1549 0 <= scmp (buffer_string, completion_string, buffer_length))
1551 /* Set buffer to longest match of buffer tail and completion head. */
1552 if (i <= 0) i = 1;
1553 buffer_string += i;
1554 buffer_length -= i;
1555 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
1556 i++;
1557 del_range (1, i + 1);
1558 SET_PT (ZV);
1560 UNGCPRO;
1562 #endif /* Rewritten code */
1563 i = ZV - BEGV;
1565 /* If completion finds next char not unique,
1566 consider adding a space or a hyphen. */
1567 if (i == XSTRING (completion)->size)
1569 GCPRO1 (completion);
1570 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1571 Vminibuffer_completion_table,
1572 Vminibuffer_completion_predicate);
1573 UNGCPRO;
1575 if (STRINGP (tem))
1576 completion = tem;
1577 else
1579 GCPRO1 (completion);
1580 tem =
1581 Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1582 Vminibuffer_completion_table,
1583 Vminibuffer_completion_predicate);
1584 UNGCPRO;
1586 if (STRINGP (tem))
1587 completion = tem;
1591 /* Now find first word-break in the stuff found by completion.
1592 i gets index in string of where to stop completing. */
1594 int len, c;
1596 completion_string = XSTRING (completion)->data;
1597 for (; i < XSTRING (completion)->size; i += len)
1599 c = STRING_CHAR_AND_LENGTH (completion_string + i,
1600 XSTRING (completion)->size - i,
1601 len);
1602 if (SYNTAX (c) != Sword)
1604 i += len;
1605 break;
1610 /* If got no characters, print help for user. */
1612 if (i == ZV - BEGV)
1614 if (auto_help)
1615 Fminibuffer_completion_help ();
1616 return Qnil;
1619 /* Otherwise insert in minibuffer the chars we got */
1621 Ferase_buffer ();
1622 insert_from_string (completion, 0, i, 1);
1623 return Qt;
1626 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
1627 1, 1, 0,
1628 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
1629 Each element may be just a symbol or string\n\
1630 or may be a list of two strings to be printed as if concatenated.\n\
1631 `standard-output' must be a buffer.\n\
1632 At the end, run the normal hook `completion-setup-hook'.\n\
1633 It can find the completion buffer in `standard-output'.")
1634 (completions)
1635 Lisp_Object completions;
1637 Lisp_Object tail, elt;
1638 register int i;
1639 int column = 0;
1640 struct gcpro gcpro1, gcpro2;
1641 struct buffer *old = current_buffer;
1642 int first = 1;
1644 /* Note that (when it matters) every variable
1645 points to a non-string that is pointed to by COMPLETIONS,
1646 except for ELT. ELT can be pointing to a string
1647 when terpri or Findent_to calls a change hook. */
1648 elt = Qnil;
1649 GCPRO2 (completions, elt);
1651 if (BUFFERP (Vstandard_output))
1652 set_buffer_internal (XBUFFER (Vstandard_output));
1654 if (NILP (completions))
1655 write_string ("There are no possible completions of what you have typed.",
1656 -1);
1657 else
1659 write_string ("Possible completions are:", -1);
1660 for (tail = completions, i = 0; !NILP (tail); tail = Fcdr (tail), i++)
1662 Lisp_Object tem;
1663 int length;
1664 Lisp_Object startpos, endpos;
1666 elt = Fcar (tail);
1667 /* Compute the length of this element. */
1668 if (CONSP (elt))
1670 tem = XCAR (elt);
1671 CHECK_STRING (tem, 0);
1672 length = XSTRING (tem)->size;
1674 tem = Fcar (XCDR (elt));
1675 CHECK_STRING (tem, 0);
1676 length += XSTRING (tem)->size;
1678 else
1680 CHECK_STRING (elt, 0);
1681 length = XSTRING (elt)->size;
1684 /* This does a bad job for narrower than usual windows.
1685 Sadly, the window it will appear in is not known
1686 until after the text has been made. */
1688 if (BUFFERP (Vstandard_output))
1689 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
1691 /* If the previous completion was very wide,
1692 or we have two on this line already,
1693 don't put another on the same line. */
1694 if (column > 33 || first
1695 /* If this is really wide, don't put it second on a line. */
1696 || column > 0 && length > 45)
1698 Fterpri (Qnil);
1699 column = 0;
1701 /* Otherwise advance to column 35. */
1702 else
1704 if (BUFFERP (Vstandard_output))
1706 tem = Findent_to (make_number (35), make_number (2));
1708 column = XINT (tem);
1710 else
1714 write_string (" ", -1);
1715 column++;
1717 while (column < 35);
1721 if (BUFFERP (Vstandard_output))
1723 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
1724 Fset_text_properties (startpos, endpos,
1725 Qnil, Vstandard_output);
1728 /* Output this element and update COLUMN. */
1729 if (CONSP (elt))
1731 Fprinc (Fcar (elt), Qnil);
1732 Fprinc (Fcar (Fcdr (elt)), Qnil);
1734 else
1735 Fprinc (elt, Qnil);
1737 column += length;
1739 /* If output is to a buffer, recompute COLUMN in a way
1740 that takes account of character widths. */
1741 if (BUFFERP (Vstandard_output))
1743 tem = Fcurrent_column ();
1744 column = XINT (tem);
1747 first = 0;
1751 UNGCPRO;
1753 if (BUFFERP (Vstandard_output))
1754 set_buffer_internal (old);
1756 if (!NILP (Vrun_hooks))
1757 call1 (Vrun_hooks, intern ("completion-setup-hook"));
1759 return Qnil;
1762 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
1763 0, 0, "",
1764 "Display a list of possible completions of the current minibuffer contents.")
1767 Lisp_Object completions;
1769 message ("Making completion list...");
1770 completions = Fall_completions (Fbuffer_string (),
1771 Vminibuffer_completion_table,
1772 Vminibuffer_completion_predicate,
1773 Qt);
1774 echo_area_glyphs = 0;
1776 if (NILP (completions))
1778 bitch_at_user ();
1779 temp_echo_area_glyphs (" [No completions]");
1781 else
1782 internal_with_output_to_temp_buffer ("*Completions*",
1783 Fdisplay_completion_list,
1784 Fsort (completions, Qstring_lessp));
1785 return Qnil;
1788 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
1789 "Terminate minibuffer input.")
1792 if (INTEGERP (last_command_char))
1793 internal_self_insert (last_command_char, 0);
1794 else
1795 bitch_at_user ();
1797 Fthrow (Qexit, Qnil);
1800 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
1801 "Terminate this minibuffer argument.")
1804 Fthrow (Qexit, Qnil);
1807 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1808 "Return current depth of activations of minibuffer, a nonnegative integer.")
1811 return make_number (minibuf_level);
1814 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
1815 "Return the prompt string of the currently-active minibuffer.\n\
1816 If no minibuffer is active, return nil.")
1819 return Fcopy_sequence (minibuf_prompt);
1822 DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width,
1823 Sminibuffer_prompt_width, 0, 0, 0,
1824 "Return the display width of the minibuffer prompt.")
1827 Lisp_Object width;
1828 XSETFASTINT (width, minibuf_prompt_width);
1829 return width;
1832 /* Temporarily display the string M at the end of the current
1833 minibuffer contents. This is used to display things like
1834 "[No Match]" when the user requests a completion for a prefix
1835 that has no possible completions, and other quick, unobtrusive
1836 messages. */
1838 temp_echo_area_glyphs (m)
1839 char *m;
1841 int osize = ZV;
1842 int opoint = PT;
1843 Lisp_Object oinhibit;
1844 oinhibit = Vinhibit_quit;
1846 /* Clear out any old echo-area message to make way for our new thing. */
1847 message (0);
1849 SET_PT (osize);
1850 insert_string (m);
1851 SET_PT (opoint);
1852 Vinhibit_quit = Qt;
1853 Fsit_for (make_number (2), Qnil, Qnil);
1854 del_range (osize, ZV);
1855 SET_PT (opoint);
1856 if (!NILP (Vquit_flag))
1858 Vquit_flag = Qnil;
1859 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1861 Vinhibit_quit = oinhibit;
1864 DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message,
1865 1, 1, 0,
1866 "Temporarily display STRING at the end of the minibuffer.\n\
1867 The text is displayed for two seconds,\n\
1868 or until the next input event arrives, whichever comes first.")
1869 (string)
1870 Lisp_Object string;
1872 temp_echo_area_glyphs (XSTRING (string)->data);
1873 return Qnil;
1876 init_minibuf_once ()
1878 Vminibuffer_list = Qnil;
1879 staticpro (&Vminibuffer_list);
1882 syms_of_minibuf ()
1884 minibuf_level = 0;
1885 minibuf_prompt = Qnil;
1886 staticpro (&minibuf_prompt);
1888 minibuf_save_list = Qnil;
1889 staticpro (&minibuf_save_list);
1891 Qread_file_name_internal = intern ("read-file-name-internal");
1892 staticpro (&Qread_file_name_internal);
1894 Qminibuffer_default = intern ("minibuffer-default");
1895 staticpro (&Qminibuffer_default);
1896 Fset (Qminibuffer_default, Qnil);
1898 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
1899 staticpro (&Qminibuffer_completion_table);
1901 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
1902 staticpro (&Qminibuffer_completion_confirm);
1904 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
1905 staticpro (&Qminibuffer_completion_predicate);
1907 staticpro (&last_exact_completion);
1908 last_exact_completion = Qnil;
1910 staticpro (&last_minibuf_string);
1911 last_minibuf_string = Qnil;
1913 Quser_variable_p = intern ("user-variable-p");
1914 staticpro (&Quser_variable_p);
1916 Qminibuffer_history = intern ("minibuffer-history");
1917 staticpro (&Qminibuffer_history);
1919 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
1920 staticpro (&Qminibuffer_setup_hook);
1922 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
1923 staticpro (&Qminibuffer_exit_hook);
1925 Qhistory_length = intern ("history-length");
1926 staticpro (&Qhistory_length);
1928 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
1929 "Normal hook run just after entry to minibuffer.");
1930 Vminibuffer_setup_hook = Qnil;
1932 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
1933 "Normal hook run just after exit from minibuffer.");
1934 Vminibuffer_exit_hook = Qnil;
1936 DEFVAR_LISP ("history-length", &Vhistory_length,
1937 "*Maximum length for history lists before truncation takes place.\n\
1938 A number means that length; t means infinite. Truncation takes place\n\
1939 just after a new element is inserted. Setting the history-length\n\
1940 property of a history variable overrides this default.");
1941 XSETFASTINT (Vhistory_length, 30);
1943 DEFVAR_BOOL ("completion-auto-help", &auto_help,
1944 "*Non-nil means automatically provide help for invalid completion input.");
1945 auto_help = 1;
1947 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
1948 "Non-nil means don't consider case significant in completion.");
1949 completion_ignore_case = 0;
1951 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
1952 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1953 More precisely, this variable makes a difference when the minibuffer window\n\
1954 is the selected window. If you are in some other window, minibuffer commands\n\
1955 are allowed even if a minibuffer is active.");
1956 enable_recursive_minibuffers = 0;
1958 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
1959 "Alist or obarray used for completion in the minibuffer.\n\
1960 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1962 The value may alternatively be a function, which is given three arguments:\n\
1963 STRING, the current buffer contents;\n\
1964 PREDICATE, the predicate for filtering possible matches;\n\
1965 CODE, which says what kind of things to do.\n\
1966 CODE can be nil, t or `lambda'.\n\
1967 nil means to return the best completion of STRING, or nil if there is none.\n\
1968 t means to return a list of all possible completions of STRING.\n\
1969 `lambda' means to return t if STRING is a valid completion as it stands.");
1970 Vminibuffer_completion_table = Qnil;
1972 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
1973 "Within call to `completing-read', this holds the PREDICATE argument.");
1974 Vminibuffer_completion_predicate = Qnil;
1976 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
1977 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1978 Vminibuffer_completion_confirm = Qnil;
1980 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
1981 "Value that `help-form' takes on inside the minibuffer.");
1982 Vminibuffer_help_form = Qnil;
1984 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
1985 "History list symbol to add minibuffer values to.\n\
1986 Each string of minibuffer input, as it appears on exit from the minibuffer,\n\
1987 is added with\n\
1988 (set minibuffer-history-variable\n\
1989 (cons STRING (symbol-value minibuffer-history-variable)))");
1990 XSETFASTINT (Vminibuffer_history_variable, 0);
1992 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
1993 "Current position of redoing in the history list.");
1994 Vminibuffer_history_position = Qnil;
1996 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
1997 "*Non-nil means entering the minibuffer raises the minibuffer's frame.\n\
1998 Some uses of the echo area also raise that frame (since they use it too).");
1999 minibuffer_auto_raise = 0;
2001 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
2002 "List of regexps that should restrict possible completions.");
2003 Vcompletion_regexp_list = Qnil;
2005 DEFVAR_BOOL ("minibuffer-allow-text-properties",
2006 &minibuffer_allow_text_properties,
2007 "Non-nil means `read-from-miniffer' should not discard text properties.\n\
2008 This also affects `read-string', but it does not affect `read-minibuffer',\n\
2009 `read-no-blanks-input', or any of the functions that do minibuffer input\n\
2010 with completion; they always discard text properties.");
2011 minibuffer_allow_text_properties = 0;
2013 defsubr (&Sset_minibuffer_window);
2014 defsubr (&Sread_from_minibuffer);
2015 defsubr (&Seval_minibuffer);
2016 defsubr (&Sread_minibuffer);
2017 defsubr (&Sread_string);
2018 defsubr (&Sread_command);
2019 defsubr (&Sread_variable);
2020 defsubr (&Sread_buffer);
2021 defsubr (&Sread_no_blanks_input);
2022 defsubr (&Sminibuffer_depth);
2023 defsubr (&Sminibuffer_prompt);
2024 defsubr (&Sminibuffer_prompt_width);
2026 defsubr (&Stry_completion);
2027 defsubr (&Sall_completions);
2028 defsubr (&Scompleting_read);
2029 defsubr (&Sminibuffer_complete);
2030 defsubr (&Sminibuffer_complete_word);
2031 defsubr (&Sminibuffer_complete_and_exit);
2032 defsubr (&Sdisplay_completion_list);
2033 defsubr (&Sminibuffer_completion_help);
2035 defsubr (&Sself_insert_and_exit);
2036 defsubr (&Sexit_minibuffer);
2038 defsubr (&Sminibuffer_message);
2041 keys_of_minibuf ()
2043 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
2044 "abort-recursive-edit");
2045 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
2046 "exit-minibuffer");
2047 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
2048 "exit-minibuffer");
2050 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
2051 "abort-recursive-edit");
2052 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
2053 "exit-minibuffer");
2054 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
2055 "exit-minibuffer");
2057 initial_define_key (Vminibuffer_local_ns_map, ' ',
2058 "exit-minibuffer");
2059 initial_define_key (Vminibuffer_local_ns_map, '\t',
2060 "exit-minibuffer");
2061 initial_define_key (Vminibuffer_local_ns_map, '?',
2062 "self-insert-and-exit");
2064 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
2065 "abort-recursive-edit");
2066 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
2067 "exit-minibuffer");
2068 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
2069 "exit-minibuffer");
2071 initial_define_key (Vminibuffer_local_completion_map, '\t',
2072 "minibuffer-complete");
2073 initial_define_key (Vminibuffer_local_completion_map, ' ',
2074 "minibuffer-complete-word");
2075 initial_define_key (Vminibuffer_local_completion_map, '?',
2076 "minibuffer-completion-help");
2078 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
2079 "abort-recursive-edit");
2080 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
2081 "minibuffer-complete-and-exit");
2082 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
2083 "minibuffer-complete-and-exit");
2084 initial_define_key (Vminibuffer_local_must_match_map, '\t',
2085 "minibuffer-complete");
2086 initial_define_key (Vminibuffer_local_must_match_map, ' ',
2087 "minibuffer-complete-word");
2088 initial_define_key (Vminibuffer_local_must_match_map, '?',
2089 "minibuffer-completion-help");