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