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