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