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