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