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