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