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