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