1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1992 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
));
164 current_buffer
->directory
= val
;
165 Fmake_local_variable (Qprint_escape_newlines
);
166 print_escape_newlines
= 1;
169 /* If the minibuffer window is on another frame, shift this frame's
170 focus to that window, and arrange to put it back later. */
171 if (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)))
174 record_unwind_protect (read_minibuf_unwind
,
175 Fcons (Fselected_frame (),
176 FRAME_FOCUS_FRAME (selected_frame
)));
178 Fredirect_frame_focus (Fselected_frame (), mini_frame
);
181 record_unwind_protect (read_minibuf_unwind
, Qnil
);
183 record_unwind_protect (read_minibuf_unwind
, Qnil
);
186 Vminibuf_scroll_window
= selected_window
;
187 Fset_window_buffer (minibuf_window
, Fcurrent_buffer ());
188 Fselect_window (minibuf_window
);
189 XFASTINT (XWINDOW (minibuf_window
)->hscroll
) = 0;
196 Finsert (1, &initial
);
197 if (!NILP (backup_n
) && XTYPE (backup_n
) == Lisp_Int
)
198 Fforward_char (backup_n
);
201 minibuf_prompt
= (char *) alloca (XSTRING (prompt
)->size
+ 1);
202 bcopy (XSTRING (prompt
)->data
, minibuf_prompt
, XSTRING (prompt
)->size
+ 1);
203 echo_area_glyphs
= 0;
205 Vhelp_form
= Vminibuffer_help_form
;
206 current_buffer
->keymap
= map
;
207 Vminibuffer_history_position
= histpos
;
208 Vminibuffer_history_variable
= histvar
;
210 /* ??? MCC did redraw_screen here if switching screens. */
213 /* If cursor is on the minibuffer line,
214 show the user we have exited by putting it in column 0. */
215 if ((FRAME_CURSOR_Y (selected_frame
)
216 >= XFASTINT (XWINDOW (minibuf_window
)->top
))
219 FRAME_CURSOR_X (selected_frame
) = 0;
220 update_frame (selected_frame
, 1, 1);
223 /* Make minibuffer contents into a string */
224 val
= make_buffer_string (1, Z
);
225 bcopy (GAP_END_ADDR
, XSTRING (val
)->data
+ GPT
- BEG
, Z
- GPT
);
227 /* Add the value to the appropriate history list. */
228 if (XTYPE (Vminibuffer_history_variable
) == Lisp_Symbol
229 && XSYMBOL (Vminibuffer_history_variable
)->value
!= Qunbound
)
230 Fset (Vminibuffer_history_variable
,
231 Fcons (val
, Fsymbol_value (Vminibuffer_history_variable
)));
233 unbind_to (count
, Qnil
); /* The appropriate frame will get selected
234 in set-window-configuration. */
238 /* VAL is the string of minibuffer text. */
239 last_minibuf_string
= val
;
241 /* If Lisp form desired instead of string, parse it */
248 /* Return a buffer to be used as the minibuffer at depth `depth'.
249 depth = 0 is the lowest allowed argument, and that is the value
250 used for nonrecursive minibuffer invocations */
253 get_minibuffer (depth
)
256 Lisp_Object tail
, num
, buf
;
258 extern Lisp_Object
nconc2 ();
260 XFASTINT (num
) = depth
;
261 tail
= Fnthcdr (num
, Vminibuffer_list
);
264 tail
= Fcons (Qnil
, Qnil
);
265 Vminibuffer_list
= nconc2 (Vminibuffer_list
, tail
);
268 if (NILP (buf
) || NILP (XBUFFER (buf
)->name
))
270 sprintf (name
, " *Minibuf-%d*", depth
);
271 buf
= Fget_buffer_create (build_string (name
));
272 XCONS (tail
)->car
= buf
;
275 reset_buffer (XBUFFER (buf
));
279 /* This function is called on exiting minibuffer, whether normally or not,
280 and it restores the current window, buffer, etc. */
283 read_minibuf_unwind (data
)
286 /* Erase the minibuffer we were using at this level. */
287 Fset_buffer (XWINDOW (minibuf_window
)->buffer
);
289 /* Prevent error in erase-buffer. */
290 current_buffer
->read_only
= Qnil
;
293 /* If this was a recursive minibuffer,
294 tie the minibuffer window back to the outer level minibuffer buffer */
296 /* Make sure minibuffer window is erased, not ignored */
297 windows_or_buffers_changed
++;
298 XFASTINT (XWINDOW (minibuf_window
)->last_modified
) = 0;
300 /* Restore prompt from outer minibuffer */
301 minibuf_prompt
= minibuf_save_vector
[minibuf_level
].prompt
;
302 minibuf_prompt_width
= minibuf_save_vector
[minibuf_level
].prompt_width
;
303 Vhelp_form
= minibuf_save_vector
[minibuf_level
].help_form
;
304 Vcurrent_prefix_arg
= minibuf_save_vector
[minibuf_level
].current_prefix_arg
;
305 Vminibuffer_history_position
306 = minibuf_save_vector
[minibuf_level
].history_position
;
307 Vminibuffer_history_variable
308 = minibuf_save_vector
[minibuf_level
].history_variable
;
311 /* Redirect the focus of the frame that called the minibuffer. */
313 Fredirect_frame_focus (XCONS (data
)->car
, XCONS (data
)->cdr
);
318 /* This comment supplies the doc string for read-from-minibuffer,
319 for make-docfile to see. We cannot put this in the real DEFUN
320 due to limits in the Unix cpp.
322 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
323 "Read a string from the minibuffer, prompting with string PROMPT.\n\
324 If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
325 to be inserted into the minibuffer before reading input.\n\
326 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
327 is STRING, but point is placed POSITION characters into the string.\n\
328 Third arg KEYMAP is a keymap to use whilst reading;\n\
329 if omitted or nil, the default is `minibuffer-local-map'.\n\
330 If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
331 and return that object:\n\
332 in other words, do `(car (read-from-string INPUT-STRING))'\n\
333 Fifth arg HIST, if non-nil, specifies a history list\n\
334 and optionally the initial position in the list.\n\
335 It can be a symbol, which is the history list variable to use,\n\
336 or it can be a cons cell (HISTVAR . HISTPOS).\n\
337 In that case, HISTVAR is the history list variable to use,\n\
338 and HISTPOS is the initial position (the position in the list\n\
339 which INITIAL-CONTENTS corresponds to).\n\
340 Positions are counted starting from 1 at the beginning of the list."
343 DEFUN ("read-from-minibuffer", Fread_from_minibuffer
, Sread_from_minibuffer
, 1, 5, 0,
344 0 /* See immediately above */)
345 (prompt
, initial_input
, keymap
, read
, hist
)
346 Lisp_Object prompt
, initial_input
, keymap
, read
, hist
;
349 Lisp_Object histvar
, histpos
, position
;
352 CHECK_STRING (prompt
, 0);
353 if (!NILP (initial_input
))
355 if (XTYPE (initial_input
) == Lisp_Cons
)
357 position
= Fcdr (initial_input
);
358 initial_input
= Fcar (initial_input
);
360 CHECK_STRING (initial_input
, 1);
361 if (!NILP (position
))
363 CHECK_NUMBER (position
, 0);
364 /* Convert to distance from end of input. */
365 pos
= XINT (position
) - 1 - XSTRING (initial_input
)->size
;
370 keymap
= Vminibuffer_local_map
;
372 keymap
= get_keymap (keymap
,2);
374 if (XTYPE (hist
) == Lisp_Symbol
)
381 histvar
= Fcar_safe (hist
);
382 histpos
= Fcdr_safe (hist
);
385 histvar
= Qminibuffer_history
;
387 XFASTINT (histpos
) = 0;
389 return read_minibuf (keymap
, initial_input
, prompt
,
390 make_number (pos
), !NILP (read
), histvar
, histpos
);
393 DEFUN ("read-minibuffer", Fread_minibuffer
, Sread_minibuffer
, 1, 2, 0,
394 "Return a Lisp object read using the minibuffer.\n\
395 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
396 is a string to insert in the minibuffer before reading.")
397 (prompt
, initial_contents
)
398 Lisp_Object prompt
, initial_contents
;
400 CHECK_STRING (prompt
, 0);
401 if (!NILP (initial_contents
))
402 CHECK_STRING (initial_contents
, 1)
403 return read_minibuf (Vminibuffer_local_map
, initial_contents
,
404 prompt
, Qnil
, 1, Qminibuffer_history
, make_number (0));
407 DEFUN ("eval-minibuffer", Feval_minibuffer
, Seval_minibuffer
, 1, 2, 0,
408 "Return value of Lisp expression read using the minibuffer.\n\
409 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
410 is a string to insert in the minibuffer before reading.")
411 (prompt
, initial_contents
)
412 Lisp_Object prompt
, initial_contents
;
414 return Feval (Fread_minibuffer (prompt
, initial_contents
));
417 /* Functions that use the minibuffer to read various things. */
419 DEFUN ("read-string", Fread_string
, Sread_string
, 1, 2, 0,
420 "Read a string from the minibuffer, prompting with string PROMPT.\n\
421 If non-nil second arg INITIAL-INPUT is a string to insert before reading.")
422 (prompt
, initial_input
)
423 Lisp_Object prompt
, initial_input
;
425 return Fread_from_minibuffer (prompt
, initial_input
, Qnil
, Qnil
, Qnil
);
428 DEFUN ("read-no-blanks-input", Fread_no_blanks_input
, Sread_no_blanks_input
, 2, 2, 0,
429 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
430 Prompt with PROMPT, and provide INIT as an initial value of the input string.")
432 Lisp_Object prompt
, init
;
434 CHECK_STRING (prompt
, 0);
436 CHECK_STRING (init
, 1);
438 return read_minibuf (Vminibuffer_local_ns_map
, init
, prompt
, Qnil
, 0,
439 Qminibuffer_history
, make_number (0));
442 DEFUN ("read-command", Fread_command
, Sread_command
, 1, 1, 0,
443 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
444 Prompts with PROMPT.")
448 return Fintern (Fcompleting_read (prompt
, Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
),
453 DEFUN ("read-function", Fread_function
, Sread_function
, 1, 1, 0,
454 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
455 Prompts with PROMPT.")
459 return Fintern (Fcompleting_read (prompt
, Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
),
464 DEFUN ("read-variable", Fread_variable
, Sread_variable
, 1, 1, 0,
465 "One arg PROMPT, a string. Read the name of a user variable and return\n\
466 it as a symbol. Prompts with PROMPT.\n\
467 A user variable is one whose documentation starts with a `*' character.")
471 return Fintern (Fcompleting_read (prompt
, Vobarray
,
472 Quser_variable_p
, Qt
, Qnil
, Qnil
),
476 DEFUN ("read-buffer", Fread_buffer
, Sread_buffer
, 1, 3, 0,
477 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
478 Prompts with PROMPT.\n\
479 Optional second arg is value to return if user enters an empty line.\n\
480 If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
481 (prompt
, def
, require_match
)
482 Lisp_Object prompt
, def
, require_match
;
488 if (XTYPE (def
) == Lisp_Buffer
)
489 def
= XBUFFER (def
)->name
;
492 args
[0] = build_string ("%s(default %s) ");
495 prompt
= Fformat (3, args
);
498 tem
= Fcompleting_read (prompt
, Vbuffer_alist
, Qnil
, require_match
, Qnil
, Qnil
);
500 if (XSTRING (tem
)->size
)
505 DEFUN ("try-completion", Ftry_completion
, Stry_completion
, 2, 3, 0,
506 "Return common substring of all completions of STRING in ALIST.\n\
507 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
508 All that match are compared together; the longest initial sequence\n\
509 common to all matches is returned as a string.\n\
510 If there is no match at all, nil is returned.\n\
511 For an exact match, t is returned.\n\
513 ALIST can be an obarray instead of an alist.\n\
514 Then the print names of all symbols in the obarray are the possible matches.\n\
516 ALIST can also be a function to do the completion itself.\n\
517 It receives three arguments: the values STRING, PREDICATE and nil.\n\
518 Whatever it returns becomes the value of `try-completion'.\n\
520 If optional third argument PREDICATE is non-nil,\n\
521 it is used to test each possible match.\n\
522 The match is a candidate only if PREDICATE returns non-nil.\n\
523 The argument given to PREDICATE is the alist element or the symbol from the obarray.")
524 (string
, alist
, pred
)
525 Lisp_Object string
, alist
, pred
;
527 Lisp_Object bestmatch
, tail
, elt
, eltstring
;
529 int compare
, matchsize
;
530 int list
= CONSP (alist
) || NILP (alist
);
533 Lisp_Object bucket
, zero
, end
, tem
;
534 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
536 CHECK_STRING (string
, 0);
537 if (!list
&& XTYPE (alist
) != Lisp_Vector
)
538 return call3 (alist
, string
, pred
, Qnil
);
542 /* If ALIST is not a list, set TAIL just for gc pro. */
547 obsize
= XVECTOR (alist
)->size
;
548 bucket
= XVECTOR (alist
)->contents
[index
];
553 /* Get the next element of the alist or obarray. */
554 /* Exit the loop if the elements are all used up. */
555 /* elt gets the alist element or symbol.
556 eltstring gets the name to check as a completion. */
563 eltstring
= Fcar (elt
);
568 if (XFASTINT (bucket
) != 0)
571 eltstring
= Fsymbol_name (elt
);
572 if (XSYMBOL (bucket
)->next
)
573 XSETSYMBOL (bucket
, XSYMBOL (bucket
)->next
);
575 XFASTINT (bucket
) = 0;
577 else if (++index
>= obsize
)
581 bucket
= XVECTOR (alist
)->contents
[index
];
586 /* Is this element a possible completion? */
588 if (XTYPE (eltstring
) == Lisp_String
&&
589 XSTRING (string
)->size
<= XSTRING (eltstring
)->size
&&
590 0 > scmp (XSTRING (eltstring
)->data
, XSTRING (string
)->data
,
591 XSTRING (string
)->size
))
594 /* Ignore this element if there is a predicate
595 and the predicate doesn't like it. */
599 if (EQ (pred
, Qcommandp
))
600 tem
= Fcommandp (elt
);
603 GCPRO4 (tail
, string
, eltstring
, bestmatch
);
604 tem
= call1 (pred
, elt
);
607 if (NILP (tem
)) continue;
610 /* Update computation of how much all possible completions match */
613 if (NILP (bestmatch
))
614 bestmatch
= eltstring
, bestmatchsize
= XSTRING (eltstring
)->size
;
617 compare
= min (bestmatchsize
, XSTRING (eltstring
)->size
);
618 matchsize
= scmp (XSTRING (bestmatch
)->data
,
619 XSTRING (eltstring
)->data
,
623 if (completion_ignore_case
)
625 /* If this is an exact match except for case,
626 use it as the best match rather than one that is not an
627 exact match. This way, we get the case pattern
628 of the actual match. */
629 if ((matchsize
== XSTRING (eltstring
)->size
630 && matchsize
< XSTRING (bestmatch
)->size
)
632 /* If there is more than one exact match ignoring case,
633 and one of them is exact including case,
635 /* If there is no exact match ignoring case,
636 prefer a match that does not change the case
638 ((matchsize
== XSTRING (eltstring
)->size
)
640 (matchsize
== XSTRING (bestmatch
)->size
)
641 && !bcmp (XSTRING (eltstring
)->data
,
642 XSTRING (string
)->data
, XSTRING (string
)->size
)
643 && bcmp (XSTRING (bestmatch
)->data
,
644 XSTRING (string
)->data
, XSTRING (string
)->size
)))
645 bestmatch
= eltstring
;
647 bestmatchsize
= matchsize
;
652 if (NILP (bestmatch
))
653 return Qnil
; /* No completions found */
654 /* If we are ignoring case, and there is no exact match,
655 and no additional text was supplied,
656 don't change the case of what the user typed. */
657 if (completion_ignore_case
&& bestmatchsize
== XSTRING (string
)->size
658 && XSTRING (bestmatch
)->size
> bestmatchsize
)
661 /* Return t if the supplied string is an exact match (counting case);
662 it does not require any change to be made. */
663 if (matchcount
== 1 && bestmatchsize
== XSTRING (string
)->size
664 && !bcmp (XSTRING (bestmatch
)->data
, XSTRING (string
)->data
,
668 XFASTINT (zero
) = 0; /* Else extract the part in which */
669 XFASTINT (end
) = bestmatchsize
; /* all completions agree */
670 return Fsubstring (bestmatch
, zero
, end
);
673 /* Compare exactly LEN chars of strings at S1 and S2,
674 ignoring case if appropriate.
675 Return -1 if strings match,
676 else number of chars that match at the beginning. */
679 register char *s1
, *s2
;
682 register int l
= len
;
684 if (completion_ignore_case
)
686 while (l
&& DOWNCASE (*s1
++) == DOWNCASE (*s2
++))
691 while (l
&& *s1
++ == *s2
++)
699 DEFUN ("all-completions", Fall_completions
, Sall_completions
, 2, 3, 0,
700 "Search for partial matches to STRING in ALIST.\n\
701 Each car of each element of ALIST is tested to see if it begins with STRING.\n\
702 The value is a list of all the strings from ALIST that match.\n\
703 ALIST can be an obarray instead of an alist.\n\
704 Then the print names of all symbols in the obarray are the possible matches.\n\
706 ALIST can also be a function to do the completion itself.\n\
707 It receives three arguments: the values STRING, PREDICATE and t.\n\
708 Whatever it returns becomes the value of `all-completion'.\n\
710 If optional third argument PREDICATE is non-nil,\n\
711 it is used to test each possible match.\n\
712 The match is a candidate only if PREDICATE returns non-nil.\n\
713 The argument given to PREDICATE is the alist element or the symbol from the obarray.")
714 (string
, alist
, pred
)
715 Lisp_Object string
, alist
, pred
;
717 Lisp_Object tail
, elt
, eltstring
;
718 Lisp_Object allmatches
;
719 int list
= CONSP (alist
) || NILP (alist
);
721 Lisp_Object bucket
, tem
;
722 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
724 CHECK_STRING (string
, 0);
725 if (!list
&& XTYPE (alist
) != Lisp_Vector
)
727 return call3 (alist
, string
, pred
, Qt
);
731 /* If ALIST is not a list, set TAIL just for gc pro. */
736 obsize
= XVECTOR (alist
)->size
;
737 bucket
= XVECTOR (alist
)->contents
[index
];
742 /* Get the next element of the alist or obarray. */
743 /* Exit the loop if the elements are all used up. */
744 /* elt gets the alist element or symbol.
745 eltstring gets the name to check as a completion. */
752 eltstring
= Fcar (elt
);
757 if (XFASTINT (bucket
) != 0)
760 eltstring
= Fsymbol_name (elt
);
761 if (XSYMBOL (bucket
)->next
)
762 XSETSYMBOL (bucket
, XSYMBOL (bucket
)->next
);
764 XFASTINT (bucket
) = 0;
766 else if (++index
>= obsize
)
770 bucket
= XVECTOR (alist
)->contents
[index
];
775 /* Is this element a possible completion? */
777 if (XTYPE (eltstring
) == Lisp_String
&&
778 XSTRING (string
)->size
<= XSTRING (eltstring
)->size
&&
779 XSTRING (eltstring
)->data
[0] != ' ' &&
780 0 > scmp (XSTRING (eltstring
)->data
, XSTRING (string
)->data
,
781 XSTRING (string
)->size
))
784 /* Ignore this element if there is a predicate
785 and the predicate doesn't like it. */
789 if (EQ (pred
, Qcommandp
))
790 tem
= Fcommandp (elt
);
793 GCPRO4 (tail
, eltstring
, allmatches
, string
);
794 tem
= call1 (pred
, elt
);
797 if (NILP (tem
)) continue;
799 /* Ok => put it on the list. */
800 allmatches
= Fcons (eltstring
, allmatches
);
804 return Fnreverse (allmatches
);
807 Lisp_Object Vminibuffer_completion_table
, Qminibuffer_completion_table
;
808 Lisp_Object Vminibuffer_completion_predicate
, Qminibuffer_completion_predicate
;
809 Lisp_Object Vminibuffer_completion_confirm
, Qminibuffer_completion_confirm
;
811 /* This comment supplies the doc string for completing-read,
812 for make-docfile to see. We cannot put this in the real DEFUN
813 due to limits in the Unix cpp.
815 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
816 "Read a string in the minibuffer, with completion.\n\
817 Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST.\n\
818 PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
819 TABLE is an alist whose elements' cars are strings, or an obarray.\n\
820 PREDICATE limits completion to a subset of TABLE.\n\
821 See `try-completion' for more details on completion, TABLE, and PREDICATE.\n\
822 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
823 the input is (or completes to) an element of TABLE.\n\
824 If it is also not t, Return does not exit if it does non-null completion.\n\
825 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
826 If it is (STRING . POSITION), the initial input\n\
827 is STRING, but point is placed POSITION characters into the string.\n\
828 HIST, if non-nil, specifies a history list\n\
829 and optionally the initial position in the list.\n\
830 It can be a symbol, which is the history list variable to use,\n\
831 or it can be a cons cell (HISTVAR . HISTPOS).\n\
832 In that case, HISTVAR is the history list variable to use,\n\
833 and HISTPOS is the initial position (the position in the list\n\
834 which INITIAL-CONTENTS corresponds to).\n\
835 Positions are counted starting from 1 at the beginning of the list.\n\
836 Completion ignores case if the ambient value of\n\
837 `completion-ignore-case' is non-nil."
839 DEFUN ("completing-read", Fcompleting_read
, Scompleting_read
, 2, 6, 0,
840 0 /* See immediately above */)
841 (prompt
, table
, pred
, require_match
, init
, hist
)
842 Lisp_Object prompt
, table
, pred
, require_match
, init
, hist
;
844 Lisp_Object val
, histvar
, histpos
, position
;
846 int count
= specpdl_ptr
- specpdl
;
847 specbind (Qminibuffer_completion_table
, table
);
848 specbind (Qminibuffer_completion_predicate
, pred
);
849 specbind (Qminibuffer_completion_confirm
,
850 EQ (require_match
, Qt
) ? Qnil
: Qt
);
851 last_exact_completion
= Qnil
;
856 if (XTYPE (init
) == Lisp_Cons
)
858 position
= Fcdr (init
);
861 CHECK_STRING (init
, 0);
862 if (!NILP (position
))
864 CHECK_NUMBER (position
, 0);
865 /* Convert to distance from end of input. */
866 pos
= XINT (position
) - XSTRING (init
)->size
;
870 if (XTYPE (hist
) == Lisp_Symbol
)
877 histvar
= Fcar_safe (hist
);
878 histpos
= Fcdr_safe (hist
);
881 histvar
= Qminibuffer_history
;
883 XFASTINT (histpos
) = 0;
885 val
= read_minibuf (NILP (require_match
)
886 ? Vminibuffer_local_completion_map
887 : Vminibuffer_local_must_match_map
,
888 init
, prompt
, make_number (pos
), 0,
890 return unbind_to (count
, val
);
893 /* Temporarily display the string M at the end of the current
894 minibuffer contents. This is used to display things like
895 "[No Match]" when the user requests a completion for a prefix
896 that has no possible completions, and other quick, unobtrusive
899 temp_echo_area_glyphs (m
)
902 /* It's not very modular to do things this way, but then it seems
903 to me that the whole echo_area_glyphs thing is a hack anyway. */
904 extern char *previous_echo_glyphs
;
907 Lisp_Object oinhibit
;
908 oinhibit
= Vinhibit_quit
;
910 /* Clear out any old echo-area message to make way for our new
912 echo_area_glyphs
= previous_echo_glyphs
= 0;
918 Fsit_for (make_number (2), Qnil
, Qnil
);
919 del_range (point
, ZV
);
920 if (!NILP (Vquit_flag
))
923 unread_command_char
= Ctl ('g');
925 Vinhibit_quit
= oinhibit
;
928 Lisp_Object
Fminibuffer_completion_help ();
929 Lisp_Object
assoc_for_completion ();
932 * 0 no possible completion
933 * 1 was already an exact and unique completion
934 * 3 was already an exact completion
935 * 4 completed to an exact completion
936 * 5 some completion happened
937 * 6 no completion happened
942 Lisp_Object completion
, tem
;
946 completion
= Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table
,
947 Vminibuffer_completion_predicate
);
948 last
= last_exact_completion
;
949 last_exact_completion
= Qnil
;
951 if (NILP (completion
))
954 temp_echo_area_glyphs (" [No match]");
958 if (EQ (completion
, Qt
)) /* exact and unique match */
962 tem
= Fstring_equal (completion
, Fbuffer_string());
963 if (completedp
= NILP (tem
))
965 Ferase_buffer (); /* Some completion happened */
966 Finsert (1, &completion
);
969 /* It did find a match. Do we match some possibility exactly now? */
970 if (CONSP (Vminibuffer_completion_table
)
971 || NILP (Vminibuffer_completion_table
))
972 tem
= assoc_for_completion (Fbuffer_string (),
973 Vminibuffer_completion_table
);
974 else if (XTYPE (Vminibuffer_completion_table
) == Lisp_Vector
)
976 /* the primitive used by Fintern_soft */
977 extern Lisp_Object
oblookup ();
979 tem
= Fbuffer_string ();
980 /* Bypass intern-soft as that loses for nil */
981 tem
= oblookup (Vminibuffer_completion_table
,
982 XSTRING (tem
)->data
, XSTRING (tem
)->size
);
983 if (XTYPE (tem
) != Lisp_Symbol
)
985 else if (!NILP (Vminibuffer_completion_predicate
))
986 tem
= call1 (Vminibuffer_completion_predicate
, tem
);
991 tem
= call3 (Vminibuffer_completion_table
,
993 Vminibuffer_completion_predicate
,
997 { /* not an exact match */
1001 Fminibuffer_completion_help ();
1003 temp_echo_area_glyphs (" [Next char not unique]");
1006 else if (completedp
)
1008 /* If the last exact completion and this one were the same,
1009 it means we've already given a "Complete but not unique"
1010 message and the user's hit TAB again, so now we give him help. */
1011 last_exact_completion
= completion
;
1014 tem
= Fbuffer_string ();
1015 if (!NILP (Fequal (tem
, last
)))
1016 Fminibuffer_completion_help ();
1021 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1024 assoc_for_completion (key
, list
)
1025 register Lisp_Object key
;
1028 register Lisp_Object tail
;
1030 if (completion_ignore_case
)
1031 key
= Fupcase (key
);
1033 for (tail
= list
; !NILP (tail
); tail
= Fcdr (tail
))
1035 register Lisp_Object elt
, tem
, thiscar
;
1037 if (!CONSP (elt
)) continue;
1038 thiscar
= Fcar (elt
);
1039 if (XTYPE (thiscar
) != Lisp_String
)
1041 if (completion_ignore_case
)
1042 thiscar
= Fupcase (thiscar
);
1043 tem
= Fequal (thiscar
, key
);
1044 if (!NILP (tem
)) return elt
;
1050 DEFUN ("minibuffer-complete", Fminibuffer_complete
, Sminibuffer_complete
, 0, 0, "",
1051 "Complete the minibuffer contents as far as possible.")
1054 register int i
= do_completion ();
1061 temp_echo_area_glyphs (" [Sole completion]");
1065 temp_echo_area_glyphs (" [Complete, but not unique]");
1072 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit
,
1073 Sminibuffer_complete_and_exit
, 0, 0, "",
1074 "Complete the minibuffer contents, and maybe exit.\n\
1075 Exit if the name is valid with no completion needed.\n\
1076 If name was completed to a valid match,\n\
1077 a repetition of this command will exit.")
1082 /* Allow user to specify null string */
1086 i
= do_completion ();
1094 if (!NILP (Vminibuffer_completion_confirm
))
1096 temp_echo_area_glyphs (" [Confirm]");
1106 Fthrow (Qexit
, Qnil
);
1110 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word
, Sminibuffer_complete_word
,
1112 "Complete the minibuffer contents at most a single word.\n\
1113 After one word is completed as much as possible, a space or hyphen\n\
1114 is added, provided that matches some possible completion.")
1117 Lisp_Object completion
, tem
;
1119 register unsigned char *completion_string
;
1120 /* We keep calling Fbuffer_string
1121 rather than arrange for GC to hold onto a pointer to
1122 one of the strings thus made. */
1124 completion
= Ftry_completion (Fbuffer_string (),
1125 Vminibuffer_completion_table
,
1126 Vminibuffer_completion_predicate
);
1127 if (NILP (completion
))
1130 temp_echo_area_glyphs (" [No match]");
1133 if (EQ (completion
, Qt
))
1136 #if 0 /* How the below code used to look, for reference */
1137 tem
= Fbuffer_string ();
1138 b
= XSTRING (tem
)->data
;
1139 i
= ZV
- 1 - XSTRING (completion
)->size
;
1140 p
= XSTRING (completion
)->data
;
1142 0 <= scmp (b
, p
, ZV
- 1))
1145 /* Set buffer to longest match of buffer tail and completion head. */
1146 while (0 <= scmp (b
+ i
, p
, ZV
- 1 - i
))
1148 del_range (1, i
+ 1);
1151 #else /* Rewritten code */
1153 register unsigned char *buffer_string
;
1154 int buffer_length
, completion_length
;
1156 tem
= Fbuffer_string ();
1157 buffer_string
= XSTRING (tem
)->data
;
1158 completion_string
= XSTRING (completion
)->data
;
1159 buffer_length
= XSTRING (tem
)->size
; /* ie ZV - BEGV */
1160 completion_length
= XSTRING (completion
)->size
;
1161 i
= buffer_length
- completion_length
;
1162 /* Mly: I don't understand what this is supposed to do AT ALL */
1164 0 <= scmp (buffer_string
, completion_string
, buffer_length
))
1166 /* Set buffer to longest match of buffer tail and completion head. */
1170 while (0 <= scmp (buffer_string
++, completion_string
, buffer_length
--))
1172 del_range (1, i
+ 1);
1176 #endif /* Rewritten code */
1179 /* If completion finds next char not unique,
1180 consider adding a space or a hyphen */
1181 if (i
== XSTRING (completion
)->size
)
1183 tem
= Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1184 Vminibuffer_completion_table
,
1185 Vminibuffer_completion_predicate
);
1186 if (XTYPE (tem
) == Lisp_String
)
1190 tem
= Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1191 Vminibuffer_completion_table
,
1192 Vminibuffer_completion_predicate
);
1193 if (XTYPE (tem
) == Lisp_String
)
1198 /* Now find first word-break in the stuff found by completion.
1199 i gets index in string of where to stop completing. */
1200 completion_string
= XSTRING (completion
)->data
;
1202 for (; i
< XSTRING (completion
)->size
; i
++)
1203 if (SYNTAX (completion_string
[i
]) != Sword
) break;
1204 if (i
< XSTRING (completion
)->size
)
1207 /* If got no characters, print help for user. */
1212 Fminibuffer_completion_help ();
1216 /* Otherwise insert in minibuffer the chars we got */
1219 insert_from_string (completion
, 0, i
);
1223 DEFUN ("display-completion-list", Fdisplay_completion_list
, Sdisplay_completion_list
,
1225 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
1226 Each element may be just a symbol or string\n\
1227 or may be a list of two strings to be printed as if concatenated.")
1229 Lisp_Object completions
;
1231 register Lisp_Object tail
, elt
;
1234 /* No GCPRO needed, since (when it matters) every variable
1235 points to a non-string that is pointed to by COMPLETIONS. */
1236 struct buffer
*old
= current_buffer
;
1237 if (XTYPE (Vstandard_output
) == Lisp_Buffer
)
1238 set_buffer_internal (XBUFFER (Vstandard_output
));
1240 if (NILP (completions
))
1241 write_string ("There are no possible completions of what you have typed.", -1);
1244 write_string ("Possible completions are:", -1);
1245 for (tail
= completions
, i
= 0; !NILP (tail
); tail
= Fcdr (tail
), i
++)
1247 /* this needs fixing for the case of long completions
1248 and/or narrow windows */
1249 /* Sadly, the window it will appear in is not known
1250 until after the text has been made. */
1253 if (XTYPE (Vstandard_output
) == Lisp_Buffer
)
1254 Findent_to (make_number (35), make_number (1));
1259 write_string (" ", -1);
1262 while (column
< 35);
1273 if (XTYPE (Vstandard_output
) != Lisp_Buffer
)
1276 tem
= Flength (Fcar (elt
));
1277 column
+= XINT (tem
);
1278 tem
= Flength (Fcar (Fcdr (elt
)));
1279 column
+= XINT (tem
);
1281 Fprinc (Fcar (elt
), Qnil
);
1282 Fprinc (Fcar (Fcdr (elt
)), Qnil
);
1286 if (XTYPE (Vstandard_output
) != Lisp_Buffer
)
1289 tem
= Flength (elt
, Qt
);
1290 column
+= XINT (tem
);
1297 if (XTYPE (Vstandard_output
) == Lisp_Buffer
)
1298 set_buffer_internal (old
);
1302 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help
, Sminibuffer_completion_help
,
1304 "Display a list of possible completions of the current minibuffer contents.")
1307 Lisp_Object completions
;
1309 message ("Making completion list...");
1310 completions
= Fall_completions (Fbuffer_string (),
1311 Vminibuffer_completion_table
,
1312 Vminibuffer_completion_predicate
);
1313 echo_area_glyphs
= 0;
1315 if (NILP (completions
))
1318 temp_echo_area_glyphs (" [No completions]");
1321 internal_with_output_to_temp_buffer ("*Completions*",
1322 Fdisplay_completion_list
,
1323 Fsort (completions
, Qstring_lessp
));
1327 DEFUN ("self-insert-and-exit", Fself_insert_and_exit
, Sself_insert_and_exit
, 0, 0, "",
1328 "Terminate minibuffer input.")
1331 if (XTYPE (last_command_char
) == Lisp_Int
)
1332 internal_self_insert (last_command_char
, 0);
1336 Fthrow (Qexit
, Qnil
);
1339 DEFUN ("exit-minibuffer", Fexit_minibuffer
, Sexit_minibuffer
, 0, 0, "",
1340 "Terminate this minibuffer argument.")
1343 Fthrow (Qexit
, Qnil
);
1346 DEFUN ("minibuffer-depth", Fminibuffer_depth
, Sminibuffer_depth
, 0, 0, 0,
1347 "Return current depth of activations of minibuffer, a nonnegative integer.")
1350 return make_number (minibuf_level
);
1354 init_minibuf_once ()
1356 Vminibuffer_list
= Qnil
;
1357 staticpro (&Vminibuffer_list
);
1364 minibuf_save_vector_size
= 5;
1365 minibuf_save_vector
= (struct minibuf_save_data
*) malloc (5 * sizeof (struct minibuf_save_data
));
1367 Qminibuffer_completion_table
= intern ("minibuffer-completion-table");
1368 staticpro (&Qminibuffer_completion_table
);
1370 Qminibuffer_completion_confirm
= intern ("minibuffer-completion-confirm");
1371 staticpro (&Qminibuffer_completion_confirm
);
1373 Qminibuffer_completion_predicate
= intern ("minibuffer-completion-predicate");
1374 staticpro (&Qminibuffer_completion_predicate
);
1376 staticpro (&last_minibuf_string
);
1377 last_minibuf_string
= Qnil
;
1379 Quser_variable_p
= intern ("user-variable-p");
1380 staticpro (&Quser_variable_p
);
1382 Qminibuffer_history
= intern ("minibuffer-history");
1383 staticpro (&Qminibuffer_history
);
1385 DEFVAR_BOOL ("completion-auto-help", &auto_help
,
1386 "*Non-nil means automatically provide help for invalid completion input.");
1389 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case
,
1390 "Non-nil means don't consider case significant in completion.");
1391 completion_ignore_case
= 0;
1393 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers
,
1394 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1395 More precisely, this variable makes a difference when the minibuffer window\n\
1396 is the selected window. If you are in some other window, minibuffer commands\n\
1397 are allowed even if a minibuffer is active.");
1398 enable_recursive_minibuffers
= 0;
1400 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table
,
1401 "Alist or obarray used for completion in the minibuffer.\n\
1402 This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1404 The value may alternatively be a function, which is given three arguments:\n\
1405 STRING, the current buffer contents;\n\
1406 PREDICATE, the predicate for filtering possible matches;\n\
1407 CODE, which says what kind of things to do.\n\
1408 CODE can be nil, t or `lambda'.\n\
1409 nil means to return the best completion of STRING, or nil if there is none.\n\
1410 t means to return a list of all possible completions of STRING.\n\
1411 `lambda' means to return t if STRING is a valid completion as it stands.");
1412 Vminibuffer_completion_table
= Qnil
;
1414 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate
,
1415 "Within call to `completing-read', this holds the PREDICATE argument.");
1416 Vminibuffer_completion_predicate
= Qnil
;
1418 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm
,
1419 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1420 Vminibuffer_completion_confirm
= Qnil
;
1422 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form
,
1423 "Value that `help-form' takes on inside the minibuffer.");
1424 Vminibuffer_help_form
= Qnil
;
1426 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable
,
1427 "History list symbol to add minibuffer values to.\n\
1428 Each minibuffer output is added with\n\
1429 (set minibuffer-history-variable\n\
1430 (cons STRING (symbol-value minibuffer-history-variable)))");
1431 XFASTINT (Vminibuffer_history_variable
) = 0;
1433 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position
,
1434 "Current position of redoing in the history list.");
1435 Vminibuffer_history_position
= Qnil
;
1437 defsubr (&Sread_from_minibuffer
);
1438 defsubr (&Seval_minibuffer
);
1439 defsubr (&Sread_minibuffer
);
1440 defsubr (&Sread_string
);
1441 defsubr (&Sread_command
);
1442 defsubr (&Sread_variable
);
1443 defsubr (&Sread_buffer
);
1444 defsubr (&Sread_no_blanks_input
);
1445 defsubr (&Sminibuffer_depth
);
1447 defsubr (&Stry_completion
);
1448 defsubr (&Sall_completions
);
1449 defsubr (&Scompleting_read
);
1450 defsubr (&Sminibuffer_complete
);
1451 defsubr (&Sminibuffer_complete_word
);
1452 defsubr (&Sminibuffer_complete_and_exit
);
1453 defsubr (&Sdisplay_completion_list
);
1454 defsubr (&Sminibuffer_completion_help
);
1456 defsubr (&Sself_insert_and_exit
);
1457 defsubr (&Sexit_minibuffer
);
1463 initial_define_key (Vminibuffer_local_map
, Ctl ('g'),
1464 "abort-recursive-edit");
1465 initial_define_key (Vminibuffer_local_map
, Ctl ('m'),
1467 initial_define_key (Vminibuffer_local_map
, Ctl ('j'),
1470 initial_define_key (Vminibuffer_local_ns_map
, Ctl ('g'),
1471 "abort-recursive-edit");
1472 initial_define_key (Vminibuffer_local_ns_map
, Ctl ('m'),
1474 initial_define_key (Vminibuffer_local_ns_map
, Ctl ('j'),
1477 initial_define_key (Vminibuffer_local_ns_map
, ' ',
1479 initial_define_key (Vminibuffer_local_ns_map
, '\t',
1481 initial_define_key (Vminibuffer_local_ns_map
, '?',
1482 "self-insert-and-exit");
1484 initial_define_key (Vminibuffer_local_completion_map
, Ctl ('g'),
1485 "abort-recursive-edit");
1486 initial_define_key (Vminibuffer_local_completion_map
, Ctl ('m'),
1488 initial_define_key (Vminibuffer_local_completion_map
, Ctl ('j'),
1491 initial_define_key (Vminibuffer_local_completion_map
, '\t',
1492 "minibuffer-complete");
1493 initial_define_key (Vminibuffer_local_completion_map
, ' ',
1494 "minibuffer-complete-word");
1495 initial_define_key (Vminibuffer_local_completion_map
, '?',
1496 "minibuffer-completion-help");
1498 initial_define_key (Vminibuffer_local_must_match_map
, Ctl ('g'),
1499 "abort-recursive-edit");
1500 initial_define_key (Vminibuffer_local_must_match_map
, Ctl ('m'),
1501 "minibuffer-complete-and-exit");
1502 initial_define_key (Vminibuffer_local_must_match_map
, Ctl ('j'),
1503 "minibuffer-complete-and-exit");
1504 initial_define_key (Vminibuffer_local_must_match_map
, '\t',
1505 "minibuffer-complete");
1506 initial_define_key (Vminibuffer_local_must_match_map
, ' ',
1507 "minibuffer-complete-word");
1508 initial_define_key (Vminibuffer_local_must_match_map
, '?',
1509 "minibuffer-completion-help");