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