(cal-tex-cursor-filofax-week): Renamed from cal-tex-cursor-week6.
[emacs.git] / src / minibuf.c
blobfc8e2ef506115eb7ceaaf71d23f80b1f6177e3b7
1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 #include <config.h>
22 #include "lisp.h"
23 #include "commands.h"
24 #include "buffer.h"
25 #include "dispextern.h"
26 #include "frame.h"
27 #include "window.h"
28 #include "syntax.h"
29 #include "keyboard.h"
31 #define min(a, b) ((a) < (b) ? (a) : (b))
33 extern int quit_char;
35 /* List of buffers for use as minibuffers.
36 The first element of the list is used for the outermost minibuffer
37 invocation, the next element is used for a recursive minibuffer
38 invocation, etc. The list is extended at the end as deeper
39 minibuffer recursions are encountered. */
40 Lisp_Object Vminibuffer_list;
42 /* Data to remember during recursive minibuffer invocations */
43 Lisp_Object minibuf_save_list;
45 /* Depth in minibuffer invocations. */
46 int minibuf_level;
48 /* Nonzero means display completion help for invalid input */
49 int auto_help;
51 /* Fread_minibuffer leaves the input here as a string. */
52 Lisp_Object last_minibuf_string;
54 /* Nonzero means let functions called when within a minibuffer
55 invoke recursive minibuffers (to read arguments, or whatever) */
56 int enable_recursive_minibuffers;
58 /* help-form is bound to this while in the minibuffer. */
60 Lisp_Object Vminibuffer_help_form;
62 /* Variable which is the history list to add minibuffer values to. */
64 Lisp_Object Vminibuffer_history_variable;
66 /* Current position in the history list (adjusted by M-n and M-p). */
68 Lisp_Object Vminibuffer_history_position;
70 Lisp_Object Qminibuffer_history;
72 Lisp_Object Qread_file_name_internal;
74 /* Normal hooks for entry to and exit from minibuffer. */
76 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
77 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
79 /* Nonzero means completion ignores case. */
81 int completion_ignore_case;
83 /* List of regexps that should restrict possible completions. */
85 Lisp_Object Vcompletion_regexp_list;
87 /* Nonzero means raise the minibuffer frame when the minibuffer
88 is entered. */
90 int minibuffer_auto_raise;
92 /* If last completion attempt reported "Complete but not unique"
93 then this is the string completed then; otherwise this is nil. */
95 static Lisp_Object last_exact_completion;
97 Lisp_Object Quser_variable_p;
99 /* Non-nil means it is the window for C-M-v to scroll
100 when the minibuffer is selected. */
101 extern Lisp_Object Vminibuf_scroll_window;
103 extern Lisp_Object Voverriding_local_map;
105 /* Put minibuf on currently selected frame's minibuffer.
106 We do this whenever the user starts a new minibuffer
107 or when a minibuffer exits. */
109 void
110 choose_minibuf_frame ()
112 if (selected_frame != 0
113 && !EQ (minibuf_window, selected_frame->minibuffer_window))
115 /* I don't think that any frames may validly have a null minibuffer
116 window anymore. */
117 if (NILP (selected_frame->minibuffer_window))
118 abort ();
120 Fset_window_buffer (selected_frame->minibuffer_window,
121 XWINDOW (minibuf_window)->buffer);
122 minibuf_window = selected_frame->minibuffer_window;
126 /* Actual minibuffer invocation. */
128 void read_minibuf_unwind ();
129 Lisp_Object get_minibuffer ();
130 Lisp_Object read_minibuf ();
132 /* Read from the minibuffer using keymap MAP, initial contents INITIAL
133 (a string), putting point minus BACKUP_N chars from the end of INITIAL,
134 prompting with PROMPT (a string), using history list HISTVAR
135 with initial position HISTPOS. (BACKUP_N should be <= 0.)
137 Normally return the result as a string (the text that was read),
138 but if EXPFLAG is nonzero, read it and return the object read.
139 If HISTVAR is given, save the value read on that history only if it doesn't
140 match the front of that history list exactly. The value is pushed onto
141 the list as the string that was read. */
143 Lisp_Object
144 read_minibuf (map, initial, prompt, backup_n, expflag, histvar, histpos)
145 Lisp_Object map;
146 Lisp_Object initial;
147 Lisp_Object prompt;
148 Lisp_Object backup_n;
149 int expflag;
150 Lisp_Object histvar;
151 Lisp_Object histpos;
153 Lisp_Object val;
154 int count = specpdl_ptr - specpdl;
155 Lisp_Object mini_frame;
156 struct gcpro gcpro1, gcpro2, gcpro3;
158 single_kboard_state ();
160 val = Qnil;
161 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
162 store them away before we can GC. Don't need to protect
163 BACKUP_N because we use the value only if it is an integer. */
164 GCPRO3 (map, initial, val);
166 if (!STRINGP (prompt))
167 prompt = build_string ("");
169 if (!enable_recursive_minibuffers
170 && minibuf_level > 0
171 && (EQ (selected_window, minibuf_window)))
172 error ("Command attempted to use minibuffer while in minibuffer");
174 /* Could we simply bind these variables instead? */
175 minibuf_save_list
176 = Fcons (Voverriding_local_map,
177 Fcons (minibuf_window, minibuf_save_list));
178 minibuf_save_list
179 = Fcons (minibuf_prompt,
180 Fcons (make_number (minibuf_prompt_width),
181 Fcons (Vhelp_form,
182 Fcons (Vcurrent_prefix_arg,
183 Fcons (Vminibuffer_history_position,
184 Fcons (Vminibuffer_history_variable,
185 minibuf_save_list))))));
187 minibuf_prompt_width = 0; /* xdisp.c puts in the right value. */
188 minibuf_prompt = Fcopy_sequence (prompt);
189 Vminibuffer_history_position = histpos;
190 Vminibuffer_history_variable = histvar;
192 choose_minibuf_frame ();
194 record_unwind_protect (Fset_window_configuration,
195 Fcurrent_window_configuration (Qnil));
197 /* If the minibuffer window is on a different frame, save that
198 frame's configuration too. */
199 #ifdef MULTI_FRAME
200 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
201 if (XFRAME (mini_frame) != selected_frame)
202 record_unwind_protect (Fset_window_configuration,
203 Fcurrent_window_configuration (mini_frame));
205 /* If the minibuffer is on an iconified or invisible frame,
206 make it visible now. */
207 Fmake_frame_visible (mini_frame);
209 if (minibuffer_auto_raise)
210 Fraise_frame (mini_frame);
211 #endif
213 val = current_buffer->directory;
214 Fset_buffer (get_minibuffer (minibuf_level));
216 /* The current buffer's default directory is usually the right thing
217 for our minibuffer here. However, if you're typing a command at
218 a minibuffer-only frame when minibuf_level is zero, then buf IS
219 the current_buffer, so reset_buffer leaves buf's default
220 directory unchanged. This is a bummer when you've just started
221 up Emacs and buf's default directory is Qnil. Here's a hack; can
222 you think of something better to do? Find another buffer with a
223 better directory, and use that one instead. */
224 if (STRINGP (val))
225 current_buffer->directory = val;
226 else
228 Lisp_Object buf_list;
230 for (buf_list = Vbuffer_alist;
231 CONSP (buf_list);
232 buf_list = XCONS (buf_list)->cdr)
234 Lisp_Object other_buf;
236 other_buf = XCONS (XCONS (buf_list)->car)->cdr;
237 if (STRINGP (XBUFFER (other_buf)->directory))
239 current_buffer->directory = XBUFFER (other_buf)->directory;
240 break;
245 #ifdef MULTI_FRAME
246 if (XFRAME (mini_frame) != selected_frame)
247 Fredirect_frame_focus (Fselected_frame (), mini_frame);
248 #endif
249 Fmake_local_variable (Qprint_escape_newlines);
250 print_escape_newlines = 1;
252 record_unwind_protect (read_minibuf_unwind, Qnil);
254 Vminibuf_scroll_window = selected_window;
255 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
256 Fselect_window (minibuf_window);
257 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
259 Ferase_buffer ();
260 minibuf_level++;
262 if (!NILP (initial))
264 Finsert (1, &initial);
265 if (!NILP (backup_n) && INTEGERP (backup_n))
266 Fforward_char (backup_n);
269 echo_area_glyphs = 0;
270 /* This is in case the minibuffer-setup-hook calls Fsit_for. */
271 previous_echo_glyphs = 0;
273 Vhelp_form = Vminibuffer_help_form;
274 current_buffer->keymap = map;
276 /* Run our hook, but not if it is empty.
277 (run-hooks would do nothing if it is empty,
278 but it's important to save time here in the usual case. */
279 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
280 && !NILP (Vrun_hooks))
281 call1 (Vrun_hooks, Qminibuffer_setup_hook);
283 /* ??? MCC did redraw_screen here if switching screens. */
284 recursive_edit_1 ();
286 /* If cursor is on the minibuffer line,
287 show the user we have exited by putting it in column 0. */
288 if ((FRAME_CURSOR_Y (selected_frame)
289 >= XFASTINT (XWINDOW (minibuf_window)->top))
290 && !noninteractive)
292 FRAME_CURSOR_X (selected_frame) = 0;
293 update_frame (selected_frame, 1, 1);
296 /* Make minibuffer contents into a string */
297 val = make_buffer_string (1, Z);
298 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
300 /* VAL is the string of minibuffer text. */
301 last_minibuf_string = val;
303 /* Add the value to the appropriate history list unless it is empty. */
304 if (XSTRING (val)->size != 0
305 && SYMBOLP (Vminibuffer_history_variable)
306 && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound))
308 /* If the caller wanted to save the value read on a history list,
309 then do so if the value is not already the front of the list. */
310 Lisp_Object histval;
311 histval = Fsymbol_value (Vminibuffer_history_variable);
313 /* The value of the history variable must be a cons or nil. Other
314 values are unacceptable. We silently ignore these values. */
315 if (NILP (histval)
316 || (CONSP (histval)
317 && NILP (Fequal (last_minibuf_string, Fcar (histval)))))
318 Fset (Vminibuffer_history_variable,
319 Fcons (last_minibuf_string, histval));
322 /* If Lisp form desired instead of string, parse it. */
323 if (expflag)
325 Lisp_Object expr_and_pos;
326 unsigned char *p;
328 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
329 /* Ignore trailing whitespace; any other trailing junk is an error. */
330 for (p = XSTRING (val)->data + XINT (Fcdr (expr_and_pos)); *p; p++)
331 if (*p != ' ' && *p != '\t' && *p != '\n')
332 error ("Trailing garbage following expression");
333 val = Fcar (expr_and_pos);
336 /* The appropriate frame will get selected
337 in set-window-configuration. */
338 RETURN_UNGCPRO (unbind_to (count, val));
341 /* Return a buffer to be used as the minibuffer at depth `depth'.
342 depth = 0 is the lowest allowed argument, and that is the value
343 used for nonrecursive minibuffer invocations */
345 Lisp_Object
346 get_minibuffer (depth)
347 int depth;
349 Lisp_Object tail, num, buf;
350 char name[24];
351 extern Lisp_Object nconc2 ();
353 XSETFASTINT (num, depth);
354 tail = Fnthcdr (num, Vminibuffer_list);
355 if (NILP (tail))
357 tail = Fcons (Qnil, Qnil);
358 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
360 buf = Fcar (tail);
361 if (NILP (buf) || NILP (XBUFFER (buf)->name))
363 sprintf (name, " *Minibuf-%d*", depth);
364 buf = Fget_buffer_create (build_string (name));
366 /* Although the buffer's name starts with a space, undo should be
367 enabled in it. */
368 Fbuffer_enable_undo (buf);
370 XCONS (tail)->car = buf;
372 else
374 int count = specpdl_ptr - specpdl;
376 reset_buffer (XBUFFER (buf));
377 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
378 Fset_buffer (buf);
379 Fkill_all_local_variables ();
380 unbind_to (count, Qnil);
383 return buf;
386 /* This function is called on exiting minibuffer, whether normally or not,
387 and it restores the current window, buffer, etc. */
389 void
390 read_minibuf_unwind (data)
391 Lisp_Object data;
393 Lisp_Object old_deactivate_mark;
395 /* We are exiting the minibuffer one way or the other,
396 so run the hook. */
397 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
398 && !NILP (Vrun_hooks))
399 safe_run_hooks (Qminibuffer_exit_hook);
401 /* Erase the minibuffer we were using at this level. */
402 Fset_buffer (XWINDOW (minibuf_window)->buffer);
404 /* Prevent error in erase-buffer. */
405 current_buffer->read_only = Qnil;
407 old_deactivate_mark = Vdeactivate_mark;
408 Ferase_buffer ();
409 Vdeactivate_mark = old_deactivate_mark;
411 /* If this was a recursive minibuffer,
412 tie the minibuffer window back to the outer level minibuffer buffer */
413 minibuf_level--;
414 /* Make sure minibuffer window is erased, not ignored */
415 windows_or_buffers_changed++;
416 XSETFASTINT (XWINDOW (minibuf_window)->last_modified, 0);
418 /* Restore prompt, etc from outer minibuffer */
419 minibuf_prompt = Fcar (minibuf_save_list);
420 minibuf_save_list = Fcdr (minibuf_save_list);
421 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
422 minibuf_save_list = Fcdr (minibuf_save_list);
423 Vhelp_form = Fcar (minibuf_save_list);
424 minibuf_save_list = Fcdr (minibuf_save_list);
425 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
426 minibuf_save_list = Fcdr (minibuf_save_list);
427 Vminibuffer_history_position = Fcar (minibuf_save_list);
428 minibuf_save_list = Fcdr (minibuf_save_list);
429 Vminibuffer_history_variable = Fcar (minibuf_save_list);
430 minibuf_save_list = Fcdr (minibuf_save_list);
431 Voverriding_local_map = Fcar (minibuf_save_list);
432 minibuf_save_list = Fcdr (minibuf_save_list);
433 minibuf_window = Fcar (minibuf_save_list);
434 minibuf_save_list = Fcdr (minibuf_save_list);
438 /* This comment supplies the doc string for read-from-minibuffer,
439 for make-docfile to see. We cannot put this in the real DEFUN
440 due to limits in the Unix cpp.
442 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
443 "Read a string from the minibuffer, prompting with string PROMPT.\n\
444 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
445 to be inserted into the minibuffer before reading input.\n\
446 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
447 is STRING, but point is placed POSITION characters into the string.\n\
448 Third arg KEYMAP is a keymap to use whilst reading;\n\
449 if omitted or nil, the default is `minibuffer-local-map'.\n\
450 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
451 and return that object:\n\
452 in other words, do `(car (read-from-string INPUT-STRING))'\n\
453 Fifth arg HIST, if non-nil, specifies a history list\n\
454 and optionally the initial position in the list.\n\
455 It can be a symbol, which is the history list variable to use,\n\
456 or it can be a cons cell (HISTVAR . HISTPOS).\n\
457 In that case, HISTVAR is the history list variable to use,\n\
458 and HISTPOS is the initial position (the position in the list\n\
459 which INITIAL-CONTENTS corresponds to).\n\
460 Positions are counted starting from 1 at the beginning of the list."
463 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
464 0 /* See immediately above */)
465 (prompt, initial_contents, keymap, read, hist)
466 Lisp_Object prompt, initial_contents, keymap, read, hist;
468 int pos = 0;
469 Lisp_Object histvar, histpos, position;
470 position = Qnil;
472 CHECK_STRING (prompt, 0);
473 if (!NILP (initial_contents))
475 if (CONSP (initial_contents))
477 position = Fcdr (initial_contents);
478 initial_contents = Fcar (initial_contents);
480 CHECK_STRING (initial_contents, 1);
481 if (!NILP (position))
483 CHECK_NUMBER (position, 0);
484 /* Convert to distance from end of input. */
485 pos = XINT (position) - 1 - XSTRING (initial_contents)->size;
489 if (NILP (keymap))
490 keymap = Vminibuffer_local_map;
491 else
492 keymap = get_keymap (keymap,2);
494 if (SYMBOLP (hist))
496 histvar = hist;
497 histpos = Qnil;
499 else
501 histvar = Fcar_safe (hist);
502 histpos = Fcdr_safe (hist);
504 if (NILP (histvar))
505 histvar = Qminibuffer_history;
506 if (NILP (histpos))
507 XSETFASTINT (histpos, 0);
509 return read_minibuf (keymap, initial_contents, prompt,
510 make_number (pos), !NILP (read), histvar, histpos);
513 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
514 "Return a Lisp object read using the minibuffer.\n\
515 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
516 is a string to insert in the minibuffer before reading.")
517 (prompt, initial_contents)
518 Lisp_Object prompt, initial_contents;
520 CHECK_STRING (prompt, 0);
521 if (!NILP (initial_contents))
522 CHECK_STRING (initial_contents, 1);
523 return read_minibuf (Vminibuffer_local_map, initial_contents,
524 prompt, Qnil, 1, Qminibuffer_history, make_number (0));
527 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
528 "Return value of Lisp expression read using the minibuffer.\n\
529 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
530 is a string to insert in the minibuffer before reading.")
531 (prompt, initial_contents)
532 Lisp_Object prompt, initial_contents;
534 return Feval (Fread_minibuffer (prompt, initial_contents));
537 /* Functions that use the minibuffer to read various things. */
539 DEFUN ("read-string", Fread_string, Sread_string, 1, 3, 0,
540 "Read a string from the minibuffer, prompting with string PROMPT.\n\
541 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.\n\
542 The third arg HISTORY, if non-nil, specifies a history list\n\
543 and optionally the initial position in the list.\n\
544 See `read-from-minibuffer' for details of HISTORY argument.")
545 (prompt, initial_input, history)
546 Lisp_Object prompt, initial_input, history;
548 return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, history);
551 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 2, 0,
552 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
553 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
554 (prompt, init)
555 Lisp_Object prompt, init;
557 CHECK_STRING (prompt, 0);
558 if (! NILP (init))
559 CHECK_STRING (init, 1);
561 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0,
562 Qminibuffer_history, make_number (0));
565 DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
566 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
567 Prompts with PROMPT.")
568 (prompt)
569 Lisp_Object prompt;
571 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil),
572 Qnil);
575 #ifdef NOTDEF
576 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
577 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
578 Prompts with PROMPT.")
579 (prompt)
580 Lisp_Object prompt;
582 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil),
583 Qnil);
585 #endif /* NOTDEF */
587 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
588 "One arg PROMPT, a string. Read the name of a user variable and return\n\
589 it as a symbol. Prompts with PROMPT.\n\
590 A user variable is one whose documentation starts with a `*' character.")
591 (prompt)
592 Lisp_Object prompt;
594 return Fintern (Fcompleting_read (prompt, Vobarray,
595 Quser_variable_p, Qt, Qnil, Qnil),
596 Qnil);
599 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
600 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
601 Prompts with PROMPT.\n\
602 Optional second arg is value to return if user enters an empty line.\n\
603 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
604 (prompt, def, require_match)
605 Lisp_Object prompt, def, require_match;
607 Lisp_Object tem;
608 Lisp_Object args[3];
609 struct gcpro gcpro1;
611 if (BUFFERP (def))
612 def = XBUFFER (def)->name;
613 if (!NILP (def))
615 args[0] = build_string ("%s(default %s) ");
616 args[1] = prompt;
617 args[2] = def;
618 prompt = Fformat (3, args);
620 GCPRO1 (def);
621 tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil);
622 UNGCPRO;
623 if (XSTRING (tem)->size)
624 return tem;
625 return def;
628 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
629 "Return common substring of all completions of STRING in ALIST.\n\
630 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
631 All that match are compared together; the longest initial sequence\n\
632 common to all matches is returned as a string.\n\
633 If there is no match at all, nil is returned.\n\
634 For an exact match, t is returned.\n\
636 ALIST can be an obarray instead of an alist.\n\
637 Then the print names of all symbols in the obarray are the possible matches.\n\
639 ALIST can also be a function to do the completion itself.\n\
640 It receives three arguments: the values STRING, PREDICATE and nil.\n\
641 Whatever it returns becomes the value of `try-completion'.\n\
643 If optional third argument PREDICATE is non-nil,\n\
644 it is used to test each possible match.\n\
645 The match is a candidate only if PREDICATE returns non-nil.\n\
646 The argument given to PREDICATE is the alist element\n\
647 or the symbol from the obarray.")
648 (string, alist, pred)
649 Lisp_Object string, alist, pred;
651 Lisp_Object bestmatch, tail, elt, eltstring;
652 int bestmatchsize;
653 int compare, matchsize;
654 int list = CONSP (alist) || NILP (alist);
655 int index, obsize;
656 int matchcount = 0;
657 Lisp_Object bucket, zero, end, tem;
658 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
660 CHECK_STRING (string, 0);
661 if (!list && !VECTORP (alist))
662 return call3 (alist, string, pred, Qnil);
664 bestmatch = Qnil;
666 /* If ALIST is not a list, set TAIL just for gc pro. */
667 tail = alist;
668 if (! list)
670 index = 0;
671 obsize = XVECTOR (alist)->size;
672 bucket = XVECTOR (alist)->contents[index];
675 while (1)
677 /* Get the next element of the alist or obarray. */
678 /* Exit the loop if the elements are all used up. */
679 /* elt gets the alist element or symbol.
680 eltstring gets the name to check as a completion. */
682 if (list)
684 if (NILP (tail))
685 break;
686 elt = Fcar (tail);
687 eltstring = Fcar (elt);
688 tail = Fcdr (tail);
690 else
692 if (XFASTINT (bucket) != 0)
694 elt = bucket;
695 eltstring = Fsymbol_name (elt);
696 if (XSYMBOL (bucket)->next)
697 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
698 else
699 XSETFASTINT (bucket, 0);
701 else if (++index >= obsize)
702 break;
703 else
705 bucket = XVECTOR (alist)->contents[index];
706 continue;
710 /* Is this element a possible completion? */
712 if (STRINGP (eltstring)
713 && XSTRING (string)->size <= XSTRING (eltstring)->size
714 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
715 XSTRING (string)->size))
717 /* Yes. */
718 Lisp_Object regexps;
719 Lisp_Object zero;
720 XSETFASTINT (zero, 0);
722 /* Ignore this element if it fails to match all the regexps. */
723 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
724 regexps = XCONS (regexps)->cdr)
726 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
727 if (NILP (tem))
728 break;
730 if (CONSP (regexps))
731 continue;
733 /* Ignore this element if there is a predicate
734 and the predicate doesn't like it. */
736 if (!NILP (pred))
738 if (EQ (pred, Qcommandp))
739 tem = Fcommandp (elt);
740 else
742 GCPRO4 (tail, string, eltstring, bestmatch);
743 tem = call1 (pred, elt);
744 UNGCPRO;
746 if (NILP (tem)) continue;
749 /* Update computation of how much all possible completions match */
751 matchcount++;
752 if (NILP (bestmatch))
753 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
754 else
756 compare = min (bestmatchsize, XSTRING (eltstring)->size);
757 matchsize = scmp (XSTRING (bestmatch)->data,
758 XSTRING (eltstring)->data,
759 compare);
760 if (matchsize < 0)
761 matchsize = compare;
762 if (completion_ignore_case)
764 /* If this is an exact match except for case,
765 use it as the best match rather than one that is not an
766 exact match. This way, we get the case pattern
767 of the actual match. */
768 if ((matchsize == XSTRING (eltstring)->size
769 && matchsize < XSTRING (bestmatch)->size)
771 /* If there is more than one exact match ignoring case,
772 and one of them is exact including case,
773 prefer that one. */
774 /* If there is no exact match ignoring case,
775 prefer a match that does not change the case
776 of the input. */
777 ((matchsize == XSTRING (eltstring)->size)
779 (matchsize == XSTRING (bestmatch)->size)
780 && !bcmp (XSTRING (eltstring)->data,
781 XSTRING (string)->data, XSTRING (string)->size)
782 && bcmp (XSTRING (bestmatch)->data,
783 XSTRING (string)->data, XSTRING (string)->size)))
784 bestmatch = eltstring;
786 bestmatchsize = matchsize;
791 if (NILP (bestmatch))
792 return Qnil; /* No completions found */
793 /* If we are ignoring case, and there is no exact match,
794 and no additional text was supplied,
795 don't change the case of what the user typed. */
796 if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
797 && XSTRING (bestmatch)->size > bestmatchsize)
798 return string;
800 /* Return t if the supplied string is an exact match (counting case);
801 it does not require any change to be made. */
802 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
803 && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data,
804 bestmatchsize))
805 return Qt;
807 XSETFASTINT (zero, 0); /* Else extract the part in which */
808 XSETFASTINT (end, bestmatchsize); /* all completions agree */
809 return Fsubstring (bestmatch, zero, end);
812 /* Compare exactly LEN chars of strings at S1 and S2,
813 ignoring case if appropriate.
814 Return -1 if strings match,
815 else number of chars that match at the beginning. */
818 scmp (s1, s2, len)
819 register unsigned char *s1, *s2;
820 int len;
822 register int l = len;
824 if (completion_ignore_case)
826 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
827 l--;
829 else
831 while (l && *s1++ == *s2++)
832 l--;
834 if (l == 0)
835 return -1;
836 else
837 return len - l;
840 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
841 "Search for partial matches to STRING in ALIST.\n\
842 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
843 The value is a list of all the strings from ALIST that match.\n\
845 ALIST can be an obarray instead of an alist.\n\
846 Then the print names of all symbols in the obarray are the possible matches.\n\
848 ALIST can also be a function to do the completion itself.\n\
849 It receives three arguments: the values STRING, PREDICATE and t.\n\
850 Whatever it returns becomes the value of `all-completion'.\n\
852 If optional third argument PREDICATE is non-nil,\n\
853 it is used to test each possible match.\n\
854 The match is a candidate only if PREDICATE returns non-nil.\n\
855 The argument given to PREDICATE is the alist element\n\
856 or the symbol from the obarray.\n\
858 If the optional fourth argument HIDE-SPACES is non-nil,\n\
859 strings in ALIST that start with a space\n\
860 are ignored unless STRING itself starts with a space.")
861 (string, alist, pred, hide_spaces)
862 Lisp_Object string, alist, pred, hide_spaces;
864 Lisp_Object tail, elt, eltstring;
865 Lisp_Object allmatches;
866 int list = CONSP (alist) || NILP (alist);
867 int index, obsize;
868 Lisp_Object bucket, tem;
869 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
871 CHECK_STRING (string, 0);
872 if (!list && !VECTORP (alist))
874 return call3 (alist, string, pred, Qt);
876 allmatches = Qnil;
878 /* If ALIST is not a list, set TAIL just for gc pro. */
879 tail = alist;
880 if (! list)
882 index = 0;
883 obsize = XVECTOR (alist)->size;
884 bucket = XVECTOR (alist)->contents[index];
887 while (1)
889 /* Get the next element of the alist or obarray. */
890 /* Exit the loop if the elements are all used up. */
891 /* elt gets the alist element or symbol.
892 eltstring gets the name to check as a completion. */
894 if (list)
896 if (NILP (tail))
897 break;
898 elt = Fcar (tail);
899 eltstring = Fcar (elt);
900 tail = Fcdr (tail);
902 else
904 if (XFASTINT (bucket) != 0)
906 elt = bucket;
907 eltstring = Fsymbol_name (elt);
908 if (XSYMBOL (bucket)->next)
909 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
910 else
911 XSETFASTINT (bucket, 0);
913 else if (++index >= obsize)
914 break;
915 else
917 bucket = XVECTOR (alist)->contents[index];
918 continue;
922 /* Is this element a possible completion? */
924 if (STRINGP (eltstring)
925 && XSTRING (string)->size <= XSTRING (eltstring)->size
926 /* If HIDE_SPACES, reject alternatives that start with space
927 unless the input starts with space. */
928 && ((XSTRING (string)->size > 0 && XSTRING (string)->data[0] == ' ')
929 || XSTRING (eltstring)->data[0] != ' '
930 || NILP (hide_spaces))
931 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
932 XSTRING (string)->size))
934 /* Yes. */
935 Lisp_Object regexps;
936 Lisp_Object zero;
937 XSETFASTINT (zero, 0);
939 /* Ignore this element if it fails to match all the regexps. */
940 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
941 regexps = XCONS (regexps)->cdr)
943 tem = Fstring_match (XCONS (regexps)->car, eltstring, zero);
944 if (NILP (tem))
945 break;
947 if (CONSP (regexps))
948 continue;
950 /* Ignore this element if there is a predicate
951 and the predicate doesn't like it. */
953 if (!NILP (pred))
955 if (EQ (pred, Qcommandp))
956 tem = Fcommandp (elt);
957 else
959 GCPRO4 (tail, eltstring, allmatches, string);
960 tem = call1 (pred, elt);
961 UNGCPRO;
963 if (NILP (tem)) continue;
965 /* Ok => put it on the list. */
966 allmatches = Fcons (eltstring, allmatches);
970 return Fnreverse (allmatches);
973 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
974 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
975 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
977 /* This comment supplies the doc string for completing-read,
978 for make-docfile to see. We cannot put this in the real DEFUN
979 due to limits in the Unix cpp.
981 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
982 "Read a string in the minibuffer, with completion.\n\
983 Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST.\n\
984 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
985 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
986 PREDICATE limits completion to a subset of TABLE.\n\
987 See `try-completion' and `all-completions' for more details
988 on completion, TABLE, and PREDICATE.\n\
990 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
991 the input is (or completes to) an element of TABLE or is null.\n\
992 If it is also not t, Return does not exit if it does non-null completion.\n\
993 If the input is null, `completing-read' returns nil,\n\
994 regardless of the value of REQUIRE-MATCH.\n\
996 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
997 If it is (STRING . POSITION), the initial input\n\
998 is STRING, but point is placed POSITION characters into the string.\n\
999 HIST, if non-nil, specifies a history list\n\
1000 and optionally the initial position in the list.\n\
1001 It can be a symbol, which is the history list variable to use,\n\
1002 or it can be a cons cell (HISTVAR . HISTPOS).\n\
1003 In that case, HISTVAR is the history list variable to use,\n\
1004 and HISTPOS is the initial position (the position in the list\n\
1005 which INITIAL-CONTENTS corresponds to).\n\
1006 Positions are counted starting from 1 at the beginning of the list.\n\
1007 Completion ignores case if the ambient value of\n\
1008 `completion-ignore-case' is non-nil."
1010 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
1011 0 /* See immediately above */)
1012 (prompt, table, pred, require_match, init, hist)
1013 Lisp_Object prompt, table, pred, require_match, init, hist;
1015 Lisp_Object val, histvar, histpos, position;
1016 int pos = 0;
1017 int count = specpdl_ptr - specpdl;
1018 specbind (Qminibuffer_completion_table, table);
1019 specbind (Qminibuffer_completion_predicate, pred);
1020 specbind (Qminibuffer_completion_confirm,
1021 EQ (require_match, Qt) ? Qnil : Qt);
1022 last_exact_completion = Qnil;
1024 position = Qnil;
1025 if (!NILP (init))
1027 if (CONSP (init))
1029 position = Fcdr (init);
1030 init = Fcar (init);
1032 CHECK_STRING (init, 0);
1033 if (!NILP (position))
1035 CHECK_NUMBER (position, 0);
1036 /* Convert to distance from end of input. */
1037 pos = XINT (position) - XSTRING (init)->size;
1041 if (SYMBOLP (hist))
1043 histvar = hist;
1044 histpos = Qnil;
1046 else
1048 histvar = Fcar_safe (hist);
1049 histpos = Fcdr_safe (hist);
1051 if (NILP (histvar))
1052 histvar = Qminibuffer_history;
1053 if (NILP (histpos))
1054 XSETFASTINT (histpos, 0);
1056 val = read_minibuf (NILP (require_match)
1057 ? Vminibuffer_local_completion_map
1058 : Vminibuffer_local_must_match_map,
1059 init, prompt, make_number (pos), 0,
1060 histvar, histpos);
1061 return unbind_to (count, val);
1064 /* Temporarily display the string M at the end of the current
1065 minibuffer contents. This is used to display things like
1066 "[No Match]" when the user requests a completion for a prefix
1067 that has no possible completions, and other quick, unobtrusive
1068 messages. */
1070 temp_echo_area_glyphs (m)
1071 char *m;
1073 int osize = ZV;
1074 int opoint = PT;
1075 Lisp_Object oinhibit;
1076 oinhibit = Vinhibit_quit;
1078 /* Clear out any old echo-area message to make way for our new thing. */
1079 message (0);
1081 SET_PT (osize);
1082 insert_string (m);
1083 SET_PT (opoint);
1084 Vinhibit_quit = Qt;
1085 Fsit_for (make_number (2), Qnil, Qnil);
1086 del_range (osize, ZV);
1087 SET_PT (opoint);
1088 if (!NILP (Vquit_flag))
1090 Vquit_flag = Qnil;
1091 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1093 Vinhibit_quit = oinhibit;
1096 Lisp_Object Fminibuffer_completion_help ();
1097 Lisp_Object assoc_for_completion ();
1098 /* A subroutine of Fintern_soft. */
1099 extern Lisp_Object oblookup ();
1102 /* Test whether TXT is an exact completion. */
1103 Lisp_Object
1104 test_completion (txt)
1105 Lisp_Object txt;
1107 Lisp_Object tem;
1109 if (CONSP (Vminibuffer_completion_table)
1110 || NILP (Vminibuffer_completion_table))
1111 return assoc_for_completion (txt, Vminibuffer_completion_table);
1112 else if (VECTORP (Vminibuffer_completion_table))
1114 /* Bypass intern-soft as that loses for nil */
1115 tem = oblookup (Vminibuffer_completion_table,
1116 XSTRING (txt)->data, XSTRING (txt)->size);
1117 if (!SYMBOLP (tem))
1118 return Qnil;
1119 else if (!NILP (Vminibuffer_completion_predicate))
1120 return call1 (Vminibuffer_completion_predicate, tem);
1121 else
1122 return Qt;
1124 else
1125 return call3 (Vminibuffer_completion_table, txt,
1126 Vminibuffer_completion_predicate, Qlambda);
1129 /* returns:
1130 * 0 no possible completion
1131 * 1 was already an exact and unique completion
1132 * 3 was already an exact completion
1133 * 4 completed to an exact completion
1134 * 5 some completion happened
1135 * 6 no completion happened
1138 do_completion ()
1140 Lisp_Object completion, tem;
1141 int completedp;
1142 Lisp_Object last;
1143 struct gcpro gcpro1, gcpro2;
1145 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
1146 Vminibuffer_completion_predicate);
1147 last = last_exact_completion;
1148 last_exact_completion = Qnil;
1150 GCPRO2 (completion, last);
1152 if (NILP (completion))
1154 bitch_at_user ();
1155 temp_echo_area_glyphs (" [No match]");
1156 UNGCPRO;
1157 return 0;
1160 if (EQ (completion, Qt)) /* exact and unique match */
1162 UNGCPRO;
1163 return 1;
1166 /* compiler bug */
1167 tem = Fstring_equal (completion, Fbuffer_string());
1168 if (completedp = NILP (tem))
1170 Ferase_buffer (); /* Some completion happened */
1171 Finsert (1, &completion);
1174 /* It did find a match. Do we match some possibility exactly now? */
1175 tem = test_completion (Fbuffer_string ());
1176 if (NILP (tem))
1178 /* not an exact match */
1179 UNGCPRO;
1180 if (completedp)
1181 return 5;
1182 else if (auto_help)
1183 Fminibuffer_completion_help ();
1184 else
1185 temp_echo_area_glyphs (" [Next char not unique]");
1186 return 6;
1188 else if (completedp)
1190 UNGCPRO;
1191 return 4;
1193 /* If the last exact completion and this one were the same,
1194 it means we've already given a "Complete but not unique"
1195 message and the user's hit TAB again, so now we give him help. */
1196 last_exact_completion = completion;
1197 if (!NILP (last))
1199 tem = Fbuffer_string ();
1200 if (!NILP (Fequal (tem, last)))
1201 Fminibuffer_completion_help ();
1203 UNGCPRO;
1204 return 3;
1207 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1209 Lisp_Object
1210 assoc_for_completion (key, list)
1211 register Lisp_Object key;
1212 Lisp_Object list;
1214 register Lisp_Object tail;
1216 if (completion_ignore_case)
1217 key = Fupcase (key);
1219 for (tail = list; !NILP (tail); tail = Fcdr (tail))
1221 register Lisp_Object elt, tem, thiscar;
1222 elt = Fcar (tail);
1223 if (!CONSP (elt)) continue;
1224 thiscar = Fcar (elt);
1225 if (!STRINGP (thiscar))
1226 continue;
1227 if (completion_ignore_case)
1228 thiscar = Fupcase (thiscar);
1229 tem = Fequal (thiscar, key);
1230 if (!NILP (tem)) return elt;
1231 QUIT;
1233 return Qnil;
1236 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
1237 "Complete the minibuffer contents as far as possible.\n\
1238 Return nil if there is no valid completion, else t.\n\
1239 If no characters can be completed, display a list of possible completions.\n\
1240 If you repeat this command after it displayed such a list,\n\
1241 scroll the window of possible completions.")
1244 register int i;
1245 Lisp_Object window, tem;
1247 /* If the previous command was not this, then mark the completion
1248 buffer obsolete. */
1249 if (! EQ (current_kboard->Vlast_command, this_command))
1250 Vminibuf_scroll_window = Qnil;
1252 window = Vminibuf_scroll_window;
1253 /* If there's a fresh completion window with a live buffer,
1254 and this command is repeated, scroll that window. */
1255 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
1256 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
1258 struct buffer *obuf = current_buffer;
1260 Fset_buffer (XWINDOW (window)->buffer);
1261 tem = Fpos_visible_in_window_p (make_number (ZV), window);
1262 if (! NILP (tem))
1263 /* If end is in view, scroll up to the beginning. */
1264 Fset_window_start (window, BEGV, Qnil);
1265 else
1266 /* Else scroll down one screen. */
1267 Fscroll_other_window (Qnil);
1269 set_buffer_internal (obuf);
1270 return Qnil;
1273 i = do_completion ();
1274 switch (i)
1276 case 0:
1277 return Qnil;
1279 case 1:
1280 temp_echo_area_glyphs (" [Sole completion]");
1281 break;
1283 case 3:
1284 temp_echo_area_glyphs (" [Complete, but not unique]");
1285 break;
1288 return Qt;
1291 /* Subroutines of Fminibuffer_complete_and_exit. */
1293 /* This one is called by internal_condition_case to do the real work. */
1295 Lisp_Object
1296 complete_and_exit_1 ()
1298 return make_number (do_completion ());
1301 /* This one is called by internal_condition_case if an error happens.
1302 Pretend the current value is an exact match. */
1304 Lisp_Object
1305 complete_and_exit_2 (ignore)
1306 Lisp_Object ignore;
1308 return make_number (1);
1311 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
1312 Sminibuffer_complete_and_exit, 0, 0, "",
1313 "If the minibuffer contents is a valid completion then exit.\n\
1314 Otherwise try to complete it. If completion leads to a valid completion,\n\
1315 a repetition of this command will exit.")
1318 register int i;
1319 Lisp_Object val;
1321 /* Allow user to specify null string */
1322 if (BEGV == ZV)
1323 goto exit;
1325 if (!NILP (test_completion (Fbuffer_string ())))
1326 goto exit;
1328 /* Call do_completion, but ignore errors. */
1329 val = internal_condition_case (complete_and_exit_1, Qerror,
1330 complete_and_exit_2);
1332 i = XFASTINT (val);
1333 switch (i)
1335 case 1:
1336 case 3:
1337 goto exit;
1339 case 4:
1340 if (!NILP (Vminibuffer_completion_confirm))
1342 temp_echo_area_glyphs (" [Confirm]");
1343 return Qnil;
1345 else
1346 goto exit;
1348 default:
1349 return Qnil;
1351 exit:
1352 Fthrow (Qexit, Qnil);
1353 /* NOTREACHED */
1356 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
1357 0, 0, "",
1358 "Complete the minibuffer contents at most a single word.\n\
1359 After one word is completed as much as possible, a space or hyphen\n\
1360 is added, provided that matches some possible completion.\n\
1361 Return nil if there is no valid completion, else t.")
1364 Lisp_Object completion, tem;
1365 register int i;
1366 register unsigned char *completion_string;
1367 struct gcpro gcpro1, gcpro2;
1369 /* We keep calling Fbuffer_string rather than arrange for GC to
1370 hold onto a pointer to one of the strings thus made. */
1372 completion = Ftry_completion (Fbuffer_string (),
1373 Vminibuffer_completion_table,
1374 Vminibuffer_completion_predicate);
1375 if (NILP (completion))
1377 bitch_at_user ();
1378 temp_echo_area_glyphs (" [No match]");
1379 return Qnil;
1381 if (EQ (completion, Qt))
1382 return Qnil;
1384 #if 0 /* How the below code used to look, for reference. */
1385 tem = Fbuffer_string ();
1386 b = XSTRING (tem)->data;
1387 i = ZV - 1 - XSTRING (completion)->size;
1388 p = XSTRING (completion)->data;
1389 if (i > 0 ||
1390 0 <= scmp (b, p, ZV - 1))
1392 i = 1;
1393 /* Set buffer to longest match of buffer tail and completion head. */
1394 while (0 <= scmp (b + i, p, ZV - 1 - i))
1395 i++;
1396 del_range (1, i + 1);
1397 SET_PT (ZV);
1399 #else /* Rewritten code */
1401 register unsigned char *buffer_string;
1402 int buffer_length, completion_length;
1404 tem = Fbuffer_string ();
1405 GCPRO2 (completion, tem);
1406 /* If reading a file name,
1407 expand any $ENVVAR refs in the buffer and in TEM. */
1408 if (EQ (Vminibuffer_completion_table, Qread_file_name_internal))
1410 Lisp_Object substituted;
1411 substituted = Fsubstitute_in_file_name (tem);
1412 if (! EQ (substituted, tem))
1414 tem = substituted;
1415 Ferase_buffer ();
1416 insert_from_string (tem, 0, XSTRING (tem)->size, 0);
1419 buffer_string = XSTRING (tem)->data;
1420 completion_string = XSTRING (completion)->data;
1421 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
1422 completion_length = XSTRING (completion)->size;
1423 i = buffer_length - completion_length;
1424 /* Mly: I don't understand what this is supposed to do AT ALL */
1425 if (i > 0 ||
1426 0 <= scmp (buffer_string, completion_string, buffer_length))
1428 /* Set buffer to longest match of buffer tail and completion head. */
1429 if (i <= 0) i = 1;
1430 buffer_string += i;
1431 buffer_length -= i;
1432 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
1433 i++;
1434 del_range (1, i + 1);
1435 SET_PT (ZV);
1437 UNGCPRO;
1439 #endif /* Rewritten code */
1440 i = ZV - BEGV;
1442 /* If completion finds next char not unique,
1443 consider adding a space or a hyphen. */
1444 if (i == XSTRING (completion)->size)
1446 GCPRO1 (completion);
1447 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1448 Vminibuffer_completion_table,
1449 Vminibuffer_completion_predicate);
1450 UNGCPRO;
1452 if (STRINGP (tem))
1453 completion = tem;
1454 else
1456 GCPRO1 (completion);
1457 tem =
1458 Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1459 Vminibuffer_completion_table,
1460 Vminibuffer_completion_predicate);
1461 UNGCPRO;
1463 if (STRINGP (tem))
1464 completion = tem;
1468 /* Now find first word-break in the stuff found by completion.
1469 i gets index in string of where to stop completing. */
1471 completion_string = XSTRING (completion)->data;
1473 for (; i < XSTRING (completion)->size; i++)
1474 if (SYNTAX (completion_string[i]) != Sword) break;
1475 if (i < XSTRING (completion)->size)
1476 i = i + 1;
1478 /* If got no characters, print help for user. */
1480 if (i == ZV - BEGV)
1482 if (auto_help)
1483 Fminibuffer_completion_help ();
1484 return Qnil;
1487 /* Otherwise insert in minibuffer the chars we got */
1489 Ferase_buffer ();
1490 insert_from_string (completion, 0, i, 1);
1491 return Qt;
1494 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
1495 1, 1, 0,
1496 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
1497 Each element may be just a symbol or string\n\
1498 or may be a list of two strings to be printed as if concatenated.\n\
1499 `standard-output' must be a buffer.\n\
1500 At the end, run the normal hook `completion-setup-hook'.\n\
1501 It can find the completion buffer in `standard-output'.")
1502 (completions)
1503 Lisp_Object completions;
1505 Lisp_Object tail, elt;
1506 register int i;
1507 int column = 0;
1508 struct gcpro gcpro1, gcpro2;
1509 struct buffer *old = current_buffer;
1510 int first = 1;
1512 /* Note that (when it matters) every variable
1513 points to a non-string that is pointed to by COMPLETIONS,
1514 except for ELT. ELT can be pointing to a string
1515 when terpri or Findent_to calls a change hook. */
1516 elt = Qnil;
1517 GCPRO2 (completions, elt);
1519 if (BUFFERP (Vstandard_output))
1520 set_buffer_internal (XBUFFER (Vstandard_output));
1522 if (NILP (completions))
1523 write_string ("There are no possible completions of what you have typed.",
1524 -1);
1525 else
1527 write_string ("Possible completions are:", -1);
1528 for (tail = completions, i = 0; !NILP (tail); tail = Fcdr (tail), i++)
1530 Lisp_Object tem;
1531 int length;
1532 Lisp_Object startpos, endpos;
1534 elt = Fcar (tail);
1535 /* Compute the length of this element. */
1536 if (CONSP (elt))
1538 tem = Fcar (elt);
1539 CHECK_STRING (tem, 0);
1540 length = XINT (XSTRING (tem)->size);
1542 tem = Fcar (Fcdr (elt));
1543 CHECK_STRING (tem, 0);
1544 length += XINT (XSTRING (tem)->size);
1546 else
1548 CHECK_STRING (elt, 0);
1549 length = XINT (XSTRING (elt)->size);
1552 /* This does a bad job for narrower than usual windows.
1553 Sadly, the window it will appear in is not known
1554 until after the text has been made. */
1556 if (BUFFERP (Vstandard_output))
1557 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
1559 /* If the previous completion was very wide,
1560 or we have two on this line already,
1561 don't put another on the same line. */
1562 if (column > 33 || first
1563 /* If this is really wide, don't put it second on a line. */
1564 || column > 0 && length > 45)
1566 Fterpri (Qnil);
1567 column = 0;
1569 /* Otherwise advance to column 35. */
1570 else
1572 if (BUFFERP (Vstandard_output))
1574 tem = Findent_to (make_number (35), make_number (2));
1576 column = XINT (tem);
1578 else
1582 write_string (" ", -1);
1583 column++;
1585 while (column < 35);
1589 if (BUFFERP (Vstandard_output))
1591 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
1592 Fset_text_properties (startpos, endpos,
1593 Qnil, Vstandard_output);
1596 /* Output this element and update COLUMN. */
1597 if (CONSP (elt))
1599 Fprinc (Fcar (elt), Qnil);
1600 Fprinc (Fcar (Fcdr (elt)), Qnil);
1602 else
1603 Fprinc (elt, Qnil);
1605 column += length;
1607 /* If output is to a buffer, recompute COLUMN in a way
1608 that takes account of character widths. */
1609 if (BUFFERP (Vstandard_output))
1611 tem = Fcurrent_column ();
1612 column = XINT (tem);
1615 first = 0;
1619 UNGCPRO;
1621 if (BUFFERP (Vstandard_output))
1622 set_buffer_internal (old);
1624 if (!NILP (Vrun_hooks))
1625 call1 (Vrun_hooks, intern ("completion-setup-hook"));
1627 return Qnil;
1630 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
1631 0, 0, "",
1632 "Display a list of possible completions of the current minibuffer contents.")
1635 Lisp_Object completions;
1637 message ("Making completion list...");
1638 completions = Fall_completions (Fbuffer_string (),
1639 Vminibuffer_completion_table,
1640 Vminibuffer_completion_predicate,
1641 Qt);
1642 echo_area_glyphs = 0;
1644 if (NILP (completions))
1646 bitch_at_user ();
1647 temp_echo_area_glyphs (" [No completions]");
1649 else
1650 internal_with_output_to_temp_buffer ("*Completions*",
1651 Fdisplay_completion_list,
1652 Fsort (completions, Qstring_lessp));
1653 return Qnil;
1656 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
1657 "Terminate minibuffer input.")
1660 if (INTEGERP (last_command_char))
1661 internal_self_insert (last_command_char, 0);
1662 else
1663 bitch_at_user ();
1665 Fthrow (Qexit, Qnil);
1668 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
1669 "Terminate this minibuffer argument.")
1672 Fthrow (Qexit, Qnil);
1675 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1676 "Return current depth of activations of minibuffer, a nonnegative integer.")
1679 return make_number (minibuf_level);
1682 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
1683 "Return the prompt string of the currently-active minibuffer.\n\
1684 If no minibuffer is active, return nil.")
1687 return Fcopy_sequence (minibuf_prompt);
1690 DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width,
1691 Sminibuffer_prompt_width, 0, 0, 0,
1692 "Return the display width of the minibuffer prompt.")
1695 Lisp_Object width;
1696 XSETFASTINT (width, minibuf_prompt_width);
1697 return width;
1700 init_minibuf_once ()
1702 Vminibuffer_list = Qnil;
1703 staticpro (&Vminibuffer_list);
1706 syms_of_minibuf ()
1708 minibuf_level = 0;
1709 minibuf_prompt = Qnil;
1710 staticpro (&minibuf_prompt);
1712 minibuf_save_list = Qnil;
1713 staticpro (&minibuf_save_list);
1715 Qread_file_name_internal = intern ("read-file-name-internal");
1716 staticpro (&Qread_file_name_internal);
1718 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
1719 staticpro (&Qminibuffer_completion_table);
1721 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
1722 staticpro (&Qminibuffer_completion_confirm);
1724 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
1725 staticpro (&Qminibuffer_completion_predicate);
1727 staticpro (&last_exact_completion);
1728 last_exact_completion = Qnil;
1730 staticpro (&last_minibuf_string);
1731 last_minibuf_string = Qnil;
1733 Quser_variable_p = intern ("user-variable-p");
1734 staticpro (&Quser_variable_p);
1736 Qminibuffer_history = intern ("minibuffer-history");
1737 staticpro (&Qminibuffer_history);
1739 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
1740 staticpro (&Qminibuffer_setup_hook);
1742 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
1743 staticpro (&Qminibuffer_exit_hook);
1745 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
1746 "Normal hook run just after entry to minibuffer.");
1747 Vminibuffer_setup_hook = Qnil;
1749 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
1750 "Normal hook run just after exit from minibuffer.");
1751 Vminibuffer_exit_hook = Qnil;
1753 DEFVAR_BOOL ("completion-auto-help", &auto_help,
1754 "*Non-nil means automatically provide help for invalid completion input.");
1755 auto_help = 1;
1757 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
1758 "Non-nil means don't consider case significant in completion.");
1759 completion_ignore_case = 0;
1761 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
1762 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1763 More precisely, this variable makes a difference when the minibuffer window\n\
1764 is the selected window. If you are in some other window, minibuffer commands\n\
1765 are allowed even if a minibuffer is active.");
1766 enable_recursive_minibuffers = 0;
1768 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
1769 "Alist or obarray used for completion in the minibuffer.\n\
1770 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1772 The value may alternatively be a function, which is given three arguments:\n\
1773 STRING, the current buffer contents;\n\
1774 PREDICATE, the predicate for filtering possible matches;\n\
1775 CODE, which says what kind of things to do.\n\
1776 CODE can be nil, t or `lambda'.\n\
1777 nil means to return the best completion of STRING, or nil if there is none.\n\
1778 t means to return a list of all possible completions of STRING.\n\
1779 `lambda' means to return t if STRING is a valid completion as it stands.");
1780 Vminibuffer_completion_table = Qnil;
1782 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
1783 "Within call to `completing-read', this holds the PREDICATE argument.");
1784 Vminibuffer_completion_predicate = Qnil;
1786 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
1787 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1788 Vminibuffer_completion_confirm = Qnil;
1790 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
1791 "Value that `help-form' takes on inside the minibuffer.");
1792 Vminibuffer_help_form = Qnil;
1794 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
1795 "History list symbol to add minibuffer values to.\n\
1796 Each string of minibuffer input, as it appears on exit from the minibuffer,\n\
1797 is added with\n\
1798 (set minibuffer-history-variable\n\
1799 (cons STRING (symbol-value minibuffer-history-variable)))");
1800 XSETFASTINT (Vminibuffer_history_variable, 0);
1802 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
1803 "Current position of redoing in the history list.");
1804 Vminibuffer_history_position = Qnil;
1806 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
1807 "*Non-nil means entering the minibuffer raises the minibuffer's frame.");
1808 minibuffer_auto_raise = 0;
1810 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
1811 "List of regexps that should restrict possible completions.");
1812 Vcompletion_regexp_list = Qnil;
1814 defsubr (&Sread_from_minibuffer);
1815 defsubr (&Seval_minibuffer);
1816 defsubr (&Sread_minibuffer);
1817 defsubr (&Sread_string);
1818 defsubr (&Sread_command);
1819 defsubr (&Sread_variable);
1820 defsubr (&Sread_buffer);
1821 defsubr (&Sread_no_blanks_input);
1822 defsubr (&Sminibuffer_depth);
1823 defsubr (&Sminibuffer_prompt);
1824 defsubr (&Sminibuffer_prompt_width);
1826 defsubr (&Stry_completion);
1827 defsubr (&Sall_completions);
1828 defsubr (&Scompleting_read);
1829 defsubr (&Sminibuffer_complete);
1830 defsubr (&Sminibuffer_complete_word);
1831 defsubr (&Sminibuffer_complete_and_exit);
1832 defsubr (&Sdisplay_completion_list);
1833 defsubr (&Sminibuffer_completion_help);
1835 defsubr (&Sself_insert_and_exit);
1836 defsubr (&Sexit_minibuffer);
1840 keys_of_minibuf ()
1842 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
1843 "abort-recursive-edit");
1844 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
1845 "exit-minibuffer");
1846 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
1847 "exit-minibuffer");
1849 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
1850 "abort-recursive-edit");
1851 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
1852 "exit-minibuffer");
1853 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
1854 "exit-minibuffer");
1856 initial_define_key (Vminibuffer_local_ns_map, ' ',
1857 "exit-minibuffer");
1858 initial_define_key (Vminibuffer_local_ns_map, '\t',
1859 "exit-minibuffer");
1860 initial_define_key (Vminibuffer_local_ns_map, '?',
1861 "self-insert-and-exit");
1863 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
1864 "abort-recursive-edit");
1865 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
1866 "exit-minibuffer");
1867 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
1868 "exit-minibuffer");
1870 initial_define_key (Vminibuffer_local_completion_map, '\t',
1871 "minibuffer-complete");
1872 initial_define_key (Vminibuffer_local_completion_map, ' ',
1873 "minibuffer-complete-word");
1874 initial_define_key (Vminibuffer_local_completion_map, '?',
1875 "minibuffer-completion-help");
1877 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
1878 "abort-recursive-edit");
1879 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
1880 "minibuffer-complete-and-exit");
1881 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
1882 "minibuffer-complete-and-exit");
1883 initial_define_key (Vminibuffer_local_must_match_map, '\t',
1884 "minibuffer-complete");
1885 initial_define_key (Vminibuffer_local_must_match_map, ' ',
1886 "minibuffer-complete-word");
1887 initial_define_key (Vminibuffer_local_must_match_map, '?',
1888 "minibuffer-completion-help");