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