]> code.delx.au - gnu-emacs/blob - src/minibuf.c
Merge from emacs-23
[gnu-emacs] / src / minibuf.c
1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
3 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21
22 #include <config.h>
23 #include <stdio.h>
24 #include <setjmp.h>
25
26 #include "lisp.h"
27 #include "commands.h"
28 #include "buffer.h"
29 #include "character.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 Lisp_Object minibuf_save_list;
50
51 /* Depth in minibuffer invocations. */
52
53 int minibuf_level;
54
55 /* The maximum length of a minibuffer history. */
56
57 Lisp_Object Qhistory_length, Vhistory_length;
58
59 /* No duplicates in history. */
60
61 int history_delete_duplicates;
62
63 /* Non-nil means add new input to history. */
64
65 Lisp_Object Vhistory_add_new_input;
66
67 /* Fread_minibuffer leaves the input here as a string. */
68
69 Lisp_Object last_minibuf_string;
70
71 /* Nonzero means let functions called when within a minibuffer
72 invoke recursive minibuffers (to read arguments, or whatever) */
73
74 int enable_recursive_minibuffers;
75
76 /* Nonzero means don't ignore text properties
77 in Fread_from_minibuffer. */
78
79 int minibuffer_allow_text_properties;
80
81 /* help-form is bound to this while in the minibuffer. */
82
83 Lisp_Object Vminibuffer_help_form;
84
85 /* Variable which is the history list to add minibuffer values to. */
86
87 Lisp_Object Vminibuffer_history_variable;
88
89 /* Current position in the history list (adjusted by M-n and M-p). */
90
91 Lisp_Object Vminibuffer_history_position;
92
93 /* Text properties that are added to minibuffer prompts.
94 These are in addition to the basic `field' property, and stickiness
95 properties. */
96
97 Lisp_Object Vminibuffer_prompt_properties;
98
99 Lisp_Object Qminibuffer_history, Qbuffer_name_history;
100
101 Lisp_Object Qread_file_name_internal;
102
103 /* Normal hooks for entry to and exit from minibuffer. */
104
105 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
106 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
107
108 /* Function to call to read a buffer name. */
109 Lisp_Object Vread_buffer_function;
110
111 /* Nonzero means completion ignores case. */
112
113 int completion_ignore_case;
114 Lisp_Object Qcompletion_ignore_case;
115 int read_buffer_completion_ignore_case;
116
117 /* List of regexps that should restrict possible completions. */
118
119 Lisp_Object Vcompletion_regexp_list;
120
121 /* Nonzero means raise the minibuffer frame when the minibuffer
122 is entered. */
123
124 int minibuffer_auto_raise;
125
126 /* Keymap for reading expressions. */
127 Lisp_Object Vread_expression_map;
128
129 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
130 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
131 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
132 Lisp_Object Vminibuffer_completing_file_name;
133
134 Lisp_Object Quser_variable_p;
135
136 Lisp_Object Qminibuffer_default;
137
138 Lisp_Object Qcurrent_input_method, Qactivate_input_method;
139
140 Lisp_Object Qcase_fold_search;
141
142 Lisp_Object Qread_expression_history;
143
144 \f
145 /* Put minibuf on currently selected frame's minibuffer.
146 We do this whenever the user starts a new minibuffer
147 or when a minibuffer exits. */
148
149 void
150 choose_minibuf_frame (void)
151 {
152 if (FRAMEP (selected_frame)
153 && FRAME_LIVE_P (XFRAME (selected_frame))
154 && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
155 {
156 struct frame *sf = XFRAME (selected_frame);
157 Lisp_Object buffer;
158
159 /* I don't think that any frames may validly have a null minibuffer
160 window anymore. */
161 if (NILP (sf->minibuffer_window))
162 abort ();
163
164 /* Under X, we come here with minibuf_window being the
165 minibuffer window of the unused termcap window created in
166 init_window_once. That window doesn't have a buffer. */
167 buffer = XWINDOW (minibuf_window)->buffer;
168 if (BUFFERP (buffer))
169 Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
170 minibuf_window = sf->minibuffer_window;
171 }
172
173 /* Make sure no other frame has a minibuffer as its selected window,
174 because the text would not be displayed in it, and that would be
175 confusing. Only allow the selected frame to do this,
176 and that only if the minibuffer is active. */
177 {
178 Lisp_Object tail, frame;
179
180 FOR_EACH_FRAME (tail, frame)
181 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
182 && !(EQ (frame, selected_frame)
183 && minibuf_level > 0))
184 Fset_frame_selected_window (frame, Fframe_first_window (frame), Qnil);
185 }
186 }
187
188 Lisp_Object
189 choose_minibuf_frame_1 (Lisp_Object ignore)
190 {
191 choose_minibuf_frame ();
192 return Qnil;
193 }
194
195 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
196 Sset_minibuffer_window, 1, 1, 0,
197 doc: /* Specify which minibuffer window to use for the minibuffer.
198 This affects where the minibuffer is displayed if you put text in it
199 without invoking the usual minibuffer commands. */)
200 (Lisp_Object window)
201 {
202 CHECK_WINDOW (window);
203 if (! MINI_WINDOW_P (XWINDOW (window)))
204 error ("Window is not a minibuffer window");
205
206 minibuf_window = window;
207
208 return window;
209 }
210
211 \f
212 /* Actual minibuffer invocation. */
213
214 static Lisp_Object read_minibuf_unwind (Lisp_Object);
215 static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
216 static Lisp_Object read_minibuf (Lisp_Object, Lisp_Object,
217 Lisp_Object, Lisp_Object,
218 int, Lisp_Object,
219 Lisp_Object, Lisp_Object,
220 int, int);
221 static Lisp_Object read_minibuf_noninteractive (Lisp_Object, Lisp_Object,
222 Lisp_Object, Lisp_Object,
223 int, Lisp_Object,
224 Lisp_Object, Lisp_Object,
225 int, int);
226 static Lisp_Object string_to_object (Lisp_Object, Lisp_Object);
227
228
229 /* Read a Lisp object from VAL and return it. If VAL is an empty
230 string, and DEFALT is a string, read from DEFALT instead of VAL. */
231
232 static Lisp_Object
233 string_to_object (Lisp_Object val, Lisp_Object defalt)
234 {
235 struct gcpro gcpro1, gcpro2;
236 Lisp_Object expr_and_pos;
237 EMACS_INT pos;
238
239 GCPRO2 (val, defalt);
240
241 if (STRINGP (val) && SCHARS (val) == 0)
242 {
243 if (STRINGP (defalt))
244 val = defalt;
245 else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
246 val = XCAR (defalt);
247 }
248
249 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
250 pos = XINT (Fcdr (expr_and_pos));
251 if (pos != SCHARS (val))
252 {
253 /* Ignore trailing whitespace; any other trailing junk
254 is an error. */
255 EMACS_INT i;
256 pos = string_char_to_byte (val, pos);
257 for (i = pos; i < SBYTES (val); i++)
258 {
259 int c = SREF (val, i);
260 if (c != ' ' && c != '\t' && c != '\n')
261 error ("Trailing garbage following expression");
262 }
263 }
264
265 val = Fcar (expr_and_pos);
266 RETURN_UNGCPRO (val);
267 }
268
269
270 /* Like read_minibuf but reading from stdin. This function is called
271 from read_minibuf to do the job if noninteractive. */
272
273 static Lisp_Object
274 read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
275 Lisp_Object prompt, Lisp_Object backup_n,
276 int expflag,
277 Lisp_Object histvar, Lisp_Object histpos,
278 Lisp_Object defalt,
279 int allow_props, int inherit_input_method)
280 {
281 int size, len;
282 char *line, *s;
283 Lisp_Object val;
284
285 fprintf (stdout, "%s", SDATA (prompt));
286 fflush (stdout);
287
288 val = Qnil;
289 size = 100;
290 len = 0;
291 line = (char *) xmalloc (size * sizeof *line);
292 while ((s = fgets (line + len, size - len, stdin)) != NULL
293 && (len = strlen (line),
294 len == size - 1 && line[len - 1] != '\n'))
295 {
296 size *= 2;
297 line = (char *) xrealloc (line, size);
298 }
299
300 if (s)
301 {
302 len = strlen (line);
303
304 if (len > 0 && line[len - 1] == '\n')
305 line[--len] = '\0';
306
307 val = build_string (line);
308 xfree (line);
309 }
310 else
311 {
312 xfree (line);
313 error ("Error reading from stdin");
314 }
315
316 /* If Lisp form desired instead of string, parse it. */
317 if (expflag)
318 val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
319
320 return val;
321 }
322 \f
323 DEFUN ("minibufferp", Fminibufferp,
324 Sminibufferp, 0, 1, 0,
325 doc: /* Return t if BUFFER is a minibuffer.
326 No argument or nil as argument means use current buffer as BUFFER.
327 BUFFER can be a buffer or a buffer name. */)
328 (Lisp_Object buffer)
329 {
330 Lisp_Object tem;
331
332 if (NILP (buffer))
333 buffer = Fcurrent_buffer ();
334 else if (STRINGP (buffer))
335 buffer = Fget_buffer (buffer);
336 else
337 CHECK_BUFFER (buffer);
338
339 tem = Fmemq (buffer, Vminibuffer_list);
340 return ! NILP (tem) ? Qt : Qnil;
341 }
342
343 DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
344 Sminibuffer_prompt_end, 0, 0, 0,
345 doc: /* Return the buffer position of the end of the minibuffer prompt.
346 Return (point-min) if current buffer is not a minibuffer. */)
347 (void)
348 {
349 /* This function is written to be most efficient when there's a prompt. */
350 Lisp_Object beg, end, tem;
351 beg = make_number (BEGV);
352
353 tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list);
354 if (NILP (tem))
355 return beg;
356
357 end = Ffield_end (beg, Qnil, Qnil);
358
359 if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil)))
360 return beg;
361 else
362 return end;
363 }
364
365 DEFUN ("minibuffer-contents", Fminibuffer_contents,
366 Sminibuffer_contents, 0, 0, 0,
367 doc: /* Return the user input in a minibuffer as a string.
368 If the current buffer is not a minibuffer, return its entire contents. */)
369 (void)
370 {
371 EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
372 return make_buffer_string (prompt_end, ZV, 1);
373 }
374
375 DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties,
376 Sminibuffer_contents_no_properties, 0, 0, 0,
377 doc: /* Return the user input in a minibuffer as a string, without text-properties.
378 If the current buffer is not a minibuffer, return its entire contents. */)
379 (void)
380 {
381 EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
382 return make_buffer_string (prompt_end, ZV, 0);
383 }
384
385 DEFUN ("minibuffer-completion-contents", Fminibuffer_completion_contents,
386 Sminibuffer_completion_contents, 0, 0, 0,
387 doc: /* Return the user input in a minibuffer before point as a string.
388 That is what completion commands operate on.
389 If the current buffer is not a minibuffer, return its entire contents. */)
390 (void)
391 {
392 EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
393 if (PT < prompt_end)
394 error ("Cannot do completion in the prompt");
395 return make_buffer_string (prompt_end, PT, 1);
396 }
397
398 \f
399 /* Read from the minibuffer using keymap MAP and initial contents INITIAL,
400 putting point minus BACKUP_N bytes from the end of INITIAL,
401 prompting with PROMPT (a string), using history list HISTVAR
402 with initial position HISTPOS. INITIAL should be a string or a
403 cons of a string and an integer. BACKUP_N should be <= 0, or
404 Qnil, which is equivalent to 0. If INITIAL is a cons, BACKUP_N is
405 ignored and replaced with an integer that puts point at one-indexed
406 position N in INITIAL, where N is the CDR of INITIAL, or at the
407 beginning of INITIAL if N <= 0.
408
409 Normally return the result as a string (the text that was read),
410 but if EXPFLAG is nonzero, read it and return the object read.
411 If HISTVAR is given, save the value read on that history only if it doesn't
412 match the front of that history list exactly. The value is pushed onto
413 the list as the string that was read.
414
415 DEFALT specifies the default value for the sake of history commands.
416
417 If ALLOW_PROPS is nonzero, we do not throw away text properties.
418
419 if INHERIT_INPUT_METHOD is nonzero, the minibuffer inherits the
420 current input method. */
421
422 static Lisp_Object
423 read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
424 Lisp_Object backup_n, int expflag,
425 Lisp_Object histvar, Lisp_Object histpos, Lisp_Object defalt,
426 int allow_props, int inherit_input_method)
427 {
428 Lisp_Object val;
429 int count = SPECPDL_INDEX ();
430 Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
431 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
432 Lisp_Object enable_multibyte;
433 int pos = INTEGERP (backup_n) ? XINT (backup_n) : 0;
434 /* String to add to the history. */
435 Lisp_Object histstring;
436
437 Lisp_Object empty_minibuf;
438 Lisp_Object dummy, frame;
439
440 specbind (Qminibuffer_default, defalt);
441
442 /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
443 in previous recursive minibuffer, but was not set explicitly
444 to t for this invocation, so set it to nil in this minibuffer.
445 Save the old value now, before we change it. */
446 specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name);
447 if (EQ (Vminibuffer_completing_file_name, Qlambda))
448 Vminibuffer_completing_file_name = Qnil;
449
450 #ifdef HAVE_WINDOW_SYSTEM
451 if (display_hourglass_p)
452 cancel_hourglass ();
453 #endif
454
455 if (!NILP (initial))
456 {
457 if (CONSP (initial))
458 {
459 backup_n = Fcdr (initial);
460 initial = Fcar (initial);
461 CHECK_STRING (initial);
462 if (!NILP (backup_n))
463 {
464 CHECK_NUMBER (backup_n);
465 /* Convert to distance from end of input. */
466 if (XINT (backup_n) < 1)
467 /* A number too small means the beginning of the string. */
468 pos = - SCHARS (initial);
469 else
470 pos = XINT (backup_n) - 1 - SCHARS (initial);
471 }
472 }
473 else
474 CHECK_STRING (initial);
475 }
476 val = Qnil;
477 ambient_dir = current_buffer->directory;
478 input_method = Qnil;
479 enable_multibyte = Qnil;
480
481 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
482 store them away before we can GC. Don't need to protect
483 BACKUP_N because we use the value only if it is an integer. */
484 GCPRO5 (map, initial, val, ambient_dir, input_method);
485
486 if (!STRINGP (prompt))
487 prompt = empty_unibyte_string;
488
489 if (!enable_recursive_minibuffers
490 && minibuf_level > 0)
491 {
492 if (EQ (selected_window, minibuf_window))
493 error ("Command attempted to use minibuffer while in minibuffer");
494 else
495 /* If we're in another window, cancel the minibuffer that's active. */
496 Fthrow (Qexit,
497 build_string ("Command attempted to use minibuffer while in minibuffer"));
498 }
499
500 if ((noninteractive
501 /* In case we are running as a daemon, only do this before
502 detaching from the terminal. */
503 || (IS_DAEMON && (daemon_pipe[1] >= 0)))
504 && NILP (Vexecuting_kbd_macro))
505 {
506 val = read_minibuf_noninteractive (map, initial, prompt,
507 make_number (pos),
508 expflag, histvar, histpos, defalt,
509 allow_props, inherit_input_method);
510 UNGCPRO;
511 return unbind_to (count, val);
512 }
513
514 /* Choose the minibuffer window and frame, and take action on them. */
515
516 choose_minibuf_frame ();
517
518 record_unwind_protect (choose_minibuf_frame_1, Qnil);
519
520 record_unwind_protect (Fset_window_configuration,
521 Fcurrent_window_configuration (Qnil));
522
523 /* If the minibuffer window is on a different frame, save that
524 frame's configuration too. */
525 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
526 if (!EQ (mini_frame, selected_frame))
527 record_unwind_protect (Fset_window_configuration,
528 Fcurrent_window_configuration (mini_frame));
529
530 /* If the minibuffer is on an iconified or invisible frame,
531 make it visible now. */
532 Fmake_frame_visible (mini_frame);
533
534 if (minibuffer_auto_raise)
535 Fraise_frame (mini_frame);
536
537 temporarily_switch_to_single_kboard (XFRAME (mini_frame));
538
539 /* We have to do this after saving the window configuration
540 since that is what restores the current buffer. */
541
542 /* Arrange to restore a number of minibuffer-related variables.
543 We could bind each variable separately, but that would use lots of
544 specpdl slots. */
545 minibuf_save_list
546 = Fcons (Voverriding_local_map,
547 Fcons (minibuf_window,
548 minibuf_save_list));
549 minibuf_save_list
550 = Fcons (minibuf_prompt,
551 Fcons (make_number (minibuf_prompt_width),
552 Fcons (Vhelp_form,
553 Fcons (Vcurrent_prefix_arg,
554 Fcons (Vminibuffer_history_position,
555 Fcons (Vminibuffer_history_variable,
556 minibuf_save_list))))));
557
558 record_unwind_protect (read_minibuf_unwind, Qnil);
559 minibuf_level++;
560 /* We are exiting the minibuffer one way or the other, so run the hook.
561 It should be run before unwinding the minibuf settings. Do it
562 separately from read_minibuf_unwind because we need to make sure that
563 read_minibuf_unwind is fully executed even if exit-minibuffer-hook
564 signals an error. --Stef */
565 record_unwind_protect (run_exit_minibuf_hook, Qnil);
566
567 /* Now that we can restore all those variables, start changing them. */
568
569 minibuf_prompt_width = 0;
570 minibuf_prompt = Fcopy_sequence (prompt);
571 Vminibuffer_history_position = histpos;
572 Vminibuffer_history_variable = histvar;
573 Vhelp_form = Vminibuffer_help_form;
574 /* If this minibuffer is reading a file name, that doesn't mean
575 recursive ones are. But we cannot set it to nil, because
576 completion code still need to know the minibuffer is completing a
577 file name. So use `lambda' as intermediate value meaning
578 "t" in this minibuffer, but "nil" in next minibuffer. */
579 if (!NILP (Vminibuffer_completing_file_name))
580 Vminibuffer_completing_file_name = Qlambda;
581
582 if (inherit_input_method)
583 {
584 /* `current-input-method' is buffer local. So, remember it in
585 INPUT_METHOD before changing the current buffer. */
586 input_method = Fsymbol_value (Qcurrent_input_method);
587 enable_multibyte = current_buffer->enable_multibyte_characters;
588 }
589
590 /* Switch to the minibuffer. */
591
592 minibuffer = get_minibuffer (minibuf_level);
593 Fset_buffer (minibuffer);
594
595 /* If appropriate, copy enable-multibyte-characters into the minibuffer. */
596 if (inherit_input_method)
597 current_buffer->enable_multibyte_characters = enable_multibyte;
598
599 /* The current buffer's default directory is usually the right thing
600 for our minibuffer here. However, if you're typing a command at
601 a minibuffer-only frame when minibuf_level is zero, then buf IS
602 the current_buffer, so reset_buffer leaves buf's default
603 directory unchanged. This is a bummer when you've just started
604 up Emacs and buf's default directory is Qnil. Here's a hack; can
605 you think of something better to do? Find another buffer with a
606 better directory, and use that one instead. */
607 if (STRINGP (ambient_dir))
608 current_buffer->directory = ambient_dir;
609 else
610 {
611 Lisp_Object buf_list;
612
613 for (buf_list = Vbuffer_alist;
614 CONSP (buf_list);
615 buf_list = XCDR (buf_list))
616 {
617 Lisp_Object other_buf;
618
619 other_buf = XCDR (XCAR (buf_list));
620 if (STRINGP (XBUFFER (other_buf)->directory))
621 {
622 current_buffer->directory = XBUFFER (other_buf)->directory;
623 break;
624 }
625 }
626 }
627
628 if (!EQ (mini_frame, selected_frame))
629 Fredirect_frame_focus (selected_frame, mini_frame);
630
631 Vminibuf_scroll_window = selected_window;
632 if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
633 minibuf_selected_window = selected_window;
634
635 /* Empty out the minibuffers of all frames other than the one
636 where we are going to display one now.
637 Set them to point to ` *Minibuf-0*', which is always empty. */
638 empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*"));
639
640 FOR_EACH_FRAME (dummy, frame)
641 {
642 Lisp_Object root_window = Fframe_root_window (frame);
643 Lisp_Object mini_window = XWINDOW (root_window)->next;
644
645 if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
646 && !NILP (Fwindow_minibuffer_p (mini_window)))
647 Fset_window_buffer (mini_window, empty_minibuf, Qnil);
648 }
649
650 /* Display this minibuffer in the proper window. */
651 Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
652 Fselect_window (minibuf_window, Qnil);
653 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
654
655 Fmake_local_variable (Qprint_escape_newlines);
656 print_escape_newlines = 1;
657
658 /* Erase the buffer. */
659 {
660 int count1 = SPECPDL_INDEX ();
661 specbind (Qinhibit_read_only, Qt);
662 specbind (Qinhibit_modification_hooks, Qt);
663 Ferase_buffer ();
664
665 if (!NILP (current_buffer->enable_multibyte_characters)
666 && ! STRING_MULTIBYTE (minibuf_prompt))
667 minibuf_prompt = Fstring_make_multibyte (minibuf_prompt);
668
669 /* Insert the prompt, record where it ends. */
670 Finsert (1, &minibuf_prompt);
671 if (PT > BEG)
672 {
673 Fput_text_property (make_number (BEG), make_number (PT),
674 Qfront_sticky, Qt, Qnil);
675 Fput_text_property (make_number (BEG), make_number (PT),
676 Qrear_nonsticky, Qt, Qnil);
677 Fput_text_property (make_number (BEG), make_number (PT),
678 Qfield, Qt, Qnil);
679 Fadd_text_properties (make_number (BEG), make_number (PT),
680 Vminibuffer_prompt_properties, Qnil);
681 }
682 unbind_to (count1, Qnil);
683 }
684
685 minibuf_prompt_width = (int) current_column (); /* iftc */
686
687 /* Put in the initial input. */
688 if (!NILP (initial))
689 {
690 Finsert (1, &initial);
691 Fforward_char (make_number (pos));
692 }
693
694 clear_message (1, 1);
695 current_buffer->keymap = map;
696
697 /* Turn on an input method stored in INPUT_METHOD if any. */
698 if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
699 call1 (Qactivate_input_method, input_method);
700
701 /* Run our hook, but not if it is empty.
702 (run-hooks would do nothing if it is empty,
703 but it's important to save time here in the usual case.) */
704 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
705 && !NILP (Vrun_hooks))
706 call1 (Vrun_hooks, Qminibuffer_setup_hook);
707
708 /* Don't allow the user to undo past this point. */
709 current_buffer->undo_list = Qnil;
710
711 recursive_edit_1 ();
712
713 /* If cursor is on the minibuffer line,
714 show the user we have exited by putting it in column 0. */
715 if (XWINDOW (minibuf_window)->cursor.vpos >= 0
716 && !noninteractive)
717 {
718 XWINDOW (minibuf_window)->cursor.hpos = 0;
719 XWINDOW (minibuf_window)->cursor.x = 0;
720 XWINDOW (minibuf_window)->must_be_updated_p = 1;
721 update_frame (XFRAME (selected_frame), 1, 1);
722 {
723 struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame);
724 struct redisplay_interface *rif = FRAME_RIF (f);
725 if (rif && rif->flush_display)
726 rif->flush_display (f);
727 }
728 }
729
730 /* Make minibuffer contents into a string. */
731 Fset_buffer (minibuffer);
732 if (allow_props)
733 val = Fminibuffer_contents ();
734 else
735 val = Fminibuffer_contents_no_properties ();
736
737 /* VAL is the string of minibuffer text. */
738
739 last_minibuf_string = val;
740
741 /* Choose the string to add to the history. */
742 if (SCHARS (val) != 0)
743 histstring = val;
744 else if (STRINGP (defalt))
745 histstring = defalt;
746 else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
747 histstring = XCAR (defalt);
748 else
749 histstring = Qnil;
750
751 /* Add the value to the appropriate history list, if any. */
752 if (!NILP (Vhistory_add_new_input)
753 && SYMBOLP (Vminibuffer_history_variable)
754 && !NILP (histstring))
755 {
756 /* If the caller wanted to save the value read on a history list,
757 then do so if the value is not already the front of the list. */
758 Lisp_Object histval;
759
760 /* If variable is unbound, make it nil. */
761
762 histval = find_symbol_value (Vminibuffer_history_variable);
763 if (EQ (histval, Qunbound))
764 Fset (Vminibuffer_history_variable, Qnil);
765
766 /* The value of the history variable must be a cons or nil. Other
767 values are unacceptable. We silently ignore these values. */
768
769 if (NILP (histval)
770 || (CONSP (histval)
771 /* Don't duplicate the most recent entry in the history. */
772 && (NILP (Fequal (histstring, Fcar (histval))))))
773 {
774 Lisp_Object length;
775
776 if (history_delete_duplicates) Fdelete (histstring, histval);
777 histval = Fcons (histstring, histval);
778 Fset (Vminibuffer_history_variable, histval);
779
780 /* Truncate if requested. */
781 length = Fget (Vminibuffer_history_variable, Qhistory_length);
782 if (NILP (length)) length = Vhistory_length;
783 if (INTEGERP (length))
784 {
785 if (XINT (length) <= 0)
786 Fset (Vminibuffer_history_variable, Qnil);
787 else
788 {
789 Lisp_Object temp;
790
791 temp = Fnthcdr (Fsub1 (length), histval);
792 if (CONSP (temp)) Fsetcdr (temp, Qnil);
793 }
794 }
795 }
796 }
797
798 /* If Lisp form desired instead of string, parse it. */
799 if (expflag)
800 val = string_to_object (val, defalt);
801
802 /* The appropriate frame will get selected
803 in set-window-configuration. */
804 UNGCPRO;
805 return unbind_to (count, val);
806 }
807
808 /* Return a buffer to be used as the minibuffer at depth `depth'.
809 depth = 0 is the lowest allowed argument, and that is the value
810 used for nonrecursive minibuffer invocations */
811
812 Lisp_Object
813 get_minibuffer (int depth)
814 {
815 Lisp_Object tail, num, buf;
816 char name[24];
817
818 XSETFASTINT (num, depth);
819 tail = Fnthcdr (num, Vminibuffer_list);
820 if (NILP (tail))
821 {
822 tail = Fcons (Qnil, Qnil);
823 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
824 }
825 buf = Fcar (tail);
826 if (NILP (buf) || NILP (XBUFFER (buf)->name))
827 {
828 sprintf (name, " *Minibuf-%d*", depth);
829 buf = Fget_buffer_create (build_string (name));
830
831 /* Although the buffer's name starts with a space, undo should be
832 enabled in it. */
833 Fbuffer_enable_undo (buf);
834
835 XSETCAR (tail, buf);
836 }
837 else
838 {
839 int count = SPECPDL_INDEX ();
840 /* `reset_buffer' blindly sets the list of overlays to NULL, so we
841 have to empty the list, otherwise we end up with overlays that
842 think they belong to this buffer while the buffer doesn't know about
843 them any more. */
844 delete_all_overlays (XBUFFER (buf));
845 reset_buffer (XBUFFER (buf));
846 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
847 Fset_buffer (buf);
848 Fkill_all_local_variables ();
849 unbind_to (count, Qnil);
850 }
851
852 return buf;
853 }
854
855 static Lisp_Object
856 run_exit_minibuf_hook (Lisp_Object data)
857 {
858 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
859 && !NILP (Vrun_hooks))
860 safe_run_hooks (Qminibuffer_exit_hook);
861
862 return Qnil;
863 }
864
865 /* This function is called on exiting minibuffer, whether normally or
866 not, and it restores the current window, buffer, etc. */
867
868 static Lisp_Object
869 read_minibuf_unwind (Lisp_Object data)
870 {
871 Lisp_Object old_deactivate_mark;
872 Lisp_Object window;
873
874 /* If this was a recursive minibuffer,
875 tie the minibuffer window back to the outer level minibuffer buffer. */
876 minibuf_level--;
877
878 window = minibuf_window;
879 /* To keep things predictable, in case it matters, let's be in the
880 minibuffer when we reset the relevant variables. */
881 Fset_buffer (XWINDOW (window)->buffer);
882
883 /* Restore prompt, etc, from outer minibuffer level. */
884 minibuf_prompt = Fcar (minibuf_save_list);
885 minibuf_save_list = Fcdr (minibuf_save_list);
886 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
887 minibuf_save_list = Fcdr (minibuf_save_list);
888 Vhelp_form = Fcar (minibuf_save_list);
889 minibuf_save_list = Fcdr (minibuf_save_list);
890 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
891 minibuf_save_list = Fcdr (minibuf_save_list);
892 Vminibuffer_history_position = Fcar (minibuf_save_list);
893 minibuf_save_list = Fcdr (minibuf_save_list);
894 Vminibuffer_history_variable = Fcar (minibuf_save_list);
895 minibuf_save_list = Fcdr (minibuf_save_list);
896 Voverriding_local_map = Fcar (minibuf_save_list);
897 minibuf_save_list = Fcdr (minibuf_save_list);
898 #if 0
899 temp = Fcar (minibuf_save_list);
900 if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
901 minibuf_window = temp;
902 #endif
903 minibuf_save_list = Fcdr (minibuf_save_list);
904
905 /* Erase the minibuffer we were using at this level. */
906 {
907 int count = SPECPDL_INDEX ();
908 /* Prevent error in erase-buffer. */
909 specbind (Qinhibit_read_only, Qt);
910 specbind (Qinhibit_modification_hooks, Qt);
911 old_deactivate_mark = Vdeactivate_mark;
912 Ferase_buffer ();
913 Vdeactivate_mark = old_deactivate_mark;
914 unbind_to (count, Qnil);
915 }
916
917 /* When we get to the outmost level, make sure we resize the
918 mini-window back to its normal size. */
919 if (minibuf_level == 0)
920 resize_mini_window (XWINDOW (window), 0);
921
922 /* Make sure minibuffer window is erased, not ignored. */
923 windows_or_buffers_changed++;
924 XSETFASTINT (XWINDOW (window)->last_modified, 0);
925 XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
926 return Qnil;
927 }
928 \f
929
930 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 7, 0,
931 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
932 The optional second arg INITIAL-CONTENTS is an obsolete alternative to
933 DEFAULT-VALUE. It normally should be nil in new code, except when
934 HIST is a cons. It is discussed in more detail below.
935 Third arg KEYMAP is a keymap to use whilst reading;
936 if omitted or nil, the default is `minibuffer-local-map'.
937 If fourth arg READ is non-nil, then interpret the result as a Lisp object
938 and return that object:
939 in other words, do `(car (read-from-string INPUT-STRING))'
940 Fifth arg HIST, if non-nil, specifies a history list and optionally
941 the initial position in the list. It can be a symbol, which is the
942 history list variable to use, or it can be a cons cell
943 (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable
944 to use, and HISTPOS is the initial position for use by the minibuffer
945 history commands. For consistency, you should also specify that
946 element of the history as the value of INITIAL-CONTENTS. Positions
947 are counted starting from 1 at the beginning of the list.
948 Sixth arg DEFAULT-VALUE is the default value or the list of default values.
949 If non-nil, it is available for history commands, and as the value
950 (or the first element of the list of default values) to return
951 if the user enters the empty string. But, unless READ is non-nil,
952 `read-from-minibuffer' does NOT return DEFAULT-VALUE if the user enters
953 empty input! It returns the empty string.
954 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
955 the current input method and the setting of `enable-multibyte-characters'.
956 If the variable `minibuffer-allow-text-properties' is non-nil,
957 then the string which is returned includes whatever text properties
958 were present in the minibuffer. Otherwise the value has no text properties.
959
960 The remainder of this documentation string describes the
961 INITIAL-CONTENTS argument in more detail. It is only relevant when
962 studying existing code, or when HIST is a cons. If non-nil,
963 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
964 reading input. Normally, point is put at the end of that string.
965 However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial
966 input is STRING, but point is placed at _one-indexed_ position
967 POSITION in the minibuffer. Any integer value less than or equal to
968 one puts point at the beginning of the string. *Note* that this
969 behavior differs from the way such arguments are used in `completing-read'
970 and some related functions, which use zero-indexing for POSITION. */)
971 (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)
972 {
973 Lisp_Object histvar, histpos, val;
974 struct gcpro gcpro1;
975
976 CHECK_STRING (prompt);
977 if (NILP (keymap))
978 keymap = Vminibuffer_local_map;
979 else
980 keymap = get_keymap (keymap, 1, 0);
981
982 if (SYMBOLP (hist))
983 {
984 histvar = hist;
985 histpos = Qnil;
986 }
987 else
988 {
989 histvar = Fcar_safe (hist);
990 histpos = Fcdr_safe (hist);
991 }
992 if (NILP (histvar))
993 histvar = Qminibuffer_history;
994 if (NILP (histpos))
995 XSETFASTINT (histpos, 0);
996
997 GCPRO1 (default_value);
998 val = read_minibuf (keymap, initial_contents, prompt,
999 Qnil, !NILP (read),
1000 histvar, histpos, default_value,
1001 minibuffer_allow_text_properties,
1002 !NILP (inherit_input_method));
1003 UNGCPRO;
1004 return val;
1005 }
1006
1007 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
1008 doc: /* Return a Lisp object read using the minibuffer, unevaluated.
1009 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1010 is a string to insert in the minibuffer before reading.
1011 \(INITIAL-CONTENTS can also be a cons of a string and an integer.
1012 Such arguments are used as in `read-from-minibuffer'.) */)
1013 (Lisp_Object prompt, Lisp_Object initial_contents)
1014 {
1015 CHECK_STRING (prompt);
1016 return read_minibuf (Vminibuffer_local_map, initial_contents,
1017 prompt, Qnil, 1, Qminibuffer_history,
1018 make_number (0), Qnil, 0, 0);
1019 }
1020
1021 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
1022 doc: /* Return value of Lisp expression read using the minibuffer.
1023 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1024 is a string to insert in the minibuffer before reading.
1025 \(INITIAL-CONTENTS can also be a cons of a string and an integer.
1026 Such arguments are used as in `read-from-minibuffer'.) */)
1027 (Lisp_Object prompt, Lisp_Object initial_contents)
1028 {
1029 return Feval (read_minibuf (Vread_expression_map, initial_contents,
1030 prompt, Qnil, 1, Qread_expression_history,
1031 make_number (0), Qnil, 0, 0));
1032 }
1033
1034 /* Functions that use the minibuffer to read various things. */
1035
1036 DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
1037 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
1038 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
1039 This argument has been superseded by DEFAULT-VALUE and should normally
1040 be nil in new code. It behaves as in `read-from-minibuffer'. See the
1041 documentation string of that function for details.
1042 The third arg HISTORY, if non-nil, specifies a history list
1043 and optionally the initial position in the list.
1044 See `read-from-minibuffer' for details of HISTORY argument.
1045 Fourth arg DEFAULT-VALUE is the default value or the list of default values.
1046 If non-nil, it is used for history commands, and as the value (or the first
1047 element of the list of default values) to return if the user enters the
1048 empty string.
1049 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1050 the current input method and the setting of `enable-multibyte-characters'. */)
1051 (Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method)
1052 {
1053 Lisp_Object val;
1054 val = Fread_from_minibuffer (prompt, initial_input, Qnil,
1055 Qnil, history, default_value,
1056 inherit_input_method);
1057 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
1058 val = CONSP (default_value) ? XCAR (default_value) : default_value;
1059 return val;
1060 }
1061
1062 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
1063 doc: /* Read a string from the terminal, not allowing blanks.
1064 Prompt with PROMPT. Whitespace terminates the input. If INITIAL is
1065 non-nil, it should be a string, which is used as initial input, with
1066 point positioned at the end, so that SPACE will accept the input.
1067 \(Actually, INITIAL can also be a cons of a string and an integer.
1068 Such values are treated as in `read-from-minibuffer', but are normally
1069 not useful in this function.)
1070 Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1071 the current input method and the setting of`enable-multibyte-characters'. */)
1072 (Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
1073 {
1074 CHECK_STRING (prompt);
1075 return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
1076 0, Qminibuffer_history, make_number (0), Qnil, 0,
1077 !NILP (inherit_input_method));
1078 }
1079
1080 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
1081 doc: /* Read the name of a command and return as a symbol.
1082 Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
1083 if it is a list. */)
1084 (Lisp_Object prompt, Lisp_Object default_value)
1085 {
1086 Lisp_Object name, default_string;
1087
1088 if (NILP (default_value))
1089 default_string = Qnil;
1090 else if (SYMBOLP (default_value))
1091 default_string = SYMBOL_NAME (default_value);
1092 else
1093 default_string = default_value;
1094
1095 name = Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
1096 Qnil, Qnil, default_string, Qnil);
1097 if (NILP (name))
1098 return name;
1099 return Fintern (name, Qnil);
1100 }
1101
1102 #ifdef NOTDEF
1103 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
1104 doc: /* One arg PROMPT, a string. Read the name of a function and return as a symbol.
1105 Prompt with PROMPT. */)
1106 (Lisp_Object prompt)
1107 {
1108 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil, Qnil),
1109 Qnil);
1110 }
1111 #endif /* NOTDEF */
1112
1113 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
1114 doc: /* Read the name of a user variable and return it as a symbol.
1115 Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
1116 if it is a list.
1117 A user variable is one for which `user-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 Quser_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 unsigned char *s;
1154 int len;
1155 int count = SPECPDL_INDEX ();
1156
1157 if (BUFFERP (def))
1158 def = 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 = SDATA (prompt);
1176 len = strlen (s);
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, Qbuffer_name_history,
1194 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 int bestmatchsize = 0;
1255 /* These are in bytes, too. */
1256 int 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 int index = 0, obsize = 0;
1266 int matchcount = 0;
1267 int 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 = XVECTOR (collection)->size;
1284 bucket = XVECTOR (collection)->contents[index];
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 (++index >= obsize)
1316 break;
1317 else
1318 {
1319 bucket = XVECTOR (collection)->contents[index];
1320 continue;
1321 }
1322 }
1323 else /* if (type == hash_table) */
1324 {
1325 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1326 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1327 index++;
1328 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1329 break;
1330 else
1331 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
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 index - 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 int index = 0, obsize = 0;
1531 int 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 = XVECTOR (collection)->size;
1547 bucket = XVECTOR (collection)->contents[index];
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 (++index >= obsize)
1579 break;
1580 else
1581 {
1582 bucket = XVECTOR (collection)->contents[index];
1583 continue;
1584 }
1585 }
1586 else /* if (type == 3) */
1587 {
1588 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1589 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1590 index++;
1591 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1592 break;
1593 else
1594 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
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 Lisp_Object zero;
1620 XSETFASTINT (zero, 0);
1621
1622 /* Ignore this element if it fails to match all the regexps. */
1623 {
1624 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1625 regexps = XCDR (regexps))
1626 {
1627 if (bindcount < 0) {
1628 bindcount = SPECPDL_INDEX ();
1629 specbind (Qcase_fold_search,
1630 completion_ignore_case ? Qt : Qnil);
1631 }
1632 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1633 if (NILP (tem))
1634 break;
1635 }
1636 if (CONSP (regexps))
1637 continue;
1638 }
1639
1640 /* Ignore this element if there is a predicate
1641 and the predicate doesn't like it. */
1642
1643 if (!NILP (predicate))
1644 {
1645 if (EQ (predicate, Qcommandp))
1646 tem = Fcommandp (elt, Qnil);
1647 else
1648 {
1649 if (bindcount >= 0) {
1650 unbind_to (bindcount, Qnil);
1651 bindcount = -1;
1652 }
1653 GCPRO4 (tail, eltstring, allmatches, string);
1654 tem = type == 3
1655 ? call2 (predicate, elt,
1656 HASH_VALUE (XHASH_TABLE (collection), index - 1))
1657 : call1 (predicate, elt);
1658 UNGCPRO;
1659 }
1660 if (NILP (tem)) continue;
1661 }
1662 /* Ok => put it on the list. */
1663 allmatches = Fcons (eltstring, allmatches);
1664 }
1665 }
1666
1667 if (bindcount >= 0) {
1668 unbind_to (bindcount, Qnil);
1669 bindcount = -1;
1670 }
1671
1672 return Fnreverse (allmatches);
1673 }
1674 \f
1675 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
1676 doc: /* Read a string in the minibuffer, with completion.
1677 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1678 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1679 COLLECTION can also be a function to do the completion itself.
1680 PREDICATE limits completion to a subset of COLLECTION.
1681 See `try-completion' and `all-completions' for more details
1682 on completion, COLLECTION, and PREDICATE.
1683
1684 REQUIRE-MATCH can take the following values:
1685 - t means that the user is not allowed to exit unless
1686 the input is (or completes to) an element of COLLECTION or is null.
1687 - nil means that the user can exit with any input.
1688 - `confirm' means that the user can exit with any input, but she needs
1689 to confirm her choice if the input is not an element of COLLECTION.
1690 - `confirm-after-completion' means that the user can exit with any
1691 input, but she needs to confirm her choice if she called
1692 `minibuffer-complete' right before `minibuffer-complete-and-exit'
1693 and the input is not an element of COLLECTION.
1694 - anything else behaves like t except that typing RET does not exit if it
1695 does non-null completion.
1696
1697 If the input is null, `completing-read' returns DEF, or the first element
1698 of the list of default values, or an empty string if DEF is nil,
1699 regardless of the value of REQUIRE-MATCH.
1700
1701 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
1702 with point positioned at the end.
1703 If it is (STRING . POSITION), the initial input is STRING, but point
1704 is placed at _zero-indexed_ position POSITION in STRING. (*Note*
1705 that this is different from `read-from-minibuffer' and related
1706 functions, which use one-indexing for POSITION.) This feature is
1707 deprecated--it is best to pass nil for INITIAL-INPUT and supply the
1708 default value DEF instead. The user can yank the default value into
1709 the minibuffer easily using \\[next-history-element].
1710
1711 HIST, if non-nil, specifies a history list and optionally the initial
1712 position in the list. It can be a symbol, which is the history list
1713 variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In
1714 that case, HISTVAR is the history list variable to use, and HISTPOS
1715 is the initial position (the position in the list used by the
1716 minibuffer history commands). For consistency, you should also
1717 specify that element of the history as the value of
1718 INITIAL-INPUT. (This is the only case in which you should use
1719 INITIAL-INPUT instead of DEF.) Positions are counted starting from
1720 1 at the beginning of the list. The variable `history-length'
1721 controls the maximum length of a history list.
1722
1723 DEF, if non-nil, is the default value or the list of default values.
1724
1725 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits
1726 the current input method and the setting of `enable-multibyte-characters'.
1727
1728 Completion ignores case if the ambient value of
1729 `completion-ignore-case' is non-nil. */)
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 val, histvar, histpos, position;
1733 Lisp_Object init;
1734 int pos = 0;
1735 int count = SPECPDL_INDEX ();
1736 struct gcpro gcpro1;
1737
1738 init = initial_input;
1739 GCPRO1 (def);
1740
1741 specbind (Qminibuffer_completion_table, collection);
1742 specbind (Qminibuffer_completion_predicate, predicate);
1743 specbind (Qminibuffer_completion_confirm,
1744 EQ (require_match, Qt) ? Qnil : require_match);
1745
1746 position = Qnil;
1747 if (!NILP (init))
1748 {
1749 if (CONSP (init))
1750 {
1751 position = Fcdr (init);
1752 init = Fcar (init);
1753 }
1754 CHECK_STRING (init);
1755 if (!NILP (position))
1756 {
1757 CHECK_NUMBER (position);
1758 /* Convert to distance from end of input. */
1759 pos = XINT (position) - SCHARS (init);
1760 }
1761 }
1762
1763 if (SYMBOLP (hist))
1764 {
1765 histvar = hist;
1766 histpos = Qnil;
1767 }
1768 else
1769 {
1770 histvar = Fcar_safe (hist);
1771 histpos = Fcdr_safe (hist);
1772 }
1773 if (NILP (histvar))
1774 histvar = Qminibuffer_history;
1775 if (NILP (histpos))
1776 XSETFASTINT (histpos, 0);
1777
1778 val = read_minibuf (NILP (require_match)
1779 ? (NILP (Vminibuffer_completing_file_name)
1780 || EQ (Vminibuffer_completing_file_name, Qlambda)
1781 ? Vminibuffer_local_completion_map
1782 : Vminibuffer_local_filename_completion_map)
1783 : (NILP (Vminibuffer_completing_file_name)
1784 || EQ (Vminibuffer_completing_file_name, Qlambda)
1785 ? Vminibuffer_local_must_match_map
1786 : Vminibuffer_local_filename_must_match_map),
1787 init, prompt, make_number (pos), 0,
1788 histvar, histpos, def, 0,
1789 !NILP (inherit_input_method));
1790
1791 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
1792 val = CONSP (def) ? XCAR (def) : def;
1793
1794 RETURN_UNGCPRO (unbind_to (count, val));
1795 }
1796 \f
1797 Lisp_Object Fassoc_string (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold);
1798
1799 /* Test whether TXT is an exact completion. */
1800 DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
1801 doc: /* Return non-nil if STRING is a valid completion.
1802 Takes the same arguments as `all-completions' and `try-completion'.
1803 If COLLECTION is a function, it is called with three arguments:
1804 the values STRING, PREDICATE and `lambda'. */)
1805 (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
1806 {
1807 Lisp_Object regexps, tail, tem = Qnil;
1808 int i = 0;
1809
1810 CHECK_STRING (string);
1811
1812 if ((CONSP (collection)
1813 && (!SYMBOLP (XCAR (collection)) || NILP (XCAR (collection))))
1814 || NILP (collection))
1815 {
1816 tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
1817 if (NILP (tem))
1818 return Qnil;
1819 }
1820 else if (VECTORP (collection))
1821 {
1822 /* Bypass intern-soft as that loses for nil. */
1823 tem = oblookup (collection,
1824 SDATA (string),
1825 SCHARS (string),
1826 SBYTES (string));
1827 if (!SYMBOLP (tem))
1828 {
1829 if (STRING_MULTIBYTE (string))
1830 string = Fstring_make_unibyte (string);
1831 else
1832 string = Fstring_make_multibyte (string);
1833
1834 tem = oblookup (collection,
1835 SDATA (string),
1836 SCHARS (string),
1837 SBYTES (string));
1838 }
1839
1840 if (completion_ignore_case && !SYMBOLP (tem))
1841 {
1842 for (i = XVECTOR (collection)->size - 1; i >= 0; i--)
1843 {
1844 tail = XVECTOR (collection)->contents[i];
1845 if (SYMBOLP (tail))
1846 while (1)
1847 {
1848 if (EQ((Fcompare_strings (string, make_number (0), Qnil,
1849 Fsymbol_name (tail),
1850 make_number (0) , Qnil, Qt)),
1851 Qt))
1852 {
1853 tem = tail;
1854 break;
1855 }
1856 if (XSYMBOL (tail)->next == 0)
1857 break;
1858 XSETSYMBOL (tail, XSYMBOL (tail)->next);
1859 }
1860 }
1861 }
1862
1863 if (!SYMBOLP (tem))
1864 return Qnil;
1865 }
1866 else if (HASH_TABLE_P (collection))
1867 {
1868 struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
1869 i = hash_lookup (h, string, NULL);
1870 if (i >= 0)
1871 tem = HASH_KEY (h, i);
1872 else
1873 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1874 if (!NILP (HASH_HASH (h, i)) &&
1875 EQ (Fcompare_strings (string, make_number (0), Qnil,
1876 HASH_KEY (h, i), make_number (0) , Qnil,
1877 completion_ignore_case ? Qt : Qnil),
1878 Qt))
1879 {
1880 tem = HASH_KEY (h, i);
1881 break;
1882 }
1883 if (!STRINGP (tem))
1884 return Qnil;
1885 }
1886 else
1887 return call3 (collection, string, predicate, Qlambda);
1888
1889 /* Reject this element if it fails to match all the regexps. */
1890 if (CONSP (Vcompletion_regexp_list))
1891 {
1892 int count = SPECPDL_INDEX ();
1893 specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
1894 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1895 regexps = XCDR (regexps))
1896 {
1897 if (NILP (Fstring_match (XCAR (regexps),
1898 SYMBOLP (tem) ? string : tem,
1899 Qnil)))
1900 return unbind_to (count, Qnil);
1901 }
1902 unbind_to (count, Qnil);
1903 }
1904
1905 /* Finally, check the predicate. */
1906 if (!NILP (predicate))
1907 {
1908 return HASH_TABLE_P (collection)
1909 ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
1910 : call1 (predicate, tem);
1911 }
1912 else
1913 return Qt;
1914 }
1915
1916 DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
1917 doc: /* Perform completion on buffer names.
1918 If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
1919 `all-completions', otherwise invoke `test-completion'.
1920
1921 The arguments STRING and PREDICATE are as in `try-completion',
1922 `all-completions', and `test-completion'. */)
1923 (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
1924 {
1925 if (NILP (flag))
1926 return Ftry_completion (string, Vbuffer_alist, predicate);
1927 else if (EQ (flag, Qt))
1928 {
1929 Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil);
1930 if (SCHARS (string) > 0)
1931 return res;
1932 else
1933 { /* Strip out internal buffers. */
1934 Lisp_Object bufs = res;
1935 /* First, look for a non-internal buffer in `res'. */
1936 while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ')
1937 bufs = XCDR (bufs);
1938 if (NILP (bufs))
1939 /* All bufs in `res' are internal, so don't trip them out. */
1940 return res;
1941 res = bufs;
1942 while (CONSP (XCDR (bufs)))
1943 if (SREF (XCAR (XCDR (bufs)), 0) == ' ')
1944 XSETCDR (bufs, XCDR (XCDR (bufs)));
1945 else
1946 bufs = XCDR (bufs);
1947 return res;
1948 }
1949 }
1950 else /* assume `lambda' */
1951 return Ftest_completion (string, Vbuffer_alist, predicate);
1952 }
1953
1954 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1955
1956 DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
1957 doc: /* Like `assoc' but specifically for strings (and symbols).
1958
1959 This returns the first element of LIST whose car matches the string or
1960 symbol KEY, or nil if no match exists. When performing the
1961 comparison, symbols are first converted to strings, and unibyte
1962 strings to multibyte. If the optional arg CASE-FOLD is non-nil, case
1963 is ignored.
1964
1965 Unlike `assoc', KEY can also match an entry in LIST consisting of a
1966 single string, rather than a cons cell whose car is a string. */)
1967 (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold)
1968 {
1969 register Lisp_Object tail;
1970
1971 if (SYMBOLP (key))
1972 key = Fsymbol_name (key);
1973
1974 for (tail = list; CONSP (tail); tail = XCDR (tail))
1975 {
1976 register Lisp_Object elt, tem, thiscar;
1977 elt = XCAR (tail);
1978 thiscar = CONSP (elt) ? XCAR (elt) : elt;
1979 if (SYMBOLP (thiscar))
1980 thiscar = Fsymbol_name (thiscar);
1981 else if (!STRINGP (thiscar))
1982 continue;
1983 tem = Fcompare_strings (thiscar, make_number (0), Qnil,
1984 key, make_number (0), Qnil,
1985 case_fold);
1986 if (EQ (tem, Qt))
1987 return elt;
1988 QUIT;
1989 }
1990 return Qnil;
1991 }
1992
1993 \f
1994 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1995 doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */)
1996 (void)
1997 {
1998 return make_number (minibuf_level);
1999 }
2000
2001 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
2002 doc: /* Return the prompt string of the currently-active minibuffer.
2003 If no minibuffer is active, return nil. */)
2004 (void)
2005 {
2006 return Fcopy_sequence (minibuf_prompt);
2007 }
2008
2009 \f
2010 void
2011 init_minibuf_once (void)
2012 {
2013 Vminibuffer_list = Qnil;
2014 staticpro (&Vminibuffer_list);
2015 }
2016
2017 void
2018 syms_of_minibuf (void)
2019 {
2020 minibuf_level = 0;
2021 minibuf_prompt = Qnil;
2022 staticpro (&minibuf_prompt);
2023
2024 minibuf_save_list = Qnil;
2025 staticpro (&minibuf_save_list);
2026
2027 Qcompletion_ignore_case = intern_c_string ("completion-ignore-case");
2028 staticpro (&Qcompletion_ignore_case);
2029
2030 Qread_file_name_internal = intern_c_string ("read-file-name-internal");
2031 staticpro (&Qread_file_name_internal);
2032
2033 Qminibuffer_default = intern_c_string ("minibuffer-default");
2034 staticpro (&Qminibuffer_default);
2035 Fset (Qminibuffer_default, Qnil);
2036
2037 Qminibuffer_completion_table = intern_c_string ("minibuffer-completion-table");
2038 staticpro (&Qminibuffer_completion_table);
2039
2040 Qminibuffer_completion_confirm = intern_c_string ("minibuffer-completion-confirm");
2041 staticpro (&Qminibuffer_completion_confirm);
2042
2043 Qminibuffer_completion_predicate = intern_c_string ("minibuffer-completion-predicate");
2044 staticpro (&Qminibuffer_completion_predicate);
2045
2046 staticpro (&last_minibuf_string);
2047 last_minibuf_string = Qnil;
2048
2049 Quser_variable_p = intern_c_string ("user-variable-p");
2050 staticpro (&Quser_variable_p);
2051
2052 Qminibuffer_history = intern_c_string ("minibuffer-history");
2053 staticpro (&Qminibuffer_history);
2054
2055 Qbuffer_name_history = intern_c_string ("buffer-name-history");
2056 staticpro (&Qbuffer_name_history);
2057 Fset (Qbuffer_name_history, Qnil);
2058
2059 Qminibuffer_setup_hook = intern_c_string ("minibuffer-setup-hook");
2060 staticpro (&Qminibuffer_setup_hook);
2061
2062 Qminibuffer_exit_hook = intern_c_string ("minibuffer-exit-hook");
2063 staticpro (&Qminibuffer_exit_hook);
2064
2065 Qhistory_length = intern_c_string ("history-length");
2066 staticpro (&Qhistory_length);
2067
2068 Qcurrent_input_method = intern_c_string ("current-input-method");
2069 staticpro (&Qcurrent_input_method);
2070
2071 Qactivate_input_method = intern_c_string ("activate-input-method");
2072 staticpro (&Qactivate_input_method);
2073
2074 Qcase_fold_search = intern_c_string ("case-fold-search");
2075 staticpro (&Qcase_fold_search);
2076
2077 Qread_expression_history = intern_c_string ("read-expression-history");
2078 staticpro (&Qread_expression_history);
2079
2080 DEFVAR_LISP ("read-buffer-function", &Vread_buffer_function,
2081 doc: /* If this is non-nil, `read-buffer' does its work by calling this function.
2082 The function is called with the arguments passed to `read-buffer'. */);
2083 Vread_buffer_function = Qnil;
2084
2085 DEFVAR_BOOL ("read-buffer-completion-ignore-case",
2086 &read_buffer_completion_ignore_case,
2087 doc: /* *Non-nil means completion ignores case when reading a buffer name. */);
2088 read_buffer_completion_ignore_case = 0;
2089
2090 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
2091 doc: /* Normal hook run just after entry to minibuffer. */);
2092 Vminibuffer_setup_hook = Qnil;
2093
2094 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
2095 doc: /* Normal hook run just after exit from minibuffer. */);
2096 Vminibuffer_exit_hook = Qnil;
2097
2098 DEFVAR_LISP ("history-length", &Vhistory_length,
2099 doc: /* *Maximum length for history lists before truncation takes place.
2100 A number means that length; t means infinite. Truncation takes place
2101 just after a new element is inserted. Setting the `history-length'
2102 property of a history variable overrides this default. */);
2103 XSETFASTINT (Vhistory_length, 30);
2104
2105 DEFVAR_BOOL ("history-delete-duplicates", &history_delete_duplicates,
2106 doc: /* *Non-nil means to delete duplicates in history.
2107 If set to t when adding a new history element, all previous identical
2108 elements are deleted from the history list. */);
2109 history_delete_duplicates = 0;
2110
2111 DEFVAR_LISP ("history-add-new-input", &Vhistory_add_new_input,
2112 doc: /* *Non-nil means to add new elements in history.
2113 If set to nil, minibuffer reading functions don't add new elements to the
2114 history list, so it is possible to do this afterwards by calling
2115 `add-to-history' explicitly. */);
2116 Vhistory_add_new_input = Qt;
2117
2118 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
2119 doc: /* Non-nil means don't consider case significant in completion.
2120 For file-name completion, `read-file-name-completion-ignore-case'
2121 controls the behavior, rather than this variable.
2122 For buffer name completion, `read-buffer-completion-ignore-case'
2123 controls the behavior, rather than this variable. */);
2124 completion_ignore_case = 0;
2125
2126 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
2127 doc: /* *Non-nil means to allow minibuffer commands while in the minibuffer.
2128 This variable makes a difference whenever the minibuffer window is active. */);
2129 enable_recursive_minibuffers = 0;
2130
2131 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
2132 doc: /* Alist or obarray used for completion in the minibuffer.
2133 This becomes the ALIST argument to `try-completion' and `all-completions'.
2134 The value can also be a list of strings or a hash table.
2135
2136 The value may alternatively be a function, which is given three arguments:
2137 STRING, the current buffer contents;
2138 PREDICATE, the predicate for filtering possible matches;
2139 CODE, which says what kind of things to do.
2140 CODE can be nil, t or `lambda':
2141 nil -- return the best completion of STRING, or nil if there is none.
2142 t -- return a list of all possible completions of STRING.
2143 lambda -- return t if STRING is a valid completion as it stands. */);
2144 Vminibuffer_completion_table = Qnil;
2145
2146 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
2147 doc: /* Within call to `completing-read', this holds the PREDICATE argument. */);
2148 Vminibuffer_completion_predicate = Qnil;
2149
2150 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
2151 doc: /* Whether to demand confirmation of completion before exiting minibuffer.
2152 If nil, confirmation is not required.
2153 If the value is `confirm', the user may exit with an input that is not
2154 a valid completion alternative, but Emacs asks for confirmation.
2155 If the value is `confirm-after-completion', the user may exit with an
2156 input that is not a valid completion alternative, but Emacs asks for
2157 confirmation if the user submitted the input right after any of the
2158 completion commands listed in `minibuffer-confirm-exit-commands'. */);
2159 Vminibuffer_completion_confirm = Qnil;
2160
2161 DEFVAR_LISP ("minibuffer-completing-file-name",
2162 &Vminibuffer_completing_file_name,
2163 doc: /* Non-nil means completing file names. */);
2164 Vminibuffer_completing_file_name = Qnil;
2165
2166 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
2167 doc: /* Value that `help-form' takes on inside the minibuffer. */);
2168 Vminibuffer_help_form = Qnil;
2169
2170 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
2171 doc: /* History list symbol to add minibuffer values to.
2172 Each string of minibuffer input, as it appears on exit from the minibuffer,
2173 is added with
2174 (set minibuffer-history-variable
2175 (cons STRING (symbol-value minibuffer-history-variable))) */);
2176 XSETFASTINT (Vminibuffer_history_variable, 0);
2177
2178 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
2179 doc: /* Current position of redoing in the history list. */);
2180 Vminibuffer_history_position = Qnil;
2181
2182 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
2183 doc: /* *Non-nil means entering the minibuffer raises the minibuffer's frame.
2184 Some uses of the echo area also raise that frame (since they use it too). */);
2185 minibuffer_auto_raise = 0;
2186
2187 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
2188 doc: /* List of regexps that should restrict possible completions.
2189 The basic completion functions only consider a completion acceptable
2190 if it matches all regular expressions in this list, with
2191 `case-fold-search' bound to the value of `completion-ignore-case'.
2192 See Info node `(elisp)Basic Completion', for a description of these
2193 functions. */);
2194 Vcompletion_regexp_list = Qnil;
2195
2196 DEFVAR_BOOL ("minibuffer-allow-text-properties",
2197 &minibuffer_allow_text_properties,
2198 doc: /* Non-nil means `read-from-minibuffer' should not discard text properties.
2199 This also affects `read-string', but it does not affect `read-minibuffer',
2200 `read-no-blanks-input', or any of the functions that do minibuffer input
2201 with completion; they always discard text properties. */);
2202 minibuffer_allow_text_properties = 0;
2203
2204 DEFVAR_LISP ("minibuffer-prompt-properties", &Vminibuffer_prompt_properties,
2205 doc: /* Text properties that are added to minibuffer prompts.
2206 These are in addition to the basic `field' property, and stickiness
2207 properties. */);
2208 /* We use `intern' here instead of Qread_only to avoid
2209 initialization-order problems. */
2210 Vminibuffer_prompt_properties
2211 = Fcons (intern_c_string ("read-only"), Fcons (Qt, Qnil));
2212
2213 DEFVAR_LISP ("read-expression-map", &Vread_expression_map,
2214 doc: /* Minibuffer keymap used for reading Lisp expressions. */);
2215 Vread_expression_map = Qnil;
2216
2217 defsubr (&Sset_minibuffer_window);
2218 defsubr (&Sread_from_minibuffer);
2219 defsubr (&Seval_minibuffer);
2220 defsubr (&Sread_minibuffer);
2221 defsubr (&Sread_string);
2222 defsubr (&Sread_command);
2223 defsubr (&Sread_variable);
2224 defsubr (&Sinternal_complete_buffer);
2225 defsubr (&Sread_buffer);
2226 defsubr (&Sread_no_blanks_input);
2227 defsubr (&Sminibuffer_depth);
2228 defsubr (&Sminibuffer_prompt);
2229
2230 defsubr (&Sminibufferp);
2231 defsubr (&Sminibuffer_prompt_end);
2232 defsubr (&Sminibuffer_contents);
2233 defsubr (&Sminibuffer_contents_no_properties);
2234 defsubr (&Sminibuffer_completion_contents);
2235
2236 defsubr (&Stry_completion);
2237 defsubr (&Sall_completions);
2238 defsubr (&Stest_completion);
2239 defsubr (&Sassoc_string);
2240 defsubr (&Scompleting_read);
2241 }
2242