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