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