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