]> code.delx.au - gnu-emacs/blob - src/minibuf.c
Merge from emacs--devo--0
[gnu-emacs] / src / minibuf.c
1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005,
4 2006, 2007, 2008 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
22
23
24 #include <config.h>
25 #include <stdio.h>
26
27 #include "lisp.h"
28 #include "commands.h"
29 #include "buffer.h"
30 #include "character.h"
31 #include "dispextern.h"
32 #include "keyboard.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "syntax.h"
36 #include "intervals.h"
37 #include "keymap.h"
38 #include "termhooks.h"
39
40 extern int quit_char;
41
42 /* List of buffers for use as minibuffers.
43 The first element of the list is used for the outermost minibuffer
44 invocation, the next element is used for a recursive minibuffer
45 invocation, etc. The list is extended at the end as deeper
46 minibuffer recursions are encountered. */
47
48 Lisp_Object Vminibuffer_list;
49
50 /* Data to remember during recursive minibuffer invocations */
51
52 Lisp_Object minibuf_save_list;
53
54 /* Depth in minibuffer invocations. */
55
56 int minibuf_level;
57
58 /* Nonzero means display completion help for invalid input. */
59
60 Lisp_Object Vcompletion_auto_help;
61
62 /* The maximum length of a minibuffer history. */
63
64 Lisp_Object Qhistory_length, Vhistory_length;
65
66 /* No duplicates in history. */
67
68 int history_delete_duplicates;
69
70 /* Non-nil means add new input to history. */
71
72 Lisp_Object Vhistory_add_new_input;
73
74 /* Fread_minibuffer leaves the input here as a string. */
75
76 Lisp_Object last_minibuf_string;
77
78 /* Nonzero means let functions called when within a minibuffer
79 invoke recursive minibuffers (to read arguments, or whatever) */
80
81 int enable_recursive_minibuffers;
82
83 /* Nonzero means don't ignore text properties
84 in Fread_from_minibuffer. */
85
86 int minibuffer_allow_text_properties;
87
88 /* help-form is bound to this while in the minibuffer. */
89
90 Lisp_Object Vminibuffer_help_form;
91
92 /* Variable which is the history list to add minibuffer values to. */
93
94 Lisp_Object Vminibuffer_history_variable;
95
96 /* Current position in the history list (adjusted by M-n and M-p). */
97
98 Lisp_Object Vminibuffer_history_position;
99
100 /* Text properties that are added to minibuffer prompts.
101 These are in addition to the basic `field' property, and stickiness
102 properties. */
103
104 Lisp_Object Vminibuffer_prompt_properties;
105
106 Lisp_Object Qminibuffer_history, Qbuffer_name_history;
107
108 Lisp_Object Qread_file_name_internal;
109
110 /* Normal hooks for entry to and exit from minibuffer. */
111
112 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
113 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
114
115 /* Function to call to read a buffer name. */
116 Lisp_Object Vread_buffer_function;
117
118 /* Nonzero means completion ignores case. */
119
120 int completion_ignore_case;
121 Lisp_Object Qcompletion_ignore_case;
122
123 /* List of regexps that should restrict possible completions. */
124
125 Lisp_Object Vcompletion_regexp_list;
126
127 /* Nonzero means raise the minibuffer frame when the minibuffer
128 is entered. */
129
130 int minibuffer_auto_raise;
131
132 /* If last completion attempt reported "Complete but not unique"
133 then this is the string completed then; otherwise this is nil. */
134
135 static Lisp_Object last_exact_completion;
136
137 /* Keymap for reading expressions. */
138 Lisp_Object Vread_expression_map;
139
140 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
141 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
142 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
143 Lisp_Object Vminibuffer_completing_file_name;
144
145 Lisp_Object Quser_variable_p;
146
147 Lisp_Object Qminibuffer_default;
148
149 Lisp_Object Qcurrent_input_method, Qactivate_input_method;
150
151 Lisp_Object Qcase_fold_search;
152
153 Lisp_Object Qread_expression_history;
154
155 extern Lisp_Object Voverriding_local_map;
156
157 extern Lisp_Object Qmouse_face;
158
159 extern Lisp_Object Qfield;
160 \f
161 /* Put minibuf on currently selected frame's minibuffer.
162 We do this whenever the user starts a new minibuffer
163 or when a minibuffer exits. */
164
165 void
166 choose_minibuf_frame ()
167 {
168 if (FRAMEP (selected_frame)
169 && FRAME_LIVE_P (XFRAME (selected_frame))
170 && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
171 {
172 struct frame *sf = XFRAME (selected_frame);
173 Lisp_Object buffer;
174
175 /* I don't think that any frames may validly have a null minibuffer
176 window anymore. */
177 if (NILP (sf->minibuffer_window))
178 abort ();
179
180 /* Under X, we come here with minibuf_window being the
181 minibuffer window of the unused termcap window created in
182 init_window_once. That window doesn't have a buffer. */
183 buffer = XWINDOW (minibuf_window)->buffer;
184 if (BUFFERP (buffer))
185 Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
186 minibuf_window = sf->minibuffer_window;
187 }
188
189 /* Make sure no other frame has a minibuffer as its selected window,
190 because the text would not be displayed in it, and that would be
191 confusing. Only allow the selected frame to do this,
192 and that only if the minibuffer is active. */
193 {
194 Lisp_Object tail, frame;
195
196 FOR_EACH_FRAME (tail, frame)
197 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
198 && !(EQ (frame, selected_frame)
199 && minibuf_level > 0))
200 Fset_frame_selected_window (frame, Fframe_first_window (frame));
201 }
202 }
203
204 Lisp_Object
205 choose_minibuf_frame_1 (ignore)
206 Lisp_Object ignore;
207 {
208 choose_minibuf_frame ();
209 return Qnil;
210 }
211
212 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
213 Sset_minibuffer_window, 1, 1, 0,
214 doc: /* Specify which minibuffer window to use for the minibuffer.
215 This affects where the minibuffer is displayed if you put text in it
216 without invoking the usual minibuffer commands. */)
217 (window)
218 Lisp_Object window;
219 {
220 CHECK_WINDOW (window);
221 if (! MINI_WINDOW_P (XWINDOW (window)))
222 error ("Window is not a minibuffer window");
223
224 minibuf_window = window;
225
226 return window;
227 }
228
229 \f
230 /* Actual minibuffer invocation. */
231
232 static Lisp_Object read_minibuf_unwind P_ ((Lisp_Object));
233 static Lisp_Object run_exit_minibuf_hook P_ ((Lisp_Object));
234 static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object,
235 Lisp_Object, Lisp_Object,
236 int, Lisp_Object,
237 Lisp_Object, Lisp_Object,
238 int, int));
239 static Lisp_Object read_minibuf_noninteractive P_ ((Lisp_Object, Lisp_Object,
240 Lisp_Object, Lisp_Object,
241 int, Lisp_Object,
242 Lisp_Object, Lisp_Object,
243 int, int));
244 static Lisp_Object string_to_object P_ ((Lisp_Object, Lisp_Object));
245
246
247 /* Read a Lisp object from VAL and return it. If VAL is an empty
248 string, and DEFALT is a string, read from DEFALT instead of VAL. */
249
250 static Lisp_Object
251 string_to_object (val, defalt)
252 Lisp_Object val, defalt;
253 {
254 struct gcpro gcpro1, gcpro2;
255 Lisp_Object expr_and_pos;
256 int pos;
257
258 GCPRO2 (val, defalt);
259
260 if (STRINGP (val) && SCHARS (val) == 0)
261 {
262 if (STRINGP (defalt))
263 val = defalt;
264 else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
265 val = XCAR (defalt);
266 }
267
268 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
269 pos = XINT (Fcdr (expr_and_pos));
270 if (pos != SCHARS (val))
271 {
272 /* Ignore trailing whitespace; any other trailing junk
273 is an error. */
274 int i;
275 pos = string_char_to_byte (val, pos);
276 for (i = pos; i < SBYTES (val); i++)
277 {
278 int c = SREF (val, i);
279 if (c != ' ' && c != '\t' && c != '\n')
280 error ("Trailing garbage following expression");
281 }
282 }
283
284 val = Fcar (expr_and_pos);
285 RETURN_UNGCPRO (val);
286 }
287
288
289 /* Like read_minibuf but reading from stdin. This function is called
290 from read_minibuf to do the job if noninteractive. */
291
292 static Lisp_Object
293 read_minibuf_noninteractive (map, initial, prompt, backup_n, expflag,
294 histvar, histpos, defalt, allow_props,
295 inherit_input_method)
296 Lisp_Object map;
297 Lisp_Object initial;
298 Lisp_Object prompt;
299 Lisp_Object backup_n;
300 int expflag;
301 Lisp_Object histvar;
302 Lisp_Object histpos;
303 Lisp_Object defalt;
304 int allow_props;
305 int inherit_input_method;
306 {
307 int size, len;
308 char *line, *s;
309 Lisp_Object val;
310
311 fprintf (stdout, "%s", SDATA (prompt));
312 fflush (stdout);
313
314 val = Qnil;
315 size = 100;
316 len = 0;
317 line = (char *) xmalloc (size * sizeof *line);
318 while ((s = fgets (line + len, size - len, stdin)) != NULL
319 && (len = strlen (line),
320 len == size - 1 && line[len - 1] != '\n'))
321 {
322 size *= 2;
323 line = (char *) xrealloc (line, size);
324 }
325
326 if (s)
327 {
328 len = strlen (line);
329
330 if (len > 0 && line[len - 1] == '\n')
331 line[--len] = '\0';
332
333 val = build_string (line);
334 xfree (line);
335 }
336 else
337 {
338 xfree (line);
339 error ("Error reading from stdin");
340 }
341
342 /* If Lisp form desired instead of string, parse it. */
343 if (expflag)
344 val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
345
346 return val;
347 }
348 \f
349 DEFUN ("minibufferp", Fminibufferp,
350 Sminibufferp, 0, 1, 0,
351 doc: /* Return t if BUFFER is a minibuffer.
352 No argument or nil as argument means use current buffer as BUFFER.
353 BUFFER can be a buffer or a buffer name. */)
354 (buffer)
355 Lisp_Object buffer;
356 {
357 Lisp_Object tem;
358
359 if (NILP (buffer))
360 buffer = Fcurrent_buffer ();
361 else if (STRINGP (buffer))
362 buffer = Fget_buffer (buffer);
363 else
364 CHECK_BUFFER (buffer);
365
366 tem = Fmemq (buffer, Vminibuffer_list);
367 return ! NILP (tem) ? Qt : Qnil;
368 }
369
370 DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
371 Sminibuffer_prompt_end, 0, 0, 0,
372 doc: /* Return the buffer position of the end of the minibuffer prompt.
373 Return (point-min) if current buffer is not a minibuffer. */)
374 ()
375 {
376 /* This function is written to be most efficient when there's a prompt. */
377 Lisp_Object beg, end, tem;
378 beg = make_number (BEGV);
379
380 tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list);
381 if (NILP (tem))
382 return beg;
383
384 end = Ffield_end (beg, Qnil, Qnil);
385
386 if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil)))
387 return beg;
388 else
389 return end;
390 }
391
392 DEFUN ("minibuffer-contents", Fminibuffer_contents,
393 Sminibuffer_contents, 0, 0, 0,
394 doc: /* Return the user input in a minibuffer as a string.
395 If the current buffer is not a minibuffer, return its entire contents. */)
396 ()
397 {
398 int prompt_end = XINT (Fminibuffer_prompt_end ());
399 return make_buffer_string (prompt_end, ZV, 1);
400 }
401
402 DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties,
403 Sminibuffer_contents_no_properties, 0, 0, 0,
404 doc: /* Return the user input in a minibuffer as a string, without text-properties.
405 If the current buffer is not a minibuffer, return its entire contents. */)
406 ()
407 {
408 int prompt_end = XINT (Fminibuffer_prompt_end ());
409 return make_buffer_string (prompt_end, ZV, 0);
410 }
411
412 DEFUN ("minibuffer-completion-contents", Fminibuffer_completion_contents,
413 Sminibuffer_completion_contents, 0, 0, 0,
414 doc: /* Return the user input in a minibuffer before point as a string.
415 That is what completion commands operate on.
416 If the current buffer is not a minibuffer, return its entire contents. */)
417 ()
418 {
419 int prompt_end = XINT (Fminibuffer_prompt_end ());
420 if (PT < prompt_end)
421 error ("Cannot do completion in the prompt");
422 return make_buffer_string (prompt_end, PT, 1);
423 }
424
425 DEFUN ("delete-minibuffer-contents", Fdelete_minibuffer_contents,
426 Sdelete_minibuffer_contents, 0, 0, 0,
427 doc: /* Delete all user input in a minibuffer.
428 If the current buffer is not a minibuffer, erase its entire contents. */)
429 ()
430 {
431 int prompt_end = XINT (Fminibuffer_prompt_end ());
432 if (prompt_end < ZV)
433 del_range (prompt_end, ZV);
434 return Qnil;
435 }
436
437 \f
438 /* Read from the minibuffer using keymap MAP and initial contents INITIAL,
439 putting point minus BACKUP_N bytes from the end of INITIAL,
440 prompting with PROMPT (a string), using history list HISTVAR
441 with initial position HISTPOS. INITIAL should be a string or a
442 cons of a string and an integer. BACKUP_N should be <= 0, or
443 Qnil, which is equivalent to 0. If INITIAL is a cons, BACKUP_N is
444 ignored and replaced with an integer that puts point at one-indexed
445 position N in INITIAL, where N is the CDR of INITIAL, or at the
446 beginning of INITIAL if N <= 0.
447
448 Normally return the result as a string (the text that was read),
449 but if EXPFLAG is nonzero, read it and return the object read.
450 If HISTVAR is given, save the value read on that history only if it doesn't
451 match the front of that history list exactly. The value is pushed onto
452 the list as the string that was read.
453
454 DEFALT specifies the default value for the sake of history commands.
455
456 If ALLOW_PROPS is nonzero, we do not throw away text properties.
457
458 if INHERIT_INPUT_METHOD is nonzero, the minibuffer inherits the
459 current input method. */
460
461 static Lisp_Object
462 read_minibuf (map, initial, prompt, backup_n, expflag,
463 histvar, histpos, defalt, allow_props, inherit_input_method)
464 Lisp_Object map;
465 Lisp_Object initial;
466 Lisp_Object prompt;
467 Lisp_Object backup_n;
468 int expflag;
469 Lisp_Object histvar;
470 Lisp_Object histpos;
471 Lisp_Object defalt;
472 int allow_props;
473 int inherit_input_method;
474 {
475 Lisp_Object val;
476 int count = SPECPDL_INDEX ();
477 Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
478 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
479 Lisp_Object enable_multibyte;
480 int pos = INTEGERP (backup_n) ? XINT (backup_n) : 0;
481 /* String to add to the history. */
482 Lisp_Object histstring;
483
484 Lisp_Object empty_minibuf;
485 Lisp_Object dummy, frame;
486
487 extern Lisp_Object Qfront_sticky;
488 extern Lisp_Object Qrear_nonsticky;
489
490 specbind (Qminibuffer_default, defalt);
491
492 /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
493 in previous recursive minibuffer, but was not set explicitly
494 to t for this invocation, so set it to nil in this minibuffer.
495 Save the old value now, before we change it. */
496 specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name);
497 if (EQ (Vminibuffer_completing_file_name, Qlambda))
498 Vminibuffer_completing_file_name = Qnil;
499
500 #ifdef HAVE_X_WINDOWS
501 if (display_hourglass_p)
502 cancel_hourglass ();
503 #endif
504
505 if (!NILP (initial))
506 {
507 if (CONSP (initial))
508 {
509 backup_n = Fcdr (initial);
510 initial = Fcar (initial);
511 CHECK_STRING (initial);
512 if (!NILP (backup_n))
513 {
514 CHECK_NUMBER (backup_n);
515 /* Convert to distance from end of input. */
516 if (XINT (backup_n) < 1)
517 /* A number too small means the beginning of the string. */
518 pos = - SCHARS (initial);
519 else
520 pos = XINT (backup_n) - 1 - SCHARS (initial);
521 }
522 }
523 else
524 CHECK_STRING (initial);
525 }
526 val = Qnil;
527 ambient_dir = current_buffer->directory;
528 input_method = Qnil;
529 enable_multibyte = Qnil;
530
531 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
532 store them away before we can GC. Don't need to protect
533 BACKUP_N because we use the value only if it is an integer. */
534 GCPRO5 (map, initial, val, ambient_dir, input_method);
535
536 if (!STRINGP (prompt))
537 prompt = empty_unibyte_string;
538
539 if (!enable_recursive_minibuffers
540 && minibuf_level > 0)
541 {
542 if (EQ (selected_window, minibuf_window))
543 error ("Command attempted to use minibuffer while in minibuffer");
544 else
545 /* If we're in another window, cancel the minibuffer that's active. */
546 Fthrow (Qexit,
547 build_string ("Command attempted to use minibuffer while in minibuffer"));
548 }
549
550 if (noninteractive && NILP (Vexecuting_kbd_macro))
551 {
552 val = read_minibuf_noninteractive (map, initial, prompt,
553 make_number (pos),
554 expflag, histvar, histpos, defalt,
555 allow_props, inherit_input_method);
556 UNGCPRO;
557 return unbind_to (count, val);
558 }
559
560 /* Choose the minibuffer window and frame, and take action on them. */
561
562 choose_minibuf_frame ();
563
564 record_unwind_protect (choose_minibuf_frame_1, Qnil);
565
566 record_unwind_protect (Fset_window_configuration,
567 Fcurrent_window_configuration (Qnil));
568
569 /* If the minibuffer window is on a different frame, save that
570 frame's configuration too. */
571 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
572 if (!EQ (mini_frame, selected_frame))
573 record_unwind_protect (Fset_window_configuration,
574 Fcurrent_window_configuration (mini_frame));
575
576 /* If the minibuffer is on an iconified or invisible frame,
577 make it visible now. */
578 Fmake_frame_visible (mini_frame);
579
580 if (minibuffer_auto_raise)
581 Fraise_frame (mini_frame);
582
583 temporarily_switch_to_single_kboard (XFRAME (mini_frame));
584
585 /* We have to do this after saving the window configuration
586 since that is what restores the current buffer. */
587
588 /* Arrange to restore a number of minibuffer-related variables.
589 We could bind each variable separately, but that would use lots of
590 specpdl slots. */
591 minibuf_save_list
592 = Fcons (Voverriding_local_map,
593 Fcons (minibuf_window,
594 minibuf_save_list));
595 minibuf_save_list
596 = Fcons (minibuf_prompt,
597 Fcons (make_number (minibuf_prompt_width),
598 Fcons (Vhelp_form,
599 Fcons (Vcurrent_prefix_arg,
600 Fcons (Vminibuffer_history_position,
601 Fcons (Vminibuffer_history_variable,
602 minibuf_save_list))))));
603
604 record_unwind_protect (read_minibuf_unwind, Qnil);
605 minibuf_level++;
606 /* We are exiting the minibuffer one way or the other, so run the hook.
607 It should be run before unwinding the minibuf settings. Do it
608 separately from read_minibuf_unwind because we need to make sure that
609 read_minibuf_unwind is fully executed even if exit-minibuffer-hook
610 signals an error. --Stef */
611 record_unwind_protect (run_exit_minibuf_hook, Qnil);
612
613 /* Now that we can restore all those variables, start changing them. */
614
615 minibuf_prompt_width = 0;
616 minibuf_prompt = Fcopy_sequence (prompt);
617 Vminibuffer_history_position = histpos;
618 Vminibuffer_history_variable = histvar;
619 Vhelp_form = Vminibuffer_help_form;
620 /* If this minibuffer is reading a file name, that doesn't mean
621 recursive ones are. But we cannot set it to nil, because
622 completion code still need to know the minibuffer is completing a
623 file name. So use `lambda' as intermediate value meaning
624 "t" in this minibuffer, but "nil" in next minibuffer. */
625 if (!NILP (Vminibuffer_completing_file_name))
626 Vminibuffer_completing_file_name = Qlambda;
627
628 if (inherit_input_method)
629 {
630 /* `current-input-method' is buffer local. So, remember it in
631 INPUT_METHOD before changing the current buffer. */
632 input_method = Fsymbol_value (Qcurrent_input_method);
633 enable_multibyte = current_buffer->enable_multibyte_characters;
634 }
635
636 /* Switch to the minibuffer. */
637
638 minibuffer = get_minibuffer (minibuf_level);
639 Fset_buffer (minibuffer);
640
641 /* If appropriate, copy enable-multibyte-characters into the minibuffer. */
642 if (inherit_input_method)
643 current_buffer->enable_multibyte_characters = enable_multibyte;
644
645 /* The current buffer's default directory is usually the right thing
646 for our minibuffer here. However, if you're typing a command at
647 a minibuffer-only frame when minibuf_level is zero, then buf IS
648 the current_buffer, so reset_buffer leaves buf's default
649 directory unchanged. This is a bummer when you've just started
650 up Emacs and buf's default directory is Qnil. Here's a hack; can
651 you think of something better to do? Find another buffer with a
652 better directory, and use that one instead. */
653 if (STRINGP (ambient_dir))
654 current_buffer->directory = ambient_dir;
655 else
656 {
657 Lisp_Object buf_list;
658
659 for (buf_list = Vbuffer_alist;
660 CONSP (buf_list);
661 buf_list = XCDR (buf_list))
662 {
663 Lisp_Object other_buf;
664
665 other_buf = XCDR (XCAR (buf_list));
666 if (STRINGP (XBUFFER (other_buf)->directory))
667 {
668 current_buffer->directory = XBUFFER (other_buf)->directory;
669 break;
670 }
671 }
672 }
673
674 if (!EQ (mini_frame, selected_frame))
675 Fredirect_frame_focus (selected_frame, mini_frame);
676
677 Vminibuf_scroll_window = selected_window;
678 if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
679 minibuf_selected_window = selected_window;
680
681 /* Empty out the minibuffers of all frames other than the one
682 where we are going to display one now.
683 Set them to point to ` *Minibuf-0*', which is always empty. */
684 empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*"));
685
686 FOR_EACH_FRAME (dummy, frame)
687 {
688 Lisp_Object root_window = Fframe_root_window (frame);
689 Lisp_Object mini_window = XWINDOW (root_window)->next;
690
691 if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
692 && !NILP (Fwindow_minibuffer_p (mini_window)))
693 Fset_window_buffer (mini_window, empty_minibuf, Qnil);
694 }
695
696 /* Display this minibuffer in the proper window. */
697 Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
698 Fselect_window (minibuf_window, Qnil);
699 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
700
701 Fmake_local_variable (Qprint_escape_newlines);
702 print_escape_newlines = 1;
703
704 /* Erase the buffer. */
705 {
706 int count1 = SPECPDL_INDEX ();
707 specbind (Qinhibit_read_only, Qt);
708 specbind (Qinhibit_modification_hooks, Qt);
709 Ferase_buffer ();
710
711 if (!NILP (current_buffer->enable_multibyte_characters)
712 && ! STRING_MULTIBYTE (minibuf_prompt))
713 minibuf_prompt = Fstring_make_multibyte (minibuf_prompt);
714
715 /* Insert the prompt, record where it ends. */
716 Finsert (1, &minibuf_prompt);
717 if (PT > BEG)
718 {
719 Fput_text_property (make_number (BEG), make_number (PT),
720 Qfront_sticky, Qt, Qnil);
721 Fput_text_property (make_number (BEG), make_number (PT),
722 Qrear_nonsticky, Qt, Qnil);
723 Fput_text_property (make_number (BEG), make_number (PT),
724 Qfield, Qt, Qnil);
725 Fadd_text_properties (make_number (BEG), make_number (PT),
726 Vminibuffer_prompt_properties, Qnil);
727 }
728 unbind_to (count1, Qnil);
729 }
730
731 minibuf_prompt_width = (int) current_column (); /* iftc */
732
733 /* Put in the initial input. */
734 if (!NILP (initial))
735 {
736 Finsert (1, &initial);
737 Fforward_char (make_number (pos));
738 }
739
740 clear_message (1, 1);
741 current_buffer->keymap = map;
742
743 /* Turn on an input method stored in INPUT_METHOD if any. */
744 if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
745 call1 (Qactivate_input_method, input_method);
746
747 /* Run our hook, but not if it is empty.
748 (run-hooks would do nothing if it is empty,
749 but it's important to save time here in the usual case.) */
750 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
751 && !NILP (Vrun_hooks))
752 call1 (Vrun_hooks, Qminibuffer_setup_hook);
753
754 /* Don't allow the user to undo past this point. */
755 current_buffer->undo_list = Qnil;
756
757 recursive_edit_1 ();
758
759 /* If cursor is on the minibuffer line,
760 show the user we have exited by putting it in column 0. */
761 if (XWINDOW (minibuf_window)->cursor.vpos >= 0
762 && !noninteractive)
763 {
764 XWINDOW (minibuf_window)->cursor.hpos = 0;
765 XWINDOW (minibuf_window)->cursor.x = 0;
766 XWINDOW (minibuf_window)->must_be_updated_p = 1;
767 update_frame (XFRAME (selected_frame), 1, 1);
768 {
769 struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame);
770 struct redisplay_interface *rif = FRAME_RIF (f);
771 if (rif && rif->flush_display)
772 rif->flush_display (f);
773 }
774 }
775
776 /* Make minibuffer contents into a string. */
777 Fset_buffer (minibuffer);
778 if (allow_props)
779 val = Fminibuffer_contents ();
780 else
781 val = Fminibuffer_contents_no_properties ();
782
783 /* VAL is the string of minibuffer text. */
784
785 last_minibuf_string = val;
786
787 /* Choose the string to add to the history. */
788 if (SCHARS (val) != 0)
789 histstring = val;
790 else if (STRINGP (defalt))
791 histstring = defalt;
792 else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
793 histstring = XCAR (defalt);
794 else
795 histstring = Qnil;
796
797 /* Add the value to the appropriate history list, if any. */
798 if (!NILP (Vhistory_add_new_input)
799 && SYMBOLP (Vminibuffer_history_variable)
800 && !NILP (histstring))
801 {
802 /* If the caller wanted to save the value read on a history list,
803 then do so if the value is not already the front of the list. */
804 Lisp_Object histval;
805
806 /* If variable is unbound, make it nil. */
807 if (EQ (SYMBOL_VALUE (Vminibuffer_history_variable), Qunbound))
808 Fset (Vminibuffer_history_variable, Qnil);
809
810 histval = Fsymbol_value (Vminibuffer_history_variable);
811
812 /* The value of the history variable must be a cons or nil. Other
813 values are unacceptable. We silently ignore these values. */
814
815 if (NILP (histval)
816 || (CONSP (histval)
817 /* Don't duplicate the most recent entry in the history. */
818 && (NILP (Fequal (histstring, Fcar (histval))))))
819 {
820 Lisp_Object length;
821
822 if (history_delete_duplicates) Fdelete (histstring, histval);
823 histval = Fcons (histstring, histval);
824 Fset (Vminibuffer_history_variable, histval);
825
826 /* Truncate if requested. */
827 length = Fget (Vminibuffer_history_variable, Qhistory_length);
828 if (NILP (length)) length = Vhistory_length;
829 if (INTEGERP (length))
830 {
831 if (XINT (length) <= 0)
832 Fset (Vminibuffer_history_variable, Qnil);
833 else
834 {
835 Lisp_Object temp;
836
837 temp = Fnthcdr (Fsub1 (length), histval);
838 if (CONSP (temp)) Fsetcdr (temp, Qnil);
839 }
840 }
841 }
842 }
843
844 /* If Lisp form desired instead of string, parse it. */
845 if (expflag)
846 val = string_to_object (val, defalt);
847
848 /* The appropriate frame will get selected
849 in set-window-configuration. */
850 UNGCPRO;
851 return unbind_to (count, val);
852 }
853
854 /* Return a buffer to be used as the minibuffer at depth `depth'.
855 depth = 0 is the lowest allowed argument, and that is the value
856 used for nonrecursive minibuffer invocations */
857
858 Lisp_Object
859 get_minibuffer (depth)
860 int depth;
861 {
862 Lisp_Object tail, num, buf;
863 char name[24];
864 extern Lisp_Object nconc2 ();
865
866 XSETFASTINT (num, depth);
867 tail = Fnthcdr (num, Vminibuffer_list);
868 if (NILP (tail))
869 {
870 tail = Fcons (Qnil, Qnil);
871 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
872 }
873 buf = Fcar (tail);
874 if (NILP (buf) || NILP (XBUFFER (buf)->name))
875 {
876 sprintf (name, " *Minibuf-%d*", depth);
877 buf = Fget_buffer_create (build_string (name));
878
879 /* Although the buffer's name starts with a space, undo should be
880 enabled in it. */
881 Fbuffer_enable_undo (buf);
882
883 XSETCAR (tail, buf);
884 }
885 else
886 {
887 int count = SPECPDL_INDEX ();
888 /* `reset_buffer' blindly sets the list of overlays to NULL, so we
889 have to empty the list, otherwise we end up with overlays that
890 think they belong to this buffer while the buffer doesn't know about
891 them any more. */
892 delete_all_overlays (XBUFFER (buf));
893 reset_buffer (XBUFFER (buf));
894 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
895 Fset_buffer (buf);
896 Fkill_all_local_variables ();
897 unbind_to (count, Qnil);
898 }
899
900 return buf;
901 }
902
903 static Lisp_Object
904 run_exit_minibuf_hook (data)
905 Lisp_Object data;
906 {
907 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
908 && !NILP (Vrun_hooks))
909 safe_run_hooks (Qminibuffer_exit_hook);
910
911 return Qnil;
912 }
913
914 /* This function is called on exiting minibuffer, whether normally or
915 not, and it restores the current window, buffer, etc. */
916
917 static Lisp_Object
918 read_minibuf_unwind (data)
919 Lisp_Object data;
920 {
921 Lisp_Object old_deactivate_mark;
922 Lisp_Object window;
923
924 /* If this was a recursive minibuffer,
925 tie the minibuffer window back to the outer level minibuffer buffer. */
926 minibuf_level--;
927
928 window = minibuf_window;
929 /* To keep things predictable, in case it matters, let's be in the
930 minibuffer when we reset the relevant variables. */
931 Fset_buffer (XWINDOW (window)->buffer);
932
933 /* Restore prompt, etc, from outer minibuffer level. */
934 minibuf_prompt = Fcar (minibuf_save_list);
935 minibuf_save_list = Fcdr (minibuf_save_list);
936 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
937 minibuf_save_list = Fcdr (minibuf_save_list);
938 Vhelp_form = Fcar (minibuf_save_list);
939 minibuf_save_list = Fcdr (minibuf_save_list);
940 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
941 minibuf_save_list = Fcdr (minibuf_save_list);
942 Vminibuffer_history_position = Fcar (minibuf_save_list);
943 minibuf_save_list = Fcdr (minibuf_save_list);
944 Vminibuffer_history_variable = Fcar (minibuf_save_list);
945 minibuf_save_list = Fcdr (minibuf_save_list);
946 Voverriding_local_map = Fcar (minibuf_save_list);
947 minibuf_save_list = Fcdr (minibuf_save_list);
948 #if 0
949 temp = Fcar (minibuf_save_list);
950 if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
951 minibuf_window = temp;
952 #endif
953 minibuf_save_list = Fcdr (minibuf_save_list);
954
955 /* Erase the minibuffer we were using at this level. */
956 {
957 int count = SPECPDL_INDEX ();
958 /* Prevent error in erase-buffer. */
959 specbind (Qinhibit_read_only, Qt);
960 specbind (Qinhibit_modification_hooks, Qt);
961 old_deactivate_mark = Vdeactivate_mark;
962 Ferase_buffer ();
963 Vdeactivate_mark = old_deactivate_mark;
964 unbind_to (count, Qnil);
965 }
966
967 /* When we get to the outmost level, make sure we resize the
968 mini-window back to its normal size. */
969 if (minibuf_level == 0)
970 resize_mini_window (XWINDOW (window), 0);
971
972 /* Make sure minibuffer window is erased, not ignored. */
973 windows_or_buffers_changed++;
974 XSETFASTINT (XWINDOW (window)->last_modified, 0);
975 XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
976 return Qnil;
977 }
978 \f
979
980 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 7, 0,
981 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
982 The optional second arg INITIAL-CONTENTS is an obsolete alternative to
983 DEFAULT-VALUE. It normally should be nil in new code, except when
984 HIST is a cons. It is discussed in more detail below.
985 Third arg KEYMAP is a keymap to use whilst reading;
986 if omitted or nil, the default is `minibuffer-local-map'.
987 If fourth arg READ is non-nil, then interpret the result as a Lisp object
988 and return that object:
989 in other words, do `(car (read-from-string INPUT-STRING))'
990 Fifth arg HIST, if non-nil, specifies a history list and optionally
991 the initial position in the list. It can be a symbol, which is the
992 history list variable to use, or it can be a cons cell
993 (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable
994 to use, and HISTPOS is the initial position for use by the minibuffer
995 history commands. For consistency, you should also specify that
996 element of the history as the value of INITIAL-CONTENTS. Positions
997 are counted starting from 1 at the beginning of the list.
998 Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is available
999 for history commands; but, unless READ is non-nil, `read-from-minibuffer'
1000 does NOT return DEFAULT-VALUE if the user enters empty input! It returns
1001 the empty string.
1002 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1003 the current input method and the setting of `enable-multibyte-characters'.
1004 If the variable `minibuffer-allow-text-properties' is non-nil,
1005 then the string which is returned includes whatever text properties
1006 were present in the minibuffer. Otherwise the value has no text properties.
1007
1008 The remainder of this documentation string describes the
1009 INITIAL-CONTENTS argument in more detail. It is only relevant when
1010 studying existing code, or when HIST is a cons. If non-nil,
1011 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
1012 reading input. Normally, point is put at the end of that string.
1013 However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial
1014 input is STRING, but point is placed at _one-indexed_ position
1015 POSITION in the minibuffer. Any integer value less than or equal to
1016 one puts point at the beginning of the string. *Note* that this
1017 behavior differs from the way such arguments are used in `completing-read'
1018 and some related functions, which use zero-indexing for POSITION. */)
1019 (prompt, initial_contents, keymap, read, hist, default_value, inherit_input_method)
1020 Lisp_Object prompt, initial_contents, keymap, read, hist, default_value;
1021 Lisp_Object inherit_input_method;
1022 {
1023 Lisp_Object histvar, histpos, val;
1024 struct gcpro gcpro1;
1025
1026 CHECK_STRING (prompt);
1027 if (NILP (keymap))
1028 keymap = Vminibuffer_local_map;
1029 else
1030 keymap = get_keymap (keymap, 1, 0);
1031
1032 if (SYMBOLP (hist))
1033 {
1034 histvar = hist;
1035 histpos = Qnil;
1036 }
1037 else
1038 {
1039 histvar = Fcar_safe (hist);
1040 histpos = Fcdr_safe (hist);
1041 }
1042 if (NILP (histvar))
1043 histvar = Qminibuffer_history;
1044 if (NILP (histpos))
1045 XSETFASTINT (histpos, 0);
1046
1047 GCPRO1 (default_value);
1048 val = read_minibuf (keymap, initial_contents, prompt,
1049 Qnil, !NILP (read),
1050 histvar, histpos, default_value,
1051 minibuffer_allow_text_properties,
1052 !NILP (inherit_input_method));
1053 UNGCPRO;
1054 return val;
1055 }
1056
1057 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
1058 doc: /* Return a Lisp object read using the minibuffer, unevaluated.
1059 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1060 is a string to insert in the minibuffer before reading.
1061 \(INITIAL-CONTENTS can also be a cons of a string and an integer.
1062 Such arguments are used as in `read-from-minibuffer'.) */)
1063 (prompt, initial_contents)
1064 Lisp_Object prompt, initial_contents;
1065 {
1066 CHECK_STRING (prompt);
1067 return read_minibuf (Vminibuffer_local_map, initial_contents,
1068 prompt, Qnil, 1, Qminibuffer_history,
1069 make_number (0), Qnil, 0, 0);
1070 }
1071
1072 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
1073 doc: /* Return value of Lisp expression read using the minibuffer.
1074 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1075 is a string to insert in the minibuffer before reading.
1076 \(INITIAL-CONTENTS can also be a cons of a string and an integer.
1077 Such arguments are used as in `read-from-minibuffer'.) */)
1078 (prompt, initial_contents)
1079 Lisp_Object prompt, initial_contents;
1080 {
1081 return Feval (read_minibuf (Vread_expression_map, initial_contents,
1082 prompt, Qnil, 1, Qread_expression_history,
1083 make_number (0), Qnil, 0, 0));
1084 }
1085
1086 /* Functions that use the minibuffer to read various things. */
1087
1088 DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
1089 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
1090 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
1091 This argument has been superseded by DEFAULT-VALUE and should normally
1092 be nil in new code. It behaves as in `read-from-minibuffer'. See the
1093 documentation string of that function for details.
1094 The third arg HISTORY, if non-nil, specifies a history list
1095 and optionally the initial position in the list.
1096 See `read-from-minibuffer' for details of HISTORY argument.
1097 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1098 for history commands, and as the value to return if the user enters
1099 the empty string.
1100 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1101 the current input method and the setting of `enable-multibyte-characters'. */)
1102 (prompt, initial_input, history, default_value, inherit_input_method)
1103 Lisp_Object prompt, initial_input, history, default_value;
1104 Lisp_Object inherit_input_method;
1105 {
1106 Lisp_Object val;
1107 val = Fread_from_minibuffer (prompt, initial_input, Qnil,
1108 Qnil, history, default_value,
1109 inherit_input_method);
1110 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
1111 val = CONSP (default_value) ? XCAR (default_value) : default_value;
1112 return val;
1113 }
1114
1115 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
1116 doc: /* Read a string from the terminal, not allowing blanks.
1117 Prompt with PROMPT. Whitespace terminates the input. If INITIAL is
1118 non-nil, it should be a string, which is used as initial input, with
1119 point positioned at the end, so that SPACE will accept the input.
1120 \(Actually, INITIAL can also be a cons of a string and an integer.
1121 Such values are treated as in `read-from-minibuffer', but are normally
1122 not useful in this function.)
1123 Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1124 the current input method and the setting of`enable-multibyte-characters'. */)
1125 (prompt, initial, inherit_input_method)
1126 Lisp_Object prompt, initial, inherit_input_method;
1127 {
1128 CHECK_STRING (prompt);
1129 return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
1130 0, Qminibuffer_history, make_number (0), Qnil, 0,
1131 !NILP (inherit_input_method));
1132 }
1133
1134 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
1135 doc: /* Read the name of a command and return as a symbol.
1136 Prompt with PROMPT. By default, return DEFAULT-VALUE. */)
1137 (prompt, default_value)
1138 Lisp_Object prompt, default_value;
1139 {
1140 Lisp_Object name, default_string;
1141
1142 if (NILP (default_value))
1143 default_string = Qnil;
1144 else if (SYMBOLP (default_value))
1145 default_string = SYMBOL_NAME (default_value);
1146 else
1147 default_string = default_value;
1148
1149 name = Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
1150 Qnil, Qnil, default_string, Qnil);
1151 if (NILP (name))
1152 return name;
1153 return Fintern (name, Qnil);
1154 }
1155
1156 #ifdef NOTDEF
1157 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
1158 doc: /* One arg PROMPT, a string. Read the name of a function and return as a symbol.
1159 Prompt with PROMPT. */)
1160 (prompt)
1161 Lisp_Object prompt;
1162 {
1163 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil, Qnil),
1164 Qnil);
1165 }
1166 #endif /* NOTDEF */
1167
1168 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
1169 doc: /* Read the name of a user variable and return it as a symbol.
1170 Prompt with PROMPT. By default, return DEFAULT-VALUE.
1171 A user variable is one for which `user-variable-p' returns non-nil. */)
1172 (prompt, default_value)
1173 Lisp_Object prompt, default_value;
1174 {
1175 Lisp_Object name, default_string;
1176
1177 if (NILP (default_value))
1178 default_string = Qnil;
1179 else if (SYMBOLP (default_value))
1180 default_string = SYMBOL_NAME (default_value);
1181 else
1182 default_string = default_value;
1183
1184 name = Fcompleting_read (prompt, Vobarray,
1185 Quser_variable_p, Qt,
1186 Qnil, Qnil, default_string, Qnil);
1187 if (NILP (name))
1188 return name;
1189 return Fintern (name, Qnil);
1190 }
1191
1192 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
1193 doc: /* Read the name of a buffer and return as a string.
1194 Prompt with PROMPT.
1195 Optional second arg DEF is value to return if user enters an empty line.
1196 If optional third arg REQUIRE-MATCH is non-nil,
1197 only existing buffer names are allowed.
1198 The argument PROMPT should be a string ending with a colon and a space. */)
1199 (prompt, def, require_match)
1200 Lisp_Object prompt, def, require_match;
1201 {
1202 Lisp_Object args[4];
1203 unsigned char *s;
1204 int len;
1205
1206 if (BUFFERP (def))
1207 def = XBUFFER (def)->name;
1208
1209 if (NILP (Vread_buffer_function))
1210 {
1211 if (!NILP (def))
1212 {
1213 /* A default value was provided: we must change PROMPT,
1214 editing the default value in before the colon. To achieve
1215 this, we replace PROMPT with a substring that doesn't
1216 contain the terminal space and colon (if present). They
1217 are then added back using Fformat. */
1218
1219 if (STRINGP (prompt))
1220 {
1221 s = SDATA (prompt);
1222 len = strlen (s);
1223 if (len >= 2 && s[len - 2] == ':' && s[len - 1] == ' ')
1224 len = len - 2;
1225 else if (len >= 1 && (s[len - 1] == ':' || s[len - 1] == ' '))
1226 len--;
1227
1228 prompt = make_specified_string (s, -1, len,
1229 STRING_MULTIBYTE (prompt));
1230 }
1231
1232 args[0] = build_string ("%s (default %s): ");
1233 args[1] = prompt;
1234 args[2] = CONSP (def) ? XCAR (def) : def;
1235 prompt = Fformat (3, args);
1236 }
1237
1238 return Fcompleting_read (prompt, intern ("internal-complete-buffer"),
1239 Qnil, require_match, Qnil, Qbuffer_name_history,
1240 def, Qnil);
1241 }
1242 else
1243 {
1244 args[0] = Vread_buffer_function;
1245 args[1] = prompt;
1246 args[2] = def;
1247 args[3] = require_match;
1248 return Ffuncall(4, args);
1249 }
1250 }
1251 \f
1252 static Lisp_Object
1253 minibuf_conform_representation (string, basis)
1254 Lisp_Object string, basis;
1255 {
1256 if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis))
1257 return string;
1258
1259 if (STRING_MULTIBYTE (string))
1260 return Fstring_make_unibyte (string);
1261 else
1262 return Fstring_make_multibyte (string);
1263 }
1264
1265 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
1266 doc: /* Return common substring of all completions of STRING in COLLECTION.
1267 Test each possible completion specified by COLLECTION
1268 to see if it begins with STRING. The possible completions may be
1269 strings or symbols. Symbols are converted to strings before testing,
1270 see `symbol-name'.
1271 All that match STRING are compared together; the longest initial sequence
1272 common to all these matches is the return value.
1273 If there is no match at all, the return value is nil.
1274 For a unique match which is exact, the return value is t.
1275
1276 If COLLECTION is an alist, the keys (cars of elements) are the
1277 possible completions. If an element is not a cons cell, then the
1278 element itself is the possible completion.
1279 If COLLECTION is a hash-table, all the keys that are strings or symbols
1280 are the possible completions.
1281 If COLLECTION is an obarray, the names of all symbols in the obarray
1282 are the possible completions.
1283
1284 COLLECTION can also be a function to do the completion itself.
1285 It receives three arguments: the values STRING, PREDICATE and nil.
1286 Whatever it returns becomes the value of `try-completion'.
1287
1288 If optional third argument PREDICATE is non-nil,
1289 it is used to test each possible match.
1290 The match is a candidate only if PREDICATE returns non-nil.
1291 The argument given to PREDICATE is the alist element
1292 or the symbol from the obarray. If COLLECTION is a hash-table,
1293 predicate is called with two arguments: the key and the value.
1294 Additionally to this predicate, `completion-regexp-list'
1295 is used to further constrain the set of candidates. */)
1296 (string, collection, predicate)
1297 Lisp_Object string, collection, predicate;
1298 {
1299 Lisp_Object bestmatch, tail, elt, eltstring;
1300 /* Size in bytes of BESTMATCH. */
1301 int bestmatchsize = 0;
1302 /* These are in bytes, too. */
1303 int compare, matchsize;
1304 enum { function_table, list_table, obarray_table, hash_table}
1305 type = (HASH_TABLE_P (collection) ? hash_table
1306 : VECTORP (collection) ? obarray_table
1307 : ((NILP (collection)
1308 || (CONSP (collection)
1309 && (!SYMBOLP (XCAR (collection))
1310 || NILP (XCAR (collection)))))
1311 ? list_table : function_table));
1312 int index = 0, obsize = 0;
1313 int matchcount = 0;
1314 int bindcount = -1;
1315 Lisp_Object bucket, zero, end, tem;
1316 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1317
1318 CHECK_STRING (string);
1319 if (type == function_table)
1320 return call3 (collection, string, predicate, Qnil);
1321
1322 bestmatch = bucket = Qnil;
1323 zero = make_number (0);
1324
1325 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1326 tail = collection;
1327 if (type == obarray_table)
1328 {
1329 collection = check_obarray (collection);
1330 obsize = XVECTOR (collection)->size;
1331 bucket = XVECTOR (collection)->contents[index];
1332 }
1333
1334 while (1)
1335 {
1336 /* Get the next element of the alist, obarray, or hash-table. */
1337 /* Exit the loop if the elements are all used up. */
1338 /* elt gets the alist element or symbol.
1339 eltstring gets the name to check as a completion. */
1340
1341 if (type == list_table)
1342 {
1343 if (!CONSP (tail))
1344 break;
1345 elt = XCAR (tail);
1346 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1347 tail = XCDR (tail);
1348 }
1349 else if (type == obarray_table)
1350 {
1351 if (!EQ (bucket, zero))
1352 {
1353 if (!SYMBOLP (bucket))
1354 error ("Bad data in guts of obarray");
1355 elt = bucket;
1356 eltstring = elt;
1357 if (XSYMBOL (bucket)->next)
1358 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1359 else
1360 XSETFASTINT (bucket, 0);
1361 }
1362 else if (++index >= obsize)
1363 break;
1364 else
1365 {
1366 bucket = XVECTOR (collection)->contents[index];
1367 continue;
1368 }
1369 }
1370 else /* if (type == hash_table) */
1371 {
1372 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1373 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1374 index++;
1375 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1376 break;
1377 else
1378 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
1379 }
1380
1381 /* Is this element a possible completion? */
1382
1383 if (SYMBOLP (eltstring))
1384 eltstring = Fsymbol_name (eltstring);
1385
1386 if (STRINGP (eltstring)
1387 && SCHARS (string) <= SCHARS (eltstring)
1388 && (tem = Fcompare_strings (eltstring, zero,
1389 make_number (SCHARS (string)),
1390 string, zero, Qnil,
1391 completion_ignore_case ? Qt : Qnil),
1392 EQ (Qt, tem)))
1393 {
1394 /* Yes. */
1395 Lisp_Object regexps;
1396
1397 /* Ignore this element if it fails to match all the regexps. */
1398 {
1399 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1400 regexps = XCDR (regexps))
1401 {
1402 if (bindcount < 0) {
1403 bindcount = SPECPDL_INDEX ();
1404 specbind (Qcase_fold_search,
1405 completion_ignore_case ? Qt : Qnil);
1406 }
1407 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1408 if (NILP (tem))
1409 break;
1410 }
1411 if (CONSP (regexps))
1412 continue;
1413 }
1414
1415 /* Ignore this element if there is a predicate
1416 and the predicate doesn't like it. */
1417
1418 if (!NILP (predicate))
1419 {
1420 if (EQ (predicate, Qcommandp))
1421 tem = Fcommandp (elt, Qnil);
1422 else
1423 {
1424 if (bindcount >= 0)
1425 {
1426 unbind_to (bindcount, Qnil);
1427 bindcount = -1;
1428 }
1429 GCPRO4 (tail, string, eltstring, bestmatch);
1430 tem = (type == hash_table
1431 ? call2 (predicate, elt,
1432 HASH_VALUE (XHASH_TABLE (collection),
1433 index - 1))
1434 : call1 (predicate, elt));
1435 UNGCPRO;
1436 }
1437 if (NILP (tem)) continue;
1438 }
1439
1440 /* Update computation of how much all possible completions match */
1441
1442 if (NILP (bestmatch))
1443 {
1444 matchcount = 1;
1445 bestmatch = eltstring;
1446 bestmatchsize = SCHARS (eltstring);
1447 }
1448 else
1449 {
1450 compare = min (bestmatchsize, SCHARS (eltstring));
1451 tem = Fcompare_strings (bestmatch, zero,
1452 make_number (compare),
1453 eltstring, zero,
1454 make_number (compare),
1455 completion_ignore_case ? Qt : Qnil);
1456 if (EQ (tem, Qt))
1457 matchsize = compare;
1458 else if (XINT (tem) < 0)
1459 matchsize = - XINT (tem) - 1;
1460 else
1461 matchsize = XINT (tem) - 1;
1462
1463 if (matchsize < 0)
1464 /* When can this happen ? -stef */
1465 matchsize = compare;
1466 if (completion_ignore_case)
1467 {
1468 /* If this is an exact match except for case,
1469 use it as the best match rather than one that is not an
1470 exact match. This way, we get the case pattern
1471 of the actual match. */
1472 if ((matchsize == SCHARS (eltstring)
1473 && matchsize < SCHARS (bestmatch))
1474 ||
1475 /* If there is more than one exact match ignoring case,
1476 and one of them is exact including case,
1477 prefer that one. */
1478 /* If there is no exact match ignoring case,
1479 prefer a match that does not change the case
1480 of the input. */
1481 ((matchsize == SCHARS (eltstring))
1482 ==
1483 (matchsize == SCHARS (bestmatch))
1484 && (tem = Fcompare_strings (eltstring, zero,
1485 make_number (SCHARS (string)),
1486 string, zero,
1487 Qnil,
1488 Qnil),
1489 EQ (Qt, tem))
1490 && (tem = Fcompare_strings (bestmatch, zero,
1491 make_number (SCHARS (string)),
1492 string, zero,
1493 Qnil,
1494 Qnil),
1495 ! EQ (Qt, tem))))
1496 bestmatch = eltstring;
1497 }
1498 if (bestmatchsize != SCHARS (eltstring)
1499 || bestmatchsize != matchsize)
1500 /* Don't count the same string multiple times. */
1501 matchcount++;
1502 bestmatchsize = matchsize;
1503 if (matchsize <= SCHARS (string)
1504 /* If completion-ignore-case is non-nil, don't
1505 short-circuit because we want to find the best
1506 possible match *including* case differences. */
1507 && !completion_ignore_case
1508 && matchcount > 1)
1509 /* No need to look any further. */
1510 break;
1511 }
1512 }
1513 }
1514
1515 if (bindcount >= 0) {
1516 unbind_to (bindcount, Qnil);
1517 bindcount = -1;
1518 }
1519
1520 if (NILP (bestmatch))
1521 return Qnil; /* No completions found */
1522 /* If we are ignoring case, and there is no exact match,
1523 and no additional text was supplied,
1524 don't change the case of what the user typed. */
1525 if (completion_ignore_case && bestmatchsize == SCHARS (string)
1526 && SCHARS (bestmatch) > bestmatchsize)
1527 return minibuf_conform_representation (string, bestmatch);
1528
1529 /* Return t if the supplied string is an exact match (counting case);
1530 it does not require any change to be made. */
1531 if (matchcount == 1 && bestmatchsize == SCHARS (string)
1532 && (tem = Fcompare_strings (bestmatch, make_number (0),
1533 make_number (bestmatchsize),
1534 string, make_number (0),
1535 make_number (bestmatchsize),
1536 Qnil),
1537 EQ (Qt, tem)))
1538 return Qt;
1539
1540 XSETFASTINT (zero, 0); /* Else extract the part in which */
1541 XSETFASTINT (end, bestmatchsize); /* all completions agree */
1542 return Fsubstring (bestmatch, zero, end);
1543 }
1544 \f
1545 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
1546 doc: /* Search for partial matches to STRING in COLLECTION.
1547 Test each of the possible completions specified by COLLECTION
1548 to see if it begins with STRING. The possible completions may be
1549 strings or symbols. Symbols are converted to strings before testing,
1550 see `symbol-name'.
1551 The value is a list of all the possible completions that match STRING.
1552
1553 If COLLECTION is an alist, the keys (cars of elements) are the
1554 possible completions. If an element is not a cons cell, then the
1555 element itself is the possible completion.
1556 If COLLECTION is a hash-table, all the keys that are strings or symbols
1557 are the possible completions.
1558 If COLLECTION is an obarray, the names of all symbols in the obarray
1559 are the possible completions.
1560
1561 COLLECTION can also be a function to do the completion itself.
1562 It receives three arguments: the values STRING, PREDICATE and t.
1563 Whatever it returns becomes the value of `all-completions'.
1564
1565 If optional third argument PREDICATE is non-nil,
1566 it is used to test each possible match.
1567 The match is a candidate only if PREDICATE returns non-nil.
1568 The argument given to PREDICATE is the alist element
1569 or the symbol from the obarray. If COLLECTION is a hash-table,
1570 predicate is called with two arguments: the key and the value.
1571 Additionally to this predicate, `completion-regexp-list'
1572 is used to further constrain the set of candidates.
1573
1574 If the optional fourth argument HIDE-SPACES is non-nil,
1575 strings in COLLECTION that start with a space
1576 are ignored unless STRING itself starts with a space. */)
1577 (string, collection, predicate, hide_spaces)
1578 Lisp_Object string, collection, predicate, hide_spaces;
1579 {
1580 Lisp_Object tail, elt, eltstring;
1581 Lisp_Object allmatches;
1582 int type = HASH_TABLE_P (collection) ? 3
1583 : VECTORP (collection) ? 2
1584 : NILP (collection) || (CONSP (collection)
1585 && (!SYMBOLP (XCAR (collection))
1586 || NILP (XCAR (collection))));
1587 int index = 0, obsize = 0;
1588 int bindcount = -1;
1589 Lisp_Object bucket, tem, zero;
1590 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1591
1592 CHECK_STRING (string);
1593 if (type == 0)
1594 return call3 (collection, string, predicate, Qt);
1595 allmatches = bucket = Qnil;
1596 zero = make_number (0);
1597
1598 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1599 tail = collection;
1600 if (type == 2)
1601 {
1602 obsize = XVECTOR (collection)->size;
1603 bucket = XVECTOR (collection)->contents[index];
1604 }
1605
1606 while (1)
1607 {
1608 /* Get the next element of the alist, obarray, or hash-table. */
1609 /* Exit the loop if the elements are all used up. */
1610 /* elt gets the alist element or symbol.
1611 eltstring gets the name to check as a completion. */
1612
1613 if (type == 1)
1614 {
1615 if (!CONSP (tail))
1616 break;
1617 elt = XCAR (tail);
1618 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1619 tail = XCDR (tail);
1620 }
1621 else if (type == 2)
1622 {
1623 if (!EQ (bucket, zero))
1624 {
1625 elt = bucket;
1626 eltstring = elt;
1627 if (XSYMBOL (bucket)->next)
1628 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1629 else
1630 XSETFASTINT (bucket, 0);
1631 }
1632 else if (++index >= obsize)
1633 break;
1634 else
1635 {
1636 bucket = XVECTOR (collection)->contents[index];
1637 continue;
1638 }
1639 }
1640 else /* if (type == 3) */
1641 {
1642 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1643 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1644 index++;
1645 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1646 break;
1647 else
1648 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
1649 }
1650
1651 /* Is this element a possible completion? */
1652
1653 if (SYMBOLP (eltstring))
1654 eltstring = Fsymbol_name (eltstring);
1655
1656 if (STRINGP (eltstring)
1657 && SCHARS (string) <= SCHARS (eltstring)
1658 /* If HIDE_SPACES, reject alternatives that start with space
1659 unless the input starts with space. */
1660 && ((SBYTES (string) > 0
1661 && SREF (string, 0) == ' ')
1662 || SREF (eltstring, 0) != ' '
1663 || NILP (hide_spaces))
1664 && (tem = Fcompare_strings (eltstring, zero,
1665 make_number (SCHARS (string)),
1666 string, zero,
1667 make_number (SCHARS (string)),
1668 completion_ignore_case ? Qt : Qnil),
1669 EQ (Qt, tem)))
1670 {
1671 /* Yes. */
1672 Lisp_Object regexps;
1673 Lisp_Object zero;
1674 XSETFASTINT (zero, 0);
1675
1676 /* Ignore this element if it fails to match all the regexps. */
1677 {
1678 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1679 regexps = XCDR (regexps))
1680 {
1681 if (bindcount < 0) {
1682 bindcount = SPECPDL_INDEX ();
1683 specbind (Qcase_fold_search,
1684 completion_ignore_case ? Qt : Qnil);
1685 }
1686 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1687 if (NILP (tem))
1688 break;
1689 }
1690 if (CONSP (regexps))
1691 continue;
1692 }
1693
1694 /* Ignore this element if there is a predicate
1695 and the predicate doesn't like it. */
1696
1697 if (!NILP (predicate))
1698 {
1699 if (EQ (predicate, Qcommandp))
1700 tem = Fcommandp (elt, Qnil);
1701 else
1702 {
1703 if (bindcount >= 0) {
1704 unbind_to (bindcount, Qnil);
1705 bindcount = -1;
1706 }
1707 GCPRO4 (tail, eltstring, allmatches, string);
1708 tem = type == 3
1709 ? call2 (predicate, elt,
1710 HASH_VALUE (XHASH_TABLE (collection), index - 1))
1711 : call1 (predicate, elt);
1712 UNGCPRO;
1713 }
1714 if (NILP (tem)) continue;
1715 }
1716 /* Ok => put it on the list. */
1717 allmatches = Fcons (eltstring, allmatches);
1718 }
1719 }
1720
1721 if (bindcount >= 0) {
1722 unbind_to (bindcount, Qnil);
1723 bindcount = -1;
1724 }
1725
1726 return Fnreverse (allmatches);
1727 }
1728 \f
1729 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
1730 doc: /* Read a string in the minibuffer, with completion.
1731 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1732 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1733 COLLECTION can also be a function to do the completion itself.
1734 PREDICATE limits completion to a subset of COLLECTION.
1735 See `try-completion' and `all-completions' for more details
1736 on completion, COLLECTION, and PREDICATE.
1737
1738 REQUIRE-MATCH can take the following values:
1739 - t means that the user is not allowed to exit unless
1740 the input is (or completes to) an element of COLLECTION or is null.
1741 - nil means that the user can exit with any input.
1742 - `confirm-only' means that the user can exit with any input, but she will
1743 need to confirm her choice if the input is not an element of COLLECTION.
1744 - anything else behaves like t except that typing RET does not exit if it
1745 does non-null completion.
1746
1747 If the input is null, `completing-read' returns DEF, or an empty string
1748 if DEF is nil, regardless of the value of REQUIRE-MATCH.
1749
1750 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
1751 with point positioned at the end.
1752 If it is (STRING . POSITION), the initial input is STRING, but point
1753 is placed at _zero-indexed_ position POSITION in STRING. (*Note*
1754 that this is different from `read-from-minibuffer' and related
1755 functions, which use one-indexing for POSITION.) This feature is
1756 deprecated--it is best to pass nil for INITIAL-INPUT and supply the
1757 default value DEF instead. The user can yank the default value into
1758 the minibuffer easily using \\[next-history-element].
1759
1760 HIST, if non-nil, specifies a history list and optionally the initial
1761 position in the list. It can be a symbol, which is the history list
1762 variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In
1763 that case, HISTVAR is the history list variable to use, and HISTPOS
1764 is the initial position (the position in the list used by the
1765 minibuffer history commands). For consistency, you should also
1766 specify that element of the history as the value of
1767 INITIAL-INPUT. (This is the only case in which you should use
1768 INITIAL-INPUT instead of DEF.) Positions are counted starting from
1769 1 at the beginning of the list. The variable `history-length'
1770 controls the maximum length of a history list.
1771
1772 DEF, if non-nil, is the default value.
1773
1774 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits
1775 the current input method and the setting of `enable-multibyte-characters'.
1776
1777 Completion ignores case if the ambient value of
1778 `completion-ignore-case' is non-nil. */)
1779 (prompt, collection, predicate, require_match, initial_input, hist, def, inherit_input_method)
1780 Lisp_Object prompt, collection, predicate, require_match, initial_input;
1781 Lisp_Object hist, def, inherit_input_method;
1782 {
1783 Lisp_Object val, histvar, histpos, position;
1784 Lisp_Object init;
1785 int pos = 0;
1786 int count = SPECPDL_INDEX ();
1787 struct gcpro gcpro1;
1788
1789 init = initial_input;
1790 GCPRO1 (def);
1791
1792 specbind (Qminibuffer_completion_table, collection);
1793 specbind (Qminibuffer_completion_predicate, predicate);
1794 specbind (Qminibuffer_completion_confirm,
1795 EQ (require_match, Qt) ? Qnil : require_match);
1796 last_exact_completion = Qnil;
1797
1798 position = Qnil;
1799 if (!NILP (init))
1800 {
1801 if (CONSP (init))
1802 {
1803 position = Fcdr (init);
1804 init = Fcar (init);
1805 }
1806 CHECK_STRING (init);
1807 if (!NILP (position))
1808 {
1809 CHECK_NUMBER (position);
1810 /* Convert to distance from end of input. */
1811 pos = XINT (position) - SCHARS (init);
1812 }
1813 }
1814
1815 if (SYMBOLP (hist))
1816 {
1817 histvar = hist;
1818 histpos = Qnil;
1819 }
1820 else
1821 {
1822 histvar = Fcar_safe (hist);
1823 histpos = Fcdr_safe (hist);
1824 }
1825 if (NILP (histvar))
1826 histvar = Qminibuffer_history;
1827 if (NILP (histpos))
1828 XSETFASTINT (histpos, 0);
1829
1830 val = read_minibuf (NILP (require_match)
1831 ? (NILP (Vminibuffer_completing_file_name)
1832 || EQ (Vminibuffer_completing_file_name, Qlambda)
1833 ? Vminibuffer_local_completion_map
1834 : Vminibuffer_local_filename_completion_map)
1835 : (NILP (Vminibuffer_completing_file_name)
1836 || EQ (Vminibuffer_completing_file_name, Qlambda)
1837 ? Vminibuffer_local_must_match_map
1838 : Vminibuffer_local_must_match_filename_map),
1839 init, prompt, make_number (pos), 0,
1840 histvar, histpos, def, 0,
1841 !NILP (inherit_input_method));
1842
1843 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
1844 val = CONSP (def) ? XCAR (def) : def;
1845
1846 RETURN_UNGCPRO (unbind_to (count, val));
1847 }
1848 \f
1849 Lisp_Object Fminibuffer_completion_help ();
1850 Lisp_Object Fassoc_string ();
1851
1852 /* Test whether TXT is an exact completion. */
1853 DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
1854 doc: /* Return non-nil if STRING is a valid completion.
1855 Takes the same arguments as `all-completions' and `try-completion'.
1856 If COLLECTION is a function, it is called with three arguments:
1857 the values STRING, PREDICATE and `lambda'. */)
1858 (string, collection, predicate)
1859 Lisp_Object string, collection, predicate;
1860 {
1861 Lisp_Object regexps, tail, tem = Qnil;
1862 int i = 0;
1863
1864 CHECK_STRING (string);
1865
1866 if ((CONSP (collection)
1867 && (!SYMBOLP (XCAR (collection)) || NILP (XCAR (collection))))
1868 || NILP (collection))
1869 {
1870 tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
1871 if (NILP (tem))
1872 return Qnil;
1873 }
1874 else if (VECTORP (collection))
1875 {
1876 /* Bypass intern-soft as that loses for nil. */
1877 tem = oblookup (collection,
1878 SDATA (string),
1879 SCHARS (string),
1880 SBYTES (string));
1881 if (!SYMBOLP (tem))
1882 {
1883 if (STRING_MULTIBYTE (string))
1884 string = Fstring_make_unibyte (string);
1885 else
1886 string = Fstring_make_multibyte (string);
1887
1888 tem = oblookup (collection,
1889 SDATA (string),
1890 SCHARS (string),
1891 SBYTES (string));
1892 }
1893
1894 if (completion_ignore_case && !SYMBOLP (tem))
1895 {
1896 for (i = XVECTOR (collection)->size - 1; i >= 0; i--)
1897 {
1898 tail = XVECTOR (collection)->contents[i];
1899 if (SYMBOLP (tail))
1900 while (1)
1901 {
1902 if (EQ((Fcompare_strings (string, make_number (0), Qnil,
1903 Fsymbol_name (tail),
1904 make_number (0) , Qnil, Qt)),
1905 Qt))
1906 {
1907 tem = tail;
1908 break;
1909 }
1910 if (XSYMBOL (tail)->next == 0)
1911 break;
1912 XSETSYMBOL (tail, XSYMBOL (tail)->next);
1913 }
1914 }
1915 }
1916
1917 if (!SYMBOLP (tem))
1918 return Qnil;
1919 }
1920 else if (HASH_TABLE_P (collection))
1921 {
1922 struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
1923 i = hash_lookup (h, string, NULL);
1924 if (i >= 0)
1925 tem = HASH_KEY (h, i);
1926 else
1927 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1928 if (!NILP (HASH_HASH (h, i)) &&
1929 EQ (Fcompare_strings (string, make_number (0), Qnil,
1930 HASH_KEY (h, i), make_number (0) , Qnil,
1931 completion_ignore_case ? Qt : Qnil),
1932 Qt))
1933 {
1934 tem = HASH_KEY (h, i);
1935 break;
1936 }
1937 if (!STRINGP (tem))
1938 return Qnil;
1939 }
1940 else
1941 return call3 (collection, string, predicate, Qlambda);
1942
1943 /* Reject this element if it fails to match all the regexps. */
1944 if (CONSP (Vcompletion_regexp_list))
1945 {
1946 int count = SPECPDL_INDEX ();
1947 specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
1948 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1949 regexps = XCDR (regexps))
1950 {
1951 if (NILP (Fstring_match (XCAR (regexps),
1952 SYMBOLP (tem) ? string : tem,
1953 Qnil)))
1954 return unbind_to (count, Qnil);
1955 }
1956 unbind_to (count, Qnil);
1957 }
1958
1959 /* Finally, check the predicate. */
1960 if (!NILP (predicate))
1961 {
1962 return HASH_TABLE_P (collection)
1963 ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
1964 : call1 (predicate, tem);
1965 }
1966 else
1967 return Qt;
1968 }
1969
1970 DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
1971 doc: /* Perform completion on buffer names.
1972 If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
1973 `all-completions', otherwise invoke `test-completion'.
1974
1975 The arguments STRING and PREDICATE are as in `try-completion',
1976 `all-completions', and `test-completion'. */)
1977 (string, predicate, flag)
1978 Lisp_Object string, predicate, flag;
1979 {
1980 if (NILP (flag))
1981 return Ftry_completion (string, Vbuffer_alist, predicate);
1982 else if (EQ (flag, Qt))
1983 return Fall_completions (string, Vbuffer_alist, predicate, Qt);
1984 else /* assume `lambda' */
1985 return Ftest_completion (string, Vbuffer_alist, predicate);
1986 }
1987
1988 /* returns:
1989 * 0 no possible completion
1990 * 1 was already an exact and unique completion
1991 * 3 was already an exact completion
1992 * 4 completed to an exact completion
1993 * 5 some completion happened
1994 * 6 no completion happened
1995 */
1996 int
1997 do_completion ()
1998 {
1999 Lisp_Object completion, string, tem;
2000 int completedp;
2001 Lisp_Object last;
2002 struct gcpro gcpro1, gcpro2;
2003
2004 completion = Ftry_completion (Fminibuffer_completion_contents (),
2005 Vminibuffer_completion_table,
2006 Vminibuffer_completion_predicate);
2007 last = last_exact_completion;
2008 last_exact_completion = Qnil;
2009
2010 GCPRO2 (completion, last);
2011
2012 if (NILP (completion))
2013 {
2014 bitch_at_user ();
2015 temp_echo_area_glyphs (build_string (" [No match]"));
2016 UNGCPRO;
2017 return 0;
2018 }
2019
2020 if (EQ (completion, Qt)) /* exact and unique match */
2021 {
2022 UNGCPRO;
2023 return 1;
2024 }
2025
2026 string = Fminibuffer_completion_contents ();
2027
2028 /* COMPLETEDP should be true if some completion was done, which
2029 doesn't include simply changing the case of the entered string.
2030 However, for appearance, the string is rewritten if the case
2031 changes. */
2032 tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qt);
2033 completedp = !EQ (tem, Qt);
2034
2035 tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qnil);
2036 if (!EQ (tem, Qt))
2037 /* Rewrite the user's input. */
2038 {
2039 int prompt_end = XINT (Fminibuffer_prompt_end ());
2040 /* Some completion happened */
2041
2042 if (! NILP (Vminibuffer_completing_file_name)
2043 && SREF (completion, SBYTES (completion) - 1) == '/'
2044 && PT < ZV
2045 && FETCH_CHAR (PT_BYTE) == '/')
2046 {
2047 del_range (prompt_end, PT + 1);
2048 }
2049 else
2050 del_range (prompt_end, PT);
2051
2052 Finsert (1, &completion);
2053
2054 if (! completedp)
2055 /* The case of the string changed, but that's all. We're not
2056 sure whether this is a unique completion or not, so try again
2057 using the real case (this shouldn't recurse again, because
2058 the next time try-completion will return either `t' or the
2059 exact string). */
2060 {
2061 UNGCPRO;
2062 return do_completion ();
2063 }
2064 }
2065
2066 /* It did find a match. Do we match some possibility exactly now? */
2067 tem = Ftest_completion (Fminibuffer_contents (),
2068 Vminibuffer_completion_table,
2069 Vminibuffer_completion_predicate);
2070 if (NILP (tem))
2071 {
2072 /* not an exact match */
2073 UNGCPRO;
2074 if (completedp)
2075 return 5;
2076 else if (!NILP (Vcompletion_auto_help))
2077 Fminibuffer_completion_help ();
2078 else
2079 temp_echo_area_glyphs (build_string (" [Next char not unique]"));
2080 return 6;
2081 }
2082 else if (completedp)
2083 {
2084 UNGCPRO;
2085 return 4;
2086 }
2087 /* If the last exact completion and this one were the same,
2088 it means we've already given a "Complete but not unique"
2089 message and the user's hit TAB again, so now we give him help. */
2090 last_exact_completion = completion;
2091 if (!NILP (last))
2092 {
2093 tem = Fminibuffer_completion_contents ();
2094 if (!NILP (Fequal (tem, last)))
2095 Fminibuffer_completion_help ();
2096 }
2097 UNGCPRO;
2098 return 3;
2099 }
2100
2101 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
2102
2103 DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
2104 doc: /* Like `assoc' but specifically for strings (and symbols).
2105 Symbols are converted to strings, and unibyte strings are converted to
2106 multibyte for comparison.
2107 Case is ignored if optional arg CASE-FOLD is non-nil.
2108 As opposed to `assoc', it will also match an entry consisting of a single
2109 string rather than a cons cell whose car is a string. */)
2110 (key, list, case_fold)
2111 register Lisp_Object key;
2112 Lisp_Object list, case_fold;
2113 {
2114 register Lisp_Object tail;
2115
2116 if (SYMBOLP (key))
2117 key = Fsymbol_name (key);
2118
2119 for (tail = list; CONSP (tail); tail = XCDR (tail))
2120 {
2121 register Lisp_Object elt, tem, thiscar;
2122 elt = XCAR (tail);
2123 thiscar = CONSP (elt) ? XCAR (elt) : elt;
2124 if (SYMBOLP (thiscar))
2125 thiscar = Fsymbol_name (thiscar);
2126 else if (!STRINGP (thiscar))
2127 continue;
2128 tem = Fcompare_strings (thiscar, make_number (0), Qnil,
2129 key, make_number (0), Qnil,
2130 case_fold);
2131 if (EQ (tem, Qt))
2132 return elt;
2133 QUIT;
2134 }
2135 return Qnil;
2136 }
2137
2138 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
2139 doc: /* Complete the minibuffer contents as far as possible.
2140 Return nil if there is no valid completion, else t.
2141 If no characters can be completed, display a list of possible completions.
2142 If you repeat this command after it displayed such a list,
2143 scroll the window of possible completions. */)
2144 ()
2145 {
2146 register int i;
2147 Lisp_Object window, tem;
2148
2149 /* If the previous command was not this,
2150 mark the completion buffer obsolete. */
2151 if (! EQ (current_kboard->Vlast_command, Vthis_command))
2152 Vminibuf_scroll_window = Qnil;
2153
2154 window = Vminibuf_scroll_window;
2155 /* If there's a fresh completion window with a live buffer,
2156 and this command is repeated, scroll that window. */
2157 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
2158 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
2159 {
2160 struct buffer *obuf = current_buffer;
2161
2162 Fset_buffer (XWINDOW (window)->buffer);
2163 tem = Fpos_visible_in_window_p (make_number (ZV), window, Qnil);
2164 if (! NILP (tem))
2165 /* If end is in view, scroll up to the beginning. */
2166 Fset_window_start (window, make_number (BEGV), Qnil);
2167 else
2168 /* Else scroll down one screen. */
2169 Fscroll_other_window (Qnil);
2170
2171 set_buffer_internal (obuf);
2172 return Qnil;
2173 }
2174
2175 i = do_completion ();
2176 switch (i)
2177 {
2178 case 0:
2179 return Qnil;
2180
2181 case 1:
2182 if (PT != ZV)
2183 Fgoto_char (make_number (ZV));
2184 temp_echo_area_glyphs (build_string (" [Sole completion]"));
2185 break;
2186
2187 case 3:
2188 if (PT != ZV)
2189 Fgoto_char (make_number (ZV));
2190 temp_echo_area_glyphs (build_string (" [Complete, but not unique]"));
2191 break;
2192 }
2193
2194 return Qt;
2195 }
2196 \f
2197 /* Subroutines of Fminibuffer_complete_and_exit. */
2198
2199 /* This one is called by internal_condition_case to do the real work. */
2200
2201 Lisp_Object
2202 complete_and_exit_1 ()
2203 {
2204 return make_number (do_completion ());
2205 }
2206
2207 /* This one is called by internal_condition_case if an error happens.
2208 Pretend the current value is an exact match. */
2209
2210 Lisp_Object
2211 complete_and_exit_2 (ignore)
2212 Lisp_Object ignore;
2213 {
2214 return make_number (1);
2215 }
2216
2217 EXFUN (Fexit_minibuffer, 0) NO_RETURN;
2218
2219 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
2220 Sminibuffer_complete_and_exit, 0, 0, "",
2221 doc: /* If the minibuffer contents is a valid completion then exit.
2222 Otherwise try to complete it. If completion leads to a valid completion,
2223 a repetition of this command will exit. */)
2224 ()
2225 {
2226 register int i;
2227 Lisp_Object val, tem;
2228
2229 /* Allow user to specify null string */
2230 if (XINT (Fminibuffer_prompt_end ()) == ZV)
2231 goto exit;
2232
2233 val = Fminibuffer_contents ();
2234 tem = Ftest_completion (val,
2235 Vminibuffer_completion_table,
2236 Vminibuffer_completion_predicate);
2237 if (!NILP (tem))
2238 {
2239 if (completion_ignore_case)
2240 { /* Fixup case of the field, if necessary. */
2241 Lisp_Object compl
2242 = Ftry_completion (val,
2243 Vminibuffer_completion_table,
2244 Vminibuffer_completion_predicate);
2245 if (STRINGP (compl)
2246 /* If it weren't for this piece of paranoia, I'd replace
2247 the whole thing with a call to do_completion. */
2248 && EQ (Flength (val), Flength (compl)))
2249 {
2250 del_range (XINT (Fminibuffer_prompt_end ()), ZV);
2251 Finsert (1, &compl);
2252 }
2253 }
2254 goto exit;
2255 }
2256
2257 if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only")))
2258 { /* The user is permitted to exit with an input that's rejected
2259 by test-completion, but at the condition to confirm her choice. */
2260 if (EQ (current_kboard->Vlast_command, Vthis_command))
2261 goto exit;
2262 else
2263 {
2264 temp_echo_area_glyphs (build_string (" [Confirm]"));
2265 return Qnil;
2266 }
2267 }
2268
2269 /* Call do_completion, but ignore errors. */
2270 SET_PT (ZV);
2271 val = internal_condition_case (complete_and_exit_1, Qerror,
2272 complete_and_exit_2);
2273
2274 i = XFASTINT (val);
2275 switch (i)
2276 {
2277 case 1:
2278 case 3:
2279 goto exit;
2280
2281 case 4:
2282 if (!NILP (Vminibuffer_completion_confirm))
2283 {
2284 temp_echo_area_glyphs (build_string (" [Confirm]"));
2285 return Qnil;
2286 }
2287 else
2288 goto exit;
2289
2290 default:
2291 return Qnil;
2292 }
2293 exit:
2294 return Fexit_minibuffer ();
2295 /* NOTREACHED */
2296 }
2297
2298 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
2299 0, 0, "",
2300 doc: /* Complete the minibuffer contents at most a single word.
2301 After one word is completed as much as possible, a space or hyphen
2302 is added, provided that matches some possible completion.
2303 Return nil if there is no valid completion, else t. */)
2304 ()
2305 {
2306 Lisp_Object completion, tem, tem1;
2307 register int i, i_byte;
2308 struct gcpro gcpro1, gcpro2;
2309 int prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
2310
2311 /* We keep calling Fbuffer_string rather than arrange for GC to
2312 hold onto a pointer to one of the strings thus made. */
2313
2314 completion = Ftry_completion (Fminibuffer_completion_contents (),
2315 Vminibuffer_completion_table,
2316 Vminibuffer_completion_predicate);
2317 if (NILP (completion))
2318 {
2319 bitch_at_user ();
2320 temp_echo_area_glyphs (build_string (" [No match]"));
2321 return Qnil;
2322 }
2323 if (EQ (completion, Qt))
2324 return Qnil;
2325
2326 #if 0 /* How the below code used to look, for reference. */
2327 tem = Fminibuffer_contents ();
2328 b = SDATA (tem);
2329 i = ZV - 1 - SCHARS (completion);
2330 p = SDATA (completion);
2331 if (i > 0 ||
2332 0 <= scmp (b, p, ZV - 1))
2333 {
2334 i = 1;
2335 /* Set buffer to longest match of buffer tail and completion head. */
2336 while (0 <= scmp (b + i, p, ZV - 1 - i))
2337 i++;
2338 del_range (1, i + 1);
2339 SET_PT (ZV);
2340 }
2341 #else /* Rewritten code */
2342 {
2343 int buffer_nchars, completion_nchars;
2344
2345 CHECK_STRING (completion);
2346 tem = Fminibuffer_completion_contents ();
2347 GCPRO2 (completion, tem);
2348 /* If reading a file name,
2349 expand any $ENVVAR refs in the buffer and in TEM. */
2350 if (! NILP (Vminibuffer_completing_file_name))
2351 {
2352 Lisp_Object substituted;
2353 substituted = Fsubstitute_in_file_name (tem);
2354 if (! EQ (substituted, tem))
2355 {
2356 tem = substituted;
2357 del_range (prompt_end_charpos, PT);
2358 Finsert (1, &tem);
2359 }
2360 }
2361 buffer_nchars = SCHARS (tem); /* # chars in what we completed. */
2362 completion_nchars = SCHARS (completion);
2363 i = buffer_nchars - completion_nchars;
2364 if (i > 0
2365 ||
2366 (tem1 = Fcompare_strings (tem, make_number (0),
2367 make_number (buffer_nchars),
2368 completion, make_number (0),
2369 make_number (buffer_nchars),
2370 completion_ignore_case ? Qt : Qnil),
2371 ! EQ (tem1, Qt)))
2372 {
2373 int start_pos;
2374
2375 /* Make buffer (before point) contain the longest match
2376 of TEM's tail and COMPLETION's head. */
2377 if (i <= 0) i = 1;
2378 start_pos= i;
2379 buffer_nchars -= i;
2380 while (i > 0)
2381 {
2382 tem1 = Fcompare_strings (tem, make_number (start_pos), Qnil,
2383 completion, make_number (0),
2384 make_number (buffer_nchars),
2385 completion_ignore_case ? Qt : Qnil);
2386 start_pos++;
2387 if (EQ (tem1, Qt))
2388 break;
2389 i++;
2390 buffer_nchars--;
2391 }
2392 del_range (start_pos, start_pos + buffer_nchars);
2393 }
2394 UNGCPRO;
2395 }
2396 #endif /* Rewritten code */
2397
2398 {
2399 int prompt_end_bytepos;
2400 prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos);
2401 i = PT - prompt_end_charpos;
2402 i_byte = PT_BYTE - prompt_end_bytepos;
2403 }
2404
2405 /* If completion finds next char not unique,
2406 consider adding a space or a hyphen. */
2407 if (i == SCHARS (completion))
2408 {
2409 GCPRO1 (completion);
2410 tem = Ftry_completion (concat2 (Fminibuffer_completion_contents (),
2411 build_string (" ")),
2412 Vminibuffer_completion_table,
2413 Vminibuffer_completion_predicate);
2414 UNGCPRO;
2415
2416 if (STRINGP (tem))
2417 completion = tem;
2418 else
2419 {
2420 GCPRO1 (completion);
2421 tem =
2422 Ftry_completion (concat2 (Fminibuffer_completion_contents (),
2423 build_string ("-")),
2424 Vminibuffer_completion_table,
2425 Vminibuffer_completion_predicate);
2426 UNGCPRO;
2427
2428 if (STRINGP (tem))
2429 completion = tem;
2430 }
2431 }
2432
2433 /* Now find first word-break in the stuff found by completion.
2434 i gets index in string of where to stop completing. */
2435 while (i_byte < SBYTES (completion))
2436 {
2437 int c;
2438
2439 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte);
2440 if (SYNTAX (c) != Sword)
2441 break;
2442 }
2443
2444 /* If got no characters, print help for user. */
2445
2446 if (i == PT - prompt_end_charpos)
2447 {
2448 if (!NILP (Vcompletion_auto_help))
2449 Fminibuffer_completion_help ();
2450 return Qnil;
2451 }
2452
2453 /* Otherwise insert in minibuffer the chars we got */
2454
2455 if (! NILP (Vminibuffer_completing_file_name)
2456 && SREF (completion, SBYTES (completion) - 1) == '/'
2457 && PT < ZV
2458 && FETCH_CHAR (PT_BYTE) == '/')
2459 {
2460 del_range (prompt_end_charpos, PT + 1);
2461 }
2462 else
2463 del_range (prompt_end_charpos, PT);
2464
2465 insert_from_string (completion, 0, 0, i, i_byte, 1);
2466 return Qt;
2467 }
2468 \f
2469 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
2470 1, 2, 0,
2471 doc: /* Display the list of completions, COMPLETIONS, using `standard-output'.
2472 Each element may be just a symbol or string
2473 or may be a list of two strings to be printed as if concatenated.
2474 If it is a list of two strings, the first is the actual completion
2475 alternative, the second serves as annotation.
2476 `standard-output' must be a buffer.
2477 The actual completion alternatives, as inserted, are given `mouse-face'
2478 properties of `highlight'.
2479 At the end, this runs the normal hook `completion-setup-hook'.
2480 It can find the completion buffer in `standard-output'.
2481 The optional second arg COMMON-SUBSTRING is a string.
2482 It is used to put faces, `completions-first-difference' and
2483 `completions-common-part' on the completion buffer. The
2484 `completions-common-part' face is put on the common substring
2485 specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil
2486 and the current buffer is not the minibuffer, the faces are not put.
2487 Internally, COMMON-SUBSTRING is bound to `completion-common-substring'
2488 during running `completion-setup-hook'. */)
2489 (completions, common_substring)
2490 Lisp_Object completions;
2491 Lisp_Object common_substring;
2492 {
2493 Lisp_Object tail, elt;
2494 register int i;
2495 int column = 0;
2496 struct gcpro gcpro1, gcpro2, gcpro3;
2497 struct buffer *old = current_buffer;
2498 int first = 1;
2499
2500 /* Note that (when it matters) every variable
2501 points to a non-string that is pointed to by COMPLETIONS,
2502 except for ELT. ELT can be pointing to a string
2503 when terpri or Findent_to calls a change hook. */
2504 elt = Qnil;
2505 GCPRO3 (completions, elt, common_substring);
2506
2507 if (BUFFERP (Vstandard_output))
2508 set_buffer_internal (XBUFFER (Vstandard_output));
2509
2510 if (NILP (completions))
2511 write_string ("There are no possible completions of what you have typed.",
2512 -1);
2513 else
2514 {
2515 write_string ("Possible completions are:", -1);
2516 for (tail = completions, i = 0; CONSP (tail); tail = XCDR (tail), i++)
2517 {
2518 Lisp_Object tem, string;
2519 int length;
2520 Lisp_Object startpos, endpos;
2521
2522 startpos = Qnil;
2523
2524 elt = XCAR (tail);
2525 if (SYMBOLP (elt))
2526 elt = SYMBOL_NAME (elt);
2527 /* Compute the length of this element. */
2528 if (CONSP (elt))
2529 {
2530 tem = XCAR (elt);
2531 CHECK_STRING (tem);
2532 length = SCHARS (tem);
2533
2534 tem = Fcar (XCDR (elt));
2535 CHECK_STRING (tem);
2536 length += SCHARS (tem);
2537 }
2538 else
2539 {
2540 CHECK_STRING (elt);
2541 length = SCHARS (elt);
2542 }
2543
2544 /* This does a bad job for narrower than usual windows.
2545 Sadly, the window it will appear in is not known
2546 until after the text has been made. */
2547
2548 if (BUFFERP (Vstandard_output))
2549 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2550
2551 /* If the previous completion was very wide,
2552 or we have two on this line already,
2553 don't put another on the same line. */
2554 if (column > 33 || first
2555 /* If this is really wide, don't put it second on a line. */
2556 || (column > 0 && length > 45))
2557 {
2558 Fterpri (Qnil);
2559 column = 0;
2560 }
2561 /* Otherwise advance to column 35. */
2562 else
2563 {
2564 if (BUFFERP (Vstandard_output))
2565 {
2566 tem = Findent_to (make_number (35), make_number (2));
2567
2568 column = XINT (tem);
2569 }
2570 else
2571 {
2572 do
2573 {
2574 write_string (" ", -1);
2575 column++;
2576 }
2577 while (column < 35);
2578 }
2579 }
2580
2581 if (BUFFERP (Vstandard_output))
2582 {
2583 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2584 Fset_text_properties (startpos, endpos,
2585 Qnil, Vstandard_output);
2586 }
2587
2588 /* Output this element.
2589 If necessary, convert it to unibyte or to multibyte first. */
2590 if (CONSP (elt))
2591 string = Fcar (elt);
2592 else
2593 string = elt;
2594 if (NILP (current_buffer->enable_multibyte_characters)
2595 && STRING_MULTIBYTE (string))
2596 string = Fstring_make_unibyte (string);
2597 else if (!NILP (current_buffer->enable_multibyte_characters)
2598 && !STRING_MULTIBYTE (string))
2599 string = Fstring_make_multibyte (string);
2600
2601 if (BUFFERP (Vstandard_output))
2602 {
2603 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2604
2605 Fprinc (string, Qnil);
2606
2607 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2608
2609 Fput_text_property (startpos, endpos,
2610 Qmouse_face, intern ("highlight"),
2611 Vstandard_output);
2612 }
2613 else
2614 {
2615 Fprinc (string, Qnil);
2616 }
2617
2618 /* Output the annotation for this element. */
2619 if (CONSP (elt))
2620 {
2621 if (BUFFERP (Vstandard_output))
2622 {
2623 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2624
2625 Fprinc (Fcar (Fcdr (elt)), Qnil);
2626
2627 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2628
2629 Fset_text_properties (startpos, endpos, Qnil,
2630 Vstandard_output);
2631 }
2632 else
2633 {
2634 Fprinc (Fcar (Fcdr (elt)), Qnil);
2635 }
2636 }
2637
2638
2639 /* Update COLUMN for what we have output. */
2640 column += length;
2641
2642 /* If output is to a buffer, recompute COLUMN in a way
2643 that takes account of character widths. */
2644 if (BUFFERP (Vstandard_output))
2645 {
2646 tem = Fcurrent_column ();
2647 column = XINT (tem);
2648 }
2649
2650 first = 0;
2651 }
2652 }
2653
2654 if (BUFFERP (Vstandard_output))
2655 set_buffer_internal (old);
2656
2657 if (!NILP (Vrun_hooks))
2658 {
2659 int count1 = SPECPDL_INDEX ();
2660
2661 specbind (intern ("completion-common-substring"), common_substring);
2662 call1 (Vrun_hooks, intern ("completion-setup-hook"));
2663
2664 unbind_to (count1, Qnil);
2665 }
2666
2667 UNGCPRO;
2668
2669 return Qnil;
2670 }
2671
2672
2673 static Lisp_Object
2674 display_completion_list_1 (list)
2675 Lisp_Object list;
2676 {
2677 return Fdisplay_completion_list (list, Qnil);
2678 }
2679
2680 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
2681 0, 0, "",
2682 doc: /* Display a list of possible completions of the current minibuffer contents. */)
2683 ()
2684 {
2685 Lisp_Object completions;
2686
2687 message ("Making completion list...");
2688 completions = Fall_completions (Fminibuffer_completion_contents (),
2689 Vminibuffer_completion_table,
2690 Vminibuffer_completion_predicate,
2691 Qt);
2692 clear_message (1, 0);
2693
2694 if (NILP (completions))
2695 {
2696 bitch_at_user ();
2697 temp_echo_area_glyphs (build_string (" [No completions]"));
2698 }
2699 else
2700 {
2701 /* Sort and remove duplicates. */
2702 Lisp_Object tmp = completions = Fsort (completions, Qstring_lessp);
2703 while (CONSP (tmp))
2704 {
2705 if (CONSP (XCDR (tmp))
2706 && !NILP (Fequal (XCAR (tmp), XCAR (XCDR (tmp)))))
2707 XSETCDR (tmp, XCDR (XCDR (tmp)));
2708 else
2709 tmp = XCDR (tmp);
2710 }
2711 internal_with_output_to_temp_buffer ("*Completions*",
2712 display_completion_list_1,
2713 completions);
2714 }
2715 return Qnil;
2716 }
2717 \f
2718 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
2719 doc: /* Terminate minibuffer input. */)
2720 ()
2721 {
2722 if (CHARACTERP (last_command_char))
2723 internal_self_insert (XINT (last_command_char), 0);
2724 else
2725 bitch_at_user ();
2726
2727 return Fexit_minibuffer ();
2728 }
2729
2730 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
2731 doc: /* Terminate this minibuffer argument. */)
2732 ()
2733 {
2734 /* If the command that uses this has made modifications in the minibuffer,
2735 we don't want them to cause deactivation of the mark in the original
2736 buffer.
2737 A better solution would be to make deactivate-mark buffer-local
2738 (or to turn it into a list of buffers, ...), but in the mean time,
2739 this should do the trick in most cases. */
2740 Vdeactivate_mark = Qnil;
2741 Fthrow (Qexit, Qnil);
2742 }
2743
2744 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
2745 doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */)
2746 ()
2747 {
2748 return make_number (minibuf_level);
2749 }
2750
2751 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
2752 doc: /* Return the prompt string of the currently-active minibuffer.
2753 If no minibuffer is active, return nil. */)
2754 ()
2755 {
2756 return Fcopy_sequence (minibuf_prompt);
2757 }
2758
2759 \f
2760 /* Temporarily display STRING at the end of the current
2761 minibuffer contents. This is used to display things like
2762 "[No Match]" when the user requests a completion for a prefix
2763 that has no possible completions, and other quick, unobtrusive
2764 messages. */
2765
2766 extern Lisp_Object Vminibuffer_message_timeout;
2767
2768 void
2769 temp_echo_area_glyphs (string)
2770 Lisp_Object string;
2771 {
2772 int osize = ZV;
2773 int osize_byte = ZV_BYTE;
2774 int opoint = PT;
2775 int opoint_byte = PT_BYTE;
2776 Lisp_Object oinhibit;
2777 oinhibit = Vinhibit_quit;
2778
2779 /* Clear out any old echo-area message to make way for our new thing. */
2780 message (0);
2781
2782 SET_PT_BOTH (osize, osize_byte);
2783 insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 0);
2784 SET_PT_BOTH (opoint, opoint_byte);
2785 Vinhibit_quit = Qt;
2786
2787 if (NUMBERP (Vminibuffer_message_timeout))
2788 sit_for (Vminibuffer_message_timeout, 0, 2);
2789 else
2790 sit_for (Qt, 0, 2);
2791
2792 del_range_both (osize, osize_byte, ZV, ZV_BYTE, 1);
2793 SET_PT_BOTH (opoint, opoint_byte);
2794 if (!NILP (Vquit_flag))
2795 {
2796 Vquit_flag = Qnil;
2797 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
2798 }
2799 Vinhibit_quit = oinhibit;
2800 }
2801
2802 DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message,
2803 1, 1, 0,
2804 doc: /* Temporarily display STRING at the end of the minibuffer.
2805 The text is displayed for a period controlled by `minibuffer-message-timeout',
2806 or until the next input event arrives, whichever comes first. */)
2807 (string)
2808 Lisp_Object string;
2809 {
2810 CHECK_STRING (string);
2811 temp_echo_area_glyphs (string);
2812 return Qnil;
2813 }
2814 \f
2815 void
2816 init_minibuf_once ()
2817 {
2818 Vminibuffer_list = Qnil;
2819 staticpro (&Vminibuffer_list);
2820 }
2821
2822 void
2823 syms_of_minibuf ()
2824 {
2825 minibuf_level = 0;
2826 minibuf_prompt = Qnil;
2827 staticpro (&minibuf_prompt);
2828
2829 minibuf_save_list = Qnil;
2830 staticpro (&minibuf_save_list);
2831
2832 Qcompletion_ignore_case = intern ("completion-ignore-case");
2833 staticpro (&Qcompletion_ignore_case);
2834
2835 Qread_file_name_internal = intern ("read-file-name-internal");
2836 staticpro (&Qread_file_name_internal);
2837
2838 Qminibuffer_default = intern ("minibuffer-default");
2839 staticpro (&Qminibuffer_default);
2840 Fset (Qminibuffer_default, Qnil);
2841
2842 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
2843 staticpro (&Qminibuffer_completion_table);
2844
2845 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
2846 staticpro (&Qminibuffer_completion_confirm);
2847
2848 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
2849 staticpro (&Qminibuffer_completion_predicate);
2850
2851 staticpro (&last_exact_completion);
2852 last_exact_completion = Qnil;
2853
2854 staticpro (&last_minibuf_string);
2855 last_minibuf_string = Qnil;
2856
2857 Quser_variable_p = intern ("user-variable-p");
2858 staticpro (&Quser_variable_p);
2859
2860 Qminibuffer_history = intern ("minibuffer-history");
2861 staticpro (&Qminibuffer_history);
2862
2863 Qbuffer_name_history = intern ("buffer-name-history");
2864 staticpro (&Qbuffer_name_history);
2865 Fset (Qbuffer_name_history, Qnil);
2866
2867 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
2868 staticpro (&Qminibuffer_setup_hook);
2869
2870 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
2871 staticpro (&Qminibuffer_exit_hook);
2872
2873 Qhistory_length = intern ("history-length");
2874 staticpro (&Qhistory_length);
2875
2876 Qcurrent_input_method = intern ("current-input-method");
2877 staticpro (&Qcurrent_input_method);
2878
2879 Qactivate_input_method = intern ("activate-input-method");
2880 staticpro (&Qactivate_input_method);
2881
2882 Qcase_fold_search = intern ("case-fold-search");
2883 staticpro (&Qcase_fold_search);
2884
2885 Qread_expression_history = intern ("read-expression-history");
2886 staticpro (&Qread_expression_history);
2887
2888 DEFVAR_LISP ("read-buffer-function", &Vread_buffer_function,
2889 doc: /* If this is non-nil, `read-buffer' does its work by calling this function. */);
2890 Vread_buffer_function = Qnil;
2891
2892 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
2893 doc: /* Normal hook run just after entry to minibuffer. */);
2894 Vminibuffer_setup_hook = Qnil;
2895
2896 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
2897 doc: /* Normal hook run just after exit from minibuffer. */);
2898 Vminibuffer_exit_hook = Qnil;
2899
2900 DEFVAR_LISP ("history-length", &Vhistory_length,
2901 doc: /* *Maximum length for history lists before truncation takes place.
2902 A number means that length; t means infinite. Truncation takes place
2903 just after a new element is inserted. Setting the `history-length'
2904 property of a history variable overrides this default. */);
2905 XSETFASTINT (Vhistory_length, 30);
2906
2907 DEFVAR_BOOL ("history-delete-duplicates", &history_delete_duplicates,
2908 doc: /* *Non-nil means to delete duplicates in history.
2909 If set to t when adding a new history element, all previous identical
2910 elements are deleted from the history list. */);
2911 history_delete_duplicates = 0;
2912
2913 DEFVAR_LISP ("history-add-new-input", &Vhistory_add_new_input,
2914 doc: /* *Non-nil means to add new elements in history.
2915 If set to nil, minibuffer reading functions don't add new elements to the
2916 history list, so it is possible to do this afterwards by calling
2917 `add-to-history' explicitly. */);
2918 Vhistory_add_new_input = Qt;
2919
2920 DEFVAR_LISP ("completion-auto-help", &Vcompletion_auto_help,
2921 doc: /* *Non-nil means automatically provide help for invalid completion input.
2922 Under Partial Completion mode, a non-nil, non-t value has a special meaning;
2923 see the doc string of `partial-completion-mode' for more details. */);
2924 Vcompletion_auto_help = Qt;
2925
2926 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
2927 doc: /* Non-nil means don't consider case significant in completion.
2928
2929 For file-name completion, the variable `read-file-name-completion-ignore-case'
2930 controls the behavior, rather than this variable. */);
2931 completion_ignore_case = 0;
2932
2933 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
2934 doc: /* *Non-nil means to allow minibuffer commands while in the minibuffer.
2935 This variable makes a difference whenever the minibuffer window is active. */);
2936 enable_recursive_minibuffers = 0;
2937
2938 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
2939 doc: /* Alist or obarray used for completion in the minibuffer.
2940 This becomes the ALIST argument to `try-completion' and `all-completions'.
2941 The value can also be a list of strings or a hash table.
2942
2943 The value may alternatively be a function, which is given three arguments:
2944 STRING, the current buffer contents;
2945 PREDICATE, the predicate for filtering possible matches;
2946 CODE, which says what kind of things to do.
2947 CODE can be nil, t or `lambda':
2948 nil -- return the best completion of STRING, or nil if there is none.
2949 t -- return a list of all possible completions of STRING.
2950 lambda -- return t if STRING is a valid completion as it stands. */);
2951 Vminibuffer_completion_table = Qnil;
2952
2953 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
2954 doc: /* Within call to `completing-read', this holds the PREDICATE argument. */);
2955 Vminibuffer_completion_predicate = Qnil;
2956
2957 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
2958 doc: /* Non-nil means to demand confirmation of completion before exiting minibuffer. */);
2959 Vminibuffer_completion_confirm = Qnil;
2960
2961 DEFVAR_LISP ("minibuffer-completing-file-name",
2962 &Vminibuffer_completing_file_name,
2963 doc: /* Non-nil and non-`lambda' means completing file names. */);
2964 Vminibuffer_completing_file_name = Qnil;
2965
2966 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
2967 doc: /* Value that `help-form' takes on inside the minibuffer. */);
2968 Vminibuffer_help_form = Qnil;
2969
2970 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
2971 doc: /* History list symbol to add minibuffer values to.
2972 Each string of minibuffer input, as it appears on exit from the minibuffer,
2973 is added with
2974 (set minibuffer-history-variable
2975 (cons STRING (symbol-value minibuffer-history-variable))) */);
2976 XSETFASTINT (Vminibuffer_history_variable, 0);
2977
2978 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
2979 doc: /* Current position of redoing in the history list. */);
2980 Vminibuffer_history_position = Qnil;
2981
2982 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
2983 doc: /* *Non-nil means entering the minibuffer raises the minibuffer's frame.
2984 Some uses of the echo area also raise that frame (since they use it too). */);
2985 minibuffer_auto_raise = 0;
2986
2987 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
2988 doc: /* List of regexps that should restrict possible completions.
2989 The basic completion functions only consider a completion acceptable
2990 if it matches all regular expressions in this list, with
2991 `case-fold-search' bound to the value of `completion-ignore-case'.
2992 See Info node `(elisp)Basic Completion', for a description of these
2993 functions. */);
2994 Vcompletion_regexp_list = Qnil;
2995
2996 DEFVAR_BOOL ("minibuffer-allow-text-properties",
2997 &minibuffer_allow_text_properties,
2998 doc: /* Non-nil means `read-from-minibuffer' should not discard text properties.
2999 This also affects `read-string', but it does not affect `read-minibuffer',
3000 `read-no-blanks-input', or any of the functions that do minibuffer input
3001 with completion; they always discard text properties. */);
3002 minibuffer_allow_text_properties = 0;
3003
3004 DEFVAR_LISP ("minibuffer-prompt-properties", &Vminibuffer_prompt_properties,
3005 doc: /* Text properties that are added to minibuffer prompts.
3006 These are in addition to the basic `field' property, and stickiness
3007 properties. */);
3008 /* We use `intern' here instead of Qread_only to avoid
3009 initialization-order problems. */
3010 Vminibuffer_prompt_properties
3011 = Fcons (intern ("read-only"), Fcons (Qt, Qnil));
3012
3013 DEFVAR_LISP ("read-expression-map", &Vread_expression_map,
3014 doc: /* Minibuffer keymap used for reading Lisp expressions. */);
3015 Vread_expression_map = Qnil;
3016
3017 defsubr (&Sset_minibuffer_window);
3018 defsubr (&Sread_from_minibuffer);
3019 defsubr (&Seval_minibuffer);
3020 defsubr (&Sread_minibuffer);
3021 defsubr (&Sread_string);
3022 defsubr (&Sread_command);
3023 defsubr (&Sread_variable);
3024 defsubr (&Sinternal_complete_buffer);
3025 defsubr (&Sread_buffer);
3026 defsubr (&Sread_no_blanks_input);
3027 defsubr (&Sminibuffer_depth);
3028 defsubr (&Sminibuffer_prompt);
3029
3030 defsubr (&Sminibufferp);
3031 defsubr (&Sminibuffer_prompt_end);
3032 defsubr (&Sminibuffer_contents);
3033 defsubr (&Sminibuffer_contents_no_properties);
3034 defsubr (&Sminibuffer_completion_contents);
3035 defsubr (&Sdelete_minibuffer_contents);
3036
3037 defsubr (&Stry_completion);
3038 defsubr (&Sall_completions);
3039 defsubr (&Stest_completion);
3040 defsubr (&Sassoc_string);
3041 defsubr (&Scompleting_read);
3042 defsubr (&Sminibuffer_complete);
3043 defsubr (&Sminibuffer_complete_word);
3044 defsubr (&Sminibuffer_complete_and_exit);
3045 defsubr (&Sdisplay_completion_list);
3046 defsubr (&Sminibuffer_completion_help);
3047
3048 defsubr (&Sself_insert_and_exit);
3049 defsubr (&Sexit_minibuffer);
3050
3051 defsubr (&Sminibuffer_message);
3052 }
3053
3054 void
3055 keys_of_minibuf ()
3056 {
3057 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
3058 "abort-recursive-edit");
3059 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
3060 "exit-minibuffer");
3061 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
3062 "exit-minibuffer");
3063
3064 initial_define_key (Vminibuffer_local_ns_map, ' ',
3065 "exit-minibuffer");
3066 initial_define_key (Vminibuffer_local_ns_map, '\t',
3067 "exit-minibuffer");
3068 initial_define_key (Vminibuffer_local_ns_map, '?',
3069 "self-insert-and-exit");
3070
3071 initial_define_key (Vminibuffer_local_completion_map, '\t',
3072 "minibuffer-complete");
3073 initial_define_key (Vminibuffer_local_completion_map, ' ',
3074 "minibuffer-complete-word");
3075 initial_define_key (Vminibuffer_local_completion_map, '?',
3076 "minibuffer-completion-help");
3077
3078 Fdefine_key (Vminibuffer_local_filename_completion_map,
3079 build_string (" "), Qnil);
3080
3081 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
3082 "minibuffer-complete-and-exit");
3083 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
3084 "minibuffer-complete-and-exit");
3085
3086 Fdefine_key (Vminibuffer_local_must_match_filename_map,
3087 build_string (" "), Qnil);
3088 }
3089
3090 /* arch-tag: 8f69b601-fba3-484c-a6dd-ceaee54a7a73
3091 (do not change this comment) */