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