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