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