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