(read_minibuf): Get the string from the minibuffer
[emacs.git] / src / minibuf.c
blob249e96f485a5b63a36598691a0d4e84529306dca
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 /* help-form is bound to this while in the minibuffer. */
65 Lisp_Object Vminibuffer_help_form;
67 /* Variable which is the history list to add minibuffer values to. */
69 Lisp_Object Vminibuffer_history_variable;
71 /* Current position in the history list (adjusted by M-n and M-p). */
73 Lisp_Object Vminibuffer_history_position;
75 Lisp_Object Qminibuffer_history;
77 Lisp_Object Qread_file_name_internal;
79 /* Normal hooks for entry to and exit from minibuffer. */
81 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
82 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
84 /* Nonzero means completion ignores case. */
86 int completion_ignore_case;
88 /* List of regexps that should restrict possible completions. */
90 Lisp_Object Vcompletion_regexp_list;
92 /* Nonzero means raise the minibuffer frame when the minibuffer
93 is entered. */
95 int minibuffer_auto_raise;
97 /* If last completion attempt reported "Complete but not unique"
98 then this is the string completed then; otherwise this is nil. */
100 static Lisp_Object last_exact_completion;
102 Lisp_Object Quser_variable_p;
104 /* Non-nil means it is the window for C-M-v to scroll
105 when the minibuffer is selected. */
106 extern Lisp_Object Vminibuf_scroll_window;
108 extern Lisp_Object Voverriding_local_map;
110 /* Put minibuf on currently selected frame's minibuffer.
111 We do this whenever the user starts a new minibuffer
112 or when a minibuffer exits. */
114 void
115 choose_minibuf_frame ()
117 if (selected_frame != 0
118 && !EQ (minibuf_window, selected_frame->minibuffer_window))
120 /* I don't think that any frames may validly have a null minibuffer
121 window anymore. */
122 if (NILP (selected_frame->minibuffer_window))
123 abort ();
125 Fset_window_buffer (selected_frame->minibuffer_window,
126 XWINDOW (minibuf_window)->buffer);
127 minibuf_window = selected_frame->minibuffer_window;
130 /* Make sure no other frame has a minibuffer as its selected window,
131 because the text would not be displayed in it, and that would be
132 confusing. Only allow the selected frame to do this,
133 and that only if the minibuffer is active. */
135 Lisp_Object tail, frame;
137 FOR_EACH_FRAME (tail, frame)
138 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
139 && !(XFRAME (frame) == selected_frame
140 && minibuf_level > 0))
141 Fset_frame_selected_window (frame, Fframe_first_window (frame));
145 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
146 Sset_minibuffer_window, 1, 1, 0,
147 "Specify which minibuffer window to use for the minibuffer.\n\
148 This effects where the minibuffer is displayed if you put text in it\n\
149 without invoking the usual minibuffer commands.")
150 (window)
151 Lisp_Object window;
153 CHECK_WINDOW (window, 1);
154 if (! MINI_WINDOW_P (XWINDOW (window)))
155 error ("Window is not a minibuffer window");
157 minibuf_window = window;
159 return window;
163 /* Actual minibuffer invocation. */
165 void read_minibuf_unwind ();
166 Lisp_Object get_minibuffer ();
167 Lisp_Object read_minibuf ();
169 /* Read from the minibuffer using keymap MAP, initial contents INITIAL
170 (a string), putting point minus BACKUP_N chars from the end of INITIAL,
171 prompting with PROMPT (a string), using history list HISTVAR
172 with initial position HISTPOS. (BACKUP_N should be <= 0.)
174 Normally return the result as a string (the text that was read),
175 but if EXPFLAG is nonzero, read it and return the object read.
176 If HISTVAR is given, save the value read on that history only if it doesn't
177 match the front of that history list exactly. The value is pushed onto
178 the list as the string that was read. */
180 Lisp_Object
181 read_minibuf (map, initial, prompt, backup_n, expflag, histvar, histpos)
182 Lisp_Object map;
183 Lisp_Object initial;
184 Lisp_Object prompt;
185 Lisp_Object backup_n;
186 int expflag;
187 Lisp_Object histvar;
188 Lisp_Object histpos;
190 Lisp_Object val;
191 int count = specpdl_ptr - specpdl;
192 Lisp_Object mini_frame, ambient_dir, minibuffer;
193 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
195 single_kboard_state ();
197 val = Qnil;
198 ambient_dir = current_buffer->directory;
200 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
201 store them away before we can GC. Don't need to protect
202 BACKUP_N because we use the value only if it is an integer. */
203 GCPRO4 (map, initial, val, ambient_dir);
205 if (!STRINGP (prompt))
206 prompt = build_string ("");
208 if (!enable_recursive_minibuffers
209 && minibuf_level > 0)
211 if (EQ (selected_window, minibuf_window))
212 error ("Command attempted to use minibuffer while in minibuffer");
213 else
214 /* If we're in another window, cancel the minibuffer that's active. */
215 Fthrow (Qexit,
216 build_string ("Command attempted to use minibuffer while in minibuffer"));
219 /* Choose the minibuffer window and frame, and take action on them. */
221 choose_minibuf_frame ();
223 record_unwind_protect (Fset_window_configuration,
224 Fcurrent_window_configuration (Qnil));
226 /* If the minibuffer window is on a different frame, save that
227 frame's configuration too. */
228 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
229 if (XFRAME (mini_frame) != selected_frame)
230 record_unwind_protect (Fset_window_configuration,
231 Fcurrent_window_configuration (mini_frame));
233 /* If the minibuffer is on an iconified or invisible frame,
234 make it visible now. */
235 Fmake_frame_visible (mini_frame);
237 if (minibuffer_auto_raise)
238 Fraise_frame (mini_frame);
240 /* We have to do this after saving the window configuration
241 since that is what restores the current buffer. */
243 /* Arrange to restore a number of minibuffer-related variables.
244 We could bind each variable separately, but that would use lots of
245 specpdl slots. */
246 minibuf_save_list
247 = Fcons (Voverriding_local_map,
248 Fcons (minibuf_window, minibuf_save_list));
249 minibuf_save_list
250 = Fcons (minibuf_prompt,
251 Fcons (make_number (minibuf_prompt_width),
252 Fcons (Vhelp_form,
253 Fcons (Vcurrent_prefix_arg,
254 Fcons (Vminibuffer_history_position,
255 Fcons (Vminibuffer_history_variable,
256 minibuf_save_list))))));
258 record_unwind_protect (read_minibuf_unwind, Qnil);
259 minibuf_level++;
261 /* Now that we can restore all those variables, start changing them. */
263 minibuf_prompt_width = 0; /* xdisp.c puts in the right value. */
264 minibuf_prompt = Fcopy_sequence (prompt);
265 Vminibuffer_history_position = histpos;
266 Vminibuffer_history_variable = histvar;
267 Vhelp_form = Vminibuffer_help_form;
269 /* Switch to the minibuffer. */
271 minibuffer = get_minibuffer (minibuf_level);
272 Fset_buffer (minibuffer);
274 /* The current buffer's default directory is usually the right thing
275 for our minibuffer here. However, if you're typing a command at
276 a minibuffer-only frame when minibuf_level is zero, then buf IS
277 the current_buffer, so reset_buffer leaves buf's default
278 directory unchanged. This is a bummer when you've just started
279 up Emacs and buf's default directory is Qnil. Here's a hack; can
280 you think of something better to do? Find another buffer with a
281 better directory, and use that one instead. */
282 if (STRINGP (ambient_dir))
283 current_buffer->directory = ambient_dir;
284 else
286 Lisp_Object buf_list;
288 for (buf_list = Vbuffer_alist;
289 CONSP (buf_list);
290 buf_list = XCONS (buf_list)->cdr)
292 Lisp_Object other_buf;
294 other_buf = XCONS (XCONS (buf_list)->car)->cdr;
295 if (STRINGP (XBUFFER (other_buf)->directory))
297 current_buffer->directory = XBUFFER (other_buf)->directory;
298 break;
303 if (XFRAME (mini_frame) != selected_frame)
304 Fredirect_frame_focus (Fselected_frame (), mini_frame);
306 Vminibuf_scroll_window = selected_window;
307 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
308 Fselect_window (minibuf_window);
309 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
311 Fmake_local_variable (Qprint_escape_newlines);
312 print_escape_newlines = 1;
314 /* Erase the buffer. */
316 int count1 = specpdl_ptr - specpdl;
317 specbind (Qinhibit_read_only, Qt);
318 Ferase_buffer ();
319 unbind_to (count1, Qnil);
322 /* Put in the initial input. */
323 if (!NILP (initial))
325 Finsert (1, &initial);
326 if (!NILP (backup_n) && INTEGERP (backup_n))
327 Fgoto_char (make_number (PT + XFASTINT (backup_n)));
330 echo_area_glyphs = 0;
331 /* This is in case the minibuffer-setup-hook calls Fsit_for. */
332 previous_echo_glyphs = 0;
334 current_buffer->keymap = map;
336 /* Run our hook, but not if it is empty.
337 (run-hooks would do nothing if it is empty,
338 but it's important to save time here in the usual case). */
339 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
340 && !NILP (Vrun_hooks))
341 call1 (Vrun_hooks, Qminibuffer_setup_hook);
343 /* ??? MCC did redraw_screen here if switching screens. */
344 recursive_edit_1 ();
346 /* If cursor is on the minibuffer line,
347 show the user we have exited by putting it in column 0. */
348 if ((FRAME_CURSOR_Y (selected_frame)
349 >= XFASTINT (XWINDOW (minibuf_window)->top))
350 && !noninteractive)
352 FRAME_CURSOR_X (selected_frame)
353 = FRAME_LEFT_SCROLL_BAR_WIDTH (selected_frame);
354 update_frame (selected_frame, 1, 1);
357 /* Make minibuffer contents into a string */
358 Fset_buffer (minibuffer);
359 val = make_buffer_string (1, Z, 1);
360 #if 0 /* make_buffer_string should handle the gap. */
361 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
362 #endif
364 /* VAL is the string of minibuffer text. */
365 last_minibuf_string = val;
367 /* Add the value to the appropriate history list unless it is empty. */
368 if (XSTRING (val)->size != 0
369 && SYMBOLP (Vminibuffer_history_variable)
370 && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound))
372 /* If the caller wanted to save the value read on a history list,
373 then do so if the value is not already the front of the list. */
374 Lisp_Object histval;
375 histval = Fsymbol_value (Vminibuffer_history_variable);
377 /* The value of the history variable must be a cons or nil. Other
378 values are unacceptable. We silently ignore these values. */
379 if (NILP (histval)
380 || (CONSP (histval)
381 && NILP (Fequal (last_minibuf_string, Fcar (histval)))))
383 Lisp_Object length;
385 histval = Fcons (last_minibuf_string, histval);
386 Fset (Vminibuffer_history_variable, histval);
388 /* Truncate if requested. */
389 length = Fget (Vminibuffer_history_variable, Qhistory_length);
390 if (NILP (length)) length = Vhistory_length;
391 if (INTEGERP (length)) {
392 if (XINT (length) <= 0)
393 Fset (Vminibuffer_history_variable, Qnil);
394 else
396 Lisp_Object temp;
398 temp = Fnthcdr (Fsub1 (length), histval);
399 if (CONSP (temp)) Fsetcdr (temp, Qnil);
405 /* If Lisp form desired instead of string, parse it. */
406 if (expflag)
408 Lisp_Object expr_and_pos;
409 unsigned char *p;
411 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
412 /* Ignore trailing whitespace; any other trailing junk is an error. */
413 for (p = XSTRING (val)->data + XINT (Fcdr (expr_and_pos)); *p; p++)
414 if (*p != ' ' && *p != '\t' && *p != '\n')
415 error ("Trailing garbage following expression");
416 val = Fcar (expr_and_pos);
419 /* The appropriate frame will get selected
420 in set-window-configuration. */
421 RETURN_UNGCPRO (unbind_to (count, val));
424 /* Return a buffer to be used as the minibuffer at depth `depth'.
425 depth = 0 is the lowest allowed argument, and that is the value
426 used for nonrecursive minibuffer invocations */
428 Lisp_Object
429 get_minibuffer (depth)
430 int depth;
432 Lisp_Object tail, num, buf;
433 char name[24];
434 extern Lisp_Object nconc2 ();
436 XSETFASTINT (num, depth);
437 tail = Fnthcdr (num, Vminibuffer_list);
438 if (NILP (tail))
440 tail = Fcons (Qnil, Qnil);
441 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
443 buf = Fcar (tail);
444 if (NILP (buf) || NILP (XBUFFER (buf)->name))
446 sprintf (name, " *Minibuf-%d*", depth);
447 buf = Fget_buffer_create (build_string (name));
449 /* Although the buffer's name starts with a space, undo should be
450 enabled in it. */
451 Fbuffer_enable_undo (buf);
453 XCONS (tail)->car = buf;
455 else
457 int count = specpdl_ptr - specpdl;
459 reset_buffer (XBUFFER (buf));
460 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
461 Fset_buffer (buf);
462 Fkill_all_local_variables ();
463 unbind_to (count, Qnil);
466 return buf;
469 /* This function is called on exiting minibuffer, whether normally or not,
470 and it restores the current window, buffer, etc. */
472 void
473 read_minibuf_unwind (data)
474 Lisp_Object data;
476 Lisp_Object old_deactivate_mark;
477 Lisp_Object window;
479 /* We are exiting the minibuffer one way or the other,
480 so run the hook. */
481 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
482 && !NILP (Vrun_hooks))
483 safe_run_hooks (Qminibuffer_exit_hook);
485 /* If this was a recursive minibuffer,
486 tie the minibuffer window back to the outer level minibuffer buffer. */
487 minibuf_level--;
489 window = minibuf_window;
490 /* To keep things predictable, in case it matters, let's be in the minibuffer
491 when we reset the relevant variables. */
492 Fset_buffer (XWINDOW (window)->buffer);
494 /* Restore prompt, etc, from outer minibuffer level. */
495 minibuf_prompt = Fcar (minibuf_save_list);
496 minibuf_save_list = Fcdr (minibuf_save_list);
497 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
498 minibuf_save_list = Fcdr (minibuf_save_list);
499 Vhelp_form = Fcar (minibuf_save_list);
500 minibuf_save_list = Fcdr (minibuf_save_list);
501 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
502 minibuf_save_list = Fcdr (minibuf_save_list);
503 Vminibuffer_history_position = Fcar (minibuf_save_list);
504 minibuf_save_list = Fcdr (minibuf_save_list);
505 Vminibuffer_history_variable = Fcar (minibuf_save_list);
506 minibuf_save_list = Fcdr (minibuf_save_list);
507 Voverriding_local_map = Fcar (minibuf_save_list);
508 minibuf_save_list = Fcdr (minibuf_save_list);
509 #if 0
510 temp = Fcar (minibuf_save_list);
511 if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
512 minibuf_window = temp;
513 #endif
514 minibuf_save_list = Fcdr (minibuf_save_list);
516 /* Erase the minibuffer we were using at this level. */
518 int count = specpdl_ptr - specpdl;
519 /* Prevent error in erase-buffer. */
520 specbind (Qinhibit_read_only, Qt);
521 old_deactivate_mark = Vdeactivate_mark;
522 Ferase_buffer ();
523 Vdeactivate_mark = old_deactivate_mark;
524 unbind_to (count, Qnil);
527 /* Make the minibuffer follow the selected frame
528 (in case we are exiting a recursive minibuffer). */
529 choose_minibuf_frame ();
531 /* Make sure minibuffer window is erased, not ignored. */
532 windows_or_buffers_changed++;
533 XSETFASTINT (XWINDOW (window)->last_modified, 0);
534 XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
538 /* This comment supplies the doc string for read-from-minibuffer,
539 for make-docfile to see. We cannot put this in the real DEFUN
540 due to limits in the Unix cpp.
542 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
543 "Read a string from the minibuffer, prompting with string PROMPT.\n\
544 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
545 to be inserted into the minibuffer before reading input.\n\
546 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
547 is STRING, but point is placed at position POSITION in the minibuffer.\n\
548 Third arg KEYMAP is a keymap to use whilst reading;\n\
549 if omitted or nil, the default is `minibuffer-local-map'.\n\
550 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
551 and return that object:\n\
552 in other words, do `(car (read-from-string INPUT-STRING))'\n\
553 Fifth arg HIST, if non-nil, specifies a history list\n\
554 and optionally the initial position in the list.\n\
555 It can be a symbol, which is the history list variable to use,\n\
556 or it can be a cons cell (HISTVAR . HISTPOS).\n\
557 In that case, HISTVAR is the history list variable to use,\n\
558 and HISTPOS is the initial position (the position in the list\n\
559 which INITIAL-CONTENTS corresponds to).\n\
560 Positions are counted starting from 1 at the beginning of the list."
563 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
564 0 /* See immediately above */)
565 (prompt, initial_contents, keymap, read, hist)
566 Lisp_Object prompt, initial_contents, keymap, read, hist;
568 int pos = 0;
569 Lisp_Object histvar, histpos, position;
570 position = Qnil;
572 CHECK_STRING (prompt, 0);
573 if (!NILP (initial_contents))
575 if (CONSP (initial_contents))
577 position = Fcdr (initial_contents);
578 initial_contents = Fcar (initial_contents);
580 CHECK_STRING (initial_contents, 1);
581 if (!NILP (position))
583 CHECK_NUMBER (position, 0);
584 /* Convert to distance from end of input. */
585 if (XINT (position) < 1)
586 /* A number too small means the beginning of the string. */
587 pos = - XSTRING (initial_contents)->size;
588 else
589 pos = XINT (position) - 1 - XSTRING (initial_contents)->size;
593 if (NILP (keymap))
594 keymap = Vminibuffer_local_map;
595 else
596 keymap = get_keymap (keymap,2);
598 if (SYMBOLP (hist))
600 histvar = hist;
601 histpos = Qnil;
603 else
605 histvar = Fcar_safe (hist);
606 histpos = Fcdr_safe (hist);
608 if (NILP (histvar))
609 histvar = Qminibuffer_history;
610 if (NILP (histpos))
611 XSETFASTINT (histpos, 0);
613 return read_minibuf (keymap, initial_contents, prompt,
614 make_number (pos), !NILP (read), histvar, histpos);
617 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
618 "Return a Lisp object read using the minibuffer.\n\
619 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
620 is a string to insert in the minibuffer before reading.")
621 (prompt, initial_contents)
622 Lisp_Object prompt, initial_contents;
624 CHECK_STRING (prompt, 0);
625 if (!NILP (initial_contents))
626 CHECK_STRING (initial_contents, 1);
627 return read_minibuf (Vminibuffer_local_map, initial_contents,
628 prompt, Qnil, 1, Qminibuffer_history, make_number (0));
631 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
632 "Return value of Lisp expression read using the minibuffer.\n\
633 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
634 is a string to insert in the minibuffer before reading.")
635 (prompt, initial_contents)
636 Lisp_Object prompt, initial_contents;
638 return Feval (Fread_minibuffer (prompt, initial_contents));
641 /* Functions that use the minibuffer to read various things. */
643 DEFUN ("read-string", Fread_string, Sread_string, 1, 3, 0,
644 "Read a string from the minibuffer, prompting with string PROMPT.\n\
645 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.\n\
646 The third arg HISTORY, if non-nil, specifies a history list\n\
647 and optionally the initial position in the list.\n\
648 See `read-from-minibuffer' for details of HISTORY argument.")
649 (prompt, initial_input, history)
650 Lisp_Object prompt, initial_input, history;
652 return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, history);
655 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 2, 0,
656 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
657 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
658 (prompt, init)
659 Lisp_Object prompt, init;
661 CHECK_STRING (prompt, 0);
662 if (! NILP (init))
663 CHECK_STRING (init, 1);
665 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0,
666 Qminibuffer_history, make_number (0));
669 DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
670 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
671 Prompts with PROMPT.")
672 (prompt)
673 Lisp_Object prompt;
675 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil),
676 Qnil);
679 #ifdef NOTDEF
680 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
681 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
682 Prompts with PROMPT.")
683 (prompt)
684 Lisp_Object prompt;
686 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil),
687 Qnil);
689 #endif /* NOTDEF */
691 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
692 "One arg PROMPT, a string. Read the name of a user variable and return\n\
693 it as a symbol. Prompts with PROMPT.\n\
694 A user variable is one whose documentation starts with a `*' character.")
695 (prompt)
696 Lisp_Object prompt;
698 return Fintern (Fcompleting_read (prompt, Vobarray,
699 Quser_variable_p, Qt, Qnil, Qnil),
700 Qnil);
703 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
704 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
705 Prompts with PROMPT.\n\
706 Optional second arg is value to return if user enters an empty line.\n\
707 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
708 (prompt, def, require_match)
709 Lisp_Object prompt, def, require_match;
711 Lisp_Object tem;
712 Lisp_Object args[3];
713 struct gcpro gcpro1;
715 if (BUFFERP (def))
716 def = XBUFFER (def)->name;
717 if (!NILP (def))
719 args[0] = build_string ("%s(default %s) ");
720 args[1] = prompt;
721 args[2] = def;
722 prompt = Fformat (3, args);
724 GCPRO1 (def);
725 tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil);
726 UNGCPRO;
727 if (XSTRING (tem)->size)
728 return tem;
729 return def;
732 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
733 "Return common substring of all completions of STRING in ALIST.\n\
734 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
735 All that match are compared together; the longest initial sequence\n\
736 common to all matches is returned as a string.\n\
737 If there is no match at all, nil is returned.\n\
738 For an exact match, t is returned.\n\
740 ALIST can be an obarray instead of an alist.\n\
741 Then the print names of all symbols in the obarray are the possible matches.\n\
743 ALIST can also be a function to do the completion itself.\n\
744 It receives three arguments: the values STRING, PREDICATE and nil.\n\
745 Whatever it returns becomes the value of `try-completion'.\n\
747 If optional third argument PREDICATE is non-nil,\n\
748 it is used to test each possible match.\n\
749 The match is a candidate only if PREDICATE returns non-nil.\n\
750 The argument given to PREDICATE is the alist element\n\
751 or the symbol from the obarray.")
752 (string, alist, predicate)
753 Lisp_Object string, alist, predicate;
755 Lisp_Object bestmatch, tail, elt, eltstring;
756 int bestmatchsize;
757 int compare, matchsize;
758 int list = CONSP (alist) || NILP (alist);
759 int index, obsize;
760 int matchcount = 0;
761 Lisp_Object bucket, zero, end, tem;
762 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
764 CHECK_STRING (string, 0);
765 if (!list && !VECTORP (alist))
766 return call3 (alist, string, predicate, Qnil);
768 bestmatch = Qnil;
770 /* If ALIST is not a list, set TAIL just for gc pro. */
771 tail = alist;
772 if (! list)
774 index = 0;
775 obsize = XVECTOR (alist)->size;
776 bucket = XVECTOR (alist)->contents[index];
779 while (1)
781 /* Get the next element of the alist or obarray. */
782 /* Exit the loop if the elements are all used up. */
783 /* elt gets the alist element or symbol.
784 eltstring gets the name to check as a completion. */
786 if (list)
788 if (NILP (tail))
789 break;
790 elt = Fcar (tail);
791 eltstring = Fcar (elt);
792 tail = Fcdr (tail);
794 else
796 if (XFASTINT (bucket) != 0)
798 elt = bucket;
799 eltstring = Fsymbol_name (elt);
800 if (XSYMBOL (bucket)->next)
801 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
802 else
803 XSETFASTINT (bucket, 0);
805 else if (++index >= obsize)
806 break;
807 else
809 bucket = XVECTOR (alist)->contents[index];
810 continue;
814 /* Is this element a possible completion? */
816 if (STRINGP (eltstring)
817 && XSTRING (string)->size <= XSTRING (eltstring)->size
818 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
819 XSTRING (string)->size))
821 /* Yes. */
822 Lisp_Object regexps;
823 Lisp_Object zero;
824 XSETFASTINT (zero, 0);
826 /* Ignore this element if it fails to match all the regexps. */
827 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
828 regexps = XCONS (regexps)->cdr)
830 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
831 if (NILP (tem))
832 break;
834 if (CONSP (regexps))
835 continue;
837 /* Ignore this element if there is a predicate
838 and the predicate doesn't like it. */
840 if (!NILP (predicate))
842 if (EQ (predicate, Qcommandp))
843 tem = Fcommandp (elt);
844 else
846 GCPRO4 (tail, string, eltstring, bestmatch);
847 tem = call1 (predicate, elt);
848 UNGCPRO;
850 if (NILP (tem)) continue;
853 /* Update computation of how much all possible completions match */
855 matchcount++;
856 if (NILP (bestmatch))
857 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
858 else
860 compare = min (bestmatchsize, XSTRING (eltstring)->size);
861 matchsize = scmp (XSTRING (bestmatch)->data,
862 XSTRING (eltstring)->data,
863 compare);
864 if (matchsize < 0)
865 matchsize = compare;
866 if (completion_ignore_case)
868 /* If this is an exact match except for case,
869 use it as the best match rather than one that is not an
870 exact match. This way, we get the case pattern
871 of the actual match. */
872 if ((matchsize == XSTRING (eltstring)->size
873 && matchsize < XSTRING (bestmatch)->size)
875 /* If there is more than one exact match ignoring case,
876 and one of them is exact including case,
877 prefer that one. */
878 /* If there is no exact match ignoring case,
879 prefer a match that does not change the case
880 of the input. */
881 ((matchsize == XSTRING (eltstring)->size)
883 (matchsize == XSTRING (bestmatch)->size)
884 && !bcmp (XSTRING (eltstring)->data,
885 XSTRING (string)->data, XSTRING (string)->size)
886 && bcmp (XSTRING (bestmatch)->data,
887 XSTRING (string)->data, XSTRING (string)->size)))
888 bestmatch = eltstring;
890 bestmatchsize = matchsize;
895 if (NILP (bestmatch))
896 return Qnil; /* No completions found */
897 /* If we are ignoring case, and there is no exact match,
898 and no additional text was supplied,
899 don't change the case of what the user typed. */
900 if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
901 && XSTRING (bestmatch)->size > bestmatchsize)
902 return string;
904 /* Return t if the supplied string is an exact match (counting case);
905 it does not require any change to be made. */
906 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
907 && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data,
908 bestmatchsize))
909 return Qt;
911 XSETFASTINT (zero, 0); /* Else extract the part in which */
912 XSETFASTINT (end, bestmatchsize); /* all completions agree */
913 return Fsubstring (bestmatch, zero, end);
916 /* Compare exactly LEN chars of strings at S1 and S2,
917 ignoring case if appropriate.
918 Return -1 if strings match,
919 else number of chars that match at the beginning. */
922 scmp (s1, s2, len)
923 register unsigned char *s1, *s2;
924 int len;
926 register int l = len;
927 register unsigned char *start = s1;
929 if (completion_ignore_case)
931 while (l && EQ (DOWNCASE (*s1++), DOWNCASE (*s2++)))
932 l--;
934 else
936 while (l && *s1++ == *s2++)
937 l--;
939 if (l == 0)
940 return -1;
941 else
943 int match = len - l;
945 /* Now *--S1 is the unmatching byte. If it is in the middle of
946 multi-byte form, we must say that the multi-byte character
947 there doesn't match. */
948 while (match && *--s1 >= 0xA0) match--;
949 return match;
953 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
954 "Search for partial matches to STRING in ALIST.\n\
955 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
956 The value is a list of all the strings from ALIST that match.\n\
958 ALIST can be an obarray instead of an alist.\n\
959 Then the print names of all symbols in the obarray are the possible matches.\n\
961 ALIST can also be a function to do the completion itself.\n\
962 It receives three arguments: the values STRING, PREDICATE and t.\n\
963 Whatever it returns becomes the value of `all-completion'.\n\
965 If optional third argument PREDICATE is non-nil,\n\
966 it is used to test each possible match.\n\
967 The match is a candidate only if PREDICATE returns non-nil.\n\
968 The argument given to PREDICATE is the alist element\n\
969 or the symbol from the obarray.\n\
971 If the optional fourth argument HIDE-SPACES is non-nil,\n\
972 strings in ALIST that start with a space\n\
973 are ignored unless STRING itself starts with a space.")
974 (string, alist, predicate, hide_spaces)
975 Lisp_Object string, alist, predicate, hide_spaces;
977 Lisp_Object tail, elt, eltstring;
978 Lisp_Object allmatches;
979 int list = CONSP (alist) || NILP (alist);
980 int index, obsize;
981 Lisp_Object bucket, tem;
982 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
984 CHECK_STRING (string, 0);
985 if (!list && !VECTORP (alist))
987 return call3 (alist, string, predicate, Qt);
989 allmatches = Qnil;
991 /* If ALIST is not a list, set TAIL just for gc pro. */
992 tail = alist;
993 if (! list)
995 index = 0;
996 obsize = XVECTOR (alist)->size;
997 bucket = XVECTOR (alist)->contents[index];
1000 while (1)
1002 /* Get the next element of the alist or obarray. */
1003 /* Exit the loop if the elements are all used up. */
1004 /* elt gets the alist element or symbol.
1005 eltstring gets the name to check as a completion. */
1007 if (list)
1009 if (NILP (tail))
1010 break;
1011 elt = Fcar (tail);
1012 eltstring = Fcar (elt);
1013 tail = Fcdr (tail);
1015 else
1017 if (XFASTINT (bucket) != 0)
1019 elt = bucket;
1020 eltstring = Fsymbol_name (elt);
1021 if (XSYMBOL (bucket)->next)
1022 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1023 else
1024 XSETFASTINT (bucket, 0);
1026 else if (++index >= obsize)
1027 break;
1028 else
1030 bucket = XVECTOR (alist)->contents[index];
1031 continue;
1035 /* Is this element a possible completion? */
1037 if (STRINGP (eltstring)
1038 && XSTRING (string)->size <= XSTRING (eltstring)->size
1039 /* If HIDE_SPACES, reject alternatives that start with space
1040 unless the input starts with space. */
1041 && ((XSTRING (string)->size > 0 && XSTRING (string)->data[0] == ' ')
1042 || XSTRING (eltstring)->data[0] != ' '
1043 || NILP (hide_spaces))
1044 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
1045 XSTRING (string)->size))
1047 /* Yes. */
1048 Lisp_Object regexps;
1049 Lisp_Object zero;
1050 XSETFASTINT (zero, 0);
1052 /* Ignore this element if it fails to match all the regexps. */
1053 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1054 regexps = XCONS (regexps)->cdr)
1056 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
1057 if (NILP (tem))
1058 break;
1060 if (CONSP (regexps))
1061 continue;
1063 /* Ignore this element if there is a predicate
1064 and the predicate doesn't like it. */
1066 if (!NILP (predicate))
1068 if (EQ (predicate, Qcommandp))
1069 tem = Fcommandp (elt);
1070 else
1072 GCPRO4 (tail, eltstring, allmatches, string);
1073 tem = call1 (predicate, elt);
1074 UNGCPRO;
1076 if (NILP (tem)) continue;
1078 /* Ok => put it on the list. */
1079 allmatches = Fcons (eltstring, allmatches);
1083 return Fnreverse (allmatches);
1086 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
1087 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
1088 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
1090 /* This comment supplies the doc string for completing-read,
1091 for make-docfile to see. We cannot put this in the real DEFUN
1092 due to limits in the Unix cpp.
1094 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
1095 "Read a string in the minibuffer, with completion.\n\
1096 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
1097 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
1098 PREDICATE limits completion to a subset of TABLE.\n\
1099 See `try-completion' and `all-completions' for more details
1100 on completion, TABLE, and PREDICATE.\n\
1102 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
1103 the input is (or completes to) an element of TABLE or is null.\n\
1104 If it is also not t, Return does not exit if it does non-null completion.\n\
1105 If the input is null, `completing-read' returns an empty string,\n\
1106 regardless of the value of REQUIRE-MATCH.\n\
1108 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
1109 If it is (STRING . POSITION), the initial input\n\
1110 is STRING, but point is placed POSITION characters into the string.\n\
1111 HIST, if non-nil, specifies a history list\n\
1112 and optionally the initial position in the list.\n\
1113 It can be a symbol, which is the history list variable to use,\n\
1114 or it can be a cons cell (HISTVAR . HISTPOS).\n\
1115 In that case, HISTVAR is the history list variable to use,\n\
1116 and HISTPOS is the initial position (the position in the list\n\
1117 which INITIAL-CONTENTS corresponds to).\n\
1118 Positions are counted starting from 1 at the beginning of the list.\n\
1119 Completion ignores case if the ambient value of\n\
1120 `completion-ignore-case' is non-nil."
1122 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
1123 0 /* See immediately above */)
1124 (prompt, table, predicate, require_match, init, hist)
1125 Lisp_Object prompt, table, predicate, require_match, init, hist;
1127 Lisp_Object val, histvar, histpos, position;
1128 int pos = 0;
1129 int count = specpdl_ptr - specpdl;
1130 specbind (Qminibuffer_completion_table, table);
1131 specbind (Qminibuffer_completion_predicate, predicate);
1132 specbind (Qminibuffer_completion_confirm,
1133 EQ (require_match, Qt) ? Qnil : Qt);
1134 last_exact_completion = Qnil;
1136 position = Qnil;
1137 if (!NILP (init))
1139 if (CONSP (init))
1141 position = Fcdr (init);
1142 init = Fcar (init);
1144 CHECK_STRING (init, 0);
1145 if (!NILP (position))
1147 CHECK_NUMBER (position, 0);
1148 /* Convert to distance from end of input. */
1149 pos = XINT (position) - XSTRING (init)->size;
1153 if (SYMBOLP (hist))
1155 histvar = hist;
1156 histpos = Qnil;
1158 else
1160 histvar = Fcar_safe (hist);
1161 histpos = Fcdr_safe (hist);
1163 if (NILP (histvar))
1164 histvar = Qminibuffer_history;
1165 if (NILP (histpos))
1166 XSETFASTINT (histpos, 0);
1168 val = read_minibuf (NILP (require_match)
1169 ? Vminibuffer_local_completion_map
1170 : Vminibuffer_local_must_match_map,
1171 init, prompt, make_number (pos), 0,
1172 histvar, histpos);
1173 return unbind_to (count, val);
1176 Lisp_Object Fminibuffer_completion_help ();
1177 Lisp_Object assoc_for_completion ();
1178 /* A subroutine of Fintern_soft. */
1179 extern Lisp_Object oblookup ();
1182 /* Test whether TXT is an exact completion. */
1183 Lisp_Object
1184 test_completion (txt)
1185 Lisp_Object txt;
1187 Lisp_Object tem;
1189 if (CONSP (Vminibuffer_completion_table)
1190 || NILP (Vminibuffer_completion_table))
1191 return assoc_for_completion (txt, Vminibuffer_completion_table);
1192 else if (VECTORP (Vminibuffer_completion_table))
1194 /* Bypass intern-soft as that loses for nil */
1195 tem = oblookup (Vminibuffer_completion_table,
1196 XSTRING (txt)->data, XSTRING (txt)->size);
1197 if (!SYMBOLP (tem))
1198 return Qnil;
1199 else if (!NILP (Vminibuffer_completion_predicate))
1200 return call1 (Vminibuffer_completion_predicate, tem);
1201 else
1202 return Qt;
1204 else
1205 return call3 (Vminibuffer_completion_table, txt,
1206 Vminibuffer_completion_predicate, Qlambda);
1209 /* returns:
1210 * 0 no possible completion
1211 * 1 was already an exact and unique completion
1212 * 3 was already an exact completion
1213 * 4 completed to an exact completion
1214 * 5 some completion happened
1215 * 6 no completion happened
1218 do_completion ()
1220 Lisp_Object completion, tem;
1221 int completedp;
1222 Lisp_Object last;
1223 struct gcpro gcpro1, gcpro2;
1225 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
1226 Vminibuffer_completion_predicate);
1227 last = last_exact_completion;
1228 last_exact_completion = Qnil;
1230 GCPRO2 (completion, last);
1232 if (NILP (completion))
1234 bitch_at_user ();
1235 temp_echo_area_glyphs (" [No match]");
1236 UNGCPRO;
1237 return 0;
1240 if (EQ (completion, Qt)) /* exact and unique match */
1242 UNGCPRO;
1243 return 1;
1246 /* compiler bug */
1247 tem = Fstring_equal (completion, Fbuffer_string());
1248 if (completedp = NILP (tem))
1250 Ferase_buffer (); /* Some completion happened */
1251 Finsert (1, &completion);
1254 /* It did find a match. Do we match some possibility exactly now? */
1255 tem = test_completion (Fbuffer_string ());
1256 if (NILP (tem))
1258 /* not an exact match */
1259 UNGCPRO;
1260 if (completedp)
1261 return 5;
1262 else if (auto_help)
1263 Fminibuffer_completion_help ();
1264 else
1265 temp_echo_area_glyphs (" [Next char not unique]");
1266 return 6;
1268 else if (completedp)
1270 UNGCPRO;
1271 return 4;
1273 /* If the last exact completion and this one were the same,
1274 it means we've already given a "Complete but not unique"
1275 message and the user's hit TAB again, so now we give him help. */
1276 last_exact_completion = completion;
1277 if (!NILP (last))
1279 tem = Fbuffer_string ();
1280 if (!NILP (Fequal (tem, last)))
1281 Fminibuffer_completion_help ();
1283 UNGCPRO;
1284 return 3;
1287 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1289 Lisp_Object
1290 assoc_for_completion (key, list)
1291 register Lisp_Object key;
1292 Lisp_Object list;
1294 register Lisp_Object tail;
1296 if (completion_ignore_case)
1297 key = Fupcase (key);
1299 for (tail = list; !NILP (tail); tail = Fcdr (tail))
1301 register Lisp_Object elt, tem, thiscar;
1302 elt = Fcar (tail);
1303 if (!CONSP (elt)) continue;
1304 thiscar = Fcar (elt);
1305 if (!STRINGP (thiscar))
1306 continue;
1307 if (completion_ignore_case)
1308 thiscar = Fupcase (thiscar);
1309 tem = Fequal (thiscar, key);
1310 if (!NILP (tem)) return elt;
1311 QUIT;
1313 return Qnil;
1316 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
1317 "Complete the minibuffer contents as far as possible.\n\
1318 Return nil if there is no valid completion, else t.\n\
1319 If no characters can be completed, display a list of possible completions.\n\
1320 If you repeat this command after it displayed such a list,\n\
1321 scroll the window of possible completions.")
1324 register int i;
1325 Lisp_Object window, tem;
1327 /* If the previous command was not this, then mark the completion
1328 buffer obsolete. */
1329 if (! EQ (current_kboard->Vlast_command, this_command))
1330 Vminibuf_scroll_window = Qnil;
1332 window = Vminibuf_scroll_window;
1333 /* If there's a fresh completion window with a live buffer,
1334 and this command is repeated, scroll that window. */
1335 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
1336 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
1338 struct buffer *obuf = current_buffer;
1340 Fset_buffer (XWINDOW (window)->buffer);
1341 tem = Fpos_visible_in_window_p (make_number (ZV), window);
1342 if (! NILP (tem))
1343 /* If end is in view, scroll up to the beginning. */
1344 Fset_window_start (window, BEGV, Qnil);
1345 else
1346 /* Else scroll down one screen. */
1347 Fscroll_other_window (Qnil);
1349 set_buffer_internal (obuf);
1350 return Qnil;
1353 i = do_completion ();
1354 switch (i)
1356 case 0:
1357 return Qnil;
1359 case 1:
1360 temp_echo_area_glyphs (" [Sole completion]");
1361 break;
1363 case 3:
1364 temp_echo_area_glyphs (" [Complete, but not unique]");
1365 break;
1368 return Qt;
1371 /* Subroutines of Fminibuffer_complete_and_exit. */
1373 /* This one is called by internal_condition_case to do the real work. */
1375 Lisp_Object
1376 complete_and_exit_1 ()
1378 return make_number (do_completion ());
1381 /* This one is called by internal_condition_case if an error happens.
1382 Pretend the current value is an exact match. */
1384 Lisp_Object
1385 complete_and_exit_2 (ignore)
1386 Lisp_Object ignore;
1388 return make_number (1);
1391 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
1392 Sminibuffer_complete_and_exit, 0, 0, "",
1393 "If the minibuffer contents is a valid completion then exit.\n\
1394 Otherwise try to complete it. If completion leads to a valid completion,\n\
1395 a repetition of this command will exit.")
1398 register int i;
1399 Lisp_Object val;
1401 /* Allow user to specify null string */
1402 if (BEGV == ZV)
1403 goto exit;
1405 if (!NILP (test_completion (Fbuffer_string ())))
1406 goto exit;
1408 /* Call do_completion, but ignore errors. */
1409 val = internal_condition_case (complete_and_exit_1, Qerror,
1410 complete_and_exit_2);
1412 i = XFASTINT (val);
1413 switch (i)
1415 case 1:
1416 case 3:
1417 goto exit;
1419 case 4:
1420 if (!NILP (Vminibuffer_completion_confirm))
1422 temp_echo_area_glyphs (" [Confirm]");
1423 return Qnil;
1425 else
1426 goto exit;
1428 default:
1429 return Qnil;
1431 exit:
1432 Fthrow (Qexit, Qnil);
1433 /* NOTREACHED */
1436 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
1437 0, 0, "",
1438 "Complete the minibuffer contents at most a single word.\n\
1439 After one word is completed as much as possible, a space or hyphen\n\
1440 is added, provided that matches some possible completion.\n\
1441 Return nil if there is no valid completion, else t.")
1444 Lisp_Object completion, tem;
1445 register int i;
1446 register unsigned char *completion_string;
1447 struct gcpro gcpro1, gcpro2;
1449 /* We keep calling Fbuffer_string rather than arrange for GC to
1450 hold onto a pointer to one of the strings thus made. */
1452 completion = Ftry_completion (Fbuffer_string (),
1453 Vminibuffer_completion_table,
1454 Vminibuffer_completion_predicate);
1455 if (NILP (completion))
1457 bitch_at_user ();
1458 temp_echo_area_glyphs (" [No match]");
1459 return Qnil;
1461 if (EQ (completion, Qt))
1462 return Qnil;
1464 #if 0 /* How the below code used to look, for reference. */
1465 tem = Fbuffer_string ();
1466 b = XSTRING (tem)->data;
1467 i = ZV - 1 - XSTRING (completion)->size;
1468 p = XSTRING (completion)->data;
1469 if (i > 0 ||
1470 0 <= scmp (b, p, ZV - 1))
1472 i = 1;
1473 /* Set buffer to longest match of buffer tail and completion head. */
1474 while (0 <= scmp (b + i, p, ZV - 1 - i))
1475 i++;
1476 del_range (1, i + 1);
1477 SET_PT (ZV);
1479 #else /* Rewritten code */
1481 register unsigned char *buffer_string;
1482 int buffer_length, completion_length;
1484 CHECK_STRING (completion, 0);
1485 tem = Fbuffer_string ();
1486 GCPRO2 (completion, tem);
1487 /* If reading a file name,
1488 expand any $ENVVAR refs in the buffer and in TEM. */
1489 if (EQ (Vminibuffer_completion_table, Qread_file_name_internal))
1491 Lisp_Object substituted;
1492 substituted = Fsubstitute_in_file_name (tem);
1493 if (! EQ (substituted, tem))
1495 tem = substituted;
1496 Ferase_buffer ();
1497 insert_from_string (tem, 0, XSTRING (tem)->size, 0);
1500 buffer_string = XSTRING (tem)->data;
1501 completion_string = XSTRING (completion)->data;
1502 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
1503 completion_length = XSTRING (completion)->size;
1504 i = buffer_length - completion_length;
1505 /* Mly: I don't understand what this is supposed to do AT ALL */
1506 if (i > 0 ||
1507 0 <= scmp (buffer_string, completion_string, buffer_length))
1509 /* Set buffer to longest match of buffer tail and completion head. */
1510 if (i <= 0) i = 1;
1511 buffer_string += i;
1512 buffer_length -= i;
1513 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
1514 i++;
1515 del_range (1, i + 1);
1516 SET_PT (ZV);
1518 UNGCPRO;
1520 #endif /* Rewritten code */
1521 i = ZV - BEGV;
1523 /* If completion finds next char not unique,
1524 consider adding a space or a hyphen. */
1525 if (i == XSTRING (completion)->size)
1527 GCPRO1 (completion);
1528 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1529 Vminibuffer_completion_table,
1530 Vminibuffer_completion_predicate);
1531 UNGCPRO;
1533 if (STRINGP (tem))
1534 completion = tem;
1535 else
1537 GCPRO1 (completion);
1538 tem =
1539 Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1540 Vminibuffer_completion_table,
1541 Vminibuffer_completion_predicate);
1542 UNGCPRO;
1544 if (STRINGP (tem))
1545 completion = tem;
1549 /* Now find first word-break in the stuff found by completion.
1550 i gets index in string of where to stop completing. */
1552 int len, c;
1554 completion_string = XSTRING (completion)->data;
1555 for (; i < XSTRING (completion)->size; i += len)
1557 c = STRING_CHAR_AND_LENGTH (completion_string + i,
1558 XSTRING (completion)->size - i,
1559 len);
1560 if (SYNTAX (c) != Sword)
1562 i += len;
1563 break;
1568 /* If got no characters, print help for user. */
1570 if (i == ZV - BEGV)
1572 if (auto_help)
1573 Fminibuffer_completion_help ();
1574 return Qnil;
1577 /* Otherwise insert in minibuffer the chars we got */
1579 Ferase_buffer ();
1580 insert_from_string (completion, 0, i, 1);
1581 return Qt;
1584 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
1585 1, 1, 0,
1586 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
1587 Each element may be just a symbol or string\n\
1588 or may be a list of two strings to be printed as if concatenated.\n\
1589 `standard-output' must be a buffer.\n\
1590 At the end, run the normal hook `completion-setup-hook'.\n\
1591 It can find the completion buffer in `standard-output'.")
1592 (completions)
1593 Lisp_Object completions;
1595 Lisp_Object tail, elt;
1596 register int i;
1597 int column = 0;
1598 struct gcpro gcpro1, gcpro2;
1599 struct buffer *old = current_buffer;
1600 int first = 1;
1602 /* Note that (when it matters) every variable
1603 points to a non-string that is pointed to by COMPLETIONS,
1604 except for ELT. ELT can be pointing to a string
1605 when terpri or Findent_to calls a change hook. */
1606 elt = Qnil;
1607 GCPRO2 (completions, elt);
1609 if (BUFFERP (Vstandard_output))
1610 set_buffer_internal (XBUFFER (Vstandard_output));
1612 if (NILP (completions))
1613 write_string ("There are no possible completions of what you have typed.",
1614 -1);
1615 else
1617 write_string ("Possible completions are:", -1);
1618 for (tail = completions, i = 0; !NILP (tail); tail = Fcdr (tail), i++)
1620 Lisp_Object tem;
1621 int length;
1622 Lisp_Object startpos, endpos;
1624 elt = Fcar (tail);
1625 /* Compute the length of this element. */
1626 if (CONSP (elt))
1628 tem = XCAR (elt);
1629 CHECK_STRING (tem, 0);
1630 length = XSTRING (tem)->size;
1632 tem = Fcar (XCDR (elt));
1633 CHECK_STRING (tem, 0);
1634 length += XSTRING (tem)->size;
1636 else
1638 CHECK_STRING (elt, 0);
1639 length = XSTRING (elt)->size;
1642 /* This does a bad job for narrower than usual windows.
1643 Sadly, the window it will appear in is not known
1644 until after the text has been made. */
1646 if (BUFFERP (Vstandard_output))
1647 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
1649 /* If the previous completion was very wide,
1650 or we have two on this line already,
1651 don't put another on the same line. */
1652 if (column > 33 || first
1653 /* If this is really wide, don't put it second on a line. */
1654 || column > 0 && length > 45)
1656 Fterpri (Qnil);
1657 column = 0;
1659 /* Otherwise advance to column 35. */
1660 else
1662 if (BUFFERP (Vstandard_output))
1664 tem = Findent_to (make_number (35), make_number (2));
1666 column = XINT (tem);
1668 else
1672 write_string (" ", -1);
1673 column++;
1675 while (column < 35);
1679 if (BUFFERP (Vstandard_output))
1681 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
1682 Fset_text_properties (startpos, endpos,
1683 Qnil, Vstandard_output);
1686 /* Output this element and update COLUMN. */
1687 if (CONSP (elt))
1689 Fprinc (Fcar (elt), Qnil);
1690 Fprinc (Fcar (Fcdr (elt)), Qnil);
1692 else
1693 Fprinc (elt, Qnil);
1695 column += length;
1697 /* If output is to a buffer, recompute COLUMN in a way
1698 that takes account of character widths. */
1699 if (BUFFERP (Vstandard_output))
1701 tem = Fcurrent_column ();
1702 column = XINT (tem);
1705 first = 0;
1709 UNGCPRO;
1711 if (BUFFERP (Vstandard_output))
1712 set_buffer_internal (old);
1714 if (!NILP (Vrun_hooks))
1715 call1 (Vrun_hooks, intern ("completion-setup-hook"));
1717 return Qnil;
1720 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
1721 0, 0, "",
1722 "Display a list of possible completions of the current minibuffer contents.")
1725 Lisp_Object completions;
1727 message ("Making completion list...");
1728 completions = Fall_completions (Fbuffer_string (),
1729 Vminibuffer_completion_table,
1730 Vminibuffer_completion_predicate,
1731 Qt);
1732 echo_area_glyphs = 0;
1734 if (NILP (completions))
1736 bitch_at_user ();
1737 temp_echo_area_glyphs (" [No completions]");
1739 else
1740 internal_with_output_to_temp_buffer ("*Completions*",
1741 Fdisplay_completion_list,
1742 Fsort (completions, Qstring_lessp));
1743 return Qnil;
1746 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
1747 "Terminate minibuffer input.")
1750 if (INTEGERP (last_command_char))
1751 internal_self_insert (last_command_char, 0);
1752 else
1753 bitch_at_user ();
1755 Fthrow (Qexit, Qnil);
1758 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
1759 "Terminate this minibuffer argument.")
1762 Fthrow (Qexit, Qnil);
1765 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1766 "Return current depth of activations of minibuffer, a nonnegative integer.")
1769 return make_number (minibuf_level);
1772 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
1773 "Return the prompt string of the currently-active minibuffer.\n\
1774 If no minibuffer is active, return nil.")
1777 return Fcopy_sequence (minibuf_prompt);
1780 DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width,
1781 Sminibuffer_prompt_width, 0, 0, 0,
1782 "Return the display width of the minibuffer prompt.")
1785 Lisp_Object width;
1786 XSETFASTINT (width, minibuf_prompt_width);
1787 return width;
1790 /* Temporarily display the string M at the end of the current
1791 minibuffer contents. This is used to display things like
1792 "[No Match]" when the user requests a completion for a prefix
1793 that has no possible completions, and other quick, unobtrusive
1794 messages. */
1796 temp_echo_area_glyphs (m)
1797 char *m;
1799 int osize = ZV;
1800 int opoint = PT;
1801 Lisp_Object oinhibit;
1802 oinhibit = Vinhibit_quit;
1804 /* Clear out any old echo-area message to make way for our new thing. */
1805 message (0);
1807 SET_PT (osize);
1808 insert_string (m);
1809 SET_PT (opoint);
1810 Vinhibit_quit = Qt;
1811 Fsit_for (make_number (2), Qnil, Qnil);
1812 del_range (osize, ZV);
1813 SET_PT (opoint);
1814 if (!NILP (Vquit_flag))
1816 Vquit_flag = Qnil;
1817 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1819 Vinhibit_quit = oinhibit;
1822 DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message,
1823 1, 1, 0,
1824 "Temporarily display STRING at the end of the minibuffer.\n\
1825 The text is displayed for two seconds,\n\
1826 or until the next input event arrives, whichever comes first.")
1827 (string)
1828 Lisp_Object string;
1830 temp_echo_area_glyphs (XSTRING (string)->data);
1831 return Qnil;
1834 init_minibuf_once ()
1836 Vminibuffer_list = Qnil;
1837 staticpro (&Vminibuffer_list);
1840 syms_of_minibuf ()
1842 minibuf_level = 0;
1843 minibuf_prompt = Qnil;
1844 staticpro (&minibuf_prompt);
1846 minibuf_save_list = Qnil;
1847 staticpro (&minibuf_save_list);
1849 Qread_file_name_internal = intern ("read-file-name-internal");
1850 staticpro (&Qread_file_name_internal);
1852 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
1853 staticpro (&Qminibuffer_completion_table);
1855 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
1856 staticpro (&Qminibuffer_completion_confirm);
1858 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
1859 staticpro (&Qminibuffer_completion_predicate);
1861 staticpro (&last_exact_completion);
1862 last_exact_completion = Qnil;
1864 staticpro (&last_minibuf_string);
1865 last_minibuf_string = Qnil;
1867 Quser_variable_p = intern ("user-variable-p");
1868 staticpro (&Quser_variable_p);
1870 Qminibuffer_history = intern ("minibuffer-history");
1871 staticpro (&Qminibuffer_history);
1873 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
1874 staticpro (&Qminibuffer_setup_hook);
1876 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
1877 staticpro (&Qminibuffer_exit_hook);
1879 Qhistory_length = intern ("history-length");
1880 staticpro (&Qhistory_length);
1882 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
1883 "Normal hook run just after entry to minibuffer.");
1884 Vminibuffer_setup_hook = Qnil;
1886 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
1887 "Normal hook run just after exit from minibuffer.");
1888 Vminibuffer_exit_hook = Qnil;
1890 DEFVAR_LISP ("history-length", &Vhistory_length,
1891 "*Maximum length for history lists before truncation takes place.\n\
1892 A number means that length; t means infinite. Truncation takes place\n\
1893 just after a new element is inserted. Setting the history-length\n\
1894 property of a history variable overrides this default.");
1895 XSETFASTINT (Vhistory_length, 30);
1897 DEFVAR_BOOL ("completion-auto-help", &auto_help,
1898 "*Non-nil means automatically provide help for invalid completion input.");
1899 auto_help = 1;
1901 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
1902 "Non-nil means don't consider case significant in completion.");
1903 completion_ignore_case = 0;
1905 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
1906 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1907 More precisely, this variable makes a difference when the minibuffer window\n\
1908 is the selected window. If you are in some other window, minibuffer commands\n\
1909 are allowed even if a minibuffer is active.");
1910 enable_recursive_minibuffers = 0;
1912 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
1913 "Alist or obarray used for completion in the minibuffer.\n\
1914 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1916 The value may alternatively be a function, which is given three arguments:\n\
1917 STRING, the current buffer contents;\n\
1918 PREDICATE, the predicate for filtering possible matches;\n\
1919 CODE, which says what kind of things to do.\n\
1920 CODE can be nil, t or `lambda'.\n\
1921 nil means to return the best completion of STRING, or nil if there is none.\n\
1922 t means to return a list of all possible completions of STRING.\n\
1923 `lambda' means to return t if STRING is a valid completion as it stands.");
1924 Vminibuffer_completion_table = Qnil;
1926 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
1927 "Within call to `completing-read', this holds the PREDICATE argument.");
1928 Vminibuffer_completion_predicate = Qnil;
1930 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
1931 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1932 Vminibuffer_completion_confirm = Qnil;
1934 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
1935 "Value that `help-form' takes on inside the minibuffer.");
1936 Vminibuffer_help_form = Qnil;
1938 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
1939 "History list symbol to add minibuffer values to.\n\
1940 Each string of minibuffer input, as it appears on exit from the minibuffer,\n\
1941 is added with\n\
1942 (set minibuffer-history-variable\n\
1943 (cons STRING (symbol-value minibuffer-history-variable)))");
1944 XSETFASTINT (Vminibuffer_history_variable, 0);
1946 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
1947 "Current position of redoing in the history list.");
1948 Vminibuffer_history_position = Qnil;
1950 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
1951 "*Non-nil means entering the minibuffer raises the minibuffer's frame.\n\
1952 Some uses of the echo area also raise that frame (since they use it too).");
1953 minibuffer_auto_raise = 0;
1955 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
1956 "List of regexps that should restrict possible completions.");
1957 Vcompletion_regexp_list = Qnil;
1959 defsubr (&Sset_minibuffer_window);
1960 defsubr (&Sread_from_minibuffer);
1961 defsubr (&Seval_minibuffer);
1962 defsubr (&Sread_minibuffer);
1963 defsubr (&Sread_string);
1964 defsubr (&Sread_command);
1965 defsubr (&Sread_variable);
1966 defsubr (&Sread_buffer);
1967 defsubr (&Sread_no_blanks_input);
1968 defsubr (&Sminibuffer_depth);
1969 defsubr (&Sminibuffer_prompt);
1970 defsubr (&Sminibuffer_prompt_width);
1972 defsubr (&Stry_completion);
1973 defsubr (&Sall_completions);
1974 defsubr (&Scompleting_read);
1975 defsubr (&Sminibuffer_complete);
1976 defsubr (&Sminibuffer_complete_word);
1977 defsubr (&Sminibuffer_complete_and_exit);
1978 defsubr (&Sdisplay_completion_list);
1979 defsubr (&Sminibuffer_completion_help);
1981 defsubr (&Sself_insert_and_exit);
1982 defsubr (&Sexit_minibuffer);
1984 defsubr (&Sminibuffer_message);
1987 keys_of_minibuf ()
1989 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
1990 "abort-recursive-edit");
1991 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
1992 "exit-minibuffer");
1993 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
1994 "exit-minibuffer");
1996 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
1997 "abort-recursive-edit");
1998 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
1999 "exit-minibuffer");
2000 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
2001 "exit-minibuffer");
2003 initial_define_key (Vminibuffer_local_ns_map, ' ',
2004 "exit-minibuffer");
2005 initial_define_key (Vminibuffer_local_ns_map, '\t',
2006 "exit-minibuffer");
2007 initial_define_key (Vminibuffer_local_ns_map, '?',
2008 "self-insert-and-exit");
2010 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
2011 "abort-recursive-edit");
2012 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
2013 "exit-minibuffer");
2014 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
2015 "exit-minibuffer");
2017 initial_define_key (Vminibuffer_local_completion_map, '\t',
2018 "minibuffer-complete");
2019 initial_define_key (Vminibuffer_local_completion_map, ' ',
2020 "minibuffer-complete-word");
2021 initial_define_key (Vminibuffer_local_completion_map, '?',
2022 "minibuffer-completion-help");
2024 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
2025 "abort-recursive-edit");
2026 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
2027 "minibuffer-complete-and-exit");
2028 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
2029 "minibuffer-complete-and-exit");
2030 initial_define_key (Vminibuffer_local_must_match_map, '\t',
2031 "minibuffer-complete");
2032 initial_define_key (Vminibuffer_local_must_match_map, ' ',
2033 "minibuffer-complete-word");
2034 initial_define_key (Vminibuffer_local_must_match_map, '?',
2035 "minibuffer-completion-help");