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