1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
25 #include "dispextern.h"
30 #define min(a, b) ((a) < (b) ? (a) : (b))
32 /* List of buffers for use as minibuffers.
33 The first element of the list is used for the outermost minibuffer invocation,
34 the next element is used for a recursive minibuffer invocation, etc.
35 The list is extended at the end as deeped minibuffer recursions are encountered. */
36 Lisp_Object Vminibuffer_list
;
38 struct minibuf_save_data
42 Lisp_Object help_form
;
43 Lisp_Object current_prefix_arg
;
44 Lisp_Object history_position
;
45 Lisp_Object history_variable
;
48 int minibuf_save_vector_size
;
49 struct minibuf_save_data
*minibuf_save_vector
;
51 /* Depth in minibuffer invocations. */
54 /* Nonzero means display completion help for invalid input */
57 /* Fread_minibuffer leaves the input, as a string, here */
58 Lisp_Object last_minibuf_string
;
60 /* Nonzero means let functions called when within a minibuffer
61 invoke recursive minibuffers (to read arguments, or whatever) */
62 int enable_recursive_minibuffers
;
64 /* help-form is bound to this while in the minibuffer. */
66 Lisp_Object Vminibuffer_help_form
;
68 /* Variable which is the history list to add minibuffer values to. */
70 Lisp_Object Vminibuffer_history_variable
;
72 /* Current position in the history list (adjusted by M-n and M-p). */
74 Lisp_Object Vminibuffer_history_position
;
76 Lisp_Object Qminibuffer_history
;
78 /* Nonzero means completion ignores case. */
80 int completion_ignore_case
;
82 /* If last completion attempt reported "Complete but not unique"
83 then this is the string completed then; otherwise this is nil. */
85 static Lisp_Object last_exact_completion
;
87 Lisp_Object Quser_variable_p
;
90 /* Actual minibuffer invocation. */
92 void read_minibuf_unwind ();
93 Lisp_Object
get_minibuffer ();
94 Lisp_Object
read_minibuf ();
96 /* Read from the minibuffer using keymap MAP, initial contents INITIAL
97 (a string), putting point minus BACKUP_N chars from the end of INITIAL,
98 prompting with PROMPT (a string), using history list HISTVAR
99 with initial position HISTPOS. (BACKUP_N should be <= 0.)
101 Normally return the result as a string (the text that was read),
102 but if EXPFLAG is non-nil, read it and return the object read. */
105 read_minibuf (map
, initial
, prompt
, backup_n
, expflag
, histvar
, histpos
)
114 register Lisp_Object val
;
115 int count
= specpdl_ptr
- specpdl
;
116 Lisp_Object mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
117 struct gcpro gcpro1
, gcpro2
;
119 if (XTYPE (prompt
) != Lisp_String
)
120 prompt
= build_string ("");
122 /* Emacs in -batch mode calls minibuffer: print the prompt. */
123 if (noninteractive
&& XTYPE (prompt
) == Lisp_String
)
124 printf ("%s", XSTRING (prompt
)->data
);
126 if (!enable_recursive_minibuffers
128 && (EQ (selected_window
, minibuf_window
)))
130 || selected_frame
!= XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)))
132 error ("Command attempted to use minibuffer while in minibuffer");
134 if (minibuf_level
== minibuf_save_vector_size
)
135 minibuf_save_vector
=
136 (struct minibuf_save_data
*)
137 xrealloc (minibuf_save_vector
,
138 (minibuf_save_vector_size
*= 2)
139 * sizeof (struct minibuf_save_data
));
140 minibuf_save_vector
[minibuf_level
].prompt
= minibuf_prompt
;
141 minibuf_save_vector
[minibuf_level
].prompt_width
= minibuf_prompt_width
;
142 minibuf_prompt_width
= 0;
143 /* >> Why is this done this way rather than binding these variables? */
144 minibuf_save_vector
[minibuf_level
].help_form
= Vhelp_form
;
145 minibuf_save_vector
[minibuf_level
].current_prefix_arg
= Vcurrent_prefix_arg
;
146 minibuf_save_vector
[minibuf_level
].history_position
= Vminibuffer_history_position
;
147 minibuf_save_vector
[minibuf_level
].history_variable
= Vminibuffer_history_variable
;
148 GCPRO2 (minibuf_save_vector
[minibuf_level
].help_form
,
149 minibuf_save_vector
[minibuf_level
].current_prefix_arg
);
151 record_unwind_protect (Fset_window_configuration
,
152 Fcurrent_window_configuration (Qnil
));
154 /* If the minibuffer window is on a different frame, save that
155 frame's configuration too. */
156 if (XFRAME (mini_frame
) != selected_frame
)
158 record_unwind_protect (Fset_window_configuration
,
159 Fcurrent_window_configuration (mini_frame
));
162 val
= current_buffer
->directory
;
163 Fset_buffer (get_minibuffer (minibuf_level
));
165 /* The current buffer's default directory is usually the right thing
166 for our minibuffer here. However, if you're typing a command at
167 a minibuffer-only frame when minibuf_level is zero, then buf IS
168 the current_buffer, so reset_buffer leaves buf's default
169 directory unchanged. This is a bummer when you've just started
170 up Emacs and buf's default directory is Qnil. Here's a hack; can
171 you think of something better to do? Find another buffer with a
172 better directory, and use that one instead. */
173 if (XTYPE (val
) == Lisp_String
)
174 current_buffer
->directory
= val
;
177 Lisp_Object buf_list
;
179 for (buf_list
= Vbuffer_alist
;
181 buf_list
= XCONS (buf_list
)->cdr
)
183 Lisp_Object other_buf
= XCONS (XCONS (buf_list
)->car
)->cdr
;
185 if (XTYPE (XBUFFER (other_buf
)->directory
) == Lisp_String
)
187 current_buffer
->directory
= XBUFFER (other_buf
)->directory
;
194 Fredirect_frame_focus (Fselected_frame (), mini_frame
);
196 Fmake_local_variable (Qprint_escape_newlines
);
197 print_escape_newlines
= 1;
199 record_unwind_protect (read_minibuf_unwind
, Qnil
);
201 Vminibuf_scroll_window
= selected_window
;
202 Fset_window_buffer (minibuf_window
, Fcurrent_buffer ());
203 Fselect_window (minibuf_window
);
204 XFASTINT (XWINDOW (minibuf_window
)->hscroll
) = 0;
211 Finsert (1, &initial
);
212 if (!NILP (backup_n
) && XTYPE (backup_n
) == Lisp_Int
)
213 Fforward_char (backup_n
);
216 minibuf_prompt
= (char *) alloca (XSTRING (prompt
)->size
+ 1);
217 bcopy (XSTRING (prompt
)->data
, minibuf_prompt
, XSTRING (prompt
)->size
+ 1);
218 echo_area_glyphs
= 0;
220 Vhelp_form
= Vminibuffer_help_form
;
221 current_buffer
->keymap
= map
;
222 Vminibuffer_history_position
= histpos
;
223 Vminibuffer_history_variable
= histvar
;
225 /* ??? MCC did redraw_screen here if switching screens. */
228 /* If cursor is on the minibuffer line,
229 show the user we have exited by putting it in column 0. */
230 if ((FRAME_CURSOR_Y (selected_frame
)
231 >= XFASTINT (XWINDOW (minibuf_window
)->top
))
234 FRAME_CURSOR_X (selected_frame
) = 0;
235 update_frame (selected_frame
, 1, 1);
238 /* Make minibuffer contents into a string */
239 val
= make_buffer_string (1, Z
);
240 bcopy (GAP_END_ADDR
, XSTRING (val
)->data
+ GPT
- BEG
, Z
- GPT
);
242 /* Add the value to the appropriate history list. */
243 if (XTYPE (Vminibuffer_history_variable
) == Lisp_Symbol
244 && ! EQ (XSYMBOL (Vminibuffer_history_variable
)->value
, Qunbound
))
245 Fset (Vminibuffer_history_variable
,
246 Fcons (val
, Fsymbol_value (Vminibuffer_history_variable
)));
248 unbind_to (count
, Qnil
); /* The appropriate frame will get selected
249 in set-window-configuration. */
253 /* VAL is the string of minibuffer text. */
254 last_minibuf_string
= val
;
256 /* If Lisp form desired instead of string, parse it */
263 /* Return a buffer to be used as the minibuffer at depth `depth'.
264 depth = 0 is the lowest allowed argument, and that is the value
265 used for nonrecursive minibuffer invocations */
268 get_minibuffer (depth
)
271 Lisp_Object tail
, num
, buf
;
273 extern Lisp_Object
nconc2 ();
275 XFASTINT (num
) = depth
;
276 tail
= Fnthcdr (num
, Vminibuffer_list
);
279 tail
= Fcons (Qnil
, Qnil
);
280 Vminibuffer_list
= nconc2 (Vminibuffer_list
, tail
);
283 if (NILP (buf
) || NILP (XBUFFER (buf
)->name
))
285 sprintf (name
, " *Minibuf-%d*", depth
);
286 buf
= Fget_buffer_create (build_string (name
));
288 /* Although the buffer's name starts with a space, undo should be
290 Fbuffer_enable_undo (buf
);
292 XCONS (tail
)->car
= buf
;
295 reset_buffer (XBUFFER (buf
));
300 /* This function is called on exiting minibuffer, whether normally or not,
301 and it restores the current window, buffer, etc. */
304 read_minibuf_unwind (data
)
307 /* Erase the minibuffer we were using at this level. */
308 Fset_buffer (XWINDOW (minibuf_window
)->buffer
);
310 /* Prevent error in erase-buffer. */
311 current_buffer
->read_only
= Qnil
;
314 /* If this was a recursive minibuffer,
315 tie the minibuffer window back to the outer level minibuffer buffer */
317 /* Make sure minibuffer window is erased, not ignored */
318 windows_or_buffers_changed
++;
319 XFASTINT (XWINDOW (minibuf_window
)->last_modified
) = 0;
321 /* Restore prompt from outer minibuffer */
322 minibuf_prompt
= minibuf_save_vector
[minibuf_level
].prompt
;
323 minibuf_prompt_width
= minibuf_save_vector
[minibuf_level
].prompt_width
;
324 Vhelp_form
= minibuf_save_vector
[minibuf_level
].help_form
;
325 Vcurrent_prefix_arg
= minibuf_save_vector
[minibuf_level
].current_prefix_arg
;
326 Vminibuffer_history_position
327 = minibuf_save_vector
[minibuf_level
].history_position
;
328 Vminibuffer_history_variable
329 = minibuf_save_vector
[minibuf_level
].history_variable
;
333 /* This comment supplies the doc string for read-from-minibuffer,
334 for make-docfile to see. We cannot put this in the real DEFUN
335 due to limits in the Unix cpp.
337 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
338 "Read a string from the minibuffer, prompting with string PROMPT.\n\
339 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
340 to be inserted into the minibuffer before reading input.\n\
341 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
342 is STRING, but point is placed POSITION characters into the string.\n\
343 Third arg KEYMAP is a keymap to use whilst reading;\n\
344 if omitted or nil, the default is `minibuffer-local-map'.\n\
345 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
346 and return that object:\n\
347 in other words, do `(car (read-from-string INPUT-STRING))'\n\
348 Fifth arg HIST, if non-nil, specifies a history list\n\
349 and optionally the initial position in the list.\n\
350 It can be a symbol, which is the history list variable to use,\n\
351 or it can be a cons cell (HISTVAR . HISTPOS).\n\
352 In that case, HISTVAR is the history list variable to use,\n\
353 and HISTPOS is the initial position (the position in the list\n\
354 which INITIAL-CONTENTS corresponds to).\n\
355 Positions are counted starting from 1 at the beginning of the list."
358 DEFUN ("read-from-minibuffer", Fread_from_minibuffer
, Sread_from_minibuffer
, 1, 5, 0,
359 0 /* See immediately above */)
360 (prompt
, initial_input
, keymap
, read
, hist
)
361 Lisp_Object prompt
, initial_input
, keymap
, read
, hist
;
364 Lisp_Object histvar
, histpos
, position
;
367 CHECK_STRING (prompt
, 0);
368 if (!NILP (initial_input
))
370 if (XTYPE (initial_input
) == Lisp_Cons
)
372 position
= Fcdr (initial_input
);
373 initial_input
= Fcar (initial_input
);
375 CHECK_STRING (initial_input
, 1);
376 if (!NILP (position
))
378 CHECK_NUMBER (position
, 0);
379 /* Convert to distance from end of input. */
380 pos
= XINT (position
) - 1 - XSTRING (initial_input
)->size
;
385 keymap
= Vminibuffer_local_map
;
387 keymap
= get_keymap (keymap
,2);
389 if (XTYPE (hist
) == Lisp_Symbol
)
396 histvar
= Fcar_safe (hist
);
397 histpos
= Fcdr_safe (hist
);
400 histvar
= Qminibuffer_history
;
402 XFASTINT (histpos
) = 0;
404 return read_minibuf (keymap
, initial_input
, prompt
,
405 make_number (pos
), !NILP (read
), histvar
, histpos
);
408 DEFUN ("read-minibuffer", Fread_minibuffer
, Sread_minibuffer
, 1, 2, 0,
409 "Return a Lisp object read using the minibuffer.\n\
410 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
411 is a string to insert in the minibuffer before reading.")
412 (prompt
, initial_contents
)
413 Lisp_Object prompt
, initial_contents
;
415 CHECK_STRING (prompt
, 0);
416 if (!NILP (initial_contents
))
417 CHECK_STRING (initial_contents
, 1)
418 return read_minibuf (Vminibuffer_local_map
, initial_contents
,
419 prompt
, Qnil
, 1, Qminibuffer_history
, make_number (0));
422 DEFUN ("eval-minibuffer", Feval_minibuffer
, Seval_minibuffer
, 1, 2, 0,
423 "Return value of Lisp expression read using the minibuffer.\n\
424 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
425 is a string to insert in the minibuffer before reading.")
426 (prompt
, initial_contents
)
427 Lisp_Object prompt
, initial_contents
;
429 return Feval (Fread_minibuffer (prompt
, initial_contents
));
432 /* Functions that use the minibuffer to read various things. */
434 DEFUN ("read-string", Fread_string
, Sread_string
, 1, 2, 0,
435 "Read a string from the minibuffer, prompting with string PROMPT.\n\
436 If non-nil second arg INITIAL-INPUT is a string to insert before reading.")
437 (prompt
, initial_input
)
438 Lisp_Object prompt
, initial_input
;
440 return Fread_from_minibuffer (prompt
, initial_input
, Qnil
, Qnil
, Qnil
);
443 DEFUN ("read-no-blanks-input", Fread_no_blanks_input
, Sread_no_blanks_input
, 2, 2, 0,
444 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
445 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
447 Lisp_Object prompt
, init
;
449 CHECK_STRING (prompt
, 0);
451 CHECK_STRING (init
, 1);
453 return read_minibuf (Vminibuffer_local_ns_map
, init
, prompt
, Qnil
, 0,
454 Qminibuffer_history
, make_number (0));
457 DEFUN ("read-command", Fread_command
, Sread_command
, 1, 1, 0,
458 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
459 Prompts with PROMPT.")
463 return Fintern (Fcompleting_read (prompt
, Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
),
468 DEFUN ("read-function", Fread_function
, Sread_function
, 1, 1, 0,
469 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
470 Prompts with PROMPT.")
474 return Fintern (Fcompleting_read (prompt
, Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
),
479 DEFUN ("read-variable", Fread_variable
, Sread_variable
, 1, 1, 0,
480 "One arg PROMPT, a string. Read the name of a user variable and return\n\
481 it as a symbol. Prompts with PROMPT.\n\
482 A user variable is one whose documentation starts with a `*' character.")
486 return Fintern (Fcompleting_read (prompt
, Vobarray
,
487 Quser_variable_p
, Qt
, Qnil
, Qnil
),
491 DEFUN ("read-buffer", Fread_buffer
, Sread_buffer
, 1, 3, 0,
492 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
493 Prompts with PROMPT.\n\
494 Optional second arg is value to return if user enters an empty line.\n\
495 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
496 (prompt
, def
, require_match
)
497 Lisp_Object prompt
, def
, require_match
;
503 if (XTYPE (def
) == Lisp_Buffer
)
504 def
= XBUFFER (def
)->name
;
507 args
[0] = build_string ("%s(default %s) ");
510 prompt
= Fformat (3, args
);
513 tem
= Fcompleting_read (prompt
, Vbuffer_alist
, Qnil
, require_match
, Qnil
, Qnil
);
515 if (XSTRING (tem
)->size
)
520 DEFUN ("try-completion", Ftry_completion
, Stry_completion
, 2, 3, 0,
521 "Return common substring of all completions of STRING in ALIST.\n\
522 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
523 All that match are compared together; the longest initial sequence\n\
524 common to all matches is returned as a string.\n\
525 If there is no match at all, nil is returned.\n\
526 For an exact match, t is returned.\n\
528 ALIST can be an obarray instead of an alist.\n\
529 Then the print names of all symbols in the obarray are the possible matches.\n\
531 ALIST can also be a function to do the completion itself.\n\
532 It receives three arguments: the values STRING, PREDICATE and nil.\n\
533 Whatever it returns becomes the value of `try-completion'.\n\
535 If optional third argument PREDICATE is non-nil,\n\
536 it is used to test each possible match.\n\
537 The match is a candidate only if PREDICATE returns non-nil.\n\
538 The argument given to PREDICATE is the alist element or the symbol from the obarray.")
539 (string
, alist
, pred
)
540 Lisp_Object string
, alist
, pred
;
542 Lisp_Object bestmatch
, tail
, elt
, eltstring
;
544 int compare
, matchsize
;
545 int list
= CONSP (alist
) || NILP (alist
);
548 Lisp_Object bucket
, zero
, end
, tem
;
549 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
551 CHECK_STRING (string
, 0);
552 if (!list
&& XTYPE (alist
) != Lisp_Vector
)
553 return call3 (alist
, string
, pred
, Qnil
);
557 /* If ALIST is not a list, set TAIL just for gc pro. */
562 obsize
= XVECTOR (alist
)->size
;
563 bucket
= XVECTOR (alist
)->contents
[index
];
568 /* Get the next element of the alist or obarray. */
569 /* Exit the loop if the elements are all used up. */
570 /* elt gets the alist element or symbol.
571 eltstring gets the name to check as a completion. */
578 eltstring
= Fcar (elt
);
583 if (XFASTINT (bucket
) != 0)
586 eltstring
= Fsymbol_name (elt
);
587 if (XSYMBOL (bucket
)->next
)
588 XSETSYMBOL (bucket
, XSYMBOL (bucket
)->next
);
590 XFASTINT (bucket
) = 0;
592 else if (++index
>= obsize
)
596 bucket
= XVECTOR (alist
)->contents
[index
];
601 /* Is this element a possible completion? */
603 if (XTYPE (eltstring
) == Lisp_String
&&
604 XSTRING (string
)->size
<= XSTRING (eltstring
)->size
&&
605 0 > scmp (XSTRING (eltstring
)->data
, XSTRING (string
)->data
,
606 XSTRING (string
)->size
))
609 /* Ignore this element if there is a predicate
610 and the predicate doesn't like it. */
614 if (EQ (pred
, Qcommandp
))
615 tem
= Fcommandp (elt
);
618 GCPRO4 (tail
, string
, eltstring
, bestmatch
);
619 tem
= call1 (pred
, elt
);
622 if (NILP (tem
)) continue;
625 /* Update computation of how much all possible completions match */
628 if (NILP (bestmatch
))
629 bestmatch
= eltstring
, bestmatchsize
= XSTRING (eltstring
)->size
;
632 compare
= min (bestmatchsize
, XSTRING (eltstring
)->size
);
633 matchsize
= scmp (XSTRING (bestmatch
)->data
,
634 XSTRING (eltstring
)->data
,
638 if (completion_ignore_case
)
640 /* If this is an exact match except for case,
641 use it as the best match rather than one that is not an
642 exact match. This way, we get the case pattern
643 of the actual match. */
644 if ((matchsize
== XSTRING (eltstring
)->size
645 && matchsize
< XSTRING (bestmatch
)->size
)
647 /* If there is more than one exact match ignoring case,
648 and one of them is exact including case,
650 /* If there is no exact match ignoring case,
651 prefer a match that does not change the case
653 ((matchsize
== XSTRING (eltstring
)->size
)
655 (matchsize
== XSTRING (bestmatch
)->size
)
656 && !bcmp (XSTRING (eltstring
)->data
,
657 XSTRING (string
)->data
, XSTRING (string
)->size
)
658 && bcmp (XSTRING (bestmatch
)->data
,
659 XSTRING (string
)->data
, XSTRING (string
)->size
)))
660 bestmatch
= eltstring
;
662 bestmatchsize
= matchsize
;
667 if (NILP (bestmatch
))
668 return Qnil
; /* No completions found */
669 /* If we are ignoring case, and there is no exact match,
670 and no additional text was supplied,
671 don't change the case of what the user typed. */
672 if (completion_ignore_case
&& bestmatchsize
== XSTRING (string
)->size
673 && XSTRING (bestmatch
)->size
> bestmatchsize
)
676 /* Return t if the supplied string is an exact match (counting case);
677 it does not require any change to be made. */
678 if (matchcount
== 1 && bestmatchsize
== XSTRING (string
)->size
679 && !bcmp (XSTRING (bestmatch
)->data
, XSTRING (string
)->data
,
683 XFASTINT (zero
) = 0; /* Else extract the part in which */
684 XFASTINT (end
) = bestmatchsize
; /* all completions agree */
685 return Fsubstring (bestmatch
, zero
, end
);
688 /* Compare exactly LEN chars of strings at S1 and S2,
689 ignoring case if appropriate.
690 Return -1 if strings match,
691 else number of chars that match at the beginning. */
694 register char *s1
, *s2
;
697 register int l
= len
;
699 if (completion_ignore_case
)
701 while (l
&& DOWNCASE (*s1
++) == DOWNCASE (*s2
++))
706 while (l
&& *s1
++ == *s2
++)
714 DEFUN ("all-completions", Fall_completions
, Sall_completions
, 2, 3, 0,
715 "Search for partial matches to STRING in ALIST.\n\
716 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
717 The value is a list of all the strings from ALIST that match.\n\
718 ALIST can be an obarray instead of an alist.\n\
719 Then the print names of all symbols in the obarray are the possible matches.\n\
721 ALIST can also be a function to do the completion itself.\n\
722 It receives three arguments: the values STRING, PREDICATE and t.\n\
723 Whatever it returns becomes the value of `all-completion'.\n\
725 If optional third argument PREDICATE is non-nil,\n\
726 it is used to test each possible match.\n\
727 The match is a candidate only if PREDICATE returns non-nil.\n\
728 The argument given to PREDICATE is the alist element or the symbol from the obarray.")
729 (string
, alist
, pred
)
730 Lisp_Object string
, alist
, pred
;
732 Lisp_Object tail
, elt
, eltstring
;
733 Lisp_Object allmatches
;
734 int list
= CONSP (alist
) || NILP (alist
);
736 Lisp_Object bucket
, tem
;
737 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
739 CHECK_STRING (string
, 0);
740 if (!list
&& XTYPE (alist
) != Lisp_Vector
)
742 return call3 (alist
, string
, pred
, Qt
);
746 /* If ALIST is not a list, set TAIL just for gc pro. */
751 obsize
= XVECTOR (alist
)->size
;
752 bucket
= XVECTOR (alist
)->contents
[index
];
757 /* Get the next element of the alist or obarray. */
758 /* Exit the loop if the elements are all used up. */
759 /* elt gets the alist element or symbol.
760 eltstring gets the name to check as a completion. */
767 eltstring
= Fcar (elt
);
772 if (XFASTINT (bucket
) != 0)
775 eltstring
= Fsymbol_name (elt
);
776 if (XSYMBOL (bucket
)->next
)
777 XSETSYMBOL (bucket
, XSYMBOL (bucket
)->next
);
779 XFASTINT (bucket
) = 0;
781 else if (++index
>= obsize
)
785 bucket
= XVECTOR (alist
)->contents
[index
];
790 /* Is this element a possible completion? */
792 if (XTYPE (eltstring
) == Lisp_String
&&
793 XSTRING (string
)->size
<= XSTRING (eltstring
)->size
&&
794 XSTRING (eltstring
)->data
[0] != ' ' &&
795 0 > scmp (XSTRING (eltstring
)->data
, XSTRING (string
)->data
,
796 XSTRING (string
)->size
))
799 /* Ignore this element if there is a predicate
800 and the predicate doesn't like it. */
804 if (EQ (pred
, Qcommandp
))
805 tem
= Fcommandp (elt
);
808 GCPRO4 (tail
, eltstring
, allmatches
, string
);
809 tem
= call1 (pred
, elt
);
812 if (NILP (tem
)) continue;
814 /* Ok => put it on the list. */
815 allmatches
= Fcons (eltstring
, allmatches
);
819 return Fnreverse (allmatches
);
822 Lisp_Object Vminibuffer_completion_table
, Qminibuffer_completion_table
;
823 Lisp_Object Vminibuffer_completion_predicate
, Qminibuffer_completion_predicate
;
824 Lisp_Object Vminibuffer_completion_confirm
, Qminibuffer_completion_confirm
;
826 /* This comment supplies the doc string for completing-read,
827 for make-docfile to see. We cannot put this in the real DEFUN
828 due to limits in the Unix cpp.
830 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
831 "Read a string in the minibuffer, with completion.\n\
832 Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST.\n\
833 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
834 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
835 PREDICATE limits completion to a subset of TABLE.\n\
836 See `try-completion' for more details on completion, TABLE, and PREDICATE.\n\
837 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
838 the input is (or completes to) an element of TABLE.\n\
839 If it is also not t, Return does not exit if it does non-null completion.\n\
840 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
841 If it is (STRING . POSITION), the initial input\n\
842 is STRING, but point is placed POSITION characters into the string.\n\
843 HIST, if non-nil, specifies a history list\n\
844 and optionally the initial position in the list.\n\
845 It can be a symbol, which is the history list variable to use,\n\
846 or it can be a cons cell (HISTVAR . HISTPOS).\n\
847 In that case, HISTVAR is the history list variable to use,\n\
848 and HISTPOS is the initial position (the position in the list\n\
849 which INITIAL-CONTENTS corresponds to).\n\
850 Positions are counted starting from 1 at the beginning of the list.\n\
851 Completion ignores case if the ambient value of\n\
852 `completion-ignore-case' is non-nil."
854 DEFUN ("completing-read", Fcompleting_read
, Scompleting_read
, 2, 6, 0,
855 0 /* See immediately above */)
856 (prompt
, table
, pred
, require_match
, init
, hist
)
857 Lisp_Object prompt
, table
, pred
, require_match
, init
, hist
;
859 Lisp_Object val
, histvar
, histpos
, position
;
861 int count
= specpdl_ptr
- specpdl
;
862 specbind (Qminibuffer_completion_table
, table
);
863 specbind (Qminibuffer_completion_predicate
, pred
);
864 specbind (Qminibuffer_completion_confirm
,
865 EQ (require_match
, Qt
) ? Qnil
: Qt
);
866 last_exact_completion
= Qnil
;
871 if (XTYPE (init
) == Lisp_Cons
)
873 position
= Fcdr (init
);
876 CHECK_STRING (init
, 0);
877 if (!NILP (position
))
879 CHECK_NUMBER (position
, 0);
880 /* Convert to distance from end of input. */
881 pos
= XINT (position
) - XSTRING (init
)->size
;
885 if (XTYPE (hist
) == Lisp_Symbol
)
892 histvar
= Fcar_safe (hist
);
893 histpos
= Fcdr_safe (hist
);
896 histvar
= Qminibuffer_history
;
898 XFASTINT (histpos
) = 0;
900 val
= read_minibuf (NILP (require_match
)
901 ? Vminibuffer_local_completion_map
902 : Vminibuffer_local_must_match_map
,
903 init
, prompt
, make_number (pos
), 0,
905 return unbind_to (count
, val
);
908 /* Temporarily display the string M at the end of the current
909 minibuffer contents. This is used to display things like
910 "[No Match]" when the user requests a completion for a prefix
911 that has no possible completions, and other quick, unobtrusive
914 temp_echo_area_glyphs (m
)
918 Lisp_Object oinhibit
;
919 oinhibit
= Vinhibit_quit
;
921 /* Clear out any old echo-area message to make way for our new thing. */
928 Fsit_for (make_number (2), Qnil
, Qnil
);
929 del_range (point
, ZV
);
930 if (!NILP (Vquit_flag
))
933 unread_command_events
= Fcons (make_number (Ctl ('g')), Qnil
);
935 Vinhibit_quit
= oinhibit
;
938 Lisp_Object
Fminibuffer_completion_help ();
939 Lisp_Object
assoc_for_completion ();
942 * 0 no possible completion
943 * 1 was already an exact and unique completion
944 * 3 was already an exact completion
945 * 4 completed to an exact completion
946 * 5 some completion happened
947 * 6 no completion happened
952 Lisp_Object completion
, tem
;
956 completion
= Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table
,
957 Vminibuffer_completion_predicate
);
958 last
= last_exact_completion
;
959 last_exact_completion
= Qnil
;
961 if (NILP (completion
))
964 temp_echo_area_glyphs (" [No match]");
968 if (EQ (completion
, Qt
)) /* exact and unique match */
972 tem
= Fstring_equal (completion
, Fbuffer_string());
973 if (completedp
= NILP (tem
))
975 Ferase_buffer (); /* Some completion happened */
976 Finsert (1, &completion
);
979 /* It did find a match. Do we match some possibility exactly now? */
980 if (CONSP (Vminibuffer_completion_table
)
981 || NILP (Vminibuffer_completion_table
))
982 tem
= assoc_for_completion (Fbuffer_string (),
983 Vminibuffer_completion_table
);
984 else if (XTYPE (Vminibuffer_completion_table
) == Lisp_Vector
)
986 /* the primitive used by Fintern_soft */
987 extern Lisp_Object
oblookup ();
989 tem
= Fbuffer_string ();
990 /* Bypass intern-soft as that loses for nil */
991 tem
= oblookup (Vminibuffer_completion_table
,
992 XSTRING (tem
)->data
, XSTRING (tem
)->size
);
993 if (XTYPE (tem
) != Lisp_Symbol
)
995 else if (!NILP (Vminibuffer_completion_predicate
))
996 tem
= call1 (Vminibuffer_completion_predicate
, tem
);
1001 tem
= call3 (Vminibuffer_completion_table
,
1003 Vminibuffer_completion_predicate
,
1007 { /* not an exact match */
1011 Fminibuffer_completion_help ();
1013 temp_echo_area_glyphs (" [Next char not unique]");
1016 else if (completedp
)
1018 /* If the last exact completion and this one were the same,
1019 it means we've already given a "Complete but not unique"
1020 message and the user's hit TAB again, so now we give him help. */
1021 last_exact_completion
= completion
;
1024 tem
= Fbuffer_string ();
1025 if (!NILP (Fequal (tem
, last
)))
1026 Fminibuffer_completion_help ();
1031 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1034 assoc_for_completion (key
, list
)
1035 register Lisp_Object key
;
1038 register Lisp_Object tail
;
1040 if (completion_ignore_case
)
1041 key
= Fupcase (key
);
1043 for (tail
= list
; !NILP (tail
); tail
= Fcdr (tail
))
1045 register Lisp_Object elt
, tem
, thiscar
;
1047 if (!CONSP (elt
)) continue;
1048 thiscar
= Fcar (elt
);
1049 if (XTYPE (thiscar
) != Lisp_String
)
1051 if (completion_ignore_case
)
1052 thiscar
= Fupcase (thiscar
);
1053 tem
= Fequal (thiscar
, key
);
1054 if (!NILP (tem
)) return elt
;
1060 DEFUN ("minibuffer-complete", Fminibuffer_complete
, Sminibuffer_complete
, 0, 0, "",
1061 "Complete the minibuffer contents as far as possible.")
1064 register int i
= do_completion ();
1071 temp_echo_area_glyphs (" [Sole completion]");
1075 temp_echo_area_glyphs (" [Complete, but not unique]");
1082 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit
,
1083 Sminibuffer_complete_and_exit
, 0, 0, "",
1084 "Complete the minibuffer contents, and maybe exit.\n\
1085 Exit if the name is valid with no completion needed.\n\
1086 If name was completed to a valid match,\n\
1087 a repetition of this command will exit.")
1092 /* Allow user to specify null string */
1096 i
= do_completion ();
1104 if (!NILP (Vminibuffer_completion_confirm
))
1106 temp_echo_area_glyphs (" [Confirm]");
1116 Fthrow (Qexit
, Qnil
);
1120 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word
, Sminibuffer_complete_word
,
1122 "Complete the minibuffer contents at most a single word.\n\
1123 After one word is completed as much as possible, a space or hyphen\n\
1124 is added, provided that matches some possible completion.")
1127 Lisp_Object completion
, tem
;
1129 register unsigned char *completion_string
;
1130 /* We keep calling Fbuffer_string
1131 rather than arrange for GC to hold onto a pointer to
1132 one of the strings thus made. */
1134 completion
= Ftry_completion (Fbuffer_string (),
1135 Vminibuffer_completion_table
,
1136 Vminibuffer_completion_predicate
);
1137 if (NILP (completion
))
1140 temp_echo_area_glyphs (" [No match]");
1143 if (EQ (completion
, Qt
))
1146 #if 0 /* How the below code used to look, for reference */
1147 tem
= Fbuffer_string ();
1148 b
= XSTRING (tem
)->data
;
1149 i
= ZV
- 1 - XSTRING (completion
)->size
;
1150 p
= XSTRING (completion
)->data
;
1152 0 <= scmp (b
, p
, ZV
- 1))
1155 /* Set buffer to longest match of buffer tail and completion head. */
1156 while (0 <= scmp (b
+ i
, p
, ZV
- 1 - i
))
1158 del_range (1, i
+ 1);
1161 #else /* Rewritten code */
1163 register unsigned char *buffer_string
;
1164 int buffer_length
, completion_length
;
1166 tem
= Fbuffer_string ();
1167 buffer_string
= XSTRING (tem
)->data
;
1168 completion_string
= XSTRING (completion
)->data
;
1169 buffer_length
= XSTRING (tem
)->size
; /* ie ZV - BEGV */
1170 completion_length
= XSTRING (completion
)->size
;
1171 i
= buffer_length
- completion_length
;
1172 /* Mly: I don't understand what this is supposed to do AT ALL */
1174 0 <= scmp (buffer_string
, completion_string
, buffer_length
))
1176 /* Set buffer to longest match of buffer tail and completion head. */
1180 while (0 <= scmp (buffer_string
++, completion_string
, buffer_length
--))
1182 del_range (1, i
+ 1);
1186 #endif /* Rewritten code */
1189 /* If completion finds next char not unique,
1190 consider adding a space or a hyphen */
1191 if (i
== XSTRING (completion
)->size
)
1193 tem
= Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1194 Vminibuffer_completion_table
,
1195 Vminibuffer_completion_predicate
);
1196 if (XTYPE (tem
) == Lisp_String
)
1200 tem
= Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1201 Vminibuffer_completion_table
,
1202 Vminibuffer_completion_predicate
);
1203 if (XTYPE (tem
) == Lisp_String
)
1208 /* Now find first word-break in the stuff found by completion.
1209 i gets index in string of where to stop completing. */
1210 completion_string
= XSTRING (completion
)->data
;
1212 for (; i
< XSTRING (completion
)->size
; i
++)
1213 if (SYNTAX (completion_string
[i
]) != Sword
) break;
1214 if (i
< XSTRING (completion
)->size
)
1217 /* If got no characters, print help for user. */
1222 Fminibuffer_completion_help ();
1226 /* Otherwise insert in minibuffer the chars we got */
1229 insert_from_string (completion
, 0, i
);
1233 DEFUN ("display-completion-list", Fdisplay_completion_list
, Sdisplay_completion_list
,
1235 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
1236 Each element may be just a symbol or string\n\
1237 or may be a list of two strings to be printed as if concatenated.")
1239 Lisp_Object completions
;
1241 register Lisp_Object tail
, elt
;
1244 /* No GCPRO needed, since (when it matters) every variable
1245 points to a non-string that is pointed to by COMPLETIONS. */
1246 struct buffer
*old
= current_buffer
;
1247 if (XTYPE (Vstandard_output
) == Lisp_Buffer
)
1248 set_buffer_internal (XBUFFER (Vstandard_output
));
1250 if (NILP (completions
))
1251 write_string ("There are no possible completions of what you have typed.", -1);
1254 write_string ("Possible completions are:", -1);
1255 for (tail
= completions
, i
= 0; !NILP (tail
); tail
= Fcdr (tail
), i
++)
1257 /* this needs fixing for the case of long completions
1258 and/or narrow windows */
1259 /* Sadly, the window it will appear in is not known
1260 until after the text has been made. */
1263 if (XTYPE (Vstandard_output
) == Lisp_Buffer
)
1264 Findent_to (make_number (35), make_number (1));
1269 write_string (" ", -1);
1272 while (column
< 35);
1283 if (XTYPE (Vstandard_output
) != Lisp_Buffer
)
1286 tem
= Flength (Fcar (elt
));
1287 column
+= XINT (tem
);
1288 tem
= Flength (Fcar (Fcdr (elt
)));
1289 column
+= XINT (tem
);
1291 Fprinc (Fcar (elt
), Qnil
);
1292 Fprinc (Fcar (Fcdr (elt
)), Qnil
);
1296 if (XTYPE (Vstandard_output
) != Lisp_Buffer
)
1299 tem
= Flength (elt
);
1300 column
+= XINT (tem
);
1307 if (XTYPE (Vstandard_output
) == Lisp_Buffer
)
1308 set_buffer_internal (old
);
1312 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help
, Sminibuffer_completion_help
,
1314 "Display a list of possible completions of the current minibuffer contents.")
1317 Lisp_Object completions
;
1319 message ("Making completion list...");
1320 completions
= Fall_completions (Fbuffer_string (),
1321 Vminibuffer_completion_table
,
1322 Vminibuffer_completion_predicate
);
1323 echo_area_glyphs
= 0;
1325 if (NILP (completions
))
1328 temp_echo_area_glyphs (" [No completions]");
1331 internal_with_output_to_temp_buffer ("*Completions*",
1332 Fdisplay_completion_list
,
1333 Fsort (completions
, Qstring_lessp
));
1337 DEFUN ("self-insert-and-exit", Fself_insert_and_exit
, Sself_insert_and_exit
, 0, 0, "",
1338 "Terminate minibuffer input.")
1341 if (XTYPE (last_command_char
) == Lisp_Int
)
1342 internal_self_insert (last_command_char
, 0);
1346 Fthrow (Qexit
, Qnil
);
1349 DEFUN ("exit-minibuffer", Fexit_minibuffer
, Sexit_minibuffer
, 0, 0, "",
1350 "Terminate this minibuffer argument.")
1353 Fthrow (Qexit
, Qnil
);
1356 DEFUN ("minibuffer-depth", Fminibuffer_depth
, Sminibuffer_depth
, 0, 0, 0,
1357 "Return current depth of activations of minibuffer, a nonnegative integer.")
1360 return make_number (minibuf_level
);
1364 init_minibuf_once ()
1366 Vminibuffer_list
= Qnil
;
1367 staticpro (&Vminibuffer_list
);
1374 minibuf_save_vector_size
= 5;
1375 minibuf_save_vector
= (struct minibuf_save_data
*) malloc (5 * sizeof (struct minibuf_save_data
));
1377 Qminibuffer_completion_table
= intern ("minibuffer-completion-table");
1378 staticpro (&Qminibuffer_completion_table
);
1380 Qminibuffer_completion_confirm
= intern ("minibuffer-completion-confirm");
1381 staticpro (&Qminibuffer_completion_confirm
);
1383 Qminibuffer_completion_predicate
= intern ("minibuffer-completion-predicate");
1384 staticpro (&Qminibuffer_completion_predicate
);
1386 staticpro (&last_minibuf_string
);
1387 last_minibuf_string
= Qnil
;
1389 Quser_variable_p
= intern ("user-variable-p");
1390 staticpro (&Quser_variable_p
);
1392 Qminibuffer_history
= intern ("minibuffer-history");
1393 staticpro (&Qminibuffer_history
);
1395 DEFVAR_BOOL ("completion-auto-help", &auto_help
,
1396 "*Non-nil means automatically provide help for invalid completion input.");
1399 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case
,
1400 "Non-nil means don't consider case significant in completion.");
1401 completion_ignore_case
= 0;
1403 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers
,
1404 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1405 More precisely, this variable makes a difference when the minibuffer window\n\
1406 is the selected window. If you are in some other window, minibuffer commands\n\
1407 are allowed even if a minibuffer is active.");
1408 enable_recursive_minibuffers
= 0;
1410 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table
,
1411 "Alist or obarray used for completion in the minibuffer.\n\
1412 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1414 The value may alternatively be a function, which is given three arguments:\n\
1415 STRING, the current buffer contents;\n\
1416 PREDICATE, the predicate for filtering possible matches;\n\
1417 CODE, which says what kind of things to do.\n\
1418 CODE can be nil, t or `lambda'.\n\
1419 nil means to return the best completion of STRING, or nil if there is none.\n\
1420 t means to return a list of all possible completions of STRING.\n\
1421 `lambda' means to return t if STRING is a valid completion as it stands.");
1422 Vminibuffer_completion_table
= Qnil
;
1424 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate
,
1425 "Within call to `completing-read', this holds the PREDICATE argument.");
1426 Vminibuffer_completion_predicate
= Qnil
;
1428 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm
,
1429 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1430 Vminibuffer_completion_confirm
= Qnil
;
1432 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form
,
1433 "Value that `help-form' takes on inside the minibuffer.");
1434 Vminibuffer_help_form
= Qnil
;
1436 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable
,
1437 "History list symbol to add minibuffer values to.\n\
1438 Each minibuffer output is added with\n\
1439 (set minibuffer-history-variable\n\
1440 (cons STRING (symbol-value minibuffer-history-variable)))");
1441 XFASTINT (Vminibuffer_history_variable
) = 0;
1443 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position
,
1444 "Current position of redoing in the history list.");
1445 Vminibuffer_history_position
= Qnil
;
1447 defsubr (&Sread_from_minibuffer
);
1448 defsubr (&Seval_minibuffer
);
1449 defsubr (&Sread_minibuffer
);
1450 defsubr (&Sread_string
);
1451 defsubr (&Sread_command
);
1452 defsubr (&Sread_variable
);
1453 defsubr (&Sread_buffer
);
1454 defsubr (&Sread_no_blanks_input
);
1455 defsubr (&Sminibuffer_depth
);
1457 defsubr (&Stry_completion
);
1458 defsubr (&Sall_completions
);
1459 defsubr (&Scompleting_read
);
1460 defsubr (&Sminibuffer_complete
);
1461 defsubr (&Sminibuffer_complete_word
);
1462 defsubr (&Sminibuffer_complete_and_exit
);
1463 defsubr (&Sdisplay_completion_list
);
1464 defsubr (&Sminibuffer_completion_help
);
1466 defsubr (&Sself_insert_and_exit
);
1467 defsubr (&Sexit_minibuffer
);
1473 initial_define_key (Vminibuffer_local_map
, Ctl ('g'),
1474 "abort-recursive-edit");
1475 initial_define_key (Vminibuffer_local_map
, Ctl ('m'),
1477 initial_define_key (Vminibuffer_local_map
, Ctl ('j'),
1480 initial_define_key (Vminibuffer_local_ns_map
, Ctl ('g'),
1481 "abort-recursive-edit");
1482 initial_define_key (Vminibuffer_local_ns_map
, Ctl ('m'),
1484 initial_define_key (Vminibuffer_local_ns_map
, Ctl ('j'),
1487 initial_define_key (Vminibuffer_local_ns_map
, ' ',
1489 initial_define_key (Vminibuffer_local_ns_map
, '\t',
1491 initial_define_key (Vminibuffer_local_ns_map
, '?',
1492 "self-insert-and-exit");
1494 initial_define_key (Vminibuffer_local_completion_map
, Ctl ('g'),
1495 "abort-recursive-edit");
1496 initial_define_key (Vminibuffer_local_completion_map
, Ctl ('m'),
1498 initial_define_key (Vminibuffer_local_completion_map
, Ctl ('j'),
1501 initial_define_key (Vminibuffer_local_completion_map
, '\t',
1502 "minibuffer-complete");
1503 initial_define_key (Vminibuffer_local_completion_map
, ' ',
1504 "minibuffer-complete-word");
1505 initial_define_key (Vminibuffer_local_completion_map
, '?',
1506 "minibuffer-completion-help");
1508 initial_define_key (Vminibuffer_local_must_match_map
, Ctl ('g'),
1509 "abort-recursive-edit");
1510 initial_define_key (Vminibuffer_local_must_match_map
, Ctl ('m'),
1511 "minibuffer-complete-and-exit");
1512 initial_define_key (Vminibuffer_local_must_match_map
, Ctl ('j'),
1513 "minibuffer-complete-and-exit");
1514 initial_define_key (Vminibuffer_local_must_match_map
, '\t',
1515 "minibuffer-complete");
1516 initial_define_key (Vminibuffer_local_must_match_map
, ' ',
1517 "minibuffer-complete-word");
1518 initial_define_key (Vminibuffer_local_must_match_map
, '?',
1519 "minibuffer-completion-help");