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