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