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