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