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