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