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