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