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