(Fstart_process): GCPRO some things.
[bpt/emacs.git] / src / minibuf.c
CommitLineData
f927c5ae 1/* Minibuffer input and completion.
c6c5df7f 2 Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
f927c5ae
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
ffd56f97 8the Free Software Foundation; either version 2, or (at your option)
f927c5ae
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
18160b98 21#include <config.h>
f927c5ae
JB
22#include "lisp.h"
23#include "commands.h"
24#include "buffer.h"
25#include "dispextern.h"
ff11dfa1 26#include "frame.h"
f927c5ae
JB
27#include "window.h"
28#include "syntax.h"
29
30#define min(a, b) ((a) < (b) ? (a) : (b))
31
a4e71d81
KH
32extern int quit_char;
33
f927c5ae
JB
34/* List of buffers for use as minibuffers.
35 The first element of the list is used for the outermost minibuffer invocation,
36 the next element is used for a recursive minibuffer invocation, etc.
37 The list is extended at the end as deeped minibuffer recursions are encountered. */
38Lisp_Object Vminibuffer_list;
39
40struct minibuf_save_data
41 {
42 char *prompt;
43 int prompt_width;
44 Lisp_Object help_form;
45 Lisp_Object current_prefix_arg;
770970cb
RS
46 Lisp_Object history_position;
47 Lisp_Object history_variable;
f927c5ae
JB
48 };
49
50int minibuf_save_vector_size;
51struct minibuf_save_data *minibuf_save_vector;
52
53/* Depth in minibuffer invocations. */
54int minibuf_level;
55
56/* Nonzero means display completion help for invalid input */
57int auto_help;
58
b278606c 59/* Fread_minibuffer leaves the input here as a string. */
f927c5ae
JB
60Lisp_Object last_minibuf_string;
61
62/* Nonzero means let functions called when within a minibuffer
63 invoke recursive minibuffers (to read arguments, or whatever) */
64int enable_recursive_minibuffers;
65
66/* help-form is bound to this while in the minibuffer. */
67
68Lisp_Object Vminibuffer_help_form;
69
770970cb
RS
70/* Variable which is the history list to add minibuffer values to. */
71
72Lisp_Object Vminibuffer_history_variable;
73
74/* Current position in the history list (adjusted by M-n and M-p). */
75
76Lisp_Object Vminibuffer_history_position;
77
78Lisp_Object Qminibuffer_history;
79
719b4a40
RS
80Lisp_Object Qread_file_name_internal;
81
5c781212
RS
82/* Normal hook for entry to minibuffer. */
83
84Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
85
f927c5ae
JB
86/* Nonzero means completion ignores case. */
87
88int completion_ignore_case;
89
6a9ee000
RS
90/* Nonzero means raise the minibuffer frame when the minibuffer
91 is entered. */
92
93int minibuffer_auto_raise;
94
f927c5ae
JB
95/* If last completion attempt reported "Complete but not unique"
96 then this is the string completed then; otherwise this is nil. */
97
98static Lisp_Object last_exact_completion;
99
100Lisp_Object Quser_variable_p;
f927c5ae
JB
101\f
102/* Actual minibuffer invocation. */
103
104void read_minibuf_unwind ();
105Lisp_Object get_minibuffer ();
106Lisp_Object read_minibuf ();
107
770970cb 108/* Read from the minibuffer using keymap MAP, initial contents INITIAL
85b5fe07 109 (a string), putting point minus BACKUP_N chars from the end of INITIAL,
770970cb 110 prompting with PROMPT (a string), using history list HISTVAR
85b5fe07 111 with initial position HISTPOS. (BACKUP_N should be <= 0.)
770970cb
RS
112
113 Normally return the result as a string (the text that was read),
b278606c
BF
114 but if EXPFLAG is non-nil, read it and return the object read.
115 If HISTVAR is given, save the value read on that history only if it doesn't
116 match the front of that history list exactly. The value is pushed onto
117 the list as the string that was read, or as the object that resulted iff
118 EXPFLAG is non-nil. */
770970cb 119
f927c5ae 120Lisp_Object
770970cb 121read_minibuf (map, initial, prompt, backup_n, expflag, histvar, histpos)
f927c5ae
JB
122 Lisp_Object map;
123 Lisp_Object initial;
124 Lisp_Object prompt;
5061d9c3 125 Lisp_Object backup_n;
f927c5ae 126 int expflag;
770970cb
RS
127 Lisp_Object histvar;
128 Lisp_Object histpos;
f927c5ae
JB
129{
130 register Lisp_Object val;
131 int count = specpdl_ptr - specpdl;
5061d9c3 132 Lisp_Object mini_frame;
f927c5ae 133 struct gcpro gcpro1, gcpro2;
f927c5ae
JB
134
135 if (XTYPE (prompt) != Lisp_String)
136 prompt = build_string ("");
137
138 /* Emacs in -batch mode calls minibuffer: print the prompt. */
139 if (noninteractive && XTYPE (prompt) == Lisp_String)
140 printf ("%s", XSTRING (prompt)->data);
141
142 if (!enable_recursive_minibuffers
143 && minibuf_level > 0
144 && (EQ (selected_window, minibuf_window)))
145#if 0
ff11dfa1 146 || selected_frame != XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))
f927c5ae
JB
147#endif
148 error ("Command attempted to use minibuffer while in minibuffer");
149
150 if (minibuf_level == minibuf_save_vector_size)
151 minibuf_save_vector =
152 (struct minibuf_save_data *)
153 xrealloc (minibuf_save_vector,
154 (minibuf_save_vector_size *= 2)
155 * sizeof (struct minibuf_save_data));
156 minibuf_save_vector[minibuf_level].prompt = minibuf_prompt;
157 minibuf_save_vector[minibuf_level].prompt_width = minibuf_prompt_width;
158 minibuf_prompt_width = 0;
159 /* >> Why is this done this way rather than binding these variables? */
160 minibuf_save_vector[minibuf_level].help_form = Vhelp_form;
161 minibuf_save_vector[minibuf_level].current_prefix_arg = Vcurrent_prefix_arg;
770970cb
RS
162 minibuf_save_vector[minibuf_level].history_position = Vminibuffer_history_position;
163 minibuf_save_vector[minibuf_level].history_variable = Vminibuffer_history_variable;
f927c5ae
JB
164 GCPRO2 (minibuf_save_vector[minibuf_level].help_form,
165 minibuf_save_vector[minibuf_level].current_prefix_arg);
166
167 record_unwind_protect (Fset_window_configuration,
b2b2c677
JB
168 Fcurrent_window_configuration (Qnil));
169
ff11dfa1
JB
170 /* If the minibuffer window is on a different frame, save that
171 frame's configuration too. */
5061d9c3
RS
172#ifdef MULTI_FRAME
173 XSET (mini_frame, Lisp_Frame, WINDOW_FRAME (XWINDOW (minibuf_window)));
ff11dfa1 174 if (XFRAME (mini_frame) != selected_frame)
5061d9c3
RS
175 record_unwind_protect (Fset_window_configuration,
176 Fcurrent_window_configuration (mini_frame));
5563e8e8
KH
177
178 /* If the minibuffer is on an iconified or invisible frame,
179 make it visible now. */
180 Fmake_frame_visible (mini_frame);
181
6a9ee000
RS
182 if (minibuffer_auto_raise)
183 Fraise_frame (mini_frame);
5061d9c3 184#endif
f927c5ae
JB
185
186 val = current_buffer->directory;
187 Fset_buffer (get_minibuffer (minibuf_level));
64a3a3c0
JB
188
189 /* The current buffer's default directory is usually the right thing
190 for our minibuffer here. However, if you're typing a command at
191 a minibuffer-only frame when minibuf_level is zero, then buf IS
192 the current_buffer, so reset_buffer leaves buf's default
193 directory unchanged. This is a bummer when you've just started
194 up Emacs and buf's default directory is Qnil. Here's a hack; can
195 you think of something better to do? Find another buffer with a
196 better directory, and use that one instead. */
197 if (XTYPE (val) == Lisp_String)
198 current_buffer->directory = val;
199 else
200 {
201 Lisp_Object buf_list;
202
203 for (buf_list = Vbuffer_alist;
204 CONSP (buf_list);
205 buf_list = XCONS (buf_list)->cdr)
206 {
207 Lisp_Object other_buf = XCONS (XCONS (buf_list)->car)->cdr;
208
209 if (XTYPE (XBUFFER (other_buf)->directory) == Lisp_String)
210 {
211 current_buffer->directory = XBUFFER (other_buf)->directory;
212 break;
213 }
214 }
215 }
216
33b1baf6 217#ifdef MULTI_FRAME
91dc12bb 218 Fredirect_frame_focus (Fselected_frame (), mini_frame);
33b1baf6 219#endif
f927c5ae
JB
220 Fmake_local_variable (Qprint_escape_newlines);
221 print_escape_newlines = 1;
222
43bad991 223 record_unwind_protect (read_minibuf_unwind, Qnil);
43bad991 224
f927c5ae
JB
225 Vminibuf_scroll_window = selected_window;
226 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
f927c5ae
JB
227 Fselect_window (minibuf_window);
228 XFASTINT (XWINDOW (minibuf_window)->hscroll) = 0;
229
230 Ferase_buffer ();
231 minibuf_level++;
f927c5ae 232
56a98455 233 if (!NILP (initial))
f927c5ae
JB
234 {
235 Finsert (1, &initial);
56a98455 236 if (!NILP (backup_n) && XTYPE (backup_n) == Lisp_Int)
f927c5ae
JB
237 Fforward_char (backup_n);
238 }
239
240 minibuf_prompt = (char *) alloca (XSTRING (prompt)->size + 1);
241 bcopy (XSTRING (prompt)->data, minibuf_prompt, XSTRING (prompt)->size + 1);
242 echo_area_glyphs = 0;
243
244 Vhelp_form = Vminibuffer_help_form;
245 current_buffer->keymap = map;
770970cb
RS
246 Vminibuffer_history_position = histpos;
247 Vminibuffer_history_variable = histvar;
f927c5ae 248
5c781212
RS
249 /* Run our hook, but not if it is empty.
250 (run-hooks would do nothing if it is empty,
251 but it's important to save time here in the usual case. */
92d3b06e
RS
252 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
253 && !NILP (Vrun_hooks))
5c781212
RS
254 call1 (Vrun_hooks, Qminibuffer_setup_hook);
255
f927c5ae
JB
256/* ??? MCC did redraw_screen here if switching screens. */
257 recursive_edit_1 ();
258
259 /* If cursor is on the minibuffer line,
260 show the user we have exited by putting it in column 0. */
ff11dfa1 261 if ((FRAME_CURSOR_Y (selected_frame)
f927c5ae
JB
262 >= XFASTINT (XWINDOW (minibuf_window)->top))
263 && !noninteractive)
264 {
ff11dfa1
JB
265 FRAME_CURSOR_X (selected_frame) = 0;
266 update_frame (selected_frame, 1, 1);
f927c5ae
JB
267 }
268
269 /* Make minibuffer contents into a string */
ffd56f97 270 val = make_buffer_string (1, Z);
f927c5ae 271 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
770970cb 272
b278606c
BF
273 /* VAL is the string of minibuffer text. */
274 last_minibuf_string = val;
275
770970cb
RS
276 /* Add the value to the appropriate history list. */
277 if (XTYPE (Vminibuffer_history_variable) == Lisp_Symbol
b278606c
BF
278 && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound))
279 {
280 /* If the caller wanted to save the value read on a history list,
60b73b25
RS
281 then do so if the value is not already the front of the list. */
282 Lisp_Object histval;
283 histval = Fsymbol_value (Vminibuffer_history_variable);
b278606c
BF
284
285 /* The value of the history variable must be a cons or nil. Other
60b73b25 286 values are unacceptable. We silently ignore these values. */
b278606c 287 if (NILP (histval)
60b73b25
RS
288 || (CONSP (histval)
289 && NILP (Fequal (last_minibuf_string, Fcar (histval)))))
290 Fset (Vminibuffer_history_variable,
291 Fcons (last_minibuf_string, histval));
b278606c 292 }
770970cb 293
60b73b25
RS
294 /* If Lisp form desired instead of string, parse it. */
295 if (expflag)
8acd16de
KH
296 {
297 Lisp_Object expr_and_pos;
298 unsigned char *p;
299
300 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
301 /* Ignore trailing whitespace; any other trailing junk is an error. */
302 for (p = XSTRING (val)->data + XINT (Fcdr (expr_and_pos)); *p; p++)
303 if (*p != ' ' && *p != '\t' && *p != '\n')
304 error ("Trailing garbage following expression");
305 val = Fcar (expr_and_pos);
306 }
60b73b25 307
ff11dfa1 308 unbind_to (count, Qnil); /* The appropriate frame will get selected
43bad991 309 in set-window-configuration. */
f927c5ae
JB
310
311 UNGCPRO;
312
f927c5ae
JB
313 return val;
314}
315
316/* Return a buffer to be used as the minibuffer at depth `depth'.
317 depth = 0 is the lowest allowed argument, and that is the value
318 used for nonrecursive minibuffer invocations */
319
320Lisp_Object
321get_minibuffer (depth)
322 int depth;
323{
324 Lisp_Object tail, num, buf;
9f6c23bc 325 char name[24];
f927c5ae
JB
326 extern Lisp_Object nconc2 ();
327
328 XFASTINT (num) = depth;
329 tail = Fnthcdr (num, Vminibuffer_list);
56a98455 330 if (NILP (tail))
f927c5ae
JB
331 {
332 tail = Fcons (Qnil, Qnil);
333 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
334 }
335 buf = Fcar (tail);
56a98455 336 if (NILP (buf) || NILP (XBUFFER (buf)->name))
f927c5ae
JB
337 {
338 sprintf (name, " *Minibuf-%d*", depth);
339 buf = Fget_buffer_create (build_string (name));
5d6533f1
JB
340
341 /* Although the buffer's name starts with a space, undo should be
342 enabled in it. */
343 Fbuffer_enable_undo (buf);
344
f927c5ae
JB
345 XCONS (tail)->car = buf;
346 }
347 else
348 reset_buffer (XBUFFER (buf));
64a3a3c0 349
f927c5ae
JB
350 return buf;
351}
352
353/* This function is called on exiting minibuffer, whether normally or not,
354 and it restores the current window, buffer, etc. */
355
356void
43bad991
JB
357read_minibuf_unwind (data)
358 Lisp_Object data;
f927c5ae
JB
359{
360 /* Erase the minibuffer we were using at this level. */
361 Fset_buffer (XWINDOW (minibuf_window)->buffer);
362
363 /* Prevent error in erase-buffer. */
364 current_buffer->read_only = Qnil;
365 Ferase_buffer ();
366
367 /* If this was a recursive minibuffer,
368 tie the minibuffer window back to the outer level minibuffer buffer */
369 minibuf_level--;
370 /* Make sure minibuffer window is erased, not ignored */
371 windows_or_buffers_changed++;
372 XFASTINT (XWINDOW (minibuf_window)->last_modified) = 0;
373
374 /* Restore prompt from outer minibuffer */
375 minibuf_prompt = minibuf_save_vector[minibuf_level].prompt;
376 minibuf_prompt_width = minibuf_save_vector[minibuf_level].prompt_width;
377 Vhelp_form = minibuf_save_vector[minibuf_level].help_form;
378 Vcurrent_prefix_arg = minibuf_save_vector[minibuf_level].current_prefix_arg;
770970cb
RS
379 Vminibuffer_history_position
380 = minibuf_save_vector[minibuf_level].history_position;
381 Vminibuffer_history_variable
382 = minibuf_save_vector[minibuf_level].history_variable;
f927c5ae
JB
383}
384\f
b9d721de
JB
385
386/* This comment supplies the doc string for read-from-minibuffer,
387 for make-docfile to see. We cannot put this in the real DEFUN
388 due to limits in the Unix cpp.
389
f927c5ae
JB
390DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
391 "Read a string from the minibuffer, prompting with string PROMPT.\n\
392If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
393 to be inserted into the minibuffer before reading input.\n\
770970cb
RS
394 If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\
395 is STRING, but point is placed POSITION characters into the string.\n\
f927c5ae
JB
396Third arg KEYMAP is a keymap to use whilst reading;\n\
397 if omitted or nil, the default is `minibuffer-local-map'.\n\
398If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
399 and return that object:\n\
400 in other words, do `(car (read-from-string INPUT-STRING))'\n\
770970cb
RS
401Fifth arg HIST, if non-nil, specifies a history list\n\
402 and optionally the initial position in the list.\n\
403 It can be a symbol, which is the history list variable to use,\n\
404 or it can be a cons cell (HISTVAR . HISTPOS).\n\
405 In that case, HISTVAR is the history list variable to use,\n\
406 and HISTPOS is the initial position (the position in the list\n\
407 which INITIAL-CONTENTS corresponds to).\n\
b9d721de
JB
408 Positions are counted starting from 1 at the beginning of the list."
409*/
410
411DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
412 0 /* See immediately above */)
68e5a8a2
RS
413 (prompt, initial_contents, keymap, read, hist)
414 Lisp_Object prompt, initial_contents, keymap, read, hist;
f927c5ae
JB
415{
416 int pos = 0;
770970cb
RS
417 Lisp_Object histvar, histpos, position;
418 position = Qnil;
f927c5ae
JB
419
420 CHECK_STRING (prompt, 0);
68e5a8a2 421 if (!NILP (initial_contents))
f927c5ae 422 {
68e5a8a2 423 if (XTYPE (initial_contents) == Lisp_Cons)
770970cb 424 {
68e5a8a2
RS
425 position = Fcdr (initial_contents);
426 initial_contents = Fcar (initial_contents);
770970cb 427 }
68e5a8a2 428 CHECK_STRING (initial_contents, 1);
56a98455 429 if (!NILP (position))
f927c5ae
JB
430 {
431 CHECK_NUMBER (position, 0);
432 /* Convert to distance from end of input. */
68e5a8a2 433 pos = XINT (position) - 1 - XSTRING (initial_contents)->size;
f927c5ae
JB
434 }
435 }
436
56a98455 437 if (NILP (keymap))
f927c5ae
JB
438 keymap = Vminibuffer_local_map;
439 else
440 keymap = get_keymap (keymap,2);
770970cb
RS
441
442 if (XTYPE (hist) == Lisp_Symbol)
443 {
444 histvar = hist;
445 histpos = Qnil;
446 }
447 else
448 {
449 histvar = Fcar_safe (hist);
450 histpos = Fcdr_safe (hist);
451 }
452 if (NILP (histvar))
453 histvar = Qminibuffer_history;
454 if (NILP (histpos))
455 XFASTINT (histpos) = 0;
456
68e5a8a2 457 return read_minibuf (keymap, initial_contents, prompt,
85b5fe07 458 make_number (pos), !NILP (read), histvar, histpos);
f927c5ae
JB
459}
460
461DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
462 "Return a Lisp object read using the minibuffer.\n\
463Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
464is a string to insert in the minibuffer before reading.")
465 (prompt, initial_contents)
466 Lisp_Object prompt, initial_contents;
467{
468 CHECK_STRING (prompt, 0);
56a98455 469 if (!NILP (initial_contents))
a1b4b084 470 CHECK_STRING (initial_contents, 1);
770970cb
RS
471 return read_minibuf (Vminibuffer_local_map, initial_contents,
472 prompt, Qnil, 1, Qminibuffer_history, make_number (0));
f927c5ae
JB
473}
474
475DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
476 "Return value of Lisp expression read using the minibuffer.\n\
477Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
478is a string to insert in the minibuffer before reading.")
479 (prompt, initial_contents)
480 Lisp_Object prompt, initial_contents;
481{
482 return Feval (Fread_minibuffer (prompt, initial_contents));
483}
484
485/* Functions that use the minibuffer to read various things. */
486
487DEFUN ("read-string", Fread_string, Sread_string, 1, 2, 0,
488 "Read a string from the minibuffer, prompting with string PROMPT.\n\
489If non-nil second arg INITIAL-INPUT is a string to insert before reading.")
490 (prompt, initial_input)
491 Lisp_Object prompt, initial_input;
492{
493 return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, Qnil);
494}
495
b278606c 496DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 2, 0,
f927c5ae
JB
497 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
498Prompt with PROMPT, and provide INIT as an initial value of the input string.")
499 (prompt, init)
500 Lisp_Object prompt, init;
501{
502 CHECK_STRING (prompt, 0);
56a98455 503 if (! NILP (init))
f927c5ae
JB
504 CHECK_STRING (init, 1);
505
770970cb
RS
506 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0,
507 Qminibuffer_history, make_number (0));
f927c5ae
JB
508}
509
510DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
511 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
512Prompts with PROMPT.")
513 (prompt)
514 Lisp_Object prompt;
515{
516 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil),
517 Qnil);
518}
519
520#ifdef NOTDEF
521DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
522 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
523Prompts with PROMPT.")
524 (prompt)
525 Lisp_Object prompt;
526{
527 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil),
528 Qnil);
529}
530#endif /* NOTDEF */
531
532DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
533 "One arg PROMPT, a string. Read the name of a user variable and return\n\
534it as a symbol. Prompts with PROMPT.\n\
535A user variable is one whose documentation starts with a `*' character.")
536 (prompt)
537 Lisp_Object prompt;
538{
539 return Fintern (Fcompleting_read (prompt, Vobarray,
540 Quser_variable_p, Qt, Qnil, Qnil),
541 Qnil);
542}
543
544DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
545 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
546Prompts with PROMPT.\n\
547Optional second arg is value to return if user enters an empty line.\n\
548If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
549 (prompt, def, require_match)
550 Lisp_Object prompt, def, require_match;
551{
552 Lisp_Object tem;
553 Lisp_Object args[3];
554 struct gcpro gcpro1;
555
556 if (XTYPE (def) == Lisp_Buffer)
557 def = XBUFFER (def)->name;
56a98455 558 if (!NILP (def))
f927c5ae
JB
559 {
560 args[0] = build_string ("%s(default %s) ");
561 args[1] = prompt;
562 args[2] = def;
563 prompt = Fformat (3, args);
564 }
565 GCPRO1 (def);
566 tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil);
567 UNGCPRO;
568 if (XSTRING (tem)->size)
569 return tem;
570 return def;
571}
572\f
573DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
574 "Return common substring of all completions of STRING in ALIST.\n\
575Each car of each element of ALIST is tested to see if it begins with STRING.\n\
576All that match are compared together; the longest initial sequence\n\
577common to all matches is returned as a string.\n\
578If there is no match at all, nil is returned.\n\
579For an exact match, t is returned.\n\
580\n\
581ALIST can be an obarray instead of an alist.\n\
582Then the print names of all symbols in the obarray are the possible matches.\n\
583\n\
584ALIST can also be a function to do the completion itself.\n\
585It receives three arguments: the values STRING, PREDICATE and nil.\n\
586Whatever it returns becomes the value of `try-completion'.\n\
587\n\
588If optional third argument PREDICATE is non-nil,\n\
589it is used to test each possible match.\n\
590The match is a candidate only if PREDICATE returns non-nil.\n\
591The argument given to PREDICATE is the alist element or the symbol from the obarray.")
592 (string, alist, pred)
593 Lisp_Object string, alist, pred;
594{
595 Lisp_Object bestmatch, tail, elt, eltstring;
596 int bestmatchsize;
597 int compare, matchsize;
56a98455 598 int list = CONSP (alist) || NILP (alist);
f927c5ae
JB
599 int index, obsize;
600 int matchcount = 0;
601 Lisp_Object bucket, zero, end, tem;
602 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
603
604 CHECK_STRING (string, 0);
605 if (!list && XTYPE (alist) != Lisp_Vector)
606 return call3 (alist, string, pred, Qnil);
607
608 bestmatch = Qnil;
609
610 /* If ALIST is not a list, set TAIL just for gc pro. */
611 tail = alist;
612 if (! list)
613 {
614 index = 0;
615 obsize = XVECTOR (alist)->size;
616 bucket = XVECTOR (alist)->contents[index];
617 }
618
619 while (1)
620 {
621 /* Get the next element of the alist or obarray. */
622 /* Exit the loop if the elements are all used up. */
623 /* elt gets the alist element or symbol.
624 eltstring gets the name to check as a completion. */
625
626 if (list)
627 {
56a98455 628 if (NILP (tail))
f927c5ae
JB
629 break;
630 elt = Fcar (tail);
631 eltstring = Fcar (elt);
632 tail = Fcdr (tail);
633 }
634 else
635 {
636 if (XFASTINT (bucket) != 0)
637 {
638 elt = bucket;
639 eltstring = Fsymbol_name (elt);
640 if (XSYMBOL (bucket)->next)
641 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
642 else
643 XFASTINT (bucket) = 0;
644 }
645 else if (++index >= obsize)
646 break;
647 else
648 {
649 bucket = XVECTOR (alist)->contents[index];
650 continue;
651 }
652 }
653
654 /* Is this element a possible completion? */
655
656 if (XTYPE (eltstring) == Lisp_String &&
657 XSTRING (string)->size <= XSTRING (eltstring)->size &&
658 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
659 XSTRING (string)->size))
660 {
661 /* Yes. */
662 /* Ignore this element if there is a predicate
663 and the predicate doesn't like it. */
664
56a98455 665 if (!NILP (pred))
f927c5ae
JB
666 {
667 if (EQ (pred, Qcommandp))
668 tem = Fcommandp (elt);
669 else
670 {
671 GCPRO4 (tail, string, eltstring, bestmatch);
672 tem = call1 (pred, elt);
673 UNGCPRO;
674 }
56a98455 675 if (NILP (tem)) continue;
f927c5ae
JB
676 }
677
678 /* Update computation of how much all possible completions match */
679
680 matchcount++;
56a98455 681 if (NILP (bestmatch))
f927c5ae
JB
682 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
683 else
684 {
685 compare = min (bestmatchsize, XSTRING (eltstring)->size);
686 matchsize = scmp (XSTRING (bestmatch)->data,
687 XSTRING (eltstring)->data,
688 compare);
52b14ac0
JB
689 if (matchsize < 0)
690 matchsize = compare;
691 if (completion_ignore_case)
692 {
693 /* If this is an exact match except for case,
694 use it as the best match rather than one that is not an
695 exact match. This way, we get the case pattern
696 of the actual match. */
697 if ((matchsize == XSTRING (eltstring)->size
698 && matchsize < XSTRING (bestmatch)->size)
699 ||
700 /* If there is more than one exact match ignoring case,
701 and one of them is exact including case,
702 prefer that one. */
703 /* If there is no exact match ignoring case,
704 prefer a match that does not change the case
705 of the input. */
706 ((matchsize == XSTRING (eltstring)->size)
707 ==
708 (matchsize == XSTRING (bestmatch)->size)
709 && !bcmp (XSTRING (eltstring)->data,
710 XSTRING (string)->data, XSTRING (string)->size)
711 && bcmp (XSTRING (bestmatch)->data,
712 XSTRING (string)->data, XSTRING (string)->size)))
713 bestmatch = eltstring;
714 }
715 bestmatchsize = matchsize;
f927c5ae
JB
716 }
717 }
718 }
719
56a98455 720 if (NILP (bestmatch))
f927c5ae 721 return Qnil; /* No completions found */
52b14ac0
JB
722 /* If we are ignoring case, and there is no exact match,
723 and no additional text was supplied,
724 don't change the case of what the user typed. */
725 if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
726 && XSTRING (bestmatch)->size > bestmatchsize)
727 return string;
728
729 /* Return t if the supplied string is an exact match (counting case);
730 it does not require any change to be made. */
731 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
732 && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data,
733 bestmatchsize))
f927c5ae
JB
734 return Qt;
735
736 XFASTINT (zero) = 0; /* Else extract the part in which */
737 XFASTINT (end) = bestmatchsize; /* all completions agree */
738 return Fsubstring (bestmatch, zero, end);
739}
740
741/* Compare exactly LEN chars of strings at S1 and S2,
742 ignoring case if appropriate.
743 Return -1 if strings match,
744 else number of chars that match at the beginning. */
745
746scmp (s1, s2, len)
747 register char *s1, *s2;
748 int len;
749{
750 register int l = len;
751
752 if (completion_ignore_case)
753 {
754 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
755 l--;
756 }
757 else
758 {
759 while (l && *s1++ == *s2++)
760 l--;
761 }
762 if (l == 0)
763 return -1;
764 else return len - l;
765}
766\f
767DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 3, 0,
768 "Search for partial matches to STRING in ALIST.\n\
769Each car of each element of ALIST is tested to see if it begins with STRING.\n\
770The value is a list of all the strings from ALIST that match.\n\
771ALIST can be an obarray instead of an alist.\n\
772Then the print names of all symbols in the obarray are the possible matches.\n\
773\n\
774ALIST can also be a function to do the completion itself.\n\
775It receives three arguments: the values STRING, PREDICATE and t.\n\
776Whatever it returns becomes the value of `all-completion'.\n\
777\n\
778If optional third argument PREDICATE is non-nil,\n\
779it is used to test each possible match.\n\
780The match is a candidate only if PREDICATE returns non-nil.\n\
781The argument given to PREDICATE is the alist element or the symbol from the obarray.")
782 (string, alist, pred)
783 Lisp_Object string, alist, pred;
784{
785 Lisp_Object tail, elt, eltstring;
786 Lisp_Object allmatches;
56a98455 787 int list = CONSP (alist) || NILP (alist);
f927c5ae
JB
788 int index, obsize;
789 Lisp_Object bucket, tem;
790 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
791
792 CHECK_STRING (string, 0);
793 if (!list && XTYPE (alist) != Lisp_Vector)
794 {
795 return call3 (alist, string, pred, Qt);
796 }
797 allmatches = Qnil;
798
799 /* If ALIST is not a list, set TAIL just for gc pro. */
800 tail = alist;
801 if (! list)
802 {
803 index = 0;
804 obsize = XVECTOR (alist)->size;
805 bucket = XVECTOR (alist)->contents[index];
806 }
807
808 while (1)
809 {
810 /* Get the next element of the alist or obarray. */
811 /* Exit the loop if the elements are all used up. */
812 /* elt gets the alist element or symbol.
813 eltstring gets the name to check as a completion. */
814
815 if (list)
816 {
56a98455 817 if (NILP (tail))
f927c5ae
JB
818 break;
819 elt = Fcar (tail);
820 eltstring = Fcar (elt);
821 tail = Fcdr (tail);
822 }
823 else
824 {
825 if (XFASTINT (bucket) != 0)
826 {
827 elt = bucket;
828 eltstring = Fsymbol_name (elt);
829 if (XSYMBOL (bucket)->next)
830 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
831 else
832 XFASTINT (bucket) = 0;
833 }
834 else if (++index >= obsize)
835 break;
836 else
837 {
838 bucket = XVECTOR (alist)->contents[index];
839 continue;
840 }
841 }
842
843 /* Is this element a possible completion? */
844
2cbaf886
RS
845 if (XTYPE (eltstring) == Lisp_String
846 && XSTRING (string)->size <= XSTRING (eltstring)->size
847 /* Reject alternatives that start with space
848 unless the input starts with space. */
849 && ((XSTRING (string)->size > 0 && XSTRING (string)->data[0] == ' ')
850 || XSTRING (eltstring)->data[0] != ' ')
851 && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
852 XSTRING (string)->size))
f927c5ae
JB
853 {
854 /* Yes. */
855 /* Ignore this element if there is a predicate
856 and the predicate doesn't like it. */
857
56a98455 858 if (!NILP (pred))
f927c5ae
JB
859 {
860 if (EQ (pred, Qcommandp))
861 tem = Fcommandp (elt);
862 else
863 {
864 GCPRO4 (tail, eltstring, allmatches, string);
865 tem = call1 (pred, elt);
866 UNGCPRO;
867 }
56a98455 868 if (NILP (tem)) continue;
f927c5ae
JB
869 }
870 /* Ok => put it on the list. */
871 allmatches = Fcons (eltstring, allmatches);
872 }
873 }
874
875 return Fnreverse (allmatches);
876}
877\f
878Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
879Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
880Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
881
b9d721de
JB
882/* This comment supplies the doc string for completing-read,
883 for make-docfile to see. We cannot put this in the real DEFUN
884 due to limits in the Unix cpp.
885
f927c5ae
JB
886DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
887 "Read a string in the minibuffer, with completion.\n\
770970cb 888Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST.\n\
f927c5ae
JB
889PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
890TABLE is an alist whose elements' cars are strings, or an obarray.\n\
891PREDICATE limits completion to a subset of TABLE.\n\
892See `try-completion' for more details on completion, TABLE, and PREDICATE.\n\
893If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
894 the input is (or completes to) an element of TABLE.\n\
895 If it is also not t, Return does not exit if it does non-null completion.\n\
896If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
770970cb
RS
897 If it is (STRING . POSITION), the initial input\n\
898 is STRING, but point is placed POSITION characters into the string.\n\
899HIST, if non-nil, specifies a history list\n\
900 and optionally the initial position in the list.\n\
901 It can be a symbol, which is the history list variable to use,\n\
902 or it can be a cons cell (HISTVAR . HISTPOS).\n\
903 In that case, HISTVAR is the history list variable to use,\n\
904 and HISTPOS is the initial position (the position in the list\n\
905 which INITIAL-CONTENTS corresponds to).\n\
906 Positions are counted starting from 1 at the beginning of the list.\n\
907Completion ignores case if the ambient value of\n\
b9d721de
JB
908 `completion-ignore-case' is non-nil."
909*/
910DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
911 0 /* See immediately above */)
770970cb
RS
912 (prompt, table, pred, require_match, init, hist)
913 Lisp_Object prompt, table, pred, require_match, init, hist;
f927c5ae 914{
770970cb
RS
915 Lisp_Object val, histvar, histpos, position;
916 int pos = 0;
f927c5ae
JB
917 int count = specpdl_ptr - specpdl;
918 specbind (Qminibuffer_completion_table, table);
919 specbind (Qminibuffer_completion_predicate, pred);
920 specbind (Qminibuffer_completion_confirm,
921 EQ (require_match, Qt) ? Qnil : Qt);
922 last_exact_completion = Qnil;
770970cb
RS
923
924 position = Qnil;
925 if (!NILP (init))
926 {
927 if (XTYPE (init) == Lisp_Cons)
928 {
929 position = Fcdr (init);
930 init = Fcar (init);
931 }
932 CHECK_STRING (init, 0);
933 if (!NILP (position))
934 {
935 CHECK_NUMBER (position, 0);
936 /* Convert to distance from end of input. */
5dadd3a2 937 pos = XINT (position) - XSTRING (init)->size;
770970cb
RS
938 }
939 }
940
941 if (XTYPE (hist) == Lisp_Symbol)
942 {
943 histvar = hist;
944 histpos = Qnil;
945 }
946 else
947 {
948 histvar = Fcar_safe (hist);
949 histpos = Fcdr_safe (hist);
950 }
951 if (NILP (histvar))
952 histvar = Qminibuffer_history;
953 if (NILP (histpos))
954 XFASTINT (histpos) = 0;
955
56a98455 956 val = read_minibuf (NILP (require_match)
f927c5ae
JB
957 ? Vminibuffer_local_completion_map
958 : Vminibuffer_local_must_match_map,
85b5fe07 959 init, prompt, make_number (pos), 0,
770970cb 960 histvar, histpos);
f927c5ae
JB
961 return unbind_to (count, val);
962}
963\f
964/* Temporarily display the string M at the end of the current
965 minibuffer contents. This is used to display things like
966 "[No Match]" when the user requests a completion for a prefix
967 that has no possible completions, and other quick, unobtrusive
968 messages. */
969
970temp_echo_area_glyphs (m)
971 char *m;
972{
f927c5ae
JB
973 int osize = ZV;
974 Lisp_Object oinhibit;
975 oinhibit = Vinhibit_quit;
976
896adf84
JB
977 /* Clear out any old echo-area message to make way for our new thing. */
978 message (0);
f927c5ae
JB
979
980 SET_PT (osize);
981 insert_string (m);
982 SET_PT (osize);
983 Vinhibit_quit = Qt;
984 Fsit_for (make_number (2), Qnil, Qnil);
985 del_range (point, ZV);
56a98455 986 if (!NILP (Vquit_flag))
f927c5ae
JB
987 {
988 Vquit_flag = Qnil;
a4e71d81 989 unread_command_events = Fcons (make_number (quit_char), Qnil);
f927c5ae
JB
990 }
991 Vinhibit_quit = oinhibit;
992}
993
994Lisp_Object Fminibuffer_completion_help ();
52b14ac0 995Lisp_Object assoc_for_completion ();
f927c5ae
JB
996
997/* returns:
998 * 0 no possible completion
999 * 1 was already an exact and unique completion
1000 * 3 was already an exact completion
1001 * 4 completed to an exact completion
1002 * 5 some completion happened
1003 * 6 no completion happened
1004 */
1005int
1006do_completion ()
1007{
1008 Lisp_Object completion, tem;
1009 int completedp;
1010 Lisp_Object last;
1011
1012 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
1013 Vminibuffer_completion_predicate);
1014 last = last_exact_completion;
1015 last_exact_completion = Qnil;
1016
56a98455 1017 if (NILP (completion))
f927c5ae
JB
1018 {
1019 bitch_at_user ();
1020 temp_echo_area_glyphs (" [No match]");
1021 return 0;
1022 }
1023
1024 if (EQ (completion, Qt)) /* exact and unique match */
1025 return 1;
1026
1027 /* compiler bug */
1028 tem = Fstring_equal (completion, Fbuffer_string());
56a98455 1029 if (completedp = NILP (tem))
f927c5ae
JB
1030 {
1031 Ferase_buffer (); /* Some completion happened */
1032 Finsert (1, &completion);
1033 }
1034
1035 /* It did find a match. Do we match some possibility exactly now? */
1036 if (CONSP (Vminibuffer_completion_table)
56a98455 1037 || NILP (Vminibuffer_completion_table))
52b14ac0
JB
1038 tem = assoc_for_completion (Fbuffer_string (),
1039 Vminibuffer_completion_table);
f927c5ae
JB
1040 else if (XTYPE (Vminibuffer_completion_table) == Lisp_Vector)
1041 {
1042 /* the primitive used by Fintern_soft */
1043 extern Lisp_Object oblookup ();
1044
1045 tem = Fbuffer_string ();
1046 /* Bypass intern-soft as that loses for nil */
1047 tem = oblookup (Vminibuffer_completion_table,
1048 XSTRING (tem)->data, XSTRING (tem)->size);
1049 if (XTYPE (tem) != Lisp_Symbol)
1050 tem = Qnil;
56a98455 1051 else if (!NILP (Vminibuffer_completion_predicate))
f927c5ae
JB
1052 tem = call1 (Vminibuffer_completion_predicate, tem);
1053 else
1054 tem = Qt;
1055 }
1056 else
1057 tem = call3 (Vminibuffer_completion_table,
1058 Fbuffer_string (),
1059 Vminibuffer_completion_predicate,
1060 Qlambda);
1061
56a98455 1062 if (NILP (tem))
f927c5ae
JB
1063 { /* not an exact match */
1064 if (completedp)
1065 return 5;
1066 else if (auto_help)
1067 Fminibuffer_completion_help ();
1068 else
1069 temp_echo_area_glyphs (" [Next char not unique]");
1070 return 6;
1071 }
1072 else if (completedp)
1073 return 4;
1074 /* If the last exact completion and this one were the same,
1075 it means we've already given a "Complete but not unique"
52b14ac0 1076 message and the user's hit TAB again, so now we give him help. */
f927c5ae 1077 last_exact_completion = completion;
56a98455 1078 if (!NILP (last))
f927c5ae
JB
1079 {
1080 tem = Fbuffer_string ();
56a98455 1081 if (!NILP (Fequal (tem, last)))
f927c5ae
JB
1082 Fminibuffer_completion_help ();
1083 }
1084 return 3;
f927c5ae
JB
1085}
1086
52b14ac0
JB
1087/* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
1088
1089Lisp_Object
1090assoc_for_completion (key, list)
1091 register Lisp_Object key;
1092 Lisp_Object list;
1093{
1094 register Lisp_Object tail;
1095
1096 if (completion_ignore_case)
1097 key = Fupcase (key);
1098
56a98455 1099 for (tail = list; !NILP (tail); tail = Fcdr (tail))
52b14ac0
JB
1100 {
1101 register Lisp_Object elt, tem, thiscar;
1102 elt = Fcar (tail);
1103 if (!CONSP (elt)) continue;
1104 thiscar = Fcar (elt);
1105 if (XTYPE (thiscar) != Lisp_String)
1106 continue;
1107 if (completion_ignore_case)
1108 thiscar = Fupcase (thiscar);
1109 tem = Fequal (thiscar, key);
56a98455 1110 if (!NILP (tem)) return elt;
52b14ac0
JB
1111 QUIT;
1112 }
1113 return Qnil;
1114}
f927c5ae
JB
1115
1116DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
6300d782
KH
1117 "Complete the minibuffer contents as far as possible.\n\
1118Return nil if there is no valid completion, else t.")
f927c5ae
JB
1119 ()
1120{
1121 register int i = do_completion ();
1122 switch (i)
1123 {
1124 case 0:
1125 return Qnil;
1126
1127 case 1:
1128 temp_echo_area_glyphs (" [Sole completion]");
1129 break;
1130
1131 case 3:
1132 temp_echo_area_glyphs (" [Complete, but not unique]");
1133 break;
1134 }
1135
1136 return Qt;
1137}
1138
1139DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
1140 Sminibuffer_complete_and_exit, 0, 0, "",
1141 "Complete the minibuffer contents, and maybe exit.\n\
1142Exit if the name is valid with no completion needed.\n\
1143If name was completed to a valid match,\n\
1144a repetition of this command will exit.")
1145 ()
1146{
1147 register int i;
1148
1149 /* Allow user to specify null string */
1150 if (BEGV == ZV)
1151 goto exit;
1152
1153 i = do_completion ();
1154 switch (i)
1155 {
1156 case 1:
1157 case 3:
1158 goto exit;
1159
1160 case 4:
56a98455 1161 if (!NILP (Vminibuffer_completion_confirm))
f927c5ae
JB
1162 {
1163 temp_echo_area_glyphs (" [Confirm]");
1164 return Qnil;
1165 }
1166 else
1167 goto exit;
1168
1169 default:
1170 return Qnil;
1171 }
1172 exit:
1173 Fthrow (Qexit, Qnil);
1174 /* NOTREACHED */
1175}
1176
1177DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
1178 0, 0, "",
1179 "Complete the minibuffer contents at most a single word.\n\
1180After one word is completed as much as possible, a space or hyphen\n\
6300d782
KH
1181is added, provided that matches some possible completion.\n\
1182Return nil if there is no valid completion, else t.")
f927c5ae
JB
1183 ()
1184{
1185 Lisp_Object completion, tem;
1186 register int i;
1187 register unsigned char *completion_string;
b278606c
BF
1188 struct gcpro gcpro1;
1189
1190 /* We keep calling Fbuffer_string rather than arrange for GC to
1191 hold onto a pointer to one of the strings thus made. */
f927c5ae
JB
1192
1193 completion = Ftry_completion (Fbuffer_string (),
1194 Vminibuffer_completion_table,
1195 Vminibuffer_completion_predicate);
56a98455 1196 if (NILP (completion))
f927c5ae
JB
1197 {
1198 bitch_at_user ();
1199 temp_echo_area_glyphs (" [No match]");
1200 return Qnil;
1201 }
1202 if (EQ (completion, Qt))
1203 return Qnil;
1204
b278606c 1205#if 0 /* How the below code used to look, for reference. */
f927c5ae
JB
1206 tem = Fbuffer_string ();
1207 b = XSTRING (tem)->data;
1208 i = ZV - 1 - XSTRING (completion)->size;
1209 p = XSTRING (completion)->data;
1210 if (i > 0 ||
1211 0 <= scmp (b, p, ZV - 1))
1212 {
1213 i = 1;
1214 /* Set buffer to longest match of buffer tail and completion head. */
1215 while (0 <= scmp (b + i, p, ZV - 1 - i))
1216 i++;
1217 del_range (1, i + 1);
1218 SET_PT (ZV);
1219 }
1220#else /* Rewritten code */
1221 {
1222 register unsigned char *buffer_string;
1223 int buffer_length, completion_length;
1224
1225 tem = Fbuffer_string ();
719b4a40
RS
1226 /* If reading a file name,
1227 expand any $ENVVAR refs in the buffer and in TEM. */
1228 if (EQ (Vminibuffer_completion_table, Qread_file_name_internal))
1229 {
1230 Lisp_Object substituted;
1231 substituted = Fsubstitute_in_file_name (tem);
1232 if (! EQ (substituted, tem))
1233 {
1234 tem = substituted;
1235 Ferase_buffer ();
3cab9ae4 1236 insert_from_string (tem, 0, XSTRING (tem)->size, 0);
719b4a40
RS
1237 }
1238 }
f927c5ae
JB
1239 buffer_string = XSTRING (tem)->data;
1240 completion_string = XSTRING (completion)->data;
1241 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
1242 completion_length = XSTRING (completion)->size;
1243 i = buffer_length - completion_length;
1244 /* Mly: I don't understand what this is supposed to do AT ALL */
1245 if (i > 0 ||
1246 0 <= scmp (buffer_string, completion_string, buffer_length))
1247 {
1248 /* Set buffer to longest match of buffer tail and completion head. */
1249 if (i <= 0) i = 1;
1250 buffer_string += i;
1251 buffer_length -= i;
1252 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
1253 i++;
1254 del_range (1, i + 1);
1255 SET_PT (ZV);
1256 }
1257 }
1258#endif /* Rewritten code */
1259 i = ZV - BEGV;
1260
1261 /* If completion finds next char not unique,
b278606c 1262 consider adding a space or a hyphen. */
f927c5ae
JB
1263 if (i == XSTRING (completion)->size)
1264 {
b278606c 1265 GCPRO1 (completion);
f927c5ae
JB
1266 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
1267 Vminibuffer_completion_table,
1268 Vminibuffer_completion_predicate);
b278606c
BF
1269 UNGCPRO;
1270
f927c5ae
JB
1271 if (XTYPE (tem) == Lisp_String)
1272 completion = tem;
1273 else
1274 {
b278606c
BF
1275 GCPRO1 (completion);
1276 tem =
1277 Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
1278 Vminibuffer_completion_table,
1279 Vminibuffer_completion_predicate);
1280 UNGCPRO;
1281
f927c5ae
JB
1282 if (XTYPE (tem) == Lisp_String)
1283 completion = tem;
1284 }
1285 }
1286
1287 /* Now find first word-break in the stuff found by completion.
1288 i gets index in string of where to stop completing. */
b278606c 1289
f927c5ae
JB
1290 completion_string = XSTRING (completion)->data;
1291
1292 for (; i < XSTRING (completion)->size; i++)
1293 if (SYNTAX (completion_string[i]) != Sword) break;
1294 if (i < XSTRING (completion)->size)
1295 i = i + 1;
1296
1297 /* If got no characters, print help for user. */
1298
1299 if (i == ZV - BEGV)
1300 {
1301 if (auto_help)
1302 Fminibuffer_completion_help ();
1303 return Qnil;
1304 }
1305
1306 /* Otherwise insert in minibuffer the chars we got */
1307
1308 Ferase_buffer ();
3cab9ae4 1309 insert_from_string (completion, 0, i, 1);
f927c5ae
JB
1310 return Qt;
1311}
1312\f
1313DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
1314 1, 1, 0,
2dc2b736 1315 "Display the list of completions, COMPLETIONS, using `standard-output'.\n\
f927c5ae 1316Each element may be just a symbol or string\n\
2d7e41fe
RS
1317or may be a list of two strings to be printed as if concatenated.\n\
1318`standard-output' must be a buffer.\n\
1319At the end, run the normal hook `completion-setup-hook'.\n\
1320It can find the completion buffer in `standard-output'.")
f927c5ae
JB
1321 (completions)
1322 Lisp_Object completions;
1323{
1324 register Lisp_Object tail, elt;
1325 register int i;
2dc2b736 1326 int column = 0;
f927c5ae
JB
1327 /* No GCPRO needed, since (when it matters) every variable
1328 points to a non-string that is pointed to by COMPLETIONS. */
2dc2b736
RS
1329 struct buffer *old = current_buffer;
1330 if (XTYPE (Vstandard_output) == Lisp_Buffer)
1331 set_buffer_internal (XBUFFER (Vstandard_output));
f927c5ae 1332
56a98455 1333 if (NILP (completions))
cfc736bf
RS
1334 write_string ("There are no possible completions of what you have typed.",
1335 -1);
f927c5ae
JB
1336 else
1337 {
2dc2b736 1338 write_string ("Possible completions are:", -1);
56a98455 1339 for (tail = completions, i = 0; !NILP (tail); tail = Fcdr (tail), i++)
f927c5ae
JB
1340 {
1341 /* this needs fixing for the case of long completions
1342 and/or narrow windows */
1343 /* Sadly, the window it will appear in is not known
1344 until after the text has been made. */
1345 if (i & 1)
2dc2b736
RS
1346 {
1347 if (XTYPE (Vstandard_output) == Lisp_Buffer)
1348 Findent_to (make_number (35), make_number (1));
1349 else
1350 {
1351 do
1352 {
1353 write_string (" ", -1);
1354 column++;
1355 }
1356 while (column < 35);
1357 }
1358 }
f927c5ae 1359 else
2dc2b736
RS
1360 {
1361 Fterpri (Qnil);
1362 column = 0;
1363 }
f927c5ae
JB
1364 elt = Fcar (tail);
1365 if (CONSP (elt))
1366 {
2dc2b736
RS
1367 if (XTYPE (Vstandard_output) != Lisp_Buffer)
1368 {
07accdfe 1369 Lisp_Object tem;
2dc2b736
RS
1370 tem = Flength (Fcar (elt));
1371 column += XINT (tem);
1372 tem = Flength (Fcar (Fcdr (elt)));
1373 column += XINT (tem);
1374 }
f927c5ae
JB
1375 Fprinc (Fcar (elt), Qnil);
1376 Fprinc (Fcar (Fcdr (elt)), Qnil);
1377 }
1378 else
2dc2b736
RS
1379 {
1380 if (XTYPE (Vstandard_output) != Lisp_Buffer)
1381 {
1382 Lisp_Object tem;
f1b28218 1383 tem = Flength (elt);
2dc2b736
RS
1384 column += XINT (tem);
1385 }
1386 Fprinc (elt, Qnil);
1387 }
f927c5ae
JB
1388 }
1389 }
2dc2b736 1390
2d7e41fe
RS
1391 if (XTYPE (Vstandard_output) == Lisp_Buffer)
1392 set_buffer_internal (old);
1393
cfc736bf
RS
1394 if (!NILP (Vrun_hooks))
1395 call1 (Vrun_hooks, intern ("completion-setup-hook"));
1396
f927c5ae
JB
1397 return Qnil;
1398}
1399
1400DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
1401 0, 0, "",
1402 "Display a list of possible completions of the current minibuffer contents.")
1403 ()
1404{
1405 Lisp_Object completions;
1406
1407 message ("Making completion list...");
1408 completions = Fall_completions (Fbuffer_string (),
1409 Vminibuffer_completion_table,
1410 Vminibuffer_completion_predicate);
1411 echo_area_glyphs = 0;
1412
56a98455 1413 if (NILP (completions))
f927c5ae
JB
1414 {
1415 bitch_at_user ();
1416 temp_echo_area_glyphs (" [No completions]");
1417 }
1418 else
1419 internal_with_output_to_temp_buffer ("*Completions*",
1420 Fdisplay_completion_list,
1421 Fsort (completions, Qstring_lessp));
1422 return Qnil;
1423}
1424\f
1425DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
1426 "Terminate minibuffer input.")
1427 ()
1428{
1429 if (XTYPE (last_command_char) == Lisp_Int)
1430 internal_self_insert (last_command_char, 0);
1431 else
1432 bitch_at_user ();
1433
1434 Fthrow (Qexit, Qnil);
1435}
1436
1437DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
1438 "Terminate this minibuffer argument.")
1439 ()
1440{
1441 Fthrow (Qexit, Qnil);
1442}
1443
1444DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1445 "Return current depth of activations of minibuffer, a nonnegative integer.")
1446 ()
1447{
1448 return make_number (minibuf_level);
1449}
1450
1451\f
1452init_minibuf_once ()
1453{
1454 Vminibuffer_list = Qnil;
1455 staticpro (&Vminibuffer_list);
1456}
1457
1458syms_of_minibuf ()
1459{
1460 minibuf_level = 0;
1461 minibuf_prompt = 0;
1462 minibuf_save_vector_size = 5;
1463 minibuf_save_vector = (struct minibuf_save_data *) malloc (5 * sizeof (struct minibuf_save_data));
1464
719b4a40
RS
1465 Qread_file_name_internal = intern ("read-file-name-internal");
1466 staticpro (&Qread_file_name_internal);
1467
f927c5ae
JB
1468 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
1469 staticpro (&Qminibuffer_completion_table);
1470
1471 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
1472 staticpro (&Qminibuffer_completion_confirm);
1473
1474 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
1475 staticpro (&Qminibuffer_completion_predicate);
1476
1477 staticpro (&last_minibuf_string);
1478 last_minibuf_string = Qnil;
1479
1480 Quser_variable_p = intern ("user-variable-p");
1481 staticpro (&Quser_variable_p);
1482
770970cb
RS
1483 Qminibuffer_history = intern ("minibuffer-history");
1484 staticpro (&Qminibuffer_history);
f927c5ae 1485
5c781212
RS
1486 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
1487 staticpro (&Qminibuffer_setup_hook);
1488
1489 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
1490 "Normal hook run just after entry to minibuffer.");
1491 Vminibuffer_setup_hook = Qnil;
1492
f927c5ae
JB
1493 DEFVAR_BOOL ("completion-auto-help", &auto_help,
1494 "*Non-nil means automatically provide help for invalid completion input.");
1495 auto_help = 1;
1496
1497 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
1498 "Non-nil means don't consider case significant in completion.");
1499 completion_ignore_case = 0;
1500
1501 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
1502 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1503More precisely, this variable makes a difference when the minibuffer window\n\
1504is the selected window. If you are in some other window, minibuffer commands\n\
1505are allowed even if a minibuffer is active.");
1506 enable_recursive_minibuffers = 0;
1507
1508 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
1509 "Alist or obarray used for completion in the minibuffer.\n\
1510This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1511\n\
1512The value may alternatively be a function, which is given three arguments:\n\
1513 STRING, the current buffer contents;\n\
1514 PREDICATE, the predicate for filtering possible matches;\n\
1515 CODE, which says what kind of things to do.\n\
1516CODE can be nil, t or `lambda'.\n\
1517nil means to return the best completion of STRING, or nil if there is none.\n\
1518t means to return a list of all possible completions of STRING.\n\
1519`lambda' means to return t if STRING is a valid completion as it stands.");
1520 Vminibuffer_completion_table = Qnil;
1521
1522 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
1523 "Within call to `completing-read', this holds the PREDICATE argument.");
1524 Vminibuffer_completion_predicate = Qnil;
1525
1526 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
1527 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1528 Vminibuffer_completion_confirm = Qnil;
1529
1530 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
1531 "Value that `help-form' takes on inside the minibuffer.");
1532 Vminibuffer_help_form = Qnil;
1533
770970cb
RS
1534 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
1535 "History list symbol to add minibuffer values to.\n\
1536Each minibuffer output is added with\n\
1537 (set minibuffer-history-variable\n\
1538 (cons STRING (symbol-value minibuffer-history-variable)))");
1539 XFASTINT (Vminibuffer_history_variable) = 0;
1540
1541 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
1542 "Current position of redoing in the history list.");
1543 Vminibuffer_history_position = Qnil;
1544
6a9ee000
RS
1545 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
1546 "*Non-nil means entering the minibuffer raises the minibuffer's frame.");
1547 minibuffer_auto_raise = 0;
1548
f927c5ae
JB
1549 defsubr (&Sread_from_minibuffer);
1550 defsubr (&Seval_minibuffer);
1551 defsubr (&Sread_minibuffer);
1552 defsubr (&Sread_string);
1553 defsubr (&Sread_command);
1554 defsubr (&Sread_variable);
1555 defsubr (&Sread_buffer);
1556 defsubr (&Sread_no_blanks_input);
1557 defsubr (&Sminibuffer_depth);
1558
1559 defsubr (&Stry_completion);
1560 defsubr (&Sall_completions);
1561 defsubr (&Scompleting_read);
1562 defsubr (&Sminibuffer_complete);
1563 defsubr (&Sminibuffer_complete_word);
1564 defsubr (&Sminibuffer_complete_and_exit);
1565 defsubr (&Sdisplay_completion_list);
1566 defsubr (&Sminibuffer_completion_help);
1567
1568 defsubr (&Sself_insert_and_exit);
1569 defsubr (&Sexit_minibuffer);
1570
1571}
1572
1573keys_of_minibuf ()
1574{
1575 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
1576 "abort-recursive-edit");
1577 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
1578 "exit-minibuffer");
1579 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
1580 "exit-minibuffer");
1581
1582 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
1583 "abort-recursive-edit");
1584 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
1585 "exit-minibuffer");
1586 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
1587 "exit-minibuffer");
1588
1589 initial_define_key (Vminibuffer_local_ns_map, ' ',
1590 "exit-minibuffer");
1591 initial_define_key (Vminibuffer_local_ns_map, '\t',
1592 "exit-minibuffer");
1593 initial_define_key (Vminibuffer_local_ns_map, '?',
1594 "self-insert-and-exit");
1595
1596 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
1597 "abort-recursive-edit");
1598 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
1599 "exit-minibuffer");
1600 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
1601 "exit-minibuffer");
1602
1603 initial_define_key (Vminibuffer_local_completion_map, '\t',
1604 "minibuffer-complete");
1605 initial_define_key (Vminibuffer_local_completion_map, ' ',
1606 "minibuffer-complete-word");
1607 initial_define_key (Vminibuffer_local_completion_map, '?',
1608 "minibuffer-completion-help");
1609
1610 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
1611 "abort-recursive-edit");
1612 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
1613 "minibuffer-complete-and-exit");
1614 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
1615 "minibuffer-complete-and-exit");
1616 initial_define_key (Vminibuffer_local_must_match_map, '\t',
1617 "minibuffer-complete");
1618 initial_define_key (Vminibuffer_local_must_match_map, ' ',
1619 "minibuffer-complete-word");
1620 initial_define_key (Vminibuffer_local_must_match_map, '?',
1621 "minibuffer-completion-help");
1622}