Merge from emacs--devo--0
[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 2001, 2002, 2003, 2004, 2005,
4 2006, 2007 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
22
23
24 #include <config.h>
25 #include <stdio.h>
26
27 #include "lisp.h"
28 #include "commands.h"
29 #include "buffer.h"
30 #include "character.h"
31 #include "dispextern.h"
32 #include "keyboard.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "syntax.h"
36 #include "intervals.h"
37 #include "keymap.h"
38 #include "termhooks.h"
39
40 extern int quit_char;
41
42 /* List of buffers for use as minibuffers.
43 The first element of the list is used for the outermost minibuffer
44 invocation, the next element is used for a recursive minibuffer
45 invocation, etc. The list is extended at the end as deeper
46 minibuffer recursions are encountered. */
47
48 Lisp_Object Vminibuffer_list;
49
50 /* Data to remember during recursive minibuffer invocations */
51
52 Lisp_Object minibuf_save_list;
53
54 /* Depth in minibuffer invocations. */
55
56 int minibuf_level;
57
58 /* Nonzero means display completion help for invalid input. */
59
60 Lisp_Object Vcompletion_auto_help;
61
62 /* The maximum length of a minibuffer history. */
63
64 Lisp_Object Qhistory_length, Vhistory_length;
65
66 /* No duplicates in history. */
67
68 int history_delete_duplicates;
69
70 /* Non-nil means add new input to history. */
71
72 Lisp_Object Vhistory_add_new_input;
73
74 /* Fread_minibuffer leaves the input here as a string. */
75
76 Lisp_Object last_minibuf_string;
77
78 /* Nonzero means let functions called when within a minibuffer
79 invoke recursive minibuffers (to read arguments, or whatever) */
80
81 int enable_recursive_minibuffers;
82
83 /* Nonzero means don't ignore text properties
84 in Fread_from_minibuffer. */
85
86 int minibuffer_allow_text_properties;
87
88 /* help-form is bound to this while in the minibuffer. */
89
90 Lisp_Object Vminibuffer_help_form;
91
92 /* Variable which is the history list to add minibuffer values to. */
93
94 Lisp_Object Vminibuffer_history_variable;
95
96 /* Current position in the history list (adjusted by M-n and M-p). */
97
98 Lisp_Object Vminibuffer_history_position;
99
100 /* Text properties that are added to minibuffer prompts.
101 These are in addition to the basic `field' property, and stickiness
102 properties. */
103
104 Lisp_Object Vminibuffer_prompt_properties;
105
106 Lisp_Object Qminibuffer_history, Qbuffer_name_history;
107
108 Lisp_Object Qread_file_name_internal;
109
110 /* Normal hooks for entry to and exit from minibuffer. */
111
112 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
113 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
114
115 /* Function to call to read a buffer name. */
116 Lisp_Object Vread_buffer_function;
117
118 /* Nonzero means completion ignores case. */
119
120 int completion_ignore_case;
121 Lisp_Object Qcompletion_ignore_case;
122
123 /* List of regexps that should restrict possible completions. */
124
125 Lisp_Object Vcompletion_regexp_list;
126
127 /* Nonzero means raise the minibuffer frame when the minibuffer
128 is entered. */
129
130 int minibuffer_auto_raise;
131
132 /* If last completion attempt reported "Complete but not unique"
133 then this is the string completed then; otherwise this is nil. */
134
135 static Lisp_Object last_exact_completion;
136
137 /* Keymap for reading expressions. */
138 Lisp_Object Vread_expression_map;
139
140 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
141 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
142 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
143 Lisp_Object Vminibuffer_completing_file_name;
144
145 Lisp_Object Quser_variable_p;
146
147 Lisp_Object Qminibuffer_default;
148
149 Lisp_Object Qcurrent_input_method, Qactivate_input_method;
150
151 Lisp_Object Qcase_fold_search;
152
153 Lisp_Object Qread_expression_history;
154
155 extern Lisp_Object Voverriding_local_map;
156
157 extern Lisp_Object Qmouse_face;
158
159 extern Lisp_Object Qfield;
160 \f
161 /* Put minibuf on currently selected frame's minibuffer.
162 We do this whenever the user starts a new minibuffer
163 or when a minibuffer exits. */
164
165 void
166 choose_minibuf_frame ()
167 {
168 if (FRAMEP (selected_frame)
169 && FRAME_LIVE_P (XFRAME (selected_frame))
170 && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
171 {
172 struct frame *sf = XFRAME (selected_frame);
173 Lisp_Object buffer;
174
175 /* I don't think that any frames may validly have a null minibuffer
176 window anymore. */
177 if (NILP (sf->minibuffer_window))
178 abort ();
179
180 /* Under X, we come here with minibuf_window being the
181 minibuffer window of the unused termcap window created in
182 init_window_once. That window doesn't have a buffer. */
183 buffer = XWINDOW (minibuf_window)->buffer;
184 if (BUFFERP (buffer))
185 Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
186 minibuf_window = sf->minibuffer_window;
187 }
188
189 /* Make sure no other frame has a minibuffer as its selected window,
190 because the text would not be displayed in it, and that would be
191 confusing. Only allow the selected frame to do this,
192 and that only if the minibuffer is active. */
193 {
194 Lisp_Object tail, frame;
195
196 FOR_EACH_FRAME (tail, frame)
197 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
198 && !(EQ (frame, selected_frame)
199 && minibuf_level > 0))
200 Fset_frame_selected_window (frame, Fframe_first_window (frame));
201 }
202 }
203
204 Lisp_Object
205 choose_minibuf_frame_1 (ignore)
206 Lisp_Object ignore;
207 {
208 choose_minibuf_frame ();
209 return Qnil;
210 }
211
212 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
213 Sset_minibuffer_window, 1, 1, 0,
214 doc: /* Specify which minibuffer window to use for the minibuffer.
215 This affects where the minibuffer is displayed if you put text in it
216 without invoking the usual minibuffer commands. */)
217 (window)
218 Lisp_Object window;
219 {
220 CHECK_WINDOW (window);
221 if (! MINI_WINDOW_P (XWINDOW (window)))
222 error ("Window is not a minibuffer window");
223
224 minibuf_window = window;
225
226 return window;
227 }
228
229 \f
230 /* Actual minibuffer invocation. */
231
232 static Lisp_Object read_minibuf_unwind P_ ((Lisp_Object));
233 static Lisp_Object run_exit_minibuf_hook P_ ((Lisp_Object));
234 static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object,
235 Lisp_Object, Lisp_Object,
236 int, Lisp_Object,
237 Lisp_Object, Lisp_Object,
238 int, int));
239 static Lisp_Object read_minibuf_noninteractive P_ ((Lisp_Object, Lisp_Object,
240 Lisp_Object, Lisp_Object,
241 int, Lisp_Object,
242 Lisp_Object, Lisp_Object,
243 int, int));
244 static Lisp_Object string_to_object P_ ((Lisp_Object, Lisp_Object));
245
246
247 /* Read a Lisp object from VAL and return it. If VAL is an empty
248 string, and DEFALT is a string, read from DEFALT instead of VAL. */
249
250 static Lisp_Object
251 string_to_object (val, defalt)
252 Lisp_Object val, defalt;
253 {
254 struct gcpro gcpro1, gcpro2;
255 Lisp_Object expr_and_pos;
256 int pos;
257
258 GCPRO2 (val, defalt);
259
260 if (STRINGP (val) && SCHARS (val) == 0
261 && STRINGP (defalt))
262 val = defalt;
263
264 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
265 pos = XINT (Fcdr (expr_and_pos));
266 if (pos != SCHARS (val))
267 {
268 /* Ignore trailing whitespace; any other trailing junk
269 is an error. */
270 int i;
271 pos = string_char_to_byte (val, pos);
272 for (i = pos; i < SBYTES (val); i++)
273 {
274 int c = SREF (val, i);
275 if (c != ' ' && c != '\t' && c != '\n')
276 error ("Trailing garbage following expression");
277 }
278 }
279
280 val = Fcar (expr_and_pos);
281 RETURN_UNGCPRO (val);
282 }
283
284
285 /* Like read_minibuf but reading from stdin. This function is called
286 from read_minibuf to do the job if noninteractive. */
287
288 static Lisp_Object
289 read_minibuf_noninteractive (map, initial, prompt, backup_n, expflag,
290 histvar, histpos, defalt, allow_props,
291 inherit_input_method)
292 Lisp_Object map;
293 Lisp_Object initial;
294 Lisp_Object prompt;
295 Lisp_Object backup_n;
296 int expflag;
297 Lisp_Object histvar;
298 Lisp_Object histpos;
299 Lisp_Object defalt;
300 int allow_props;
301 int inherit_input_method;
302 {
303 int size, len;
304 char *line, *s;
305 Lisp_Object val;
306
307 fprintf (stdout, "%s", SDATA (prompt));
308 fflush (stdout);
309
310 val = Qnil;
311 size = 100;
312 len = 0;
313 line = (char *) xmalloc (size * sizeof *line);
314 while ((s = fgets (line + len, size - len, stdin)) != NULL
315 && (len = strlen (line),
316 len == size - 1 && line[len - 1] != '\n'))
317 {
318 size *= 2;
319 line = (char *) xrealloc (line, size);
320 }
321
322 if (s)
323 {
324 len = strlen (line);
325
326 if (len > 0 && line[len - 1] == '\n')
327 line[--len] = '\0';
328
329 val = build_string (line);
330 xfree (line);
331 }
332 else
333 {
334 xfree (line);
335 error ("Error reading from stdin");
336 }
337
338 /* If Lisp form desired instead of string, parse it. */
339 if (expflag)
340 val = string_to_object (val, defalt);
341
342 return val;
343 }
344 \f
345 DEFUN ("minibufferp", Fminibufferp,
346 Sminibufferp, 0, 1, 0,
347 doc: /* Return t if BUFFER is a minibuffer.
348 No argument or nil as argument means use current buffer as BUFFER.
349 BUFFER can be a buffer or a buffer name. */)
350 (buffer)
351 Lisp_Object buffer;
352 {
353 Lisp_Object tem;
354
355 if (NILP (buffer))
356 buffer = Fcurrent_buffer ();
357 else if (STRINGP (buffer))
358 buffer = Fget_buffer (buffer);
359 else
360 CHECK_BUFFER (buffer);
361
362 tem = Fmemq (buffer, Vminibuffer_list);
363 return ! NILP (tem) ? Qt : Qnil;
364 }
365
366 DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
367 Sminibuffer_prompt_end, 0, 0, 0,
368 doc: /* Return the buffer position of the end of the minibuffer prompt.
369 Return (point-min) if current buffer is not a minibuffer. */)
370 ()
371 {
372 /* This function is written to be most efficient when there's a prompt. */
373 Lisp_Object beg, end, tem;
374 beg = make_number (BEGV);
375
376 tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list);
377 if (NILP (tem))
378 return beg;
379
380 end = Ffield_end (beg, Qnil, Qnil);
381
382 if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil)))
383 return beg;
384 else
385 return end;
386 }
387
388 DEFUN ("minibuffer-contents", Fminibuffer_contents,
389 Sminibuffer_contents, 0, 0, 0,
390 doc: /* Return the user input in a minibuffer as a string.
391 If the current buffer is not a minibuffer, return its entire contents. */)
392 ()
393 {
394 int prompt_end = XINT (Fminibuffer_prompt_end ());
395 return make_buffer_string (prompt_end, ZV, 1);
396 }
397
398 DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties,
399 Sminibuffer_contents_no_properties, 0, 0, 0,
400 doc: /* Return the user input in a minibuffer as a string, without text-properties.
401 If the current buffer is not a minibuffer, return its entire contents. */)
402 ()
403 {
404 int prompt_end = XINT (Fminibuffer_prompt_end ());
405 return make_buffer_string (prompt_end, ZV, 0);
406 }
407
408 DEFUN ("minibuffer-completion-contents", Fminibuffer_completion_contents,
409 Sminibuffer_completion_contents, 0, 0, 0,
410 doc: /* Return the user input in a minibuffer before point as a string.
411 That is what completion commands operate on.
412 If the current buffer is not a minibuffer, return its entire contents. */)
413 ()
414 {
415 int prompt_end = XINT (Fminibuffer_prompt_end ());
416 if (PT < prompt_end)
417 error ("Cannot do completion in the prompt");
418 return make_buffer_string (prompt_end, PT, 1);
419 }
420
421 DEFUN ("delete-minibuffer-contents", Fdelete_minibuffer_contents,
422 Sdelete_minibuffer_contents, 0, 0, 0,
423 doc: /* Delete all user input in a minibuffer.
424 If the current buffer is not a minibuffer, erase its entire contents. */)
425 ()
426 {
427 int prompt_end = XINT (Fminibuffer_prompt_end ());
428 if (prompt_end < ZV)
429 del_range (prompt_end, ZV);
430 return Qnil;
431 }
432
433 \f
434 /* Read from the minibuffer using keymap MAP and initial contents INITIAL,
435 putting point minus BACKUP_N bytes from the end of INITIAL,
436 prompting with PROMPT (a string), using history list HISTVAR
437 with initial position HISTPOS. INITIAL should be a string or a
438 cons of a string and an integer. BACKUP_N should be <= 0, or
439 Qnil, which is equivalent to 0. If INITIAL is a cons, BACKUP_N is
440 ignored and replaced with an integer that puts point at one-indexed
441 position N in INITIAL, where N is the CDR of INITIAL, or at the
442 beginning of INITIAL if N <= 0.
443
444 Normally return the result as a string (the text that was read),
445 but if EXPFLAG is nonzero, read it and return the object read.
446 If HISTVAR is given, save the value read on that history only if it doesn't
447 match the front of that history list exactly. The value is pushed onto
448 the list as the string that was read.
449
450 DEFALT specifies the default value for the sake of history commands.
451
452 If ALLOW_PROPS is nonzero, we do not throw away text properties.
453
454 if INHERIT_INPUT_METHOD is nonzero, the minibuffer inherits the
455 current input method. */
456
457 static Lisp_Object
458 read_minibuf (map, initial, prompt, backup_n, expflag,
459 histvar, histpos, defalt, allow_props, inherit_input_method)
460 Lisp_Object map;
461 Lisp_Object initial;
462 Lisp_Object prompt;
463 Lisp_Object backup_n;
464 int expflag;
465 Lisp_Object histvar;
466 Lisp_Object histpos;
467 Lisp_Object defalt;
468 int allow_props;
469 int inherit_input_method;
470 {
471 Lisp_Object val;
472 int count = SPECPDL_INDEX ();
473 Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
474 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
475 Lisp_Object enable_multibyte;
476 int pos = INTEGERP (backup_n) ? XINT (backup_n) : 0;
477 /* String to add to the history. */
478 Lisp_Object histstring;
479
480 Lisp_Object empty_minibuf;
481 Lisp_Object dummy, frame;
482
483 extern Lisp_Object Qfront_sticky;
484 extern Lisp_Object Qrear_nonsticky;
485
486 specbind (Qminibuffer_default, defalt);
487
488 /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
489 in previous recursive minibuffer, but was not set explicitly
490 to t for this invocation, so set it to nil in this minibuffer.
491 Save the old value now, before we change it. */
492 specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name);
493 if (EQ (Vminibuffer_completing_file_name, Qlambda))
494 Vminibuffer_completing_file_name = Qnil;
495
496 #ifdef HAVE_X_WINDOWS
497 if (display_hourglass_p)
498 cancel_hourglass ();
499 #endif
500
501 if (!NILP (initial))
502 {
503 if (CONSP (initial))
504 {
505 backup_n = Fcdr (initial);
506 initial = Fcar (initial);
507 CHECK_STRING (initial);
508 if (!NILP (backup_n))
509 {
510 CHECK_NUMBER (backup_n);
511 /* Convert to distance from end of input. */
512 if (XINT (backup_n) < 1)
513 /* A number too small means the beginning of the string. */
514 pos = - SCHARS (initial);
515 else
516 pos = XINT (backup_n) - 1 - SCHARS (initial);
517 }
518 }
519 else
520 CHECK_STRING (initial);
521 }
522 val = Qnil;
523 ambient_dir = current_buffer->directory;
524 input_method = Qnil;
525 enable_multibyte = Qnil;
526
527 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
528 store them away before we can GC. Don't need to protect
529 BACKUP_N because we use the value only if it is an integer. */
530 GCPRO5 (map, initial, val, ambient_dir, input_method);
531
532 if (!STRINGP (prompt))
533 prompt = empty_unibyte_string;
534
535 if (!enable_recursive_minibuffers
536 && minibuf_level > 0)
537 {
538 if (EQ (selected_window, minibuf_window))
539 error ("Command attempted to use minibuffer while in minibuffer");
540 else
541 /* If we're in another window, cancel the minibuffer that's active. */
542 Fthrow (Qexit,
543 build_string ("Command attempted to use minibuffer while in minibuffer"));
544 }
545
546 if (noninteractive && NILP (Vexecuting_kbd_macro))
547 {
548 val = read_minibuf_noninteractive (map, initial, prompt,
549 make_number (pos),
550 expflag, histvar, histpos, defalt,
551 allow_props, inherit_input_method);
552 UNGCPRO;
553 return unbind_to (count, val);
554 }
555
556 /* Choose the minibuffer window and frame, and take action on them. */
557
558 choose_minibuf_frame ();
559
560 record_unwind_protect (choose_minibuf_frame_1, Qnil);
561
562 record_unwind_protect (Fset_window_configuration,
563 Fcurrent_window_configuration (Qnil));
564
565 /* If the minibuffer window is on a different frame, save that
566 frame's configuration too. */
567 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
568 if (!EQ (mini_frame, selected_frame))
569 record_unwind_protect (Fset_window_configuration,
570 Fcurrent_window_configuration (mini_frame));
571
572 /* If the minibuffer is on an iconified or invisible frame,
573 make it visible now. */
574 Fmake_frame_visible (mini_frame);
575
576 if (minibuffer_auto_raise)
577 Fraise_frame (mini_frame);
578
579 temporarily_switch_to_single_kboard (XFRAME (mini_frame));
580
581 /* We have to do this after saving the window configuration
582 since that is what restores the current buffer. */
583
584 /* Arrange to restore a number of minibuffer-related variables.
585 We could bind each variable separately, but that would use lots of
586 specpdl slots. */
587 minibuf_save_list
588 = Fcons (Voverriding_local_map,
589 Fcons (minibuf_window,
590 minibuf_save_list));
591 minibuf_save_list
592 = Fcons (minibuf_prompt,
593 Fcons (make_number (minibuf_prompt_width),
594 Fcons (Vhelp_form,
595 Fcons (Vcurrent_prefix_arg,
596 Fcons (Vminibuffer_history_position,
597 Fcons (Vminibuffer_history_variable,
598 minibuf_save_list))))));
599
600 record_unwind_protect (read_minibuf_unwind, Qnil);
601 minibuf_level++;
602 /* We are exiting the minibuffer one way or the other, so run the hook.
603 It should be run before unwinding the minibuf settings. Do it
604 separately from read_minibuf_unwind because we need to make sure that
605 read_minibuf_unwind is fully executed even if exit-minibuffer-hook
606 signals an error. --Stef */
607 record_unwind_protect (run_exit_minibuf_hook, Qnil);
608
609 /* Now that we can restore all those variables, start changing them. */
610
611 minibuf_prompt_width = 0;
612 minibuf_prompt = Fcopy_sequence (prompt);
613 Vminibuffer_history_position = histpos;
614 Vminibuffer_history_variable = histvar;
615 Vhelp_form = Vminibuffer_help_form;
616 /* If this minibuffer is reading a file name, that doesn't mean
617 recursive ones are. But we cannot set it to nil, because
618 completion code still need to know the minibuffer is completing a
619 file name. So use `lambda' as intermediate value meaning
620 "t" in this minibuffer, but "nil" in next minibuffer. */
621 if (!NILP (Vminibuffer_completing_file_name))
622 Vminibuffer_completing_file_name = Qlambda;
623
624 if (inherit_input_method)
625 {
626 /* `current-input-method' is buffer local. So, remember it in
627 INPUT_METHOD before changing the current buffer. */
628 input_method = Fsymbol_value (Qcurrent_input_method);
629 enable_multibyte = current_buffer->enable_multibyte_characters;
630 }
631
632 /* Switch to the minibuffer. */
633
634 minibuffer = get_minibuffer (minibuf_level);
635 Fset_buffer (minibuffer);
636
637 /* If appropriate, copy enable-multibyte-characters into the minibuffer. */
638 if (inherit_input_method)
639 current_buffer->enable_multibyte_characters = enable_multibyte;
640
641 /* The current buffer's default directory is usually the right thing
642 for our minibuffer here. However, if you're typing a command at
643 a minibuffer-only frame when minibuf_level is zero, then buf IS
644 the current_buffer, so reset_buffer leaves buf's default
645 directory unchanged. This is a bummer when you've just started
646 up Emacs and buf's default directory is Qnil. Here's a hack; can
647 you think of something better to do? Find another buffer with a
648 better directory, and use that one instead. */
649 if (STRINGP (ambient_dir))
650 current_buffer->directory = ambient_dir;
651 else
652 {
653 Lisp_Object buf_list;
654
655 for (buf_list = Vbuffer_alist;
656 CONSP (buf_list);
657 buf_list = XCDR (buf_list))
658 {
659 Lisp_Object other_buf;
660
661 other_buf = XCDR (XCAR (buf_list));
662 if (STRINGP (XBUFFER (other_buf)->directory))
663 {
664 current_buffer->directory = XBUFFER (other_buf)->directory;
665 break;
666 }
667 }
668 }
669
670 if (!EQ (mini_frame, selected_frame))
671 Fredirect_frame_focus (selected_frame, mini_frame);
672
673 Vminibuf_scroll_window = selected_window;
674 if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
675 minibuf_selected_window = selected_window;
676
677 /* Empty out the minibuffers of all frames other than the one
678 where we are going to display one now.
679 Set them to point to ` *Minibuf-0*', which is always empty. */
680 empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*"));
681
682 FOR_EACH_FRAME (dummy, frame)
683 {
684 Lisp_Object root_window = Fframe_root_window (frame);
685 Lisp_Object mini_window = XWINDOW (root_window)->next;
686
687 if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
688 && !NILP (Fwindow_minibuffer_p (mini_window)))
689 Fset_window_buffer (mini_window, empty_minibuf, Qnil);
690 }
691
692 /* Display this minibuffer in the proper window. */
693 Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
694 Fselect_window (minibuf_window, Qnil);
695 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
696
697 Fmake_local_variable (Qprint_escape_newlines);
698 print_escape_newlines = 1;
699
700 /* Erase the buffer. */
701 {
702 int count1 = SPECPDL_INDEX ();
703 specbind (Qinhibit_read_only, Qt);
704 specbind (Qinhibit_modification_hooks, Qt);
705 Ferase_buffer ();
706
707 if (!NILP (current_buffer->enable_multibyte_characters)
708 && ! STRING_MULTIBYTE (minibuf_prompt))
709 minibuf_prompt = Fstring_make_multibyte (minibuf_prompt);
710
711 /* Insert the prompt, record where it ends. */
712 Finsert (1, &minibuf_prompt);
713 if (PT > BEG)
714 {
715 Fput_text_property (make_number (BEG), make_number (PT),
716 Qfront_sticky, Qt, Qnil);
717 Fput_text_property (make_number (BEG), make_number (PT),
718 Qrear_nonsticky, Qt, Qnil);
719 Fput_text_property (make_number (BEG), make_number (PT),
720 Qfield, Qt, Qnil);
721 Fadd_text_properties (make_number (BEG), make_number (PT),
722 Vminibuffer_prompt_properties, Qnil);
723 }
724 unbind_to (count1, Qnil);
725 }
726
727 minibuf_prompt_width = (int) current_column (); /* iftc */
728
729 /* Put in the initial input. */
730 if (!NILP (initial))
731 {
732 Finsert (1, &initial);
733 Fforward_char (make_number (pos));
734 }
735
736 clear_message (1, 1);
737 current_buffer->keymap = map;
738
739 /* Turn on an input method stored in INPUT_METHOD if any. */
740 if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
741 call1 (Qactivate_input_method, input_method);
742
743 /* Run our hook, but not if it is empty.
744 (run-hooks would do nothing if it is empty,
745 but it's important to save time here in the usual case.) */
746 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
747 && !NILP (Vrun_hooks))
748 call1 (Vrun_hooks, Qminibuffer_setup_hook);
749
750 /* Don't allow the user to undo past this point. */
751 current_buffer->undo_list = Qnil;
752
753 recursive_edit_1 ();
754
755 /* If cursor is on the minibuffer line,
756 show the user we have exited by putting it in column 0. */
757 if (XWINDOW (minibuf_window)->cursor.vpos >= 0
758 && !noninteractive)
759 {
760 XWINDOW (minibuf_window)->cursor.hpos = 0;
761 XWINDOW (minibuf_window)->cursor.x = 0;
762 XWINDOW (minibuf_window)->must_be_updated_p = 1;
763 update_frame (XFRAME (selected_frame), 1, 1);
764 {
765 struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame);
766 struct redisplay_interface *rif = FRAME_RIF (f);
767 if (rif && rif->flush_display)
768 rif->flush_display (f);
769 }
770 }
771
772 /* Make minibuffer contents into a string. */
773 Fset_buffer (minibuffer);
774 if (allow_props)
775 val = Fminibuffer_contents ();
776 else
777 val = Fminibuffer_contents_no_properties ();
778
779 /* VAL is the string of minibuffer text. */
780
781 last_minibuf_string = val;
782
783 /* Choose the string to add to the history. */
784 if (SCHARS (val) != 0)
785 histstring = val;
786 else if (STRINGP (defalt))
787 histstring = defalt;
788 else
789 histstring = Qnil;
790
791 /* Add the value to the appropriate history list, if any. */
792 if (!NILP (Vhistory_add_new_input)
793 && SYMBOLP (Vminibuffer_history_variable)
794 && !NILP (histstring))
795 {
796 /* If the caller wanted to save the value read on a history list,
797 then do so if the value is not already the front of the list. */
798 Lisp_Object histval;
799
800 /* If variable is unbound, make it nil. */
801 if (EQ (SYMBOL_VALUE (Vminibuffer_history_variable), Qunbound))
802 Fset (Vminibuffer_history_variable, Qnil);
803
804 histval = Fsymbol_value (Vminibuffer_history_variable);
805
806 /* The value of the history variable must be a cons or nil. Other
807 values are unacceptable. We silently ignore these values. */
808
809 if (NILP (histval)
810 || (CONSP (histval)
811 /* Don't duplicate the most recent entry in the history. */
812 && (NILP (Fequal (histstring, Fcar (histval))))))
813 {
814 Lisp_Object length;
815
816 if (history_delete_duplicates) Fdelete (histstring, histval);
817 histval = Fcons (histstring, histval);
818 Fset (Vminibuffer_history_variable, histval);
819
820 /* Truncate if requested. */
821 length = Fget (Vminibuffer_history_variable, Qhistory_length);
822 if (NILP (length)) length = Vhistory_length;
823 if (INTEGERP (length))
824 {
825 if (XINT (length) <= 0)
826 Fset (Vminibuffer_history_variable, Qnil);
827 else
828 {
829 Lisp_Object temp;
830
831 temp = Fnthcdr (Fsub1 (length), histval);
832 if (CONSP (temp)) Fsetcdr (temp, Qnil);
833 }
834 }
835 }
836 }
837
838 /* If Lisp form desired instead of string, parse it. */
839 if (expflag)
840 val = string_to_object (val, defalt);
841
842 /* The appropriate frame will get selected
843 in set-window-configuration. */
844 UNGCPRO;
845 return unbind_to (count, val);
846 }
847
848 /* Return a buffer to be used as the minibuffer at depth `depth'.
849 depth = 0 is the lowest allowed argument, and that is the value
850 used for nonrecursive minibuffer invocations */
851
852 Lisp_Object
853 get_minibuffer (depth)
854 int depth;
855 {
856 Lisp_Object tail, num, buf;
857 char name[24];
858 extern Lisp_Object nconc2 ();
859
860 XSETFASTINT (num, depth);
861 tail = Fnthcdr (num, Vminibuffer_list);
862 if (NILP (tail))
863 {
864 tail = Fcons (Qnil, Qnil);
865 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
866 }
867 buf = Fcar (tail);
868 if (NILP (buf) || NILP (XBUFFER (buf)->name))
869 {
870 sprintf (name, " *Minibuf-%d*", depth);
871 buf = Fget_buffer_create (build_string (name));
872
873 /* Although the buffer's name starts with a space, undo should be
874 enabled in it. */
875 Fbuffer_enable_undo (buf);
876
877 XSETCAR (tail, buf);
878 }
879 else
880 {
881 int count = SPECPDL_INDEX ();
882 /* `reset_buffer' blindly sets the list of overlays to NULL, so we
883 have to empty the list, otherwise we end up with overlays that
884 think they belong to this buffer while the buffer doesn't know about
885 them any more. */
886 delete_all_overlays (XBUFFER (buf));
887 reset_buffer (XBUFFER (buf));
888 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
889 Fset_buffer (buf);
890 Fkill_all_local_variables ();
891 unbind_to (count, Qnil);
892 }
893
894 return buf;
895 }
896
897 static Lisp_Object
898 run_exit_minibuf_hook (data)
899 Lisp_Object data;
900 {
901 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
902 && !NILP (Vrun_hooks))
903 safe_run_hooks (Qminibuffer_exit_hook);
904
905 return Qnil;
906 }
907
908 /* This function is called on exiting minibuffer, whether normally or
909 not, and it restores the current window, buffer, etc. */
910
911 static Lisp_Object
912 read_minibuf_unwind (data)
913 Lisp_Object data;
914 {
915 Lisp_Object old_deactivate_mark;
916 Lisp_Object window;
917
918 /* If this was a recursive minibuffer,
919 tie the minibuffer window back to the outer level minibuffer buffer. */
920 minibuf_level--;
921
922 window = minibuf_window;
923 /* To keep things predictable, in case it matters, let's be in the
924 minibuffer when we reset the relevant variables. */
925 Fset_buffer (XWINDOW (window)->buffer);
926
927 /* Restore prompt, etc, from outer minibuffer level. */
928 minibuf_prompt = Fcar (minibuf_save_list);
929 minibuf_save_list = Fcdr (minibuf_save_list);
930 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
931 minibuf_save_list = Fcdr (minibuf_save_list);
932 Vhelp_form = Fcar (minibuf_save_list);
933 minibuf_save_list = Fcdr (minibuf_save_list);
934 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
935 minibuf_save_list = Fcdr (minibuf_save_list);
936 Vminibuffer_history_position = Fcar (minibuf_save_list);
937 minibuf_save_list = Fcdr (minibuf_save_list);
938 Vminibuffer_history_variable = Fcar (minibuf_save_list);
939 minibuf_save_list = Fcdr (minibuf_save_list);
940 Voverriding_local_map = Fcar (minibuf_save_list);
941 minibuf_save_list = Fcdr (minibuf_save_list);
942 #if 0
943 temp = Fcar (minibuf_save_list);
944 if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
945 minibuf_window = temp;
946 #endif
947 minibuf_save_list = Fcdr (minibuf_save_list);
948
949 /* Erase the minibuffer we were using at this level. */
950 {
951 int count = SPECPDL_INDEX ();
952 /* Prevent error in erase-buffer. */
953 specbind (Qinhibit_read_only, Qt);
954 specbind (Qinhibit_modification_hooks, Qt);
955 old_deactivate_mark = Vdeactivate_mark;
956 Ferase_buffer ();
957 Vdeactivate_mark = old_deactivate_mark;
958 unbind_to (count, Qnil);
959 }
960
961 /* When we get to the outmost level, make sure we resize the
962 mini-window back to its normal size. */
963 if (minibuf_level == 0)
964 resize_mini_window (XWINDOW (window), 0);
965
966 /* Make sure minibuffer window is erased, not ignored. */
967 windows_or_buffers_changed++;
968 XSETFASTINT (XWINDOW (window)->last_modified, 0);
969 XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
970 return Qnil;
971 }
972 \f
973
974 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 7, 0,
975 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
976 The optional second arg INITIAL-CONTENTS is an obsolete alternative to
977 DEFAULT-VALUE. It normally should be nil in new code, except when
978 HIST is a cons. It is discussed in more detail below.
979 Third arg KEYMAP is a keymap to use whilst reading;
980 if omitted or nil, the default is `minibuffer-local-map'.
981 If fourth arg READ is non-nil, then interpret the result as a Lisp object
982 and return that object:
983 in other words, do `(car (read-from-string INPUT-STRING))'
984 Fifth arg HIST, if non-nil, specifies a history list and optionally
985 the initial position in the list. It can be a symbol, which is the
986 history list variable to use, or it can be a cons cell
987 (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable
988 to use, and HISTPOS is the initial position for use by the minibuffer
989 history commands. For consistency, you should also specify that
990 element of the history as the value of INITIAL-CONTENTS. Positions
991 are counted starting from 1 at the beginning of the list.
992 Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is available
993 for history commands; but, unless READ is non-nil, `read-from-minibuffer'
994 does NOT return DEFAULT-VALUE if the user enters empty input! It returns
995 the empty string.
996 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
997 the current input method and the setting of `enable-multibyte-characters'.
998 If the variable `minibuffer-allow-text-properties' is non-nil,
999 then the string which is returned includes whatever text properties
1000 were present in the minibuffer. Otherwise the value has no text properties.
1001
1002 The remainder of this documentation string describes the
1003 INITIAL-CONTENTS argument in more detail. It is only relevant when
1004 studying existing code, or when HIST is a cons. If non-nil,
1005 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
1006 reading input. Normally, point is put at the end of that string.
1007 However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial
1008 input is STRING, but point is placed at _one-indexed_ position
1009 POSITION in the minibuffer. Any integer value less than or equal to
1010 one puts point at the beginning of the string. *Note* that this
1011 behavior differs from the way such arguments are used in `completing-read'
1012 and some related functions, which use zero-indexing for POSITION. */)
1013 (prompt, initial_contents, keymap, read, hist, default_value, inherit_input_method)
1014 Lisp_Object prompt, initial_contents, keymap, read, hist, default_value;
1015 Lisp_Object inherit_input_method;
1016 {
1017 Lisp_Object histvar, histpos, val;
1018 struct gcpro gcpro1;
1019
1020 CHECK_STRING (prompt);
1021 if (NILP (keymap))
1022 keymap = Vminibuffer_local_map;
1023 else
1024 keymap = get_keymap (keymap, 1, 0);
1025
1026 if (SYMBOLP (hist))
1027 {
1028 histvar = hist;
1029 histpos = Qnil;
1030 }
1031 else
1032 {
1033 histvar = Fcar_safe (hist);
1034 histpos = Fcdr_safe (hist);
1035 }
1036 if (NILP (histvar))
1037 histvar = Qminibuffer_history;
1038 if (NILP (histpos))
1039 XSETFASTINT (histpos, 0);
1040
1041 GCPRO1 (default_value);
1042 val = read_minibuf (keymap, initial_contents, prompt,
1043 Qnil, !NILP (read),
1044 histvar, histpos, default_value,
1045 minibuffer_allow_text_properties,
1046 !NILP (inherit_input_method));
1047 UNGCPRO;
1048 return val;
1049 }
1050
1051 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
1052 doc: /* Return a Lisp object read using the minibuffer, unevaluated.
1053 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1054 is a string to insert in the minibuffer before reading.
1055 \(INITIAL-CONTENTS can also be a cons of a string and an integer. Such
1056 arguments are used as in `read-from-minibuffer'.) */)
1057 (prompt, initial_contents)
1058 Lisp_Object prompt, initial_contents;
1059 {
1060 CHECK_STRING (prompt);
1061 return read_minibuf (Vminibuffer_local_map, initial_contents,
1062 prompt, Qnil, 1, Qminibuffer_history,
1063 make_number (0), Qnil, 0, 0);
1064 }
1065
1066 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
1067 doc: /* Return value of Lisp expression read using the minibuffer.
1068 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1069 is a string to insert in the minibuffer before reading.
1070 \(INITIAL-CONTENTS can also be a cons of a string and an integer. Such
1071 arguments are used as in `read-from-minibuffer'.) */)
1072 (prompt, initial_contents)
1073 Lisp_Object prompt, initial_contents;
1074 {
1075 return Feval (read_minibuf (Vread_expression_map, initial_contents,
1076 prompt, Qnil, 1, Qread_expression_history,
1077 make_number (0), Qnil, 0, 0));
1078 }
1079
1080 /* Functions that use the minibuffer to read various things. */
1081
1082 DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
1083 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
1084 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
1085 This argument has been superseded by DEFAULT-VALUE and should normally
1086 be nil in new code. It behaves as in `read-from-minibuffer'. See the
1087 documentation string of that function for details.
1088 The third arg HISTORY, if non-nil, specifies a history list
1089 and optionally the initial position in the list.
1090 See `read-from-minibuffer' for details of HISTORY argument.
1091 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1092 for history commands, and as the value to return if the user enters
1093 the empty string.
1094 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1095 the current input method and the setting of `enable-multibyte-characters'. */)
1096 (prompt, initial_input, history, default_value, inherit_input_method)
1097 Lisp_Object prompt, initial_input, history, default_value;
1098 Lisp_Object inherit_input_method;
1099 {
1100 Lisp_Object val;
1101 val = Fread_from_minibuffer (prompt, initial_input, Qnil,
1102 Qnil, history, default_value,
1103 inherit_input_method);
1104 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
1105 val = default_value;
1106 return val;
1107 }
1108
1109 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
1110 doc: /* Read a string from the terminal, not allowing blanks.
1111 Prompt with PROMPT. Whitespace terminates the input. If INITIAL is
1112 non-nil, it should be a string, which is used as initial input, with
1113 point positioned at the end, so that SPACE will accept the input.
1114 \(Actually, INITIAL can also be a cons of a string and an integer.
1115 Such values are treated as in `read-from-minibuffer', but are normally
1116 not useful in this function.)
1117 Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1118 the current input method and the setting of`enable-multibyte-characters'. */)
1119 (prompt, initial, inherit_input_method)
1120 Lisp_Object prompt, initial, inherit_input_method;
1121 {
1122 CHECK_STRING (prompt);
1123 return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
1124 0, Qminibuffer_history, make_number (0), Qnil, 0,
1125 !NILP (inherit_input_method));
1126 }
1127
1128 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
1129 doc: /* Read the name of a command and return as a symbol.
1130 Prompt with PROMPT. By default, return DEFAULT-VALUE. */)
1131 (prompt, default_value)
1132 Lisp_Object prompt, default_value;
1133 {
1134 Lisp_Object name, default_string;
1135
1136 if (NILP (default_value))
1137 default_string = Qnil;
1138 else if (SYMBOLP (default_value))
1139 default_string = SYMBOL_NAME (default_value);
1140 else
1141 default_string = default_value;
1142
1143 name = Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
1144 Qnil, Qnil, default_string, Qnil);
1145 if (NILP (name))
1146 return name;
1147 return Fintern (name, Qnil);
1148 }
1149
1150 #ifdef NOTDEF
1151 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
1152 doc: /* One arg PROMPT, a string. Read the name of a function and return as a symbol.
1153 Prompt with PROMPT. */)
1154 (prompt)
1155 Lisp_Object prompt;
1156 {
1157 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil, Qnil),
1158 Qnil);
1159 }
1160 #endif /* NOTDEF */
1161
1162 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
1163 doc: /* Read the name of a user variable and return it as a symbol.
1164 Prompt with PROMPT. By default, return DEFAULT-VALUE.
1165 A user variable is one for which `user-variable-p' returns non-nil. */)
1166 (prompt, default_value)
1167 Lisp_Object prompt, default_value;
1168 {
1169 Lisp_Object name, default_string;
1170
1171 if (NILP (default_value))
1172 default_string = Qnil;
1173 else if (SYMBOLP (default_value))
1174 default_string = SYMBOL_NAME (default_value);
1175 else
1176 default_string = default_value;
1177
1178 name = Fcompleting_read (prompt, Vobarray,
1179 Quser_variable_p, Qt,
1180 Qnil, Qnil, default_string, Qnil);
1181 if (NILP (name))
1182 return name;
1183 return Fintern (name, Qnil);
1184 }
1185
1186 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
1187 doc: /* Read the name of a buffer and return as a string.
1188 Prompt with PROMPT.
1189 Optional second arg DEF is value to return if user enters an empty line.
1190 If optional third arg REQUIRE-MATCH is non-nil,
1191 only existing buffer names are allowed.
1192 The argument PROMPT should be a string ending with a colon and a space. */)
1193 (prompt, def, require_match)
1194 Lisp_Object prompt, def, require_match;
1195 {
1196 Lisp_Object args[4];
1197 unsigned char *s;
1198 int len;
1199
1200 if (BUFFERP (def))
1201 def = XBUFFER (def)->name;
1202
1203 if (NILP (Vread_buffer_function))
1204 {
1205 if (!NILP (def))
1206 {
1207 /* A default value was provided: we must change PROMPT,
1208 editing the default value in before the colon. To achieve
1209 this, we replace PROMPT with a substring that doesn't
1210 contain the terminal space and colon (if present). They
1211 are then added back using Fformat. */
1212
1213 if (STRINGP (prompt))
1214 {
1215 s = SDATA (prompt);
1216 len = strlen (s);
1217 if (len >= 2 && s[len - 2] == ':' && s[len - 1] == ' ')
1218 len = len - 2;
1219 else if (len >= 1 && (s[len - 1] == ':' || s[len - 1] == ' '))
1220 len--;
1221
1222 prompt = make_specified_string (s, -1, len,
1223 STRING_MULTIBYTE (prompt));
1224 }
1225
1226 args[0] = build_string ("%s (default %s): ");
1227 args[1] = prompt;
1228 args[2] = def;
1229 prompt = Fformat (3, args);
1230 }
1231
1232 return Fcompleting_read (prompt, intern ("internal-complete-buffer"),
1233 Qnil, require_match, Qnil, Qbuffer_name_history,
1234 def, Qnil);
1235 }
1236 else
1237 {
1238 args[0] = Vread_buffer_function;
1239 args[1] = prompt;
1240 args[2] = def;
1241 args[3] = require_match;
1242 return Ffuncall(4, args);
1243 }
1244 }
1245 \f
1246 static Lisp_Object
1247 minibuf_conform_representation (string, basis)
1248 Lisp_Object string, basis;
1249 {
1250 if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis))
1251 return string;
1252
1253 if (STRING_MULTIBYTE (string))
1254 return Fstring_make_unibyte (string);
1255 else
1256 return Fstring_make_multibyte (string);
1257 }
1258
1259 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
1260 doc: /* Return common substring of all completions of STRING in COLLECTION.
1261 Test each possible completion specified by COLLECTION
1262 to see if it begins with STRING. The possible completions may be
1263 strings or symbols. Symbols are converted to strings before testing,
1264 see `symbol-name'.
1265 All that match STRING are compared together; the longest initial sequence
1266 common to all these matches is the return value.
1267 If there is no match at all, the return value is nil.
1268 For a unique match which is exact, the return value is t.
1269
1270 If COLLECTION is an alist, the keys (cars of elements) are the
1271 possible completions. If an element is not a cons cell, then the
1272 element itself is the possible completion.
1273 If COLLECTION is a hash-table, all the keys that are strings or symbols
1274 are the possible completions.
1275 If COLLECTION is an obarray, the names of all symbols in the obarray
1276 are the possible completions.
1277
1278 COLLECTION can also be a function to do the completion itself.
1279 It receives three arguments: the values STRING, PREDICATE and nil.
1280 Whatever it returns becomes the value of `try-completion'.
1281
1282 If optional third argument PREDICATE is non-nil,
1283 it is used to test each possible match.
1284 The match is a candidate only if PREDICATE returns non-nil.
1285 The argument given to PREDICATE is the alist element
1286 or the symbol from the obarray. If COLLECTION is a hash-table,
1287 predicate is called with two arguments: the key and the value.
1288 Additionally to this predicate, `completion-regexp-list'
1289 is used to further constrain the set of candidates. */)
1290 (string, collection, predicate)
1291 Lisp_Object string, collection, predicate;
1292 {
1293 Lisp_Object bestmatch, tail, elt, eltstring;
1294 /* Size in bytes of BESTMATCH. */
1295 int bestmatchsize = 0;
1296 /* These are in bytes, too. */
1297 int compare, matchsize;
1298 enum { function_table, list_table, obarray_table, hash_table}
1299 type = (HASH_TABLE_P (collection) ? hash_table
1300 : VECTORP (collection) ? obarray_table
1301 : ((NILP (collection)
1302 || (CONSP (collection)
1303 && (!SYMBOLP (XCAR (collection))
1304 || NILP (XCAR (collection)))))
1305 ? list_table : function_table));
1306 int index = 0, obsize = 0;
1307 int matchcount = 0;
1308 int bindcount = -1;
1309 Lisp_Object bucket, zero, end, tem;
1310 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1311
1312 CHECK_STRING (string);
1313 if (type == function_table)
1314 return call3 (collection, string, predicate, Qnil);
1315
1316 bestmatch = bucket = Qnil;
1317 zero = make_number (0);
1318
1319 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1320 tail = collection;
1321 if (type == obarray_table)
1322 {
1323 collection = check_obarray (collection);
1324 obsize = XVECTOR (collection)->size;
1325 bucket = XVECTOR (collection)->contents[index];
1326 }
1327
1328 while (1)
1329 {
1330 /* Get the next element of the alist, obarray, or hash-table. */
1331 /* Exit the loop if the elements are all used up. */
1332 /* elt gets the alist element or symbol.
1333 eltstring gets the name to check as a completion. */
1334
1335 if (type == list_table)
1336 {
1337 if (!CONSP (tail))
1338 break;
1339 elt = XCAR (tail);
1340 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1341 tail = XCDR (tail);
1342 }
1343 else if (type == obarray_table)
1344 {
1345 if (!EQ (bucket, zero))
1346 {
1347 if (!SYMBOLP (bucket))
1348 error ("Bad data in guts of obarray");
1349 elt = bucket;
1350 eltstring = elt;
1351 if (XSYMBOL (bucket)->next)
1352 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1353 else
1354 XSETFASTINT (bucket, 0);
1355 }
1356 else if (++index >= obsize)
1357 break;
1358 else
1359 {
1360 bucket = XVECTOR (collection)->contents[index];
1361 continue;
1362 }
1363 }
1364 else /* if (type == hash_table) */
1365 {
1366 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1367 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1368 index++;
1369 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1370 break;
1371 else
1372 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
1373 }
1374
1375 /* Is this element a possible completion? */
1376
1377 if (SYMBOLP (eltstring))
1378 eltstring = Fsymbol_name (eltstring);
1379
1380 if (STRINGP (eltstring)
1381 && SCHARS (string) <= SCHARS (eltstring)
1382 && (tem = Fcompare_strings (eltstring, zero,
1383 make_number (SCHARS (string)),
1384 string, zero, Qnil,
1385 completion_ignore_case ? Qt : Qnil),
1386 EQ (Qt, tem)))
1387 {
1388 /* Yes. */
1389 Lisp_Object regexps;
1390
1391 /* Ignore this element if it fails to match all the regexps. */
1392 {
1393 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1394 regexps = XCDR (regexps))
1395 {
1396 if (bindcount < 0) {
1397 bindcount = SPECPDL_INDEX ();
1398 specbind (Qcase_fold_search,
1399 completion_ignore_case ? Qt : Qnil);
1400 }
1401 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1402 if (NILP (tem))
1403 break;
1404 }
1405 if (CONSP (regexps))
1406 continue;
1407 }
1408
1409 /* Ignore this element if there is a predicate
1410 and the predicate doesn't like it. */
1411
1412 if (!NILP (predicate))
1413 {
1414 if (EQ (predicate, Qcommandp))
1415 tem = Fcommandp (elt, Qnil);
1416 else
1417 {
1418 if (bindcount >= 0)
1419 {
1420 unbind_to (bindcount, Qnil);
1421 bindcount = -1;
1422 }
1423 GCPRO4 (tail, string, eltstring, bestmatch);
1424 tem = (type == hash_table
1425 ? call2 (predicate, elt,
1426 HASH_VALUE (XHASH_TABLE (collection),
1427 index - 1))
1428 : call1 (predicate, elt));
1429 UNGCPRO;
1430 }
1431 if (NILP (tem)) continue;
1432 }
1433
1434 /* Update computation of how much all possible completions match */
1435
1436 if (NILP (bestmatch))
1437 {
1438 matchcount = 1;
1439 bestmatch = eltstring;
1440 bestmatchsize = SCHARS (eltstring);
1441 }
1442 else
1443 {
1444 compare = min (bestmatchsize, SCHARS (eltstring));
1445 tem = Fcompare_strings (bestmatch, zero,
1446 make_number (compare),
1447 eltstring, zero,
1448 make_number (compare),
1449 completion_ignore_case ? Qt : Qnil);
1450 if (EQ (tem, Qt))
1451 matchsize = compare;
1452 else if (XINT (tem) < 0)
1453 matchsize = - XINT (tem) - 1;
1454 else
1455 matchsize = XINT (tem) - 1;
1456
1457 if (matchsize < 0)
1458 /* When can this happen ? -stef */
1459 matchsize = compare;
1460 if (completion_ignore_case)
1461 {
1462 /* If this is an exact match except for case,
1463 use it as the best match rather than one that is not an
1464 exact match. This way, we get the case pattern
1465 of the actual match. */
1466 if ((matchsize == SCHARS (eltstring)
1467 && matchsize < SCHARS (bestmatch))
1468 ||
1469 /* If there is more than one exact match ignoring case,
1470 and one of them is exact including case,
1471 prefer that one. */
1472 /* If there is no exact match ignoring case,
1473 prefer a match that does not change the case
1474 of the input. */
1475 ((matchsize == SCHARS (eltstring))
1476 ==
1477 (matchsize == SCHARS (bestmatch))
1478 && (tem = Fcompare_strings (eltstring, zero,
1479 make_number (SCHARS (string)),
1480 string, zero,
1481 Qnil,
1482 Qnil),
1483 EQ (Qt, tem))
1484 && (tem = Fcompare_strings (bestmatch, zero,
1485 make_number (SCHARS (string)),
1486 string, zero,
1487 Qnil,
1488 Qnil),
1489 ! EQ (Qt, tem))))
1490 bestmatch = eltstring;
1491 }
1492 if (bestmatchsize != SCHARS (eltstring)
1493 || bestmatchsize != matchsize)
1494 /* Don't count the same string multiple times. */
1495 matchcount++;
1496 bestmatchsize = matchsize;
1497 if (matchsize <= SCHARS (string)
1498 /* If completion-ignore-case is non-nil, don't
1499 short-circuit because we want to find the best
1500 possible match *including* case differences. */
1501 && !completion_ignore_case
1502 && matchcount > 1)
1503 /* No need to look any further. */
1504 break;
1505 }
1506 }
1507 }
1508
1509 if (bindcount >= 0) {
1510 unbind_to (bindcount, Qnil);
1511 bindcount = -1;
1512 }
1513
1514 if (NILP (bestmatch))
1515 return Qnil; /* No completions found */
1516 /* If we are ignoring case, and there is no exact match,
1517 and no additional text was supplied,
1518 don't change the case of what the user typed. */
1519 if (completion_ignore_case && bestmatchsize == SCHARS (string)
1520 && SCHARS (bestmatch) > bestmatchsize)
1521 return minibuf_conform_representation (string, bestmatch);
1522
1523 /* Return t if the supplied string is an exact match (counting case);
1524 it does not require any change to be made. */
1525 if (matchcount == 1 && bestmatchsize == SCHARS (string)
1526 && (tem = Fcompare_strings (bestmatch, make_number (0),
1527 make_number (bestmatchsize),
1528 string, make_number (0),
1529 make_number (bestmatchsize),
1530 Qnil),
1531 EQ (Qt, tem)))
1532 return Qt;
1533
1534 XSETFASTINT (zero, 0); /* Else extract the part in which */
1535 XSETFASTINT (end, bestmatchsize); /* all completions agree */
1536 return Fsubstring (bestmatch, zero, end);
1537 }
1538 \f
1539 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
1540 doc: /* Search for partial matches to STRING in COLLECTION.
1541 Test each of the possible completions specified by COLLECTION
1542 to see if it begins with STRING. The possible completions may be
1543 strings or symbols. Symbols are converted to strings before testing,
1544 see `symbol-name'.
1545 The value is a list of all the possible completions that match STRING.
1546
1547 If COLLECTION is an alist, the keys (cars of elements) are the
1548 possible completions. If an element is not a cons cell, then the
1549 element itself is the possible completion.
1550 If COLLECTION is a hash-table, all the keys that are strings or symbols
1551 are the possible completions.
1552 If COLLECTION is an obarray, the names of all symbols in the obarray
1553 are the possible completions.
1554
1555 COLLECTION can also be a function to do the completion itself.
1556 It receives three arguments: the values STRING, PREDICATE and t.
1557 Whatever it returns becomes the value of `all-completions'.
1558
1559 If optional third argument PREDICATE is non-nil,
1560 it is used to test each possible match.
1561 The match is a candidate only if PREDICATE returns non-nil.
1562 The argument given to PREDICATE is the alist element
1563 or the symbol from the obarray. If COLLECTION is a hash-table,
1564 predicate is called with two arguments: the key and the value.
1565 Additionally to this predicate, `completion-regexp-list'
1566 is used to further constrain the set of candidates.
1567
1568 If the optional fourth argument HIDE-SPACES is non-nil,
1569 strings in COLLECTION that start with a space
1570 are ignored unless STRING itself starts with a space. */)
1571 (string, collection, predicate, hide_spaces)
1572 Lisp_Object string, collection, predicate, hide_spaces;
1573 {
1574 Lisp_Object tail, elt, eltstring;
1575 Lisp_Object allmatches;
1576 int type = HASH_TABLE_P (collection) ? 3
1577 : VECTORP (collection) ? 2
1578 : NILP (collection) || (CONSP (collection)
1579 && (!SYMBOLP (XCAR (collection))
1580 || NILP (XCAR (collection))));
1581 int index = 0, obsize = 0;
1582 int bindcount = -1;
1583 Lisp_Object bucket, tem, zero;
1584 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1585
1586 CHECK_STRING (string);
1587 if (type == 0)
1588 return call3 (collection, string, predicate, Qt);
1589 allmatches = bucket = Qnil;
1590 zero = make_number (0);
1591
1592 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1593 tail = collection;
1594 if (type == 2)
1595 {
1596 obsize = XVECTOR (collection)->size;
1597 bucket = XVECTOR (collection)->contents[index];
1598 }
1599
1600 while (1)
1601 {
1602 /* Get the next element of the alist, obarray, or hash-table. */
1603 /* Exit the loop if the elements are all used up. */
1604 /* elt gets the alist element or symbol.
1605 eltstring gets the name to check as a completion. */
1606
1607 if (type == 1)
1608 {
1609 if (!CONSP (tail))
1610 break;
1611 elt = XCAR (tail);
1612 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1613 tail = XCDR (tail);
1614 }
1615 else if (type == 2)
1616 {
1617 if (!EQ (bucket, zero))
1618 {
1619 elt = bucket;
1620 eltstring = elt;
1621 if (XSYMBOL (bucket)->next)
1622 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1623 else
1624 XSETFASTINT (bucket, 0);
1625 }
1626 else if (++index >= obsize)
1627 break;
1628 else
1629 {
1630 bucket = XVECTOR (collection)->contents[index];
1631 continue;
1632 }
1633 }
1634 else /* if (type == 3) */
1635 {
1636 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1637 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1638 index++;
1639 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1640 break;
1641 else
1642 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
1643 }
1644
1645 /* Is this element a possible completion? */
1646
1647 if (SYMBOLP (eltstring))
1648 eltstring = Fsymbol_name (eltstring);
1649
1650 if (STRINGP (eltstring)
1651 && SCHARS (string) <= SCHARS (eltstring)
1652 /* If HIDE_SPACES, reject alternatives that start with space
1653 unless the input starts with space. */
1654 && ((SBYTES (string) > 0
1655 && SREF (string, 0) == ' ')
1656 || SREF (eltstring, 0) != ' '
1657 || NILP (hide_spaces))
1658 && (tem = Fcompare_strings (eltstring, zero,
1659 make_number (SCHARS (string)),
1660 string, zero,
1661 make_number (SCHARS (string)),
1662 completion_ignore_case ? Qt : Qnil),
1663 EQ (Qt, tem)))
1664 {
1665 /* Yes. */
1666 Lisp_Object regexps;
1667 Lisp_Object zero;
1668 XSETFASTINT (zero, 0);
1669
1670 /* Ignore this element if it fails to match all the regexps. */
1671 {
1672 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1673 regexps = XCDR (regexps))
1674 {
1675 if (bindcount < 0) {
1676 bindcount = SPECPDL_INDEX ();
1677 specbind (Qcase_fold_search,
1678 completion_ignore_case ? Qt : Qnil);
1679 }
1680 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1681 if (NILP (tem))
1682 break;
1683 }
1684 if (CONSP (regexps))
1685 continue;
1686 }
1687
1688 /* Ignore this element if there is a predicate
1689 and the predicate doesn't like it. */
1690
1691 if (!NILP (predicate))
1692 {
1693 if (EQ (predicate, Qcommandp))
1694 tem = Fcommandp (elt, Qnil);
1695 else
1696 {
1697 if (bindcount >= 0) {
1698 unbind_to (bindcount, Qnil);
1699 bindcount = -1;
1700 }
1701 GCPRO4 (tail, eltstring, allmatches, string);
1702 tem = type == 3
1703 ? call2 (predicate, elt,
1704 HASH_VALUE (XHASH_TABLE (collection), index - 1))
1705 : call1 (predicate, elt);
1706 UNGCPRO;
1707 }
1708 if (NILP (tem)) continue;
1709 }
1710 /* Ok => put it on the list. */
1711 allmatches = Fcons (eltstring, allmatches);
1712 }
1713 }
1714
1715 if (bindcount >= 0) {
1716 unbind_to (bindcount, Qnil);
1717 bindcount = -1;
1718 }
1719
1720 return Fnreverse (allmatches);
1721 }
1722 \f
1723 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
1724 doc: /* Read a string in the minibuffer, with completion.
1725 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1726 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1727 COLLECTION can also be a function to do the completion itself.
1728 PREDICATE limits completion to a subset of COLLECTION.
1729 See `try-completion' and `all-completions' for more details
1730 on completion, COLLECTION, and PREDICATE.
1731
1732 REQUIRE-MATCH can take the following values:
1733 - t means that the user is not allowed to exit unless
1734 the input is (or completes to) an element of COLLECTION or is null.
1735 - nil means that the user can exit with any input.
1736 - `confirm-only' means that the user can exit with any input, but she will
1737 need to confirm her choice if the input is not an element of COLLECTION.
1738 - anything else behaves like t except that typing RET does not exit if it
1739 does non-null completion.
1740
1741 If the input is null, `completing-read' returns DEF, or an empty string
1742 if DEF is nil, regardless of the value of REQUIRE-MATCH.
1743
1744 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
1745 with point positioned at the end.
1746 If it is (STRING . POSITION), the initial input is STRING, but point
1747 is placed at _zero-indexed_ position POSITION in STRING. (*Note*
1748 that this is different from `read-from-minibuffer' and related
1749 functions, which use one-indexing for POSITION.) This feature is
1750 deprecated--it is best to pass nil for INITIAL-INPUT and supply the
1751 default value DEF instead. The user can yank the default value into
1752 the minibuffer easily using \\[next-history-element].
1753
1754 HIST, if non-nil, specifies a history list and optionally the initial
1755 position in the list. It can be a symbol, which is the history list
1756 variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In
1757 that case, HISTVAR is the history list variable to use, and HISTPOS
1758 is the initial position (the position in the list used by the
1759 minibuffer history commands). For consistency, you should also
1760 specify that element of the history as the value of
1761 INITIAL-INPUT. (This is the only case in which you should use
1762 INITIAL-INPUT instead of DEF.) Positions are counted starting from
1763 1 at the beginning of the list. The variable `history-length'
1764 controls the maximum length of a history list.
1765
1766 DEF, if non-nil, is the default value.
1767
1768 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits
1769 the current input method and the setting of `enable-multibyte-characters'.
1770
1771 Completion ignores case if the ambient value of
1772 `completion-ignore-case' is non-nil. */)
1773 (prompt, collection, predicate, require_match, initial_input, hist, def, inherit_input_method)
1774 Lisp_Object prompt, collection, predicate, require_match, initial_input;
1775 Lisp_Object hist, def, inherit_input_method;
1776 {
1777 Lisp_Object val, histvar, histpos, position;
1778 Lisp_Object init;
1779 int pos = 0;
1780 int count = SPECPDL_INDEX ();
1781 struct gcpro gcpro1;
1782
1783 init = initial_input;
1784 GCPRO1 (def);
1785
1786 specbind (Qminibuffer_completion_table, collection);
1787 specbind (Qminibuffer_completion_predicate, predicate);
1788 specbind (Qminibuffer_completion_confirm,
1789 EQ (require_match, Qt) ? Qnil : require_match);
1790 last_exact_completion = Qnil;
1791
1792 position = Qnil;
1793 if (!NILP (init))
1794 {
1795 if (CONSP (init))
1796 {
1797 position = Fcdr (init);
1798 init = Fcar (init);
1799 }
1800 CHECK_STRING (init);
1801 if (!NILP (position))
1802 {
1803 CHECK_NUMBER (position);
1804 /* Convert to distance from end of input. */
1805 pos = XINT (position) - SCHARS (init);
1806 }
1807 }
1808
1809 if (SYMBOLP (hist))
1810 {
1811 histvar = hist;
1812 histpos = Qnil;
1813 }
1814 else
1815 {
1816 histvar = Fcar_safe (hist);
1817 histpos = Fcdr_safe (hist);
1818 }
1819 if (NILP (histvar))
1820 histvar = Qminibuffer_history;
1821 if (NILP (histpos))
1822 XSETFASTINT (histpos, 0);
1823
1824 val = read_minibuf (NILP (require_match)
1825 ? (NILP (Vminibuffer_completing_file_name)
1826 || EQ (Vminibuffer_completing_file_name, Qlambda)
1827 ? Vminibuffer_local_completion_map
1828 : Vminibuffer_local_filename_completion_map)
1829 : (NILP (Vminibuffer_completing_file_name)
1830 || EQ (Vminibuffer_completing_file_name, Qlambda)
1831 ? Vminibuffer_local_must_match_map
1832 : Vminibuffer_local_must_match_filename_map),
1833 init, prompt, make_number (pos), 0,
1834 histvar, histpos, def, 0,
1835 !NILP (inherit_input_method));
1836
1837 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
1838 val = def;
1839
1840 RETURN_UNGCPRO (unbind_to (count, val));
1841 }
1842 \f
1843 Lisp_Object Fminibuffer_completion_help ();
1844 Lisp_Object Fassoc_string ();
1845
1846 /* Test whether TXT is an exact completion. */
1847 DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
1848 doc: /* Return non-nil if STRING is a valid completion.
1849 Takes the same arguments as `all-completions' and `try-completion'.
1850 If COLLECTION is a function, it is called with three arguments:
1851 the values STRING, PREDICATE and `lambda'. */)
1852 (string, collection, predicate)
1853 Lisp_Object string, collection, predicate;
1854 {
1855 Lisp_Object regexps, tail, tem = Qnil;
1856 int i = 0;
1857
1858 CHECK_STRING (string);
1859
1860 if ((CONSP (collection)
1861 && (!SYMBOLP (XCAR (collection)) || NILP (XCAR (collection))))
1862 || NILP (collection))
1863 {
1864 tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
1865 if (NILP (tem))
1866 return Qnil;
1867 }
1868 else if (VECTORP (collection))
1869 {
1870 /* Bypass intern-soft as that loses for nil. */
1871 tem = oblookup (collection,
1872 SDATA (string),
1873 SCHARS (string),
1874 SBYTES (string));
1875 if (!SYMBOLP (tem))
1876 {
1877 if (STRING_MULTIBYTE (string))
1878 string = Fstring_make_unibyte (string);
1879 else
1880 string = Fstring_make_multibyte (string);
1881
1882 tem = oblookup (collection,
1883 SDATA (string),
1884 SCHARS (string),
1885 SBYTES (string));
1886 }
1887
1888 if (completion_ignore_case && !SYMBOLP (tem))
1889 {
1890 for (i = XVECTOR (collection)->size - 1; i >= 0; i--)
1891 {
1892 tail = XVECTOR (collection)->contents[i];
1893 if (SYMBOLP (tail))
1894 while (1)
1895 {
1896 if (EQ((Fcompare_strings (string, make_number (0), Qnil,
1897 Fsymbol_name (tail),
1898 make_number (0) , Qnil, Qt)),
1899 Qt))
1900 {
1901 tem = tail;
1902 break;
1903 }
1904 if (XSYMBOL (tail)->next == 0)
1905 break;
1906 XSETSYMBOL (tail, XSYMBOL (tail)->next);
1907 }
1908 }
1909 }
1910
1911 if (!SYMBOLP (tem))
1912 return Qnil;
1913 }
1914 else if (HASH_TABLE_P (collection))
1915 {
1916 struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
1917 i = hash_lookup (h, string, NULL);
1918 if (i >= 0)
1919 tem = HASH_KEY (h, i);
1920 else
1921 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1922 if (!NILP (HASH_HASH (h, i)) &&
1923 EQ (Fcompare_strings (string, make_number (0), Qnil,
1924 HASH_KEY (h, i), make_number (0) , Qnil,
1925 completion_ignore_case ? Qt : Qnil),
1926 Qt))
1927 {
1928 tem = HASH_KEY (h, i);
1929 break;
1930 }
1931 if (!STRINGP (tem))
1932 return Qnil;
1933 }
1934 else
1935 return call3 (collection, string, predicate, Qlambda);
1936
1937 /* Reject this element if it fails to match all the regexps. */
1938 if (CONSP (Vcompletion_regexp_list))
1939 {
1940 int count = SPECPDL_INDEX ();
1941 specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
1942 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1943 regexps = XCDR (regexps))
1944 {
1945 if (NILP (Fstring_match (XCAR (regexps),
1946 SYMBOLP (tem) ? string : tem,
1947 Qnil)))
1948 return unbind_to (count, Qnil);
1949 }
1950 unbind_to (count, Qnil);
1951 }
1952
1953 /* Finally, check the predicate. */
1954 if (!NILP (predicate))
1955 {
1956 return HASH_TABLE_P (collection)
1957 ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
1958 : call1 (predicate, tem);
1959 }
1960 else
1961 return Qt;
1962 }
1963
1964 DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
1965 doc: /* Perform completion on buffer names.
1966 If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
1967 `all-completions', otherwise invoke `test-completion'.
1968
1969 The arguments STRING and PREDICATE are as in `try-completion',
1970 `all-completions', and `test-completion'. */)
1971 (string, predicate, flag)
1972 Lisp_Object string, predicate, flag;
1973 {
1974 if (NILP (flag))
1975 return Ftry_completion (string, Vbuffer_alist, predicate);
1976 else if (EQ (flag, Qt))
1977 return Fall_completions (string, Vbuffer_alist, predicate, Qt);
1978 else /* assume `lambda' */
1979 return Ftest_completion (string, Vbuffer_alist, predicate);
1980 }
1981
1982 /* returns:
1983 * 0 no possible completion
1984 * 1 was already an exact and unique completion
1985 * 3 was already an exact completion
1986 * 4 completed to an exact completion
1987 * 5 some completion happened
1988 * 6 no completion happened
1989 */
1990 int
1991 do_completion ()
1992 {
1993 Lisp_Object completion, string, tem;
1994 int completedp;
1995 Lisp_Object last;
1996 struct gcpro gcpro1, gcpro2;
1997
1998 completion = Ftry_completion (Fminibuffer_completion_contents (),
1999 Vminibuffer_completion_table,
2000 Vminibuffer_completion_predicate);
2001 last = last_exact_completion;
2002 last_exact_completion = Qnil;
2003
2004 GCPRO2 (completion, last);
2005
2006 if (NILP (completion))
2007 {
2008 bitch_at_user ();
2009 temp_echo_area_glyphs (build_string (" [No match]"));
2010 UNGCPRO;
2011 return 0;
2012 }
2013
2014 if (EQ (completion, Qt)) /* exact and unique match */
2015 {
2016 UNGCPRO;
2017 return 1;
2018 }
2019
2020 string = Fminibuffer_completion_contents ();
2021
2022 /* COMPLETEDP should be true if some completion was done, which
2023 doesn't include simply changing the case of the entered string.
2024 However, for appearance, the string is rewritten if the case
2025 changes. */
2026 tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qt);
2027 completedp = !EQ (tem, Qt);
2028
2029 tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qnil);
2030 if (!EQ (tem, Qt))
2031 /* Rewrite the user's input. */
2032 {
2033 int prompt_end = XINT (Fminibuffer_prompt_end ());
2034 /* Some completion happened */
2035
2036 if (! NILP (Vminibuffer_completing_file_name)
2037 && SREF (completion, SBYTES (completion) - 1) == '/'
2038 && PT < ZV
2039 && FETCH_CHAR (PT_BYTE) == '/')
2040 {
2041 del_range (prompt_end, PT + 1);
2042 }
2043 else
2044 del_range (prompt_end, PT);
2045
2046 Finsert (1, &completion);
2047
2048 if (! completedp)
2049 /* The case of the string changed, but that's all. We're not
2050 sure whether this is a unique completion or not, so try again
2051 using the real case (this shouldn't recurse again, because
2052 the next time try-completion will return either `t' or the
2053 exact string). */
2054 {
2055 UNGCPRO;
2056 return do_completion ();
2057 }
2058 }
2059
2060 /* It did find a match. Do we match some possibility exactly now? */
2061 tem = Ftest_completion (Fminibuffer_contents (),
2062 Vminibuffer_completion_table,
2063 Vminibuffer_completion_predicate);
2064 if (NILP (tem))
2065 {
2066 /* not an exact match */
2067 UNGCPRO;
2068 if (completedp)
2069 return 5;
2070 else if (!NILP (Vcompletion_auto_help))
2071 Fminibuffer_completion_help ();
2072 else
2073 temp_echo_area_glyphs (build_string (" [Next char not unique]"));
2074 return 6;
2075 }
2076 else if (completedp)
2077 {
2078 UNGCPRO;
2079 return 4;
2080 }
2081 /* If the last exact completion and this one were the same,
2082 it means we've already given a "Complete but not unique"
2083 message and the user's hit TAB again, so now we give him help. */
2084 last_exact_completion = completion;
2085 if (!NILP (last))
2086 {
2087 tem = Fminibuffer_completion_contents ();
2088 if (!NILP (Fequal (tem, last)))
2089 Fminibuffer_completion_help ();
2090 }
2091 UNGCPRO;
2092 return 3;
2093 }
2094
2095 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
2096
2097 DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
2098 doc: /* Like `assoc' but specifically for strings (and symbols).
2099 Symbols are converted to strings, and unibyte strings are converted to
2100 multibyte for comparison.
2101 Case is ignored if optional arg CASE-FOLD is non-nil.
2102 As opposed to `assoc', it will also match an entry consisting of a single
2103 string rather than a cons cell whose car is a string. */)
2104 (key, list, case_fold)
2105 register Lisp_Object key;
2106 Lisp_Object list, case_fold;
2107 {
2108 register Lisp_Object tail;
2109
2110 if (SYMBOLP (key))
2111 key = Fsymbol_name (key);
2112
2113 for (tail = list; CONSP (tail); tail = XCDR (tail))
2114 {
2115 register Lisp_Object elt, tem, thiscar;
2116 elt = XCAR (tail);
2117 thiscar = CONSP (elt) ? XCAR (elt) : elt;
2118 if (SYMBOLP (thiscar))
2119 thiscar = Fsymbol_name (thiscar);
2120 else if (!STRINGP (thiscar))
2121 continue;
2122 tem = Fcompare_strings (thiscar, make_number (0), Qnil,
2123 key, make_number (0), Qnil,
2124 case_fold);
2125 if (EQ (tem, Qt))
2126 return elt;
2127 QUIT;
2128 }
2129 return Qnil;
2130 }
2131
2132 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
2133 doc: /* Complete the minibuffer contents as far as possible.
2134 Return nil if there is no valid completion, else t.
2135 If no characters can be completed, display a list of possible completions.
2136 If you repeat this command after it displayed such a list,
2137 scroll the window of possible completions. */)
2138 ()
2139 {
2140 register int i;
2141 Lisp_Object window, tem;
2142
2143 /* If the previous command was not this,
2144 mark the completion buffer obsolete. */
2145 if (! EQ (current_kboard->Vlast_command, Vthis_command))
2146 Vminibuf_scroll_window = Qnil;
2147
2148 window = Vminibuf_scroll_window;
2149 /* If there's a fresh completion window with a live buffer,
2150 and this command is repeated, scroll that window. */
2151 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
2152 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
2153 {
2154 struct buffer *obuf = current_buffer;
2155
2156 Fset_buffer (XWINDOW (window)->buffer);
2157 tem = Fpos_visible_in_window_p (make_number (ZV), window, Qnil);
2158 if (! NILP (tem))
2159 /* If end is in view, scroll up to the beginning. */
2160 Fset_window_start (window, make_number (BEGV), Qnil);
2161 else
2162 /* Else scroll down one screen. */
2163 Fscroll_other_window (Qnil);
2164
2165 set_buffer_internal (obuf);
2166 return Qnil;
2167 }
2168
2169 i = do_completion ();
2170 switch (i)
2171 {
2172 case 0:
2173 return Qnil;
2174
2175 case 1:
2176 if (PT != ZV)
2177 Fgoto_char (make_number (ZV));
2178 temp_echo_area_glyphs (build_string (" [Sole completion]"));
2179 break;
2180
2181 case 3:
2182 if (PT != ZV)
2183 Fgoto_char (make_number (ZV));
2184 temp_echo_area_glyphs (build_string (" [Complete, but not unique]"));
2185 break;
2186 }
2187
2188 return Qt;
2189 }
2190 \f
2191 /* Subroutines of Fminibuffer_complete_and_exit. */
2192
2193 /* This one is called by internal_condition_case to do the real work. */
2194
2195 Lisp_Object
2196 complete_and_exit_1 ()
2197 {
2198 return make_number (do_completion ());
2199 }
2200
2201 /* This one is called by internal_condition_case if an error happens.
2202 Pretend the current value is an exact match. */
2203
2204 Lisp_Object
2205 complete_and_exit_2 (ignore)
2206 Lisp_Object ignore;
2207 {
2208 return make_number (1);
2209 }
2210
2211 EXFUN (Fexit_minibuffer, 0) NO_RETURN;
2212
2213 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
2214 Sminibuffer_complete_and_exit, 0, 0, "",
2215 doc: /* If the minibuffer contents is a valid completion then exit.
2216 Otherwise try to complete it. If completion leads to a valid completion,
2217 a repetition of this command will exit. */)
2218 ()
2219 {
2220 register int i;
2221 Lisp_Object val, tem;
2222
2223 /* Allow user to specify null string */
2224 if (XINT (Fminibuffer_prompt_end ()) == ZV)
2225 goto exit;
2226
2227 val = Fminibuffer_contents ();
2228 tem = Ftest_completion (val,
2229 Vminibuffer_completion_table,
2230 Vminibuffer_completion_predicate);
2231 if (!NILP (tem))
2232 {
2233 if (completion_ignore_case)
2234 { /* Fixup case of the field, if necessary. */
2235 Lisp_Object compl
2236 = Ftry_completion (val,
2237 Vminibuffer_completion_table,
2238 Vminibuffer_completion_predicate);
2239 if (STRINGP (compl)
2240 /* If it weren't for this piece of paranoia, I'd replace
2241 the whole thing with a call to do_completion. */
2242 && EQ (Flength (val), Flength (compl)))
2243 {
2244 del_range (XINT (Fminibuffer_prompt_end ()), ZV);
2245 Finsert (1, &compl);
2246 }
2247 }
2248 goto exit;
2249 }
2250
2251 if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only")))
2252 { /* The user is permitted to exit with an input that's rejected
2253 by test-completion, but at the condition to confirm her choice. */
2254 if (EQ (current_kboard->Vlast_command, Vthis_command))
2255 goto exit;
2256 else
2257 {
2258 temp_echo_area_glyphs (build_string (" [Confirm]"));
2259 return Qnil;
2260 }
2261 }
2262
2263 /* Call do_completion, but ignore errors. */
2264 SET_PT (ZV);
2265 val = internal_condition_case (complete_and_exit_1, Qerror,
2266 complete_and_exit_2);
2267
2268 i = XFASTINT (val);
2269 switch (i)
2270 {
2271 case 1:
2272 case 3:
2273 goto exit;
2274
2275 case 4:
2276 if (!NILP (Vminibuffer_completion_confirm))
2277 {
2278 temp_echo_area_glyphs (build_string (" [Confirm]"));
2279 return Qnil;
2280 }
2281 else
2282 goto exit;
2283
2284 default:
2285 return Qnil;
2286 }
2287 exit:
2288 return Fexit_minibuffer ();
2289 /* NOTREACHED */
2290 }
2291
2292 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
2293 0, 0, "",
2294 doc: /* Complete the minibuffer contents at most a single word.
2295 After one word is completed as much as possible, a space or hyphen
2296 is added, provided that matches some possible completion.
2297 Return nil if there is no valid completion, else t. */)
2298 ()
2299 {
2300 Lisp_Object completion, tem, tem1;
2301 register int i, i_byte;
2302 struct gcpro gcpro1, gcpro2;
2303 int prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
2304
2305 /* We keep calling Fbuffer_string rather than arrange for GC to
2306 hold onto a pointer to one of the strings thus made. */
2307
2308 completion = Ftry_completion (Fminibuffer_completion_contents (),
2309 Vminibuffer_completion_table,
2310 Vminibuffer_completion_predicate);
2311 if (NILP (completion))
2312 {
2313 bitch_at_user ();
2314 temp_echo_area_glyphs (build_string (" [No match]"));
2315 return Qnil;
2316 }
2317 if (EQ (completion, Qt))
2318 return Qnil;
2319
2320 #if 0 /* How the below code used to look, for reference. */
2321 tem = Fminibuffer_contents ();
2322 b = SDATA (tem);
2323 i = ZV - 1 - SCHARS (completion);
2324 p = SDATA (completion);
2325 if (i > 0 ||
2326 0 <= scmp (b, p, ZV - 1))
2327 {
2328 i = 1;
2329 /* Set buffer to longest match of buffer tail and completion head. */
2330 while (0 <= scmp (b + i, p, ZV - 1 - i))
2331 i++;
2332 del_range (1, i + 1);
2333 SET_PT (ZV);
2334 }
2335 #else /* Rewritten code */
2336 {
2337 int buffer_nchars, completion_nchars;
2338
2339 CHECK_STRING (completion);
2340 tem = Fminibuffer_completion_contents ();
2341 GCPRO2 (completion, tem);
2342 /* If reading a file name,
2343 expand any $ENVVAR refs in the buffer and in TEM. */
2344 if (! NILP (Vminibuffer_completing_file_name))
2345 {
2346 Lisp_Object substituted;
2347 substituted = Fsubstitute_in_file_name (tem);
2348 if (! EQ (substituted, tem))
2349 {
2350 tem = substituted;
2351 del_range (prompt_end_charpos, PT);
2352 Finsert (1, &tem);
2353 }
2354 }
2355 buffer_nchars = SCHARS (tem); /* # chars in what we completed. */
2356 completion_nchars = SCHARS (completion);
2357 i = buffer_nchars - completion_nchars;
2358 if (i > 0
2359 ||
2360 (tem1 = Fcompare_strings (tem, make_number (0),
2361 make_number (buffer_nchars),
2362 completion, make_number (0),
2363 make_number (buffer_nchars),
2364 completion_ignore_case ? Qt : Qnil),
2365 ! EQ (tem1, Qt)))
2366 {
2367 int start_pos;
2368
2369 /* Make buffer (before point) contain the longest match
2370 of TEM's tail and COMPLETION's head. */
2371 if (i <= 0) i = 1;
2372 start_pos= i;
2373 buffer_nchars -= i;
2374 while (i > 0)
2375 {
2376 tem1 = Fcompare_strings (tem, make_number (start_pos), Qnil,
2377 completion, make_number (0),
2378 make_number (buffer_nchars),
2379 completion_ignore_case ? Qt : Qnil);
2380 start_pos++;
2381 if (EQ (tem1, Qt))
2382 break;
2383 i++;
2384 buffer_nchars--;
2385 }
2386 del_range (start_pos, start_pos + buffer_nchars);
2387 }
2388 UNGCPRO;
2389 }
2390 #endif /* Rewritten code */
2391
2392 {
2393 int prompt_end_bytepos;
2394 prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos);
2395 i = PT - prompt_end_charpos;
2396 i_byte = PT_BYTE - prompt_end_bytepos;
2397 }
2398
2399 /* If completion finds next char not unique,
2400 consider adding a space or a hyphen. */
2401 if (i == SCHARS (completion))
2402 {
2403 GCPRO1 (completion);
2404 tem = Ftry_completion (concat2 (Fminibuffer_completion_contents (),
2405 build_string (" ")),
2406 Vminibuffer_completion_table,
2407 Vminibuffer_completion_predicate);
2408 UNGCPRO;
2409
2410 if (STRINGP (tem))
2411 completion = tem;
2412 else
2413 {
2414 GCPRO1 (completion);
2415 tem =
2416 Ftry_completion (concat2 (Fminibuffer_completion_contents (),
2417 build_string ("-")),
2418 Vminibuffer_completion_table,
2419 Vminibuffer_completion_predicate);
2420 UNGCPRO;
2421
2422 if (STRINGP (tem))
2423 completion = tem;
2424 }
2425 }
2426
2427 /* Now find first word-break in the stuff found by completion.
2428 i gets index in string of where to stop completing. */
2429 while (i_byte < SBYTES (completion))
2430 {
2431 int c;
2432
2433 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte);
2434 if (SYNTAX (c) != Sword)
2435 break;
2436 }
2437
2438 /* If got no characters, print help for user. */
2439
2440 if (i == PT - prompt_end_charpos)
2441 {
2442 if (!NILP (Vcompletion_auto_help))
2443 Fminibuffer_completion_help ();
2444 return Qnil;
2445 }
2446
2447 /* Otherwise insert in minibuffer the chars we got */
2448
2449 if (! NILP (Vminibuffer_completing_file_name)
2450 && SREF (completion, SBYTES (completion) - 1) == '/'
2451 && PT < ZV
2452 && FETCH_CHAR (PT_BYTE) == '/')
2453 {
2454 del_range (prompt_end_charpos, PT + 1);
2455 }
2456 else
2457 del_range (prompt_end_charpos, PT);
2458
2459 insert_from_string (completion, 0, 0, i, i_byte, 1);
2460 return Qt;
2461 }
2462 \f
2463 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
2464 1, 2, 0,
2465 doc: /* Display the list of completions, COMPLETIONS, using `standard-output'.
2466 Each element may be just a symbol or string
2467 or may be a list of two strings to be printed as if concatenated.
2468 If it is a list of two strings, the first is the actual completion
2469 alternative, the second serves as annotation.
2470 `standard-output' must be a buffer.
2471 The actual completion alternatives, as inserted, are given `mouse-face'
2472 properties of `highlight'.
2473 At the end, this runs the normal hook `completion-setup-hook'.
2474 It can find the completion buffer in `standard-output'.
2475 The optional second arg COMMON-SUBSTRING is a string.
2476 It is used to put faces, `completions-first-difference' and
2477 `completions-common-part' on the completion buffer. The
2478 `completions-common-part' face is put on the common substring
2479 specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil
2480 and the current buffer is not the minibuffer, the faces are not put.
2481 Internally, COMMON-SUBSTRING is bound to `completion-common-substring'
2482 during running `completion-setup-hook'. */)
2483 (completions, common_substring)
2484 Lisp_Object completions;
2485 Lisp_Object common_substring;
2486 {
2487 Lisp_Object tail, elt;
2488 register int i;
2489 int column = 0;
2490 struct gcpro gcpro1, gcpro2, gcpro3;
2491 struct buffer *old = current_buffer;
2492 int first = 1;
2493
2494 /* Note that (when it matters) every variable
2495 points to a non-string that is pointed to by COMPLETIONS,
2496 except for ELT. ELT can be pointing to a string
2497 when terpri or Findent_to calls a change hook. */
2498 elt = Qnil;
2499 GCPRO3 (completions, elt, common_substring);
2500
2501 if (BUFFERP (Vstandard_output))
2502 set_buffer_internal (XBUFFER (Vstandard_output));
2503
2504 if (NILP (completions))
2505 write_string ("There are no possible completions of what you have typed.",
2506 -1);
2507 else
2508 {
2509 write_string ("Possible completions are:", -1);
2510 for (tail = completions, i = 0; CONSP (tail); tail = XCDR (tail), i++)
2511 {
2512 Lisp_Object tem, string;
2513 int length;
2514 Lisp_Object startpos, endpos;
2515
2516 startpos = Qnil;
2517
2518 elt = XCAR (tail);
2519 if (SYMBOLP (elt))
2520 elt = SYMBOL_NAME (elt);
2521 /* Compute the length of this element. */
2522 if (CONSP (elt))
2523 {
2524 tem = XCAR (elt);
2525 CHECK_STRING (tem);
2526 length = SCHARS (tem);
2527
2528 tem = Fcar (XCDR (elt));
2529 CHECK_STRING (tem);
2530 length += SCHARS (tem);
2531 }
2532 else
2533 {
2534 CHECK_STRING (elt);
2535 length = SCHARS (elt);
2536 }
2537
2538 /* This does a bad job for narrower than usual windows.
2539 Sadly, the window it will appear in is not known
2540 until after the text has been made. */
2541
2542 if (BUFFERP (Vstandard_output))
2543 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2544
2545 /* If the previous completion was very wide,
2546 or we have two on this line already,
2547 don't put another on the same line. */
2548 if (column > 33 || first
2549 /* If this is really wide, don't put it second on a line. */
2550 || (column > 0 && length > 45))
2551 {
2552 Fterpri (Qnil);
2553 column = 0;
2554 }
2555 /* Otherwise advance to column 35. */
2556 else
2557 {
2558 if (BUFFERP (Vstandard_output))
2559 {
2560 tem = Findent_to (make_number (35), make_number (2));
2561
2562 column = XINT (tem);
2563 }
2564 else
2565 {
2566 do
2567 {
2568 write_string (" ", -1);
2569 column++;
2570 }
2571 while (column < 35);
2572 }
2573 }
2574
2575 if (BUFFERP (Vstandard_output))
2576 {
2577 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2578 Fset_text_properties (startpos, endpos,
2579 Qnil, Vstandard_output);
2580 }
2581
2582 /* Output this element.
2583 If necessary, convert it to unibyte or to multibyte first. */
2584 if (CONSP (elt))
2585 string = Fcar (elt);
2586 else
2587 string = elt;
2588 if (NILP (current_buffer->enable_multibyte_characters)
2589 && STRING_MULTIBYTE (string))
2590 string = Fstring_make_unibyte (string);
2591 else if (!NILP (current_buffer->enable_multibyte_characters)
2592 && !STRING_MULTIBYTE (string))
2593 string = Fstring_make_multibyte (string);
2594
2595 if (BUFFERP (Vstandard_output))
2596 {
2597 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2598
2599 Fprinc (string, Qnil);
2600
2601 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2602
2603 Fput_text_property (startpos, endpos,
2604 Qmouse_face, intern ("highlight"),
2605 Vstandard_output);
2606 }
2607 else
2608 {
2609 Fprinc (string, Qnil);
2610 }
2611
2612 /* Output the annotation for this element. */
2613 if (CONSP (elt))
2614 {
2615 if (BUFFERP (Vstandard_output))
2616 {
2617 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2618
2619 Fprinc (Fcar (Fcdr (elt)), Qnil);
2620
2621 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2622
2623 Fset_text_properties (startpos, endpos, Qnil,
2624 Vstandard_output);
2625 }
2626 else
2627 {
2628 Fprinc (Fcar (Fcdr (elt)), Qnil);
2629 }
2630 }
2631
2632
2633 /* Update COLUMN for what we have output. */
2634 column += length;
2635
2636 /* If output is to a buffer, recompute COLUMN in a way
2637 that takes account of character widths. */
2638 if (BUFFERP (Vstandard_output))
2639 {
2640 tem = Fcurrent_column ();
2641 column = XINT (tem);
2642 }
2643
2644 first = 0;
2645 }
2646 }
2647
2648 if (BUFFERP (Vstandard_output))
2649 set_buffer_internal (old);
2650
2651 if (!NILP (Vrun_hooks))
2652 {
2653 int count1 = SPECPDL_INDEX ();
2654
2655 specbind (intern ("completion-common-substring"), common_substring);
2656 call1 (Vrun_hooks, intern ("completion-setup-hook"));
2657
2658 unbind_to (count1, Qnil);
2659 }
2660
2661 UNGCPRO;
2662
2663 return Qnil;
2664 }
2665
2666
2667 static Lisp_Object
2668 display_completion_list_1 (list)
2669 Lisp_Object list;
2670 {
2671 return Fdisplay_completion_list (list, Qnil);
2672 }
2673
2674 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
2675 0, 0, "",
2676 doc: /* Display a list of possible completions of the current minibuffer contents. */)
2677 ()
2678 {
2679 Lisp_Object completions;
2680
2681 message ("Making completion list...");
2682 completions = Fall_completions (Fminibuffer_completion_contents (),
2683 Vminibuffer_completion_table,
2684 Vminibuffer_completion_predicate,
2685 Qt);
2686 clear_message (1, 0);
2687
2688 if (NILP (completions))
2689 {
2690 bitch_at_user ();
2691 temp_echo_area_glyphs (build_string (" [No completions]"));
2692 }
2693 else
2694 {
2695 /* Sort and remove duplicates. */
2696 Lisp_Object tmp = completions = Fsort (completions, Qstring_lessp);
2697 while (CONSP (tmp))
2698 {
2699 if (CONSP (XCDR (tmp))
2700 && !NILP (Fequal (XCAR (tmp), XCAR (XCDR (tmp)))))
2701 XSETCDR (tmp, XCDR (XCDR (tmp)));
2702 else
2703 tmp = XCDR (tmp);
2704 }
2705 internal_with_output_to_temp_buffer ("*Completions*",
2706 display_completion_list_1,
2707 completions);
2708 }
2709 return Qnil;
2710 }
2711 \f
2712 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
2713 doc: /* Terminate minibuffer input. */)
2714 ()
2715 {
2716 if (CHARACTERP (last_command_char))
2717 internal_self_insert (XINT (last_command_char), 0);
2718 else
2719 bitch_at_user ();
2720
2721 return Fexit_minibuffer ();
2722 }
2723
2724 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
2725 doc: /* Terminate this minibuffer argument. */)
2726 ()
2727 {
2728 /* If the command that uses this has made modifications in the minibuffer,
2729 we don't want them to cause deactivation of the mark in the original
2730 buffer.
2731 A better solution would be to make deactivate-mark buffer-local
2732 (or to turn it into a list of buffers, ...), but in the mean time,
2733 this should do the trick in most cases. */
2734 Vdeactivate_mark = Qnil;
2735 Fthrow (Qexit, Qnil);
2736 }
2737
2738 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
2739 doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */)
2740 ()
2741 {
2742 return make_number (minibuf_level);
2743 }
2744
2745 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
2746 doc: /* Return the prompt string of the currently-active minibuffer.
2747 If no minibuffer is active, return nil. */)
2748 ()
2749 {
2750 return Fcopy_sequence (minibuf_prompt);
2751 }
2752
2753 \f
2754 /* Temporarily display STRING at the end of the current
2755 minibuffer contents. This is used to display things like
2756 "[No Match]" when the user requests a completion for a prefix
2757 that has no possible completions, and other quick, unobtrusive
2758 messages. */
2759
2760 extern Lisp_Object Vminibuffer_message_timeout;
2761
2762 void
2763 temp_echo_area_glyphs (string)
2764 Lisp_Object string;
2765 {
2766 int osize = ZV;
2767 int osize_byte = ZV_BYTE;
2768 int opoint = PT;
2769 int opoint_byte = PT_BYTE;
2770 Lisp_Object oinhibit;
2771 oinhibit = Vinhibit_quit;
2772
2773 /* Clear out any old echo-area message to make way for our new thing. */
2774 message (0);
2775
2776 SET_PT_BOTH (osize, osize_byte);
2777 insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 0);
2778 SET_PT_BOTH (opoint, opoint_byte);
2779 Vinhibit_quit = Qt;
2780
2781 if (NUMBERP (Vminibuffer_message_timeout))
2782 sit_for (Vminibuffer_message_timeout, 0, 2);
2783 else
2784 sit_for (Qt, 0, 2);
2785
2786 del_range_both (osize, osize_byte, ZV, ZV_BYTE, 1);
2787 SET_PT_BOTH (opoint, opoint_byte);
2788 if (!NILP (Vquit_flag))
2789 {
2790 Vquit_flag = Qnil;
2791 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
2792 }
2793 Vinhibit_quit = oinhibit;
2794 }
2795
2796 DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message,
2797 1, 1, 0,
2798 doc: /* Temporarily display STRING at the end of the minibuffer.
2799 The text is displayed for a period controlled by `minibuffer-message-timeout',
2800 or until the next input event arrives, whichever comes first. */)
2801 (string)
2802 Lisp_Object string;
2803 {
2804 CHECK_STRING (string);
2805 temp_echo_area_glyphs (string);
2806 return Qnil;
2807 }
2808 \f
2809 void
2810 init_minibuf_once ()
2811 {
2812 Vminibuffer_list = Qnil;
2813 staticpro (&Vminibuffer_list);
2814 }
2815
2816 void
2817 syms_of_minibuf ()
2818 {
2819 minibuf_level = 0;
2820 minibuf_prompt = Qnil;
2821 staticpro (&minibuf_prompt);
2822
2823 minibuf_save_list = Qnil;
2824 staticpro (&minibuf_save_list);
2825
2826 Qcompletion_ignore_case = intern ("completion-ignore-case");
2827 staticpro (&Qcompletion_ignore_case);
2828
2829 Qread_file_name_internal = intern ("read-file-name-internal");
2830 staticpro (&Qread_file_name_internal);
2831
2832 Qminibuffer_default = intern ("minibuffer-default");
2833 staticpro (&Qminibuffer_default);
2834 Fset (Qminibuffer_default, Qnil);
2835
2836 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
2837 staticpro (&Qminibuffer_completion_table);
2838
2839 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
2840 staticpro (&Qminibuffer_completion_confirm);
2841
2842 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
2843 staticpro (&Qminibuffer_completion_predicate);
2844
2845 staticpro (&last_exact_completion);
2846 last_exact_completion = Qnil;
2847
2848 staticpro (&last_minibuf_string);
2849 last_minibuf_string = Qnil;
2850
2851 Quser_variable_p = intern ("user-variable-p");
2852 staticpro (&Quser_variable_p);
2853
2854 Qminibuffer_history = intern ("minibuffer-history");
2855 staticpro (&Qminibuffer_history);
2856
2857 Qbuffer_name_history = intern ("buffer-name-history");
2858 staticpro (&Qbuffer_name_history);
2859 Fset (Qbuffer_name_history, Qnil);
2860
2861 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
2862 staticpro (&Qminibuffer_setup_hook);
2863
2864 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
2865 staticpro (&Qminibuffer_exit_hook);
2866
2867 Qhistory_length = intern ("history-length");
2868 staticpro (&Qhistory_length);
2869
2870 Qcurrent_input_method = intern ("current-input-method");
2871 staticpro (&Qcurrent_input_method);
2872
2873 Qactivate_input_method = intern ("activate-input-method");
2874 staticpro (&Qactivate_input_method);
2875
2876 Qcase_fold_search = intern ("case-fold-search");
2877 staticpro (&Qcase_fold_search);
2878
2879 Qread_expression_history = intern ("read-expression-history");
2880 staticpro (&Qread_expression_history);
2881
2882 DEFVAR_LISP ("read-buffer-function", &Vread_buffer_function,
2883 doc: /* If this is non-nil, `read-buffer' does its work by calling this function. */);
2884 Vread_buffer_function = Qnil;
2885
2886 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
2887 doc: /* Normal hook run just after entry to minibuffer. */);
2888 Vminibuffer_setup_hook = Qnil;
2889
2890 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
2891 doc: /* Normal hook run just after exit from minibuffer. */);
2892 Vminibuffer_exit_hook = Qnil;
2893
2894 DEFVAR_LISP ("history-length", &Vhistory_length,
2895 doc: /* *Maximum length for history lists before truncation takes place.
2896 A number means that length; t means infinite. Truncation takes place
2897 just after a new element is inserted. Setting the `history-length'
2898 property of a history variable overrides this default. */);
2899 XSETFASTINT (Vhistory_length, 30);
2900
2901 DEFVAR_BOOL ("history-delete-duplicates", &history_delete_duplicates,
2902 doc: /* *Non-nil means to delete duplicates in history.
2903 If set to t when adding a new history element, all previous identical
2904 elements are deleted from the history list. */);
2905 history_delete_duplicates = 0;
2906
2907 DEFVAR_LISP ("history-add-new-input", &Vhistory_add_new_input,
2908 doc: /* *Non-nil means to add new elements in history.
2909 If set to nil, minibuffer reading functions don't add new elements to the
2910 history list, so it is possible to do this afterwards by calling
2911 `add-to-history' explicitly. */);
2912 Vhistory_add_new_input = Qt;
2913
2914 DEFVAR_LISP ("completion-auto-help", &Vcompletion_auto_help,
2915 doc: /* *Non-nil means automatically provide help for invalid completion input.
2916 Under Partial Completion mode, a non-nil, non-t value has a special meaning;
2917 see the doc string of `partial-completion-mode' for more details. */);
2918 Vcompletion_auto_help = Qt;
2919
2920 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
2921 doc: /* Non-nil means don't consider case significant in completion.
2922
2923 For file-name completion, the variable `read-file-name-completion-ignore-case'
2924 controls the behavior, rather than this variable. */);
2925 completion_ignore_case = 0;
2926
2927 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
2928 doc: /* *Non-nil means to allow minibuffer commands while in the minibuffer.
2929 This variable makes a difference whenever the minibuffer window is active. */);
2930 enable_recursive_minibuffers = 0;
2931
2932 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
2933 doc: /* Alist or obarray used for completion in the minibuffer.
2934 This becomes the ALIST argument to `try-completion' and `all-completions'.
2935 The value can also be a list of strings or a hash table.
2936
2937 The value may alternatively be a function, which is given three arguments:
2938 STRING, the current buffer contents;
2939 PREDICATE, the predicate for filtering possible matches;
2940 CODE, which says what kind of things to do.
2941 CODE can be nil, t or `lambda':
2942 nil -- return the best completion of STRING, or nil if there is none.
2943 t -- return a list of all possible completions of STRING.
2944 lambda -- return t if STRING is a valid completion as it stands. */);
2945 Vminibuffer_completion_table = Qnil;
2946
2947 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
2948 doc: /* Within call to `completing-read', this holds the PREDICATE argument. */);
2949 Vminibuffer_completion_predicate = Qnil;
2950
2951 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
2952 doc: /* Non-nil means to demand confirmation of completion before exiting minibuffer. */);
2953 Vminibuffer_completion_confirm = Qnil;
2954
2955 DEFVAR_LISP ("minibuffer-completing-file-name",
2956 &Vminibuffer_completing_file_name,
2957 doc: /* Non-nil and non-`lambda' means completing file names. */);
2958 Vminibuffer_completing_file_name = Qnil;
2959
2960 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
2961 doc: /* Value that `help-form' takes on inside the minibuffer. */);
2962 Vminibuffer_help_form = Qnil;
2963
2964 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
2965 doc: /* History list symbol to add minibuffer values to.
2966 Each string of minibuffer input, as it appears on exit from the minibuffer,
2967 is added with
2968 (set minibuffer-history-variable
2969 (cons STRING (symbol-value minibuffer-history-variable))) */);
2970 XSETFASTINT (Vminibuffer_history_variable, 0);
2971
2972 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
2973 doc: /* Current position of redoing in the history list. */);
2974 Vminibuffer_history_position = Qnil;
2975
2976 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
2977 doc: /* *Non-nil means entering the minibuffer raises the minibuffer's frame.
2978 Some uses of the echo area also raise that frame (since they use it too). */);
2979 minibuffer_auto_raise = 0;
2980
2981 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
2982 doc: /* List of regexps that should restrict possible completions.
2983 The basic completion functions only consider a completion acceptable
2984 if it matches all regular expressions in this list, with
2985 `case-fold-search' bound to the value of `completion-ignore-case'.
2986 See Info node `(elisp)Basic Completion', for a description of these
2987 functions. */);
2988 Vcompletion_regexp_list = Qnil;
2989
2990 DEFVAR_BOOL ("minibuffer-allow-text-properties",
2991 &minibuffer_allow_text_properties,
2992 doc: /* Non-nil means `read-from-minibuffer' should not discard text properties.
2993 This also affects `read-string', but it does not affect `read-minibuffer',
2994 `read-no-blanks-input', or any of the functions that do minibuffer input
2995 with completion; they always discard text properties. */);
2996 minibuffer_allow_text_properties = 0;
2997
2998 DEFVAR_LISP ("minibuffer-prompt-properties", &Vminibuffer_prompt_properties,
2999 doc: /* Text properties that are added to minibuffer prompts.
3000 These are in addition to the basic `field' property, and stickiness
3001 properties. */);
3002 /* We use `intern' here instead of Qread_only to avoid
3003 initialization-order problems. */
3004 Vminibuffer_prompt_properties
3005 = Fcons (intern ("read-only"), Fcons (Qt, Qnil));
3006
3007 DEFVAR_LISP ("read-expression-map", &Vread_expression_map,
3008 doc: /* Minibuffer keymap used for reading Lisp expressions. */);
3009 Vread_expression_map = Qnil;
3010
3011 defsubr (&Sset_minibuffer_window);
3012 defsubr (&Sread_from_minibuffer);
3013 defsubr (&Seval_minibuffer);
3014 defsubr (&Sread_minibuffer);
3015 defsubr (&Sread_string);
3016 defsubr (&Sread_command);
3017 defsubr (&Sread_variable);
3018 defsubr (&Sinternal_complete_buffer);
3019 defsubr (&Sread_buffer);
3020 defsubr (&Sread_no_blanks_input);
3021 defsubr (&Sminibuffer_depth);
3022 defsubr (&Sminibuffer_prompt);
3023
3024 defsubr (&Sminibufferp);
3025 defsubr (&Sminibuffer_prompt_end);
3026 defsubr (&Sminibuffer_contents);
3027 defsubr (&Sminibuffer_contents_no_properties);
3028 defsubr (&Sminibuffer_completion_contents);
3029 defsubr (&Sdelete_minibuffer_contents);
3030
3031 defsubr (&Stry_completion);
3032 defsubr (&Sall_completions);
3033 defsubr (&Stest_completion);
3034 defsubr (&Sassoc_string);
3035 defsubr (&Scompleting_read);
3036 defsubr (&Sminibuffer_complete);
3037 defsubr (&Sminibuffer_complete_word);
3038 defsubr (&Sminibuffer_complete_and_exit);
3039 defsubr (&Sdisplay_completion_list);
3040 defsubr (&Sminibuffer_completion_help);
3041
3042 defsubr (&Sself_insert_and_exit);
3043 defsubr (&Sexit_minibuffer);
3044
3045 defsubr (&Sminibuffer_message);
3046 }
3047
3048 void
3049 keys_of_minibuf ()
3050 {
3051 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
3052 "abort-recursive-edit");
3053 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
3054 "exit-minibuffer");
3055 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
3056 "exit-minibuffer");
3057
3058 initial_define_key (Vminibuffer_local_ns_map, ' ',
3059 "exit-minibuffer");
3060 initial_define_key (Vminibuffer_local_ns_map, '\t',
3061 "exit-minibuffer");
3062 initial_define_key (Vminibuffer_local_ns_map, '?',
3063 "self-insert-and-exit");
3064
3065 initial_define_key (Vminibuffer_local_completion_map, '\t',
3066 "minibuffer-complete");
3067 initial_define_key (Vminibuffer_local_completion_map, ' ',
3068 "minibuffer-complete-word");
3069 initial_define_key (Vminibuffer_local_completion_map, '?',
3070 "minibuffer-completion-help");
3071
3072 Fdefine_key (Vminibuffer_local_filename_completion_map,
3073 build_string (" "), Qnil);
3074
3075 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
3076 "minibuffer-complete-and-exit");
3077 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
3078 "minibuffer-complete-and-exit");
3079
3080 Fdefine_key (Vminibuffer_local_must_match_filename_map,
3081 build_string (" "), Qnil);
3082 }
3083
3084 /* arch-tag: 8f69b601-fba3-484c-a6dd-ceaee54a7a73
3085 (do not change this comment) */