]> code.delx.au - gnu-emacs/blob - src/minibuf.c
Merge from emacs--devo--0
[gnu-emacs] / src / minibuf.c
1 /* Minibuffer input and completion.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005,
4 2006, 2007 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
22
23
24 #include <config.h>
25 #include <stdio.h>
26
27 #include "lisp.h"
28 #include "commands.h"
29 #include "buffer.h"
30 #include "character.h"
31 #include "dispextern.h"
32 #include "keyboard.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "syntax.h"
36 #include "intervals.h"
37 #include "keymap.h"
38
39 extern int quit_char;
40
41 /* List of buffers for use as minibuffers.
42 The first element of the list is used for the outermost minibuffer
43 invocation, the next element is used for a recursive minibuffer
44 invocation, etc. The list is extended at the end as deeper
45 minibuffer recursions are encountered. */
46
47 Lisp_Object Vminibuffer_list;
48
49 /* Data to remember during recursive minibuffer invocations */
50
51 Lisp_Object minibuf_save_list;
52
53 /* Depth in minibuffer invocations. */
54
55 int minibuf_level;
56
57 /* Nonzero means display completion help for invalid input. */
58
59 Lisp_Object Vcompletion_auto_help;
60
61 /* The maximum length of a minibuffer history. */
62
63 Lisp_Object Qhistory_length, Vhistory_length;
64
65 /* No duplicates in history. */
66
67 int history_delete_duplicates;
68
69 /* Non-nil means add new input to history. */
70
71 Lisp_Object Vhistory_add_new_input;
72
73 /* Fread_minibuffer leaves the input here as a string. */
74
75 Lisp_Object last_minibuf_string;
76
77 /* Nonzero means let functions called when within a minibuffer
78 invoke recursive minibuffers (to read arguments, or whatever) */
79
80 int enable_recursive_minibuffers;
81
82 /* Nonzero means don't ignore text properties
83 in Fread_from_minibuffer. */
84
85 int minibuffer_allow_text_properties;
86
87 /* help-form is bound to this while in the minibuffer. */
88
89 Lisp_Object Vminibuffer_help_form;
90
91 /* Variable which is the history list to add minibuffer values to. */
92
93 Lisp_Object Vminibuffer_history_variable;
94
95 /* Current position in the history list (adjusted by M-n and M-p). */
96
97 Lisp_Object Vminibuffer_history_position;
98
99 /* Text properties that are added to minibuffer prompts.
100 These are in addition to the basic `field' property, and stickiness
101 properties. */
102
103 Lisp_Object Vminibuffer_prompt_properties;
104
105 Lisp_Object Qminibuffer_history, Qbuffer_name_history;
106
107 Lisp_Object Qread_file_name_internal;
108
109 /* Normal hooks for entry to and exit from minibuffer. */
110
111 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
112 Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
113
114 /* Function to call to read a buffer name. */
115 Lisp_Object Vread_buffer_function;
116
117 /* Nonzero means completion ignores case. */
118
119 int completion_ignore_case;
120
121 /* List of regexps that should restrict possible completions. */
122
123 Lisp_Object Vcompletion_regexp_list;
124
125 /* Nonzero means raise the minibuffer frame when the minibuffer
126 is entered. */
127
128 int minibuffer_auto_raise;
129
130 /* If last completion attempt reported "Complete but not unique"
131 then this is the string completed then; otherwise this is nil. */
132
133 static Lisp_Object last_exact_completion;
134
135 /* Keymap for reading expressions. */
136 Lisp_Object Vread_expression_map;
137
138 Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
139 Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
140 Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
141 Lisp_Object Vminibuffer_completing_file_name;
142
143 Lisp_Object Quser_variable_p;
144
145 Lisp_Object Qminibuffer_default;
146
147 Lisp_Object Qcurrent_input_method, Qactivate_input_method;
148
149 Lisp_Object Qcase_fold_search;
150
151 Lisp_Object Qread_expression_history;
152
153 extern Lisp_Object Voverriding_local_map;
154
155 extern Lisp_Object Qmouse_face;
156
157 extern Lisp_Object Qfield;
158 \f
159 /* Put minibuf on currently selected frame's minibuffer.
160 We do this whenever the user starts a new minibuffer
161 or when a minibuffer exits. */
162
163 void
164 choose_minibuf_frame ()
165 {
166 if (FRAMEP (selected_frame)
167 && FRAME_LIVE_P (XFRAME (selected_frame))
168 && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
169 {
170 struct frame *sf = XFRAME (selected_frame);
171 Lisp_Object buffer;
172
173 /* I don't think that any frames may validly have a null minibuffer
174 window anymore. */
175 if (NILP (sf->minibuffer_window))
176 abort ();
177
178 /* Under X, we come here with minibuf_window being the
179 minibuffer window of the unused termcap window created in
180 init_window_once. That window doesn't have a buffer. */
181 buffer = XWINDOW (minibuf_window)->buffer;
182 if (BUFFERP (buffer))
183 Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
184 minibuf_window = sf->minibuffer_window;
185 }
186
187 /* Make sure no other frame has a minibuffer as its selected window,
188 because the text would not be displayed in it, and that would be
189 confusing. Only allow the selected frame to do this,
190 and that only if the minibuffer is active. */
191 {
192 Lisp_Object tail, frame;
193
194 FOR_EACH_FRAME (tail, frame)
195 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
196 && !(EQ (frame, selected_frame)
197 && minibuf_level > 0))
198 Fset_frame_selected_window (frame, Fframe_first_window (frame));
199 }
200 }
201
202 Lisp_Object
203 choose_minibuf_frame_1 (ignore)
204 Lisp_Object ignore;
205 {
206 choose_minibuf_frame ();
207 return Qnil;
208 }
209
210 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
211 Sset_minibuffer_window, 1, 1, 0,
212 doc: /* Specify which minibuffer window to use for the minibuffer.
213 This affects where the minibuffer is displayed if you put text in it
214 without invoking the usual minibuffer commands. */)
215 (window)
216 Lisp_Object window;
217 {
218 CHECK_WINDOW (window);
219 if (! MINI_WINDOW_P (XWINDOW (window)))
220 error ("Window is not a minibuffer window");
221
222 minibuf_window = window;
223
224 return window;
225 }
226
227 \f
228 /* Actual minibuffer invocation. */
229
230 static Lisp_Object read_minibuf_unwind P_ ((Lisp_Object));
231 static Lisp_Object run_exit_minibuf_hook P_ ((Lisp_Object));
232 static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object,
233 Lisp_Object, Lisp_Object,
234 int, Lisp_Object,
235 Lisp_Object, Lisp_Object,
236 int, int));
237 static Lisp_Object read_minibuf_noninteractive P_ ((Lisp_Object, Lisp_Object,
238 Lisp_Object, Lisp_Object,
239 int, Lisp_Object,
240 Lisp_Object, Lisp_Object,
241 int, int));
242 static Lisp_Object string_to_object P_ ((Lisp_Object, Lisp_Object));
243
244
245 /* Read a Lisp object from VAL and return it. If VAL is an empty
246 string, and DEFALT is a string, read from DEFALT instead of VAL. */
247
248 static Lisp_Object
249 string_to_object (val, defalt)
250 Lisp_Object val, defalt;
251 {
252 struct gcpro gcpro1, gcpro2;
253 Lisp_Object expr_and_pos;
254 int pos;
255
256 GCPRO2 (val, defalt);
257
258 if (STRINGP (val) && SCHARS (val) == 0
259 && STRINGP (defalt))
260 val = defalt;
261
262 expr_and_pos = Fread_from_string (val, Qnil, Qnil);
263 pos = XINT (Fcdr (expr_and_pos));
264 if (pos != SCHARS (val))
265 {
266 /* Ignore trailing whitespace; any other trailing junk
267 is an error. */
268 int i;
269 pos = string_char_to_byte (val, pos);
270 for (i = pos; i < SBYTES (val); i++)
271 {
272 int c = SREF (val, i);
273 if (c != ' ' && c != '\t' && c != '\n')
274 error ("Trailing garbage following expression");
275 }
276 }
277
278 val = Fcar (expr_and_pos);
279 RETURN_UNGCPRO (val);
280 }
281
282
283 /* Like read_minibuf but reading from stdin. This function is called
284 from read_minibuf to do the job if noninteractive. */
285
286 static Lisp_Object
287 read_minibuf_noninteractive (map, initial, prompt, backup_n, expflag,
288 histvar, histpos, defalt, allow_props,
289 inherit_input_method)
290 Lisp_Object map;
291 Lisp_Object initial;
292 Lisp_Object prompt;
293 Lisp_Object backup_n;
294 int expflag;
295 Lisp_Object histvar;
296 Lisp_Object histpos;
297 Lisp_Object defalt;
298 int allow_props;
299 int inherit_input_method;
300 {
301 int size, len;
302 char *line, *s;
303 Lisp_Object val;
304
305 fprintf (stdout, "%s", SDATA (prompt));
306 fflush (stdout);
307
308 val = Qnil;
309 size = 100;
310 len = 0;
311 line = (char *) xmalloc (size * sizeof *line);
312 while ((s = fgets (line + len, size - len, stdin)) != NULL
313 && (len = strlen (line),
314 len == size - 1 && line[len - 1] != '\n'))
315 {
316 size *= 2;
317 line = (char *) xrealloc (line, size);
318 }
319
320 if (s)
321 {
322 len = strlen (line);
323
324 if (len > 0 && line[len - 1] == '\n')
325 line[--len] = '\0';
326
327 val = build_string (line);
328 xfree (line);
329 }
330 else
331 {
332 xfree (line);
333 error ("Error reading from stdin");
334 }
335
336 /* If Lisp form desired instead of string, parse it. */
337 if (expflag)
338 val = string_to_object (val, defalt);
339
340 return val;
341 }
342 \f
343 DEFUN ("minibufferp", Fminibufferp,
344 Sminibufferp, 0, 1, 0,
345 doc: /* Return t if BUFFER is a minibuffer.
346 No argument or nil as argument means use current buffer as BUFFER.
347 BUFFER can be a buffer or a buffer name. */)
348 (buffer)
349 Lisp_Object buffer;
350 {
351 Lisp_Object tem;
352
353 if (NILP (buffer))
354 buffer = Fcurrent_buffer ();
355 else if (STRINGP (buffer))
356 buffer = Fget_buffer (buffer);
357 else
358 CHECK_BUFFER (buffer);
359
360 tem = Fmemq (buffer, Vminibuffer_list);
361 return ! NILP (tem) ? Qt : Qnil;
362 }
363
364 DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
365 Sminibuffer_prompt_end, 0, 0, 0,
366 doc: /* Return the buffer position of the end of the minibuffer prompt.
367 Return (point-min) if current buffer is not a minibuffer. */)
368 ()
369 {
370 /* This function is written to be most efficient when there's a prompt. */
371 Lisp_Object beg, end, tem;
372 beg = make_number (BEGV);
373
374 tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list);
375 if (NILP (tem))
376 return beg;
377
378 end = Ffield_end (beg, Qnil, Qnil);
379
380 if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil)))
381 return beg;
382 else
383 return end;
384 }
385
386 DEFUN ("minibuffer-contents", Fminibuffer_contents,
387 Sminibuffer_contents, 0, 0, 0,
388 doc: /* Return the user input in a minibuffer as a string.
389 If the current buffer is not a minibuffer, return its entire contents. */)
390 ()
391 {
392 int prompt_end = XINT (Fminibuffer_prompt_end ());
393 return make_buffer_string (prompt_end, ZV, 1);
394 }
395
396 DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties,
397 Sminibuffer_contents_no_properties, 0, 0, 0,
398 doc: /* Return the user input in a minibuffer as a string, without text-properties.
399 If the current buffer is not a minibuffer, return its entire contents. */)
400 ()
401 {
402 int prompt_end = XINT (Fminibuffer_prompt_end ());
403 return make_buffer_string (prompt_end, ZV, 0);
404 }
405
406 DEFUN ("minibuffer-completion-contents", Fminibuffer_completion_contents,
407 Sminibuffer_completion_contents, 0, 0, 0,
408 doc: /* Return the user input in a minibuffer before point as a string.
409 That is what completion commands operate on.
410 If the current buffer is not a minibuffer, return its entire contents. */)
411 ()
412 {
413 int prompt_end = XINT (Fminibuffer_prompt_end ());
414 if (PT < prompt_end)
415 error ("Cannot do completion in the prompt");
416 return make_buffer_string (prompt_end, PT, 1);
417 }
418
419 DEFUN ("delete-minibuffer-contents", Fdelete_minibuffer_contents,
420 Sdelete_minibuffer_contents, 0, 0, 0,
421 doc: /* Delete all user input in a minibuffer.
422 If the current buffer is not a minibuffer, erase its entire contents. */)
423 ()
424 {
425 int prompt_end = XINT (Fminibuffer_prompt_end ());
426 if (prompt_end < ZV)
427 del_range (prompt_end, ZV);
428 return Qnil;
429 }
430
431 \f
432 /* Read from the minibuffer using keymap MAP and initial contents INITIAL,
433 putting point minus BACKUP_N bytes from the end of INITIAL,
434 prompting with PROMPT (a string), using history list HISTVAR
435 with initial position HISTPOS. INITIAL should be a string or a
436 cons of a string and an integer. BACKUP_N should be <= 0, or
437 Qnil, which is equivalent to 0. If INITIAL is a cons, BACKUP_N is
438 ignored and replaced with an integer that puts point at one-indexed
439 position N in INITIAL, where N is the CDR of INITIAL, or at the
440 beginning of INITIAL if N <= 0.
441
442 Normally return the result as a string (the text that was read),
443 but if EXPFLAG is nonzero, read it and return the object read.
444 If HISTVAR is given, save the value read on that history only if it doesn't
445 match the front of that history list exactly. The value is pushed onto
446 the list as the string that was read.
447
448 DEFALT specifies the default value for the sake of history commands.
449
450 If ALLOW_PROPS is nonzero, we do not throw away text properties.
451
452 if INHERIT_INPUT_METHOD is nonzero, the minibuffer inherits the
453 current input method. */
454
455 static Lisp_Object
456 read_minibuf (map, initial, prompt, backup_n, expflag,
457 histvar, histpos, defalt, allow_props, inherit_input_method)
458 Lisp_Object map;
459 Lisp_Object initial;
460 Lisp_Object prompt;
461 Lisp_Object backup_n;
462 int expflag;
463 Lisp_Object histvar;
464 Lisp_Object histpos;
465 Lisp_Object defalt;
466 int allow_props;
467 int inherit_input_method;
468 {
469 Lisp_Object val;
470 int count = SPECPDL_INDEX ();
471 Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
472 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
473 Lisp_Object enable_multibyte;
474 int pos = INTEGERP (backup_n) ? XINT (backup_n) : 0;
475 /* String to add to the history. */
476 Lisp_Object histstring;
477
478 Lisp_Object empty_minibuf;
479 Lisp_Object dummy, frame;
480
481 extern Lisp_Object Qfront_sticky;
482 extern Lisp_Object Qrear_nonsticky;
483
484 specbind (Qminibuffer_default, defalt);
485
486 /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
487 in previous recursive minibuffer, but was not set explicitly
488 to t for this invocation, so set it to nil in this minibuffer.
489 Save the old value now, before we change it. */
490 specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name);
491 if (EQ (Vminibuffer_completing_file_name, Qlambda))
492 Vminibuffer_completing_file_name = Qnil;
493
494 single_kboard_state ();
495 #ifdef HAVE_X_WINDOWS
496 if (display_hourglass_p)
497 cancel_hourglass ();
498 #endif
499
500 if (!NILP (initial))
501 {
502 if (CONSP (initial))
503 {
504 backup_n = Fcdr (initial);
505 initial = Fcar (initial);
506 CHECK_STRING (initial);
507 if (!NILP (backup_n))
508 {
509 CHECK_NUMBER (backup_n);
510 /* Convert to distance from end of input. */
511 if (XINT (backup_n) < 1)
512 /* A number too small means the beginning of the string. */
513 pos = - SCHARS (initial);
514 else
515 pos = XINT (backup_n) - 1 - SCHARS (initial);
516 }
517 }
518 else
519 CHECK_STRING (initial);
520 }
521 val = Qnil;
522 ambient_dir = current_buffer->directory;
523 input_method = Qnil;
524 enable_multibyte = Qnil;
525
526 /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
527 store them away before we can GC. Don't need to protect
528 BACKUP_N because we use the value only if it is an integer. */
529 GCPRO5 (map, initial, val, ambient_dir, input_method);
530
531 if (!STRINGP (prompt))
532 prompt = empty_unibyte_string;
533
534 if (!enable_recursive_minibuffers
535 && minibuf_level > 0)
536 {
537 if (EQ (selected_window, minibuf_window))
538 error ("Command attempted to use minibuffer while in minibuffer");
539 else
540 /* If we're in another window, cancel the minibuffer that's active. */
541 Fthrow (Qexit,
542 build_string ("Command attempted to use minibuffer while in minibuffer"));
543 }
544
545 if (noninteractive && NILP (Vexecuting_kbd_macro))
546 {
547 val = read_minibuf_noninteractive (map, initial, prompt,
548 make_number (pos),
549 expflag, histvar, histpos, defalt,
550 allow_props, inherit_input_method);
551 UNGCPRO;
552 return unbind_to (count, val);
553 }
554
555 /* Choose the minibuffer window and frame, and take action on them. */
556
557 choose_minibuf_frame ();
558
559 record_unwind_protect (choose_minibuf_frame_1, Qnil);
560
561 record_unwind_protect (Fset_window_configuration,
562 Fcurrent_window_configuration (Qnil));
563
564 /* If the minibuffer window is on a different frame, save that
565 frame's configuration too. */
566 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
567 if (!EQ (mini_frame, selected_frame))
568 record_unwind_protect (Fset_window_configuration,
569 Fcurrent_window_configuration (mini_frame));
570
571 /* If the minibuffer is on an iconified or invisible frame,
572 make it visible now. */
573 Fmake_frame_visible (mini_frame);
574
575 if (minibuffer_auto_raise)
576 Fraise_frame (mini_frame);
577
578 /* We have to do this after saving the window configuration
579 since that is what restores the current buffer. */
580
581 /* Arrange to restore a number of minibuffer-related variables.
582 We could bind each variable separately, but that would use lots of
583 specpdl slots. */
584 minibuf_save_list
585 = Fcons (Voverriding_local_map,
586 Fcons (minibuf_window,
587 minibuf_save_list));
588 minibuf_save_list
589 = Fcons (minibuf_prompt,
590 Fcons (make_number (minibuf_prompt_width),
591 Fcons (Vhelp_form,
592 Fcons (Vcurrent_prefix_arg,
593 Fcons (Vminibuffer_history_position,
594 Fcons (Vminibuffer_history_variable,
595 minibuf_save_list))))));
596
597 record_unwind_protect (read_minibuf_unwind, Qnil);
598 minibuf_level++;
599 /* We are exiting the minibuffer one way or the other, so run the hook.
600 It should be run before unwinding the minibuf settings. Do it
601 separately from read_minibuf_unwind because we need to make sure that
602 read_minibuf_unwind is fully executed even if exit-minibuffer-hook
603 signals an error. --Stef */
604 record_unwind_protect (run_exit_minibuf_hook, Qnil);
605
606 /* Now that we can restore all those variables, start changing them. */
607
608 minibuf_prompt_width = 0;
609 minibuf_prompt = Fcopy_sequence (prompt);
610 Vminibuffer_history_position = histpos;
611 Vminibuffer_history_variable = histvar;
612 Vhelp_form = Vminibuffer_help_form;
613 /* If this minibuffer is reading a file name, that doesn't mean
614 recursive ones are. But we cannot set it to nil, because
615 completion code still need to know the minibuffer is completing a
616 file name. So use `lambda' as intermediate value meaning
617 "t" in this minibuffer, but "nil" in next minibuffer. */
618 if (!NILP (Vminibuffer_completing_file_name))
619 Vminibuffer_completing_file_name = Qlambda;
620
621 if (inherit_input_method)
622 {
623 /* `current-input-method' is buffer local. So, remember it in
624 INPUT_METHOD before changing the current buffer. */
625 input_method = Fsymbol_value (Qcurrent_input_method);
626 enable_multibyte = current_buffer->enable_multibyte_characters;
627 }
628
629 /* Switch to the minibuffer. */
630
631 minibuffer = get_minibuffer (minibuf_level);
632 Fset_buffer (minibuffer);
633
634 /* If appropriate, copy enable-multibyte-characters into the minibuffer. */
635 if (inherit_input_method)
636 current_buffer->enable_multibyte_characters = enable_multibyte;
637
638 /* The current buffer's default directory is usually the right thing
639 for our minibuffer here. However, if you're typing a command at
640 a minibuffer-only frame when minibuf_level is zero, then buf IS
641 the current_buffer, so reset_buffer leaves buf's default
642 directory unchanged. This is a bummer when you've just started
643 up Emacs and buf's default directory is Qnil. Here's a hack; can
644 you think of something better to do? Find another buffer with a
645 better directory, and use that one instead. */
646 if (STRINGP (ambient_dir))
647 current_buffer->directory = ambient_dir;
648 else
649 {
650 Lisp_Object buf_list;
651
652 for (buf_list = Vbuffer_alist;
653 CONSP (buf_list);
654 buf_list = XCDR (buf_list))
655 {
656 Lisp_Object other_buf;
657
658 other_buf = XCDR (XCAR (buf_list));
659 if (STRINGP (XBUFFER (other_buf)->directory))
660 {
661 current_buffer->directory = XBUFFER (other_buf)->directory;
662 break;
663 }
664 }
665 }
666
667 if (!EQ (mini_frame, selected_frame))
668 Fredirect_frame_focus (selected_frame, mini_frame);
669
670 Vminibuf_scroll_window = selected_window;
671 if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
672 minibuf_selected_window = selected_window;
673
674 /* Empty out the minibuffers of all frames other than the one
675 where we are going to display one now.
676 Set them to point to ` *Minibuf-0*', which is always empty. */
677 empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*"));
678
679 FOR_EACH_FRAME (dummy, frame)
680 {
681 Lisp_Object root_window = Fframe_root_window (frame);
682 Lisp_Object mini_window = XWINDOW (root_window)->next;
683
684 if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
685 && !NILP (Fwindow_minibuffer_p (mini_window)))
686 Fset_window_buffer (mini_window, empty_minibuf, Qnil);
687 }
688
689 /* Display this minibuffer in the proper window. */
690 Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
691 Fselect_window (minibuf_window, Qnil);
692 XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
693
694 Fmake_local_variable (Qprint_escape_newlines);
695 print_escape_newlines = 1;
696
697 /* Erase the buffer. */
698 {
699 int count1 = SPECPDL_INDEX ();
700 specbind (Qinhibit_read_only, Qt);
701 specbind (Qinhibit_modification_hooks, Qt);
702 Ferase_buffer ();
703
704 if (!NILP (current_buffer->enable_multibyte_characters)
705 && ! STRING_MULTIBYTE (minibuf_prompt))
706 minibuf_prompt = Fstring_make_multibyte (minibuf_prompt);
707
708 /* Insert the prompt, record where it ends. */
709 Finsert (1, &minibuf_prompt);
710 if (PT > BEG)
711 {
712 Fput_text_property (make_number (BEG), make_number (PT),
713 Qfront_sticky, Qt, Qnil);
714 Fput_text_property (make_number (BEG), make_number (PT),
715 Qrear_nonsticky, Qt, Qnil);
716 Fput_text_property (make_number (BEG), make_number (PT),
717 Qfield, Qt, Qnil);
718 Fadd_text_properties (make_number (BEG), make_number (PT),
719 Vminibuffer_prompt_properties, Qnil);
720 }
721 unbind_to (count1, Qnil);
722 }
723
724 minibuf_prompt_width = (int) current_column (); /* iftc */
725
726 /* Put in the initial input. */
727 if (!NILP (initial))
728 {
729 Finsert (1, &initial);
730 Fforward_char (make_number (pos));
731 }
732
733 clear_message (1, 1);
734 current_buffer->keymap = map;
735
736 /* Turn on an input method stored in INPUT_METHOD if any. */
737 if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
738 call1 (Qactivate_input_method, input_method);
739
740 /* Run our hook, but not if it is empty.
741 (run-hooks would do nothing if it is empty,
742 but it's important to save time here in the usual case.) */
743 if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound)
744 && !NILP (Vrun_hooks))
745 call1 (Vrun_hooks, Qminibuffer_setup_hook);
746
747 /* Don't allow the user to undo past this point. */
748 current_buffer->undo_list = Qnil;
749
750 recursive_edit_1 ();
751
752 /* If cursor is on the minibuffer line,
753 show the user we have exited by putting it in column 0. */
754 if (XWINDOW (minibuf_window)->cursor.vpos >= 0
755 && !noninteractive)
756 {
757 XWINDOW (minibuf_window)->cursor.hpos = 0;
758 XWINDOW (minibuf_window)->cursor.x = 0;
759 XWINDOW (minibuf_window)->must_be_updated_p = 1;
760 update_frame (XFRAME (selected_frame), 1, 1);
761 if (rif && rif->flush_display)
762 rif->flush_display (XFRAME (XWINDOW (minibuf_window)->frame));
763 }
764
765 /* Make minibuffer contents into a string. */
766 Fset_buffer (minibuffer);
767 if (allow_props)
768 val = Fminibuffer_contents ();
769 else
770 val = Fminibuffer_contents_no_properties ();
771
772 /* VAL is the string of minibuffer text. */
773
774 last_minibuf_string = val;
775
776 /* Choose the string to add to the history. */
777 if (SCHARS (val) != 0)
778 histstring = val;
779 else if (STRINGP (defalt))
780 histstring = defalt;
781 else
782 histstring = Qnil;
783
784 /* Add the value to the appropriate history list, if any. */
785 if (!NILP (Vhistory_add_new_input)
786 && SYMBOLP (Vminibuffer_history_variable)
787 && !NILP (histstring))
788 {
789 /* If the caller wanted to save the value read on a history list,
790 then do so if the value is not already the front of the list. */
791 Lisp_Object histval;
792
793 /* If variable is unbound, make it nil. */
794 if (EQ (SYMBOL_VALUE (Vminibuffer_history_variable), Qunbound))
795 Fset (Vminibuffer_history_variable, Qnil);
796
797 histval = Fsymbol_value (Vminibuffer_history_variable);
798
799 /* The value of the history variable must be a cons or nil. Other
800 values are unacceptable. We silently ignore these values. */
801
802 if (NILP (histval)
803 || (CONSP (histval)
804 /* Don't duplicate the most recent entry in the history. */
805 && (NILP (Fequal (histstring, Fcar (histval))))))
806 {
807 Lisp_Object length;
808
809 if (history_delete_duplicates) Fdelete (histstring, histval);
810 histval = Fcons (histstring, histval);
811 Fset (Vminibuffer_history_variable, histval);
812
813 /* Truncate if requested. */
814 length = Fget (Vminibuffer_history_variable, Qhistory_length);
815 if (NILP (length)) length = Vhistory_length;
816 if (INTEGERP (length))
817 {
818 if (XINT (length) <= 0)
819 Fset (Vminibuffer_history_variable, Qnil);
820 else
821 {
822 Lisp_Object temp;
823
824 temp = Fnthcdr (Fsub1 (length), histval);
825 if (CONSP (temp)) Fsetcdr (temp, Qnil);
826 }
827 }
828 }
829 }
830
831 /* If Lisp form desired instead of string, parse it. */
832 if (expflag)
833 val = string_to_object (val, defalt);
834
835 /* The appropriate frame will get selected
836 in set-window-configuration. */
837 UNGCPRO;
838 return unbind_to (count, val);
839 }
840
841 /* Return a buffer to be used as the minibuffer at depth `depth'.
842 depth = 0 is the lowest allowed argument, and that is the value
843 used for nonrecursive minibuffer invocations */
844
845 Lisp_Object
846 get_minibuffer (depth)
847 int depth;
848 {
849 Lisp_Object tail, num, buf;
850 char name[24];
851 extern Lisp_Object nconc2 ();
852
853 XSETFASTINT (num, depth);
854 tail = Fnthcdr (num, Vminibuffer_list);
855 if (NILP (tail))
856 {
857 tail = Fcons (Qnil, Qnil);
858 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
859 }
860 buf = Fcar (tail);
861 if (NILP (buf) || NILP (XBUFFER (buf)->name))
862 {
863 sprintf (name, " *Minibuf-%d*", depth);
864 buf = Fget_buffer_create (build_string (name));
865
866 /* Although the buffer's name starts with a space, undo should be
867 enabled in it. */
868 Fbuffer_enable_undo (buf);
869
870 XSETCAR (tail, buf);
871 }
872 else
873 {
874 int count = SPECPDL_INDEX ();
875 /* `reset_buffer' blindly sets the list of overlays to NULL, so we
876 have to empty the list, otherwise we end up with overlays that
877 think they belong to this buffer while the buffer doesn't know about
878 them any more. */
879 delete_all_overlays (XBUFFER (buf));
880 reset_buffer (XBUFFER (buf));
881 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
882 Fset_buffer (buf);
883 Fkill_all_local_variables ();
884 unbind_to (count, Qnil);
885 }
886
887 return buf;
888 }
889
890 static Lisp_Object
891 run_exit_minibuf_hook (data)
892 Lisp_Object data;
893 {
894 if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
895 && !NILP (Vrun_hooks))
896 safe_run_hooks (Qminibuffer_exit_hook);
897
898 return Qnil;
899 }
900
901 /* This function is called on exiting minibuffer, whether normally or
902 not, and it restores the current window, buffer, etc. */
903
904 static Lisp_Object
905 read_minibuf_unwind (data)
906 Lisp_Object data;
907 {
908 Lisp_Object old_deactivate_mark;
909 Lisp_Object window;
910
911 /* If this was a recursive minibuffer,
912 tie the minibuffer window back to the outer level minibuffer buffer. */
913 minibuf_level--;
914
915 window = minibuf_window;
916 /* To keep things predictable, in case it matters, let's be in the
917 minibuffer when we reset the relevant variables. */
918 Fset_buffer (XWINDOW (window)->buffer);
919
920 /* Restore prompt, etc, from outer minibuffer level. */
921 minibuf_prompt = Fcar (minibuf_save_list);
922 minibuf_save_list = Fcdr (minibuf_save_list);
923 minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
924 minibuf_save_list = Fcdr (minibuf_save_list);
925 Vhelp_form = Fcar (minibuf_save_list);
926 minibuf_save_list = Fcdr (minibuf_save_list);
927 Vcurrent_prefix_arg = Fcar (minibuf_save_list);
928 minibuf_save_list = Fcdr (minibuf_save_list);
929 Vminibuffer_history_position = Fcar (minibuf_save_list);
930 minibuf_save_list = Fcdr (minibuf_save_list);
931 Vminibuffer_history_variable = Fcar (minibuf_save_list);
932 minibuf_save_list = Fcdr (minibuf_save_list);
933 Voverriding_local_map = Fcar (minibuf_save_list);
934 minibuf_save_list = Fcdr (minibuf_save_list);
935 #if 0
936 temp = Fcar (minibuf_save_list);
937 if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
938 minibuf_window = temp;
939 #endif
940 minibuf_save_list = Fcdr (minibuf_save_list);
941
942 /* Erase the minibuffer we were using at this level. */
943 {
944 int count = SPECPDL_INDEX ();
945 /* Prevent error in erase-buffer. */
946 specbind (Qinhibit_read_only, Qt);
947 specbind (Qinhibit_modification_hooks, Qt);
948 old_deactivate_mark = Vdeactivate_mark;
949 Ferase_buffer ();
950 Vdeactivate_mark = old_deactivate_mark;
951 unbind_to (count, Qnil);
952 }
953
954 /* When we get to the outmost level, make sure we resize the
955 mini-window back to its normal size. */
956 if (minibuf_level == 0)
957 resize_mini_window (XWINDOW (window), 0);
958
959 /* Make sure minibuffer window is erased, not ignored. */
960 windows_or_buffers_changed++;
961 XSETFASTINT (XWINDOW (window)->last_modified, 0);
962 XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
963 return Qnil;
964 }
965 \f
966
967 DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 7, 0,
968 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
969 The optional second arg INITIAL-CONTENTS is an obsolete alternative to
970 DEFAULT-VALUE. It normally should be nil in new code, except when
971 HIST is a cons. It is discussed in more detail below.
972 Third arg KEYMAP is a keymap to use whilst reading;
973 if omitted or nil, the default is `minibuffer-local-map'.
974 If fourth arg READ is non-nil, then interpret the result as a Lisp object
975 and return that object:
976 in other words, do `(car (read-from-string INPUT-STRING))'
977 Fifth arg HIST, if non-nil, specifies a history list and optionally
978 the initial position in the list. It can be a symbol, which is the
979 history list variable to use, or it can be a cons cell
980 (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable
981 to use, and HISTPOS is the initial position for use by the minibuffer
982 history commands. For consistency, you should also specify that
983 element of the history as the value of INITIAL-CONTENTS. Positions
984 are counted starting from 1 at the beginning of the list.
985 Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is available
986 for history commands; but, unless READ is non-nil, `read-from-minibuffer'
987 does NOT return DEFAULT-VALUE if the user enters empty input! It returns
988 the empty string.
989 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
990 the current input method and the setting of `enable-multibyte-characters'.
991 If the variable `minibuffer-allow-text-properties' is non-nil,
992 then the string which is returned includes whatever text properties
993 were present in the minibuffer. Otherwise the value has no text properties.
994
995 The remainder of this documentation string describes the
996 INITIAL-CONTENTS argument in more detail. It is only relevant when
997 studying existing code, or when HIST is a cons. If non-nil,
998 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
999 reading input. Normally, point is put at the end of that string.
1000 However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial
1001 input is STRING, but point is placed at _one-indexed_ position
1002 POSITION in the minibuffer. Any integer value less than or equal to
1003 one puts point at the beginning of the string. *Note* that this
1004 behavior differs from the way such arguments are used in `completing-read'
1005 and some related functions, which use zero-indexing for POSITION. */)
1006 (prompt, initial_contents, keymap, read, hist, default_value, inherit_input_method)
1007 Lisp_Object prompt, initial_contents, keymap, read, hist, default_value;
1008 Lisp_Object inherit_input_method;
1009 {
1010 Lisp_Object histvar, histpos, val;
1011 struct gcpro gcpro1;
1012
1013 CHECK_STRING (prompt);
1014 if (NILP (keymap))
1015 keymap = Vminibuffer_local_map;
1016 else
1017 keymap = get_keymap (keymap, 1, 0);
1018
1019 if (SYMBOLP (hist))
1020 {
1021 histvar = hist;
1022 histpos = Qnil;
1023 }
1024 else
1025 {
1026 histvar = Fcar_safe (hist);
1027 histpos = Fcdr_safe (hist);
1028 }
1029 if (NILP (histvar))
1030 histvar = Qminibuffer_history;
1031 if (NILP (histpos))
1032 XSETFASTINT (histpos, 0);
1033
1034 GCPRO1 (default_value);
1035 val = read_minibuf (keymap, initial_contents, prompt,
1036 Qnil, !NILP (read),
1037 histvar, histpos, default_value,
1038 minibuffer_allow_text_properties,
1039 !NILP (inherit_input_method));
1040 UNGCPRO;
1041 return val;
1042 }
1043
1044 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
1045 doc: /* Return a Lisp object read using the minibuffer, unevaluated.
1046 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1047 is a string to insert in the minibuffer before reading.
1048 \(INITIAL-CONTENTS can also be a cons of a string and an integer. Such
1049 arguments are used as in `read-from-minibuffer'.) */)
1050 (prompt, initial_contents)
1051 Lisp_Object prompt, initial_contents;
1052 {
1053 CHECK_STRING (prompt);
1054 return read_minibuf (Vminibuffer_local_map, initial_contents,
1055 prompt, Qnil, 1, Qminibuffer_history,
1056 make_number (0), Qnil, 0, 0);
1057 }
1058
1059 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
1060 doc: /* Return value of Lisp expression read using the minibuffer.
1061 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1062 is a string to insert in the minibuffer before reading.
1063 \(INITIAL-CONTENTS can also be a cons of a string and an integer. Such
1064 arguments are used as in `read-from-minibuffer'.) */)
1065 (prompt, initial_contents)
1066 Lisp_Object prompt, initial_contents;
1067 {
1068 return Feval (read_minibuf (Vread_expression_map, initial_contents,
1069 prompt, Qnil, 1, Qread_expression_history,
1070 make_number (0), Qnil, 0, 0));
1071 }
1072
1073 /* Functions that use the minibuffer to read various things. */
1074
1075 DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
1076 doc: /* Read a string from the minibuffer, prompting with string PROMPT.
1077 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
1078 This argument has been superseded by DEFAULT-VALUE and should normally
1079 be nil in new code. It behaves as in `read-from-minibuffer'. See the
1080 documentation string of that function for details.
1081 The third arg HISTORY, if non-nil, specifies a history list
1082 and optionally the initial position in the list.
1083 See `read-from-minibuffer' for details of HISTORY argument.
1084 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1085 for history commands, and as the value to return if the user enters
1086 the empty string.
1087 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1088 the current input method and the setting of `enable-multibyte-characters'. */)
1089 (prompt, initial_input, history, default_value, inherit_input_method)
1090 Lisp_Object prompt, initial_input, history, default_value;
1091 Lisp_Object inherit_input_method;
1092 {
1093 Lisp_Object val;
1094 val = Fread_from_minibuffer (prompt, initial_input, Qnil,
1095 Qnil, history, default_value,
1096 inherit_input_method);
1097 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
1098 val = default_value;
1099 return val;
1100 }
1101
1102 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
1103 doc: /* Read a string from the terminal, not allowing blanks.
1104 Prompt with PROMPT. Whitespace terminates the input. If INITIAL is
1105 non-nil, it should be a string, which is used as initial input, with
1106 point positioned at the end, so that SPACE will accept the input.
1107 \(Actually, INITIAL can also be a cons of a string and an integer.
1108 Such values are treated as in `read-from-minibuffer', but are normally
1109 not useful in this function.)
1110 Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1111 the current input method and the setting of`enable-multibyte-characters'. */)
1112 (prompt, initial, inherit_input_method)
1113 Lisp_Object prompt, initial, inherit_input_method;
1114 {
1115 CHECK_STRING (prompt);
1116 return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
1117 0, Qminibuffer_history, make_number (0), Qnil, 0,
1118 !NILP (inherit_input_method));
1119 }
1120
1121 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
1122 doc: /* Read the name of a command and return as a symbol.
1123 Prompt with PROMPT. By default, return DEFAULT-VALUE. */)
1124 (prompt, default_value)
1125 Lisp_Object prompt, default_value;
1126 {
1127 Lisp_Object name, default_string;
1128
1129 if (NILP (default_value))
1130 default_string = Qnil;
1131 else if (SYMBOLP (default_value))
1132 default_string = SYMBOL_NAME (default_value);
1133 else
1134 default_string = default_value;
1135
1136 name = Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
1137 Qnil, Qnil, default_string, Qnil);
1138 if (NILP (name))
1139 return name;
1140 return Fintern (name, Qnil);
1141 }
1142
1143 #ifdef NOTDEF
1144 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
1145 doc: /* One arg PROMPT, a string. Read the name of a function and return as a symbol.
1146 Prompt with PROMPT. */)
1147 (prompt)
1148 Lisp_Object prompt;
1149 {
1150 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil, Qnil),
1151 Qnil);
1152 }
1153 #endif /* NOTDEF */
1154
1155 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
1156 doc: /* Read the name of a user variable and return it as a symbol.
1157 Prompt with PROMPT. By default, return DEFAULT-VALUE.
1158 A user variable is one for which `user-variable-p' returns non-nil. */)
1159 (prompt, default_value)
1160 Lisp_Object prompt, default_value;
1161 {
1162 Lisp_Object name, default_string;
1163
1164 if (NILP (default_value))
1165 default_string = Qnil;
1166 else if (SYMBOLP (default_value))
1167 default_string = SYMBOL_NAME (default_value);
1168 else
1169 default_string = default_value;
1170
1171 name = Fcompleting_read (prompt, Vobarray,
1172 Quser_variable_p, Qt,
1173 Qnil, Qnil, default_string, Qnil);
1174 if (NILP (name))
1175 return name;
1176 return Fintern (name, Qnil);
1177 }
1178
1179 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
1180 doc: /* Read the name of a buffer and return as a string.
1181 Prompt with PROMPT.
1182 Optional second arg DEF is value to return if user enters an empty line.
1183 If optional third arg REQUIRE-MATCH is non-nil,
1184 only existing buffer names are allowed.
1185 The argument PROMPT should be a string ending with a colon and a space. */)
1186 (prompt, def, require_match)
1187 Lisp_Object prompt, def, require_match;
1188 {
1189 Lisp_Object args[4];
1190 unsigned char *s;
1191 int len;
1192
1193 if (BUFFERP (def))
1194 def = XBUFFER (def)->name;
1195
1196 if (NILP (Vread_buffer_function))
1197 {
1198 if (!NILP (def))
1199 {
1200 /* A default value was provided: we must change PROMPT,
1201 editing the default value in before the colon. To achieve
1202 this, we replace PROMPT with a substring that doesn't
1203 contain the terminal space and colon (if present). They
1204 are then added back using Fformat. */
1205
1206 if (STRINGP (prompt))
1207 {
1208 s = SDATA (prompt);
1209 len = strlen (s);
1210 if (len >= 2 && s[len - 2] == ':' && s[len - 1] == ' ')
1211 len = len - 2;
1212 else if (len >= 1 && (s[len - 1] == ':' || s[len - 1] == ' '))
1213 len--;
1214
1215 prompt = make_specified_string (s, -1, len,
1216 STRING_MULTIBYTE (prompt));
1217 }
1218
1219 args[0] = build_string ("%s (default %s): ");
1220 args[1] = prompt;
1221 args[2] = def;
1222 prompt = Fformat (3, args);
1223 }
1224
1225 return Fcompleting_read (prompt, intern ("internal-complete-buffer"),
1226 Qnil, require_match, Qnil, Qbuffer_name_history,
1227 def, Qnil);
1228 }
1229 else
1230 {
1231 args[0] = Vread_buffer_function;
1232 args[1] = prompt;
1233 args[2] = def;
1234 args[3] = require_match;
1235 return Ffuncall(4, args);
1236 }
1237 }
1238 \f
1239 static Lisp_Object
1240 minibuf_conform_representation (string, basis)
1241 Lisp_Object string, basis;
1242 {
1243 if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis))
1244 return string;
1245
1246 if (STRING_MULTIBYTE (string))
1247 return Fstring_make_unibyte (string);
1248 else
1249 return Fstring_make_multibyte (string);
1250 }
1251
1252 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
1253 doc: /* Return common substring of all completions of STRING in COLLECTION.
1254 Test each possible completion specified by COLLECTION
1255 to see if it begins with STRING. The possible completions may be
1256 strings or symbols. Symbols are converted to strings before testing,
1257 see `symbol-name'.
1258 All that match STRING are compared together; the longest initial sequence
1259 common to all these matches is the return value.
1260 If there is no match at all, the return value is nil.
1261 For a unique match which is exact, the return value is t.
1262
1263 If COLLECTION is an alist, the keys (cars of elements) are the
1264 possible completions. If an element is not a cons cell, then the
1265 element itself is the possible completion.
1266 If COLLECTION is a hash-table, all the keys that are strings or symbols
1267 are the possible completions.
1268 If COLLECTION is an obarray, the names of all symbols in the obarray
1269 are the possible completions.
1270
1271 COLLECTION can also be a function to do the completion itself.
1272 It receives three arguments: the values STRING, PREDICATE and nil.
1273 Whatever it returns becomes the value of `try-completion'.
1274
1275 If optional third argument PREDICATE is non-nil,
1276 it is used to test each possible match.
1277 The match is a candidate only if PREDICATE returns non-nil.
1278 The argument given to PREDICATE is the alist element
1279 or the symbol from the obarray. If COLLECTION is a hash-table,
1280 predicate is called with two arguments: the key and the value.
1281 Additionally to this predicate, `completion-regexp-list'
1282 is used to further constrain the set of candidates. */)
1283 (string, collection, predicate)
1284 Lisp_Object string, collection, predicate;
1285 {
1286 Lisp_Object bestmatch, tail, elt, eltstring;
1287 /* Size in bytes of BESTMATCH. */
1288 int bestmatchsize = 0;
1289 /* These are in bytes, too. */
1290 int compare, matchsize;
1291 enum { function_table, list_table, obarray_table, hash_table}
1292 type = (HASH_TABLE_P (collection) ? hash_table
1293 : VECTORP (collection) ? obarray_table
1294 : ((NILP (collection)
1295 || (CONSP (collection)
1296 && (!SYMBOLP (XCAR (collection))
1297 || NILP (XCAR (collection)))))
1298 ? list_table : function_table));
1299 int index = 0, obsize = 0;
1300 int matchcount = 0;
1301 int bindcount = -1;
1302 Lisp_Object bucket, zero, end, tem;
1303 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1304
1305 CHECK_STRING (string);
1306 if (type == function_table)
1307 return call3 (collection, string, predicate, Qnil);
1308
1309 bestmatch = bucket = Qnil;
1310 zero = make_number (0);
1311
1312 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1313 tail = collection;
1314 if (type == obarray_table)
1315 {
1316 collection = check_obarray (collection);
1317 obsize = XVECTOR (collection)->size;
1318 bucket = XVECTOR (collection)->contents[index];
1319 }
1320
1321 while (1)
1322 {
1323 /* Get the next element of the alist, obarray, or hash-table. */
1324 /* Exit the loop if the elements are all used up. */
1325 /* elt gets the alist element or symbol.
1326 eltstring gets the name to check as a completion. */
1327
1328 if (type == list_table)
1329 {
1330 if (!CONSP (tail))
1331 break;
1332 elt = XCAR (tail);
1333 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1334 tail = XCDR (tail);
1335 }
1336 else if (type == obarray_table)
1337 {
1338 if (!EQ (bucket, zero))
1339 {
1340 if (!SYMBOLP (bucket))
1341 error ("Bad data in guts of obarray");
1342 elt = bucket;
1343 eltstring = elt;
1344 if (XSYMBOL (bucket)->next)
1345 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1346 else
1347 XSETFASTINT (bucket, 0);
1348 }
1349 else if (++index >= obsize)
1350 break;
1351 else
1352 {
1353 bucket = XVECTOR (collection)->contents[index];
1354 continue;
1355 }
1356 }
1357 else /* if (type == hash_table) */
1358 {
1359 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1360 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1361 index++;
1362 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1363 break;
1364 else
1365 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
1366 }
1367
1368 /* Is this element a possible completion? */
1369
1370 if (SYMBOLP (eltstring))
1371 eltstring = Fsymbol_name (eltstring);
1372
1373 if (STRINGP (eltstring)
1374 && SCHARS (string) <= SCHARS (eltstring)
1375 && (tem = Fcompare_strings (eltstring, zero,
1376 make_number (SCHARS (string)),
1377 string, zero, Qnil,
1378 completion_ignore_case ? Qt : Qnil),
1379 EQ (Qt, tem)))
1380 {
1381 /* Yes. */
1382 Lisp_Object regexps;
1383
1384 /* Ignore this element if it fails to match all the regexps. */
1385 {
1386 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1387 regexps = XCDR (regexps))
1388 {
1389 if (bindcount < 0) {
1390 bindcount = SPECPDL_INDEX ();
1391 specbind (Qcase_fold_search,
1392 completion_ignore_case ? Qt : Qnil);
1393 }
1394 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1395 if (NILP (tem))
1396 break;
1397 }
1398 if (CONSP (regexps))
1399 continue;
1400 }
1401
1402 /* Ignore this element if there is a predicate
1403 and the predicate doesn't like it. */
1404
1405 if (!NILP (predicate))
1406 {
1407 if (EQ (predicate, Qcommandp))
1408 tem = Fcommandp (elt, Qnil);
1409 else
1410 {
1411 if (bindcount >= 0)
1412 {
1413 unbind_to (bindcount, Qnil);
1414 bindcount = -1;
1415 }
1416 GCPRO4 (tail, string, eltstring, bestmatch);
1417 tem = (type == hash_table
1418 ? call2 (predicate, elt,
1419 HASH_VALUE (XHASH_TABLE (collection),
1420 index - 1))
1421 : call1 (predicate, elt));
1422 UNGCPRO;
1423 }
1424 if (NILP (tem)) continue;
1425 }
1426
1427 /* Update computation of how much all possible completions match */
1428
1429 if (NILP (bestmatch))
1430 {
1431 matchcount = 1;
1432 bestmatch = eltstring;
1433 bestmatchsize = SCHARS (eltstring);
1434 }
1435 else
1436 {
1437 compare = min (bestmatchsize, SCHARS (eltstring));
1438 tem = Fcompare_strings (bestmatch, zero,
1439 make_number (compare),
1440 eltstring, zero,
1441 make_number (compare),
1442 completion_ignore_case ? Qt : Qnil);
1443 if (EQ (tem, Qt))
1444 matchsize = compare;
1445 else if (XINT (tem) < 0)
1446 matchsize = - XINT (tem) - 1;
1447 else
1448 matchsize = XINT (tem) - 1;
1449
1450 if (matchsize < 0)
1451 /* When can this happen ? -stef */
1452 matchsize = compare;
1453 if (completion_ignore_case)
1454 {
1455 /* If this is an exact match except for case,
1456 use it as the best match rather than one that is not an
1457 exact match. This way, we get the case pattern
1458 of the actual match. */
1459 if ((matchsize == SCHARS (eltstring)
1460 && matchsize < SCHARS (bestmatch))
1461 ||
1462 /* If there is more than one exact match ignoring case,
1463 and one of them is exact including case,
1464 prefer that one. */
1465 /* If there is no exact match ignoring case,
1466 prefer a match that does not change the case
1467 of the input. */
1468 ((matchsize == SCHARS (eltstring))
1469 ==
1470 (matchsize == SCHARS (bestmatch))
1471 && (tem = Fcompare_strings (eltstring, zero,
1472 make_number (SCHARS (string)),
1473 string, zero,
1474 Qnil,
1475 Qnil),
1476 EQ (Qt, tem))
1477 && (tem = Fcompare_strings (bestmatch, zero,
1478 make_number (SCHARS (string)),
1479 string, zero,
1480 Qnil,
1481 Qnil),
1482 ! EQ (Qt, tem))))
1483 bestmatch = eltstring;
1484 }
1485 if (bestmatchsize != SCHARS (eltstring)
1486 || bestmatchsize != matchsize)
1487 /* Don't count the same string multiple times. */
1488 matchcount++;
1489 bestmatchsize = matchsize;
1490 if (matchsize <= SCHARS (string)
1491 /* If completion-ignore-case is non-nil, don't
1492 short-circuit because we want to find the best
1493 possible match *including* case differences. */
1494 && !completion_ignore_case
1495 && matchcount > 1)
1496 /* No need to look any further. */
1497 break;
1498 }
1499 }
1500 }
1501
1502 if (bindcount >= 0) {
1503 unbind_to (bindcount, Qnil);
1504 bindcount = -1;
1505 }
1506
1507 if (NILP (bestmatch))
1508 return Qnil; /* No completions found */
1509 /* If we are ignoring case, and there is no exact match,
1510 and no additional text was supplied,
1511 don't change the case of what the user typed. */
1512 if (completion_ignore_case && bestmatchsize == SCHARS (string)
1513 && SCHARS (bestmatch) > bestmatchsize)
1514 return minibuf_conform_representation (string, bestmatch);
1515
1516 /* Return t if the supplied string is an exact match (counting case);
1517 it does not require any change to be made. */
1518 if (matchcount == 1 && bestmatchsize == SCHARS (string)
1519 && (tem = Fcompare_strings (bestmatch, make_number (0),
1520 make_number (bestmatchsize),
1521 string, make_number (0),
1522 make_number (bestmatchsize),
1523 Qnil),
1524 EQ (Qt, tem)))
1525 return Qt;
1526
1527 XSETFASTINT (zero, 0); /* Else extract the part in which */
1528 XSETFASTINT (end, bestmatchsize); /* all completions agree */
1529 return Fsubstring (bestmatch, zero, end);
1530 }
1531 \f
1532 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
1533 doc: /* Search for partial matches to STRING in COLLECTION.
1534 Test each of the possible completions specified by COLLECTION
1535 to see if it begins with STRING. The possible completions may be
1536 strings or symbols. Symbols are converted to strings before testing,
1537 see `symbol-name'.
1538 The value is a list of all the possible completions that match STRING.
1539
1540 If COLLECTION is an alist, the keys (cars of elements) are the
1541 possible completions. If an element is not a cons cell, then the
1542 element itself is the possible completion.
1543 If COLLECTION is a hash-table, all the keys that are strings or symbols
1544 are the possible completions.
1545 If COLLECTION is an obarray, the names of all symbols in the obarray
1546 are the possible completions.
1547
1548 COLLECTION can also be a function to do the completion itself.
1549 It receives three arguments: the values STRING, PREDICATE and t.
1550 Whatever it returns becomes the value of `all-completions'.
1551
1552 If optional third argument PREDICATE is non-nil,
1553 it is used to test each possible match.
1554 The match is a candidate only if PREDICATE returns non-nil.
1555 The argument given to PREDICATE is the alist element
1556 or the symbol from the obarray. If COLLECTION is a hash-table,
1557 predicate is called with two arguments: the key and the value.
1558 Additionally to this predicate, `completion-regexp-list'
1559 is used to further constrain the set of candidates.
1560
1561 If the optional fourth argument HIDE-SPACES is non-nil,
1562 strings in COLLECTION that start with a space
1563 are ignored unless STRING itself starts with a space. */)
1564 (string, collection, predicate, hide_spaces)
1565 Lisp_Object string, collection, predicate, hide_spaces;
1566 {
1567 Lisp_Object tail, elt, eltstring;
1568 Lisp_Object allmatches;
1569 int type = HASH_TABLE_P (collection) ? 3
1570 : VECTORP (collection) ? 2
1571 : NILP (collection) || (CONSP (collection)
1572 && (!SYMBOLP (XCAR (collection))
1573 || NILP (XCAR (collection))));
1574 int index = 0, obsize = 0;
1575 int bindcount = -1;
1576 Lisp_Object bucket, tem, zero;
1577 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1578
1579 CHECK_STRING (string);
1580 if (type == 0)
1581 return call3 (collection, string, predicate, Qt);
1582 allmatches = bucket = Qnil;
1583 zero = make_number (0);
1584
1585 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1586 tail = collection;
1587 if (type == 2)
1588 {
1589 obsize = XVECTOR (collection)->size;
1590 bucket = XVECTOR (collection)->contents[index];
1591 }
1592
1593 while (1)
1594 {
1595 /* Get the next element of the alist, obarray, or hash-table. */
1596 /* Exit the loop if the elements are all used up. */
1597 /* elt gets the alist element or symbol.
1598 eltstring gets the name to check as a completion. */
1599
1600 if (type == 1)
1601 {
1602 if (!CONSP (tail))
1603 break;
1604 elt = XCAR (tail);
1605 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1606 tail = XCDR (tail);
1607 }
1608 else if (type == 2)
1609 {
1610 if (!EQ (bucket, zero))
1611 {
1612 elt = bucket;
1613 eltstring = elt;
1614 if (XSYMBOL (bucket)->next)
1615 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1616 else
1617 XSETFASTINT (bucket, 0);
1618 }
1619 else if (++index >= obsize)
1620 break;
1621 else
1622 {
1623 bucket = XVECTOR (collection)->contents[index];
1624 continue;
1625 }
1626 }
1627 else /* if (type == 3) */
1628 {
1629 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1630 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
1631 index++;
1632 if (index >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1633 break;
1634 else
1635 elt = eltstring = HASH_KEY (XHASH_TABLE (collection), index++);
1636 }
1637
1638 /* Is this element a possible completion? */
1639
1640 if (SYMBOLP (eltstring))
1641 eltstring = Fsymbol_name (eltstring);
1642
1643 if (STRINGP (eltstring)
1644 && SCHARS (string) <= SCHARS (eltstring)
1645 /* If HIDE_SPACES, reject alternatives that start with space
1646 unless the input starts with space. */
1647 && ((SBYTES (string) > 0
1648 && SREF (string, 0) == ' ')
1649 || SREF (eltstring, 0) != ' '
1650 || NILP (hide_spaces))
1651 && (tem = Fcompare_strings (eltstring, zero,
1652 make_number (SCHARS (string)),
1653 string, zero,
1654 make_number (SCHARS (string)),
1655 completion_ignore_case ? Qt : Qnil),
1656 EQ (Qt, tem)))
1657 {
1658 /* Yes. */
1659 Lisp_Object regexps;
1660 Lisp_Object zero;
1661 XSETFASTINT (zero, 0);
1662
1663 /* Ignore this element if it fails to match all the regexps. */
1664 {
1665 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1666 regexps = XCDR (regexps))
1667 {
1668 if (bindcount < 0) {
1669 bindcount = SPECPDL_INDEX ();
1670 specbind (Qcase_fold_search,
1671 completion_ignore_case ? Qt : Qnil);
1672 }
1673 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1674 if (NILP (tem))
1675 break;
1676 }
1677 if (CONSP (regexps))
1678 continue;
1679 }
1680
1681 /* Ignore this element if there is a predicate
1682 and the predicate doesn't like it. */
1683
1684 if (!NILP (predicate))
1685 {
1686 if (EQ (predicate, Qcommandp))
1687 tem = Fcommandp (elt, Qnil);
1688 else
1689 {
1690 if (bindcount >= 0) {
1691 unbind_to (bindcount, Qnil);
1692 bindcount = -1;
1693 }
1694 GCPRO4 (tail, eltstring, allmatches, string);
1695 tem = type == 3
1696 ? call2 (predicate, elt,
1697 HASH_VALUE (XHASH_TABLE (collection), index - 1))
1698 : call1 (predicate, elt);
1699 UNGCPRO;
1700 }
1701 if (NILP (tem)) continue;
1702 }
1703 /* Ok => put it on the list. */
1704 allmatches = Fcons (eltstring, allmatches);
1705 }
1706 }
1707
1708 if (bindcount >= 0) {
1709 unbind_to (bindcount, Qnil);
1710 bindcount = -1;
1711 }
1712
1713 return Fnreverse (allmatches);
1714 }
1715 \f
1716 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
1717 doc: /* Read a string in the minibuffer, with completion.
1718 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1719 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1720 COLLECTION can also be a function to do the completion itself.
1721 PREDICATE limits completion to a subset of COLLECTION.
1722 See `try-completion' and `all-completions' for more details
1723 on completion, COLLECTION, and PREDICATE.
1724
1725 REQUIRE-MATCH can take the following values:
1726 - t means that the user is not allowed to exit unless
1727 the input is (or completes to) an element of COLLECTION or is null.
1728 - nil means that the user can exit with any input.
1729 - `confirm-only' means that the user can exit with any input, but she will
1730 need to confirm her choice if the input is not an element of COLLECTION.
1731 - anything else behaves like t except that typing RET does not exit if it
1732 does non-null completion.
1733
1734 If the input is null, `completing-read' returns DEF, or an empty string
1735 if DEF is nil, regardless of the value of REQUIRE-MATCH.
1736
1737 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
1738 with point positioned at the end.
1739 If it is (STRING . POSITION), the initial input is STRING, but point
1740 is placed at _zero-indexed_ position POSITION in STRING. (*Note*
1741 that this is different from `read-from-minibuffer' and related
1742 functions, which use one-indexing for POSITION.) This feature is
1743 deprecated--it is best to pass nil for INITIAL-INPUT and supply the
1744 default value DEF instead. The user can yank the default value into
1745 the minibuffer easily using \\[next-history-element].
1746
1747 HIST, if non-nil, specifies a history list and optionally the initial
1748 position in the list. It can be a symbol, which is the history list
1749 variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In
1750 that case, HISTVAR is the history list variable to use, and HISTPOS
1751 is the initial position (the position in the list used by the
1752 minibuffer history commands). For consistency, you should also
1753 specify that element of the history as the value of
1754 INITIAL-INPUT. (This is the only case in which you should use
1755 INITIAL-INPUT instead of DEF.) Positions are counted starting from
1756 1 at the beginning of the list. The variable `history-length'
1757 controls the maximum length of a history list.
1758
1759 DEF, if non-nil, is the default value.
1760
1761 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits
1762 the current input method and the setting of `enable-multibyte-characters'.
1763
1764 Completion ignores case if the ambient value of
1765 `completion-ignore-case' is non-nil. */)
1766 (prompt, collection, predicate, require_match, initial_input, hist, def, inherit_input_method)
1767 Lisp_Object prompt, collection, predicate, require_match, initial_input;
1768 Lisp_Object hist, def, inherit_input_method;
1769 {
1770 Lisp_Object val, histvar, histpos, position;
1771 Lisp_Object init;
1772 int pos = 0;
1773 int count = SPECPDL_INDEX ();
1774 struct gcpro gcpro1;
1775
1776 init = initial_input;
1777 GCPRO1 (def);
1778
1779 specbind (Qminibuffer_completion_table, collection);
1780 specbind (Qminibuffer_completion_predicate, predicate);
1781 specbind (Qminibuffer_completion_confirm,
1782 EQ (require_match, Qt) ? Qnil : require_match);
1783 last_exact_completion = Qnil;
1784
1785 position = Qnil;
1786 if (!NILP (init))
1787 {
1788 if (CONSP (init))
1789 {
1790 position = Fcdr (init);
1791 init = Fcar (init);
1792 }
1793 CHECK_STRING (init);
1794 if (!NILP (position))
1795 {
1796 CHECK_NUMBER (position);
1797 /* Convert to distance from end of input. */
1798 pos = XINT (position) - SCHARS (init);
1799 }
1800 }
1801
1802 if (SYMBOLP (hist))
1803 {
1804 histvar = hist;
1805 histpos = Qnil;
1806 }
1807 else
1808 {
1809 histvar = Fcar_safe (hist);
1810 histpos = Fcdr_safe (hist);
1811 }
1812 if (NILP (histvar))
1813 histvar = Qminibuffer_history;
1814 if (NILP (histpos))
1815 XSETFASTINT (histpos, 0);
1816
1817 val = read_minibuf (NILP (require_match)
1818 ? (NILP (Vminibuffer_completing_file_name)
1819 || EQ (Vminibuffer_completing_file_name, Qlambda)
1820 ? Vminibuffer_local_completion_map
1821 : Vminibuffer_local_filename_completion_map)
1822 : (NILP (Vminibuffer_completing_file_name)
1823 || EQ (Vminibuffer_completing_file_name, Qlambda)
1824 ? Vminibuffer_local_must_match_map
1825 : Vminibuffer_local_must_match_filename_map),
1826 init, prompt, make_number (pos), 0,
1827 histvar, histpos, def, 0,
1828 !NILP (inherit_input_method));
1829
1830 if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
1831 val = def;
1832
1833 RETURN_UNGCPRO (unbind_to (count, val));
1834 }
1835 \f
1836 Lisp_Object Fminibuffer_completion_help ();
1837 Lisp_Object Fassoc_string ();
1838
1839 /* Test whether TXT is an exact completion. */
1840 DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
1841 doc: /* Return non-nil if STRING is a valid completion.
1842 Takes the same arguments as `all-completions' and `try-completion'.
1843 If COLLECTION is a function, it is called with three arguments:
1844 the values STRING, PREDICATE and `lambda'. */)
1845 (string, collection, predicate)
1846 Lisp_Object string, collection, predicate;
1847 {
1848 Lisp_Object regexps, tail, tem = Qnil;
1849 int i = 0;
1850
1851 CHECK_STRING (string);
1852
1853 if ((CONSP (collection)
1854 && (!SYMBOLP (XCAR (collection)) || NILP (XCAR (collection))))
1855 || NILP (collection))
1856 {
1857 tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
1858 if (NILP (tem))
1859 return Qnil;
1860 }
1861 else if (VECTORP (collection))
1862 {
1863 /* Bypass intern-soft as that loses for nil. */
1864 tem = oblookup (collection,
1865 SDATA (string),
1866 SCHARS (string),
1867 SBYTES (string));
1868 if (!SYMBOLP (tem))
1869 {
1870 if (STRING_MULTIBYTE (string))
1871 string = Fstring_make_unibyte (string);
1872 else
1873 string = Fstring_make_multibyte (string);
1874
1875 tem = oblookup (collection,
1876 SDATA (string),
1877 SCHARS (string),
1878 SBYTES (string));
1879 }
1880
1881 if (completion_ignore_case && !SYMBOLP (tem))
1882 {
1883 for (i = XVECTOR (collection)->size - 1; i >= 0; i--)
1884 {
1885 tail = XVECTOR (collection)->contents[i];
1886 if (SYMBOLP (tail))
1887 while (1)
1888 {
1889 if (EQ((Fcompare_strings (string, make_number (0), Qnil,
1890 Fsymbol_name (tail),
1891 make_number (0) , Qnil, Qt)),
1892 Qt))
1893 {
1894 tem = tail;
1895 break;
1896 }
1897 if (XSYMBOL (tail)->next == 0)
1898 break;
1899 XSETSYMBOL (tail, XSYMBOL (tail)->next);
1900 }
1901 }
1902 }
1903
1904 if (!SYMBOLP (tem))
1905 return Qnil;
1906 }
1907 else if (HASH_TABLE_P (collection))
1908 {
1909 struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
1910 i = hash_lookup (h, string, NULL);
1911 if (i >= 0)
1912 tem = HASH_KEY (h, i);
1913 else
1914 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1915 if (!NILP (HASH_HASH (h, i)) &&
1916 EQ (Fcompare_strings (string, make_number (0), Qnil,
1917 HASH_KEY (h, i), make_number (0) , Qnil,
1918 completion_ignore_case ? Qt : Qnil),
1919 Qt))
1920 {
1921 tem = HASH_KEY (h, i);
1922 break;
1923 }
1924 if (!STRINGP (tem))
1925 return Qnil;
1926 }
1927 else
1928 return call3 (collection, string, predicate, Qlambda);
1929
1930 /* Reject this element if it fails to match all the regexps. */
1931 if (CONSP (Vcompletion_regexp_list))
1932 {
1933 int count = SPECPDL_INDEX ();
1934 specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
1935 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1936 regexps = XCDR (regexps))
1937 {
1938 if (NILP (Fstring_match (XCAR (regexps),
1939 SYMBOLP (tem) ? string : tem,
1940 Qnil)))
1941 return unbind_to (count, Qnil);
1942 }
1943 unbind_to (count, Qnil);
1944 }
1945
1946 /* Finally, check the predicate. */
1947 if (!NILP (predicate))
1948 {
1949 return HASH_TABLE_P (collection)
1950 ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
1951 : call1 (predicate, tem);
1952 }
1953 else
1954 return Qt;
1955 }
1956
1957 DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
1958 doc: /* Perform completion on buffer names.
1959 If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
1960 `all-completions', otherwise invoke `test-completion'.
1961
1962 The arguments STRING and PREDICATE are as in `try-completion',
1963 `all-completions', and `test-completion'. */)
1964 (string, predicate, flag)
1965 Lisp_Object string, predicate, flag;
1966 {
1967 if (NILP (flag))
1968 return Ftry_completion (string, Vbuffer_alist, predicate);
1969 else if (EQ (flag, Qt))
1970 return Fall_completions (string, Vbuffer_alist, predicate, Qt);
1971 else /* assume `lambda' */
1972 return Ftest_completion (string, Vbuffer_alist, predicate);
1973 }
1974
1975 /* returns:
1976 * 0 no possible completion
1977 * 1 was already an exact and unique completion
1978 * 3 was already an exact completion
1979 * 4 completed to an exact completion
1980 * 5 some completion happened
1981 * 6 no completion happened
1982 */
1983 int
1984 do_completion ()
1985 {
1986 Lisp_Object completion, string, tem;
1987 int completedp;
1988 Lisp_Object last;
1989 struct gcpro gcpro1, gcpro2;
1990
1991 completion = Ftry_completion (Fminibuffer_completion_contents (),
1992 Vminibuffer_completion_table,
1993 Vminibuffer_completion_predicate);
1994 last = last_exact_completion;
1995 last_exact_completion = Qnil;
1996
1997 GCPRO2 (completion, last);
1998
1999 if (NILP (completion))
2000 {
2001 bitch_at_user ();
2002 temp_echo_area_glyphs (build_string (" [No match]"));
2003 UNGCPRO;
2004 return 0;
2005 }
2006
2007 if (EQ (completion, Qt)) /* exact and unique match */
2008 {
2009 UNGCPRO;
2010 return 1;
2011 }
2012
2013 string = Fminibuffer_completion_contents ();
2014
2015 /* COMPLETEDP should be true if some completion was done, which
2016 doesn't include simply changing the case of the entered string.
2017 However, for appearance, the string is rewritten if the case
2018 changes. */
2019 tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qt);
2020 completedp = !EQ (tem, Qt);
2021
2022 tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qnil);
2023 if (!EQ (tem, Qt))
2024 /* Rewrite the user's input. */
2025 {
2026 int prompt_end = XINT (Fminibuffer_prompt_end ());
2027 /* Some completion happened */
2028
2029 if (! NILP (Vminibuffer_completing_file_name)
2030 && SREF (completion, SBYTES (completion) - 1) == '/'
2031 && PT < ZV
2032 && FETCH_CHAR (PT_BYTE) == '/')
2033 {
2034 del_range (prompt_end, PT + 1);
2035 }
2036 else
2037 del_range (prompt_end, PT);
2038
2039 Finsert (1, &completion);
2040
2041 if (! completedp)
2042 /* The case of the string changed, but that's all. We're not
2043 sure whether this is a unique completion or not, so try again
2044 using the real case (this shouldn't recurse again, because
2045 the next time try-completion will return either `t' or the
2046 exact string). */
2047 {
2048 UNGCPRO;
2049 return do_completion ();
2050 }
2051 }
2052
2053 /* It did find a match. Do we match some possibility exactly now? */
2054 tem = Ftest_completion (Fminibuffer_contents (),
2055 Vminibuffer_completion_table,
2056 Vminibuffer_completion_predicate);
2057 if (NILP (tem))
2058 {
2059 /* not an exact match */
2060 UNGCPRO;
2061 if (completedp)
2062 return 5;
2063 else if (!NILP (Vcompletion_auto_help))
2064 Fminibuffer_completion_help ();
2065 else
2066 temp_echo_area_glyphs (build_string (" [Next char not unique]"));
2067 return 6;
2068 }
2069 else if (completedp)
2070 {
2071 UNGCPRO;
2072 return 4;
2073 }
2074 /* If the last exact completion and this one were the same,
2075 it means we've already given a "Complete but not unique"
2076 message and the user's hit TAB again, so now we give him help. */
2077 last_exact_completion = completion;
2078 if (!NILP (last))
2079 {
2080 tem = Fminibuffer_completion_contents ();
2081 if (!NILP (Fequal (tem, last)))
2082 Fminibuffer_completion_help ();
2083 }
2084 UNGCPRO;
2085 return 3;
2086 }
2087
2088 /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
2089
2090 DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
2091 doc: /* Like `assoc' but specifically for strings (and symbols).
2092 Symbols are converted to strings, and unibyte strings are converted to
2093 multibyte for comparison.
2094 Case is ignored if optional arg CASE-FOLD is non-nil.
2095 As opposed to `assoc', it will also match an entry consisting of a single
2096 string rather than a cons cell whose car is a string. */)
2097 (key, list, case_fold)
2098 register Lisp_Object key;
2099 Lisp_Object list, case_fold;
2100 {
2101 register Lisp_Object tail;
2102
2103 if (SYMBOLP (key))
2104 key = Fsymbol_name (key);
2105
2106 for (tail = list; !NILP (tail); tail = Fcdr (tail))
2107 {
2108 register Lisp_Object elt, tem, thiscar;
2109 elt = Fcar (tail);
2110 thiscar = CONSP (elt) ? XCAR (elt) : elt;
2111 if (SYMBOLP (thiscar))
2112 thiscar = Fsymbol_name (thiscar);
2113 else if (!STRINGP (thiscar))
2114 continue;
2115 tem = Fcompare_strings (thiscar, make_number (0), Qnil,
2116 key, make_number (0), Qnil,
2117 case_fold);
2118 if (EQ (tem, Qt))
2119 return elt;
2120 QUIT;
2121 }
2122 return Qnil;
2123 }
2124
2125 DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
2126 doc: /* Complete the minibuffer contents as far as possible.
2127 Return nil if there is no valid completion, else t.
2128 If no characters can be completed, display a list of possible completions.
2129 If you repeat this command after it displayed such a list,
2130 scroll the window of possible completions. */)
2131 ()
2132 {
2133 register int i;
2134 Lisp_Object window, tem;
2135
2136 /* If the previous command was not this,
2137 mark the completion buffer obsolete. */
2138 if (! EQ (current_kboard->Vlast_command, Vthis_command))
2139 Vminibuf_scroll_window = Qnil;
2140
2141 window = Vminibuf_scroll_window;
2142 /* If there's a fresh completion window with a live buffer,
2143 and this command is repeated, scroll that window. */
2144 if (! NILP (window) && ! NILP (XWINDOW (window)->buffer)
2145 && !NILP (XBUFFER (XWINDOW (window)->buffer)->name))
2146 {
2147 struct buffer *obuf = current_buffer;
2148
2149 Fset_buffer (XWINDOW (window)->buffer);
2150 tem = Fpos_visible_in_window_p (make_number (ZV), window, Qnil);
2151 if (! NILP (tem))
2152 /* If end is in view, scroll up to the beginning. */
2153 Fset_window_start (window, make_number (BEGV), Qnil);
2154 else
2155 /* Else scroll down one screen. */
2156 Fscroll_other_window (Qnil);
2157
2158 set_buffer_internal (obuf);
2159 return Qnil;
2160 }
2161
2162 i = do_completion ();
2163 switch (i)
2164 {
2165 case 0:
2166 return Qnil;
2167
2168 case 1:
2169 if (PT != ZV)
2170 Fgoto_char (make_number (ZV));
2171 temp_echo_area_glyphs (build_string (" [Sole completion]"));
2172 break;
2173
2174 case 3:
2175 if (PT != ZV)
2176 Fgoto_char (make_number (ZV));
2177 temp_echo_area_glyphs (build_string (" [Complete, but not unique]"));
2178 break;
2179 }
2180
2181 return Qt;
2182 }
2183 \f
2184 /* Subroutines of Fminibuffer_complete_and_exit. */
2185
2186 /* This one is called by internal_condition_case to do the real work. */
2187
2188 Lisp_Object
2189 complete_and_exit_1 ()
2190 {
2191 return make_number (do_completion ());
2192 }
2193
2194 /* This one is called by internal_condition_case if an error happens.
2195 Pretend the current value is an exact match. */
2196
2197 Lisp_Object
2198 complete_and_exit_2 (ignore)
2199 Lisp_Object ignore;
2200 {
2201 return make_number (1);
2202 }
2203
2204 EXFUN (Fexit_minibuffer, 0) NO_RETURN;
2205
2206 DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
2207 Sminibuffer_complete_and_exit, 0, 0, "",
2208 doc: /* If the minibuffer contents is a valid completion then exit.
2209 Otherwise try to complete it. If completion leads to a valid completion,
2210 a repetition of this command will exit. */)
2211 ()
2212 {
2213 register int i;
2214 Lisp_Object val, tem;
2215
2216 /* Allow user to specify null string */
2217 if (XINT (Fminibuffer_prompt_end ()) == ZV)
2218 goto exit;
2219
2220 val = Fminibuffer_contents ();
2221 tem = Ftest_completion (val,
2222 Vminibuffer_completion_table,
2223 Vminibuffer_completion_predicate);
2224 if (!NILP (tem))
2225 {
2226 if (completion_ignore_case)
2227 { /* Fixup case of the field, if necessary. */
2228 Lisp_Object compl
2229 = Ftry_completion (val,
2230 Vminibuffer_completion_table,
2231 Vminibuffer_completion_predicate);
2232 if (STRINGP (compl)
2233 /* If it weren't for this piece of paranoia, I'd replace
2234 the whole thing with a call to do_completion. */
2235 && EQ (Flength (val), Flength (compl)))
2236 {
2237 del_range (XINT (Fminibuffer_prompt_end ()), ZV);
2238 Finsert (1, &compl);
2239 }
2240 }
2241 goto exit;
2242 }
2243
2244 if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only")))
2245 { /* The user is permitted to exit with an input that's rejected
2246 by test-completion, but at the condition to confirm her choice. */
2247 if (EQ (current_kboard->Vlast_command, Vthis_command))
2248 goto exit;
2249 else
2250 {
2251 temp_echo_area_glyphs (build_string (" [Confirm]"));
2252 return Qnil;
2253 }
2254 }
2255
2256 /* Call do_completion, but ignore errors. */
2257 SET_PT (ZV);
2258 val = internal_condition_case (complete_and_exit_1, Qerror,
2259 complete_and_exit_2);
2260
2261 i = XFASTINT (val);
2262 switch (i)
2263 {
2264 case 1:
2265 case 3:
2266 goto exit;
2267
2268 case 4:
2269 if (!NILP (Vminibuffer_completion_confirm))
2270 {
2271 temp_echo_area_glyphs (build_string (" [Confirm]"));
2272 return Qnil;
2273 }
2274 else
2275 goto exit;
2276
2277 default:
2278 return Qnil;
2279 }
2280 exit:
2281 return Fexit_minibuffer ();
2282 /* NOTREACHED */
2283 }
2284
2285 DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
2286 0, 0, "",
2287 doc: /* Complete the minibuffer contents at most a single word.
2288 After one word is completed as much as possible, a space or hyphen
2289 is added, provided that matches some possible completion.
2290 Return nil if there is no valid completion, else t. */)
2291 ()
2292 {
2293 Lisp_Object completion, tem, tem1;
2294 register int i, i_byte;
2295 struct gcpro gcpro1, gcpro2;
2296 int prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
2297
2298 /* We keep calling Fbuffer_string rather than arrange for GC to
2299 hold onto a pointer to one of the strings thus made. */
2300
2301 completion = Ftry_completion (Fminibuffer_completion_contents (),
2302 Vminibuffer_completion_table,
2303 Vminibuffer_completion_predicate);
2304 if (NILP (completion))
2305 {
2306 bitch_at_user ();
2307 temp_echo_area_glyphs (build_string (" [No match]"));
2308 return Qnil;
2309 }
2310 if (EQ (completion, Qt))
2311 return Qnil;
2312
2313 #if 0 /* How the below code used to look, for reference. */
2314 tem = Fminibuffer_contents ();
2315 b = SDATA (tem);
2316 i = ZV - 1 - SCHARS (completion);
2317 p = SDATA (completion);
2318 if (i > 0 ||
2319 0 <= scmp (b, p, ZV - 1))
2320 {
2321 i = 1;
2322 /* Set buffer to longest match of buffer tail and completion head. */
2323 while (0 <= scmp (b + i, p, ZV - 1 - i))
2324 i++;
2325 del_range (1, i + 1);
2326 SET_PT (ZV);
2327 }
2328 #else /* Rewritten code */
2329 {
2330 int buffer_nchars, completion_nchars;
2331
2332 CHECK_STRING (completion);
2333 tem = Fminibuffer_completion_contents ();
2334 GCPRO2 (completion, tem);
2335 /* If reading a file name,
2336 expand any $ENVVAR refs in the buffer and in TEM. */
2337 if (! NILP (Vminibuffer_completing_file_name))
2338 {
2339 Lisp_Object substituted;
2340 substituted = Fsubstitute_in_file_name (tem);
2341 if (! EQ (substituted, tem))
2342 {
2343 tem = substituted;
2344 del_range (prompt_end_charpos, PT);
2345 Finsert (1, &tem);
2346 }
2347 }
2348 buffer_nchars = SCHARS (tem); /* # chars in what we completed. */
2349 completion_nchars = SCHARS (completion);
2350 i = buffer_nchars - completion_nchars;
2351 if (i > 0
2352 ||
2353 (tem1 = Fcompare_strings (tem, make_number (0),
2354 make_number (buffer_nchars),
2355 completion, make_number (0),
2356 make_number (buffer_nchars),
2357 completion_ignore_case ? Qt : Qnil),
2358 ! EQ (tem1, Qt)))
2359 {
2360 int start_pos;
2361
2362 /* Make buffer (before point) contain the longest match
2363 of TEM's tail and COMPLETION's head. */
2364 if (i <= 0) i = 1;
2365 start_pos= i;
2366 buffer_nchars -= i;
2367 while (i > 0)
2368 {
2369 tem1 = Fcompare_strings (tem, make_number (start_pos), Qnil,
2370 completion, make_number (0),
2371 make_number (buffer_nchars),
2372 completion_ignore_case ? Qt : Qnil);
2373 start_pos++;
2374 if (EQ (tem1, Qt))
2375 break;
2376 i++;
2377 buffer_nchars--;
2378 }
2379 del_range (start_pos, start_pos + buffer_nchars);
2380 }
2381 UNGCPRO;
2382 }
2383 #endif /* Rewritten code */
2384
2385 {
2386 int prompt_end_bytepos;
2387 prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos);
2388 i = PT - prompt_end_charpos;
2389 i_byte = PT_BYTE - prompt_end_bytepos;
2390 }
2391
2392 /* If completion finds next char not unique,
2393 consider adding a space or a hyphen. */
2394 if (i == SCHARS (completion))
2395 {
2396 GCPRO1 (completion);
2397 tem = Ftry_completion (concat2 (Fminibuffer_completion_contents (),
2398 build_string (" ")),
2399 Vminibuffer_completion_table,
2400 Vminibuffer_completion_predicate);
2401 UNGCPRO;
2402
2403 if (STRINGP (tem))
2404 completion = tem;
2405 else
2406 {
2407 GCPRO1 (completion);
2408 tem =
2409 Ftry_completion (concat2 (Fminibuffer_completion_contents (),
2410 build_string ("-")),
2411 Vminibuffer_completion_table,
2412 Vminibuffer_completion_predicate);
2413 UNGCPRO;
2414
2415 if (STRINGP (tem))
2416 completion = tem;
2417 }
2418 }
2419
2420 /* Now find first word-break in the stuff found by completion.
2421 i gets index in string of where to stop completing. */
2422 while (i_byte < SBYTES (completion))
2423 {
2424 int c;
2425
2426 FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte);
2427 if (SYNTAX (c) != Sword)
2428 break;
2429 }
2430
2431 /* If got no characters, print help for user. */
2432
2433 if (i == PT - prompt_end_charpos)
2434 {
2435 if (!NILP (Vcompletion_auto_help))
2436 Fminibuffer_completion_help ();
2437 return Qnil;
2438 }
2439
2440 /* Otherwise insert in minibuffer the chars we got */
2441
2442 if (! NILP (Vminibuffer_completing_file_name)
2443 && SREF (completion, SBYTES (completion) - 1) == '/'
2444 && PT < ZV
2445 && FETCH_CHAR (PT_BYTE) == '/')
2446 {
2447 del_range (prompt_end_charpos, PT + 1);
2448 }
2449 else
2450 del_range (prompt_end_charpos, PT);
2451
2452 insert_from_string (completion, 0, 0, i, i_byte, 1);
2453 return Qt;
2454 }
2455 \f
2456 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
2457 1, 2, 0,
2458 doc: /* Display the list of completions, COMPLETIONS, using `standard-output'.
2459 Each element may be just a symbol or string
2460 or may be a list of two strings to be printed as if concatenated.
2461 If it is a list of two strings, the first is the actual completion
2462 alternative, the second serves as annotation.
2463 `standard-output' must be a buffer.
2464 The actual completion alternatives, as inserted, are given `mouse-face'
2465 properties of `highlight'.
2466 At the end, this runs the normal hook `completion-setup-hook'.
2467 It can find the completion buffer in `standard-output'.
2468 The optional second arg COMMON-SUBSTRING is a string.
2469 It is used to put faces, `completions-first-difference' and
2470 `completions-common-part' on the completion buffer. The
2471 `completions-common-part' face is put on the common substring
2472 specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil
2473 and the current buffer is not the minibuffer, the faces are not put.
2474 Internally, COMMON-SUBSTRING is bound to `completion-common-substring'
2475 during running `completion-setup-hook'. */)
2476 (completions, common_substring)
2477 Lisp_Object completions;
2478 Lisp_Object common_substring;
2479 {
2480 Lisp_Object tail, elt;
2481 register int i;
2482 int column = 0;
2483 struct gcpro gcpro1, gcpro2, gcpro3;
2484 struct buffer *old = current_buffer;
2485 int first = 1;
2486
2487 /* Note that (when it matters) every variable
2488 points to a non-string that is pointed to by COMPLETIONS,
2489 except for ELT. ELT can be pointing to a string
2490 when terpri or Findent_to calls a change hook. */
2491 elt = Qnil;
2492 GCPRO3 (completions, elt, common_substring);
2493
2494 if (BUFFERP (Vstandard_output))
2495 set_buffer_internal (XBUFFER (Vstandard_output));
2496
2497 if (NILP (completions))
2498 write_string ("There are no possible completions of what you have typed.",
2499 -1);
2500 else
2501 {
2502 write_string ("Possible completions are:", -1);
2503 for (tail = completions, i = 0; CONSP (tail); tail = XCDR (tail), i++)
2504 {
2505 Lisp_Object tem, string;
2506 int length;
2507 Lisp_Object startpos, endpos;
2508
2509 startpos = Qnil;
2510
2511 elt = XCAR (tail);
2512 if (SYMBOLP (elt))
2513 elt = SYMBOL_NAME (elt);
2514 /* Compute the length of this element. */
2515 if (CONSP (elt))
2516 {
2517 tem = XCAR (elt);
2518 CHECK_STRING (tem);
2519 length = SCHARS (tem);
2520
2521 tem = Fcar (XCDR (elt));
2522 CHECK_STRING (tem);
2523 length += SCHARS (tem);
2524 }
2525 else
2526 {
2527 CHECK_STRING (elt);
2528 length = SCHARS (elt);
2529 }
2530
2531 /* This does a bad job for narrower than usual windows.
2532 Sadly, the window it will appear in is not known
2533 until after the text has been made. */
2534
2535 if (BUFFERP (Vstandard_output))
2536 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2537
2538 /* If the previous completion was very wide,
2539 or we have two on this line already,
2540 don't put another on the same line. */
2541 if (column > 33 || first
2542 /* If this is really wide, don't put it second on a line. */
2543 || (column > 0 && length > 45))
2544 {
2545 Fterpri (Qnil);
2546 column = 0;
2547 }
2548 /* Otherwise advance to column 35. */
2549 else
2550 {
2551 if (BUFFERP (Vstandard_output))
2552 {
2553 tem = Findent_to (make_number (35), make_number (2));
2554
2555 column = XINT (tem);
2556 }
2557 else
2558 {
2559 do
2560 {
2561 write_string (" ", -1);
2562 column++;
2563 }
2564 while (column < 35);
2565 }
2566 }
2567
2568 if (BUFFERP (Vstandard_output))
2569 {
2570 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2571 Fset_text_properties (startpos, endpos,
2572 Qnil, Vstandard_output);
2573 }
2574
2575 /* Output this element.
2576 If necessary, convert it to unibyte or to multibyte first. */
2577 if (CONSP (elt))
2578 string = Fcar (elt);
2579 else
2580 string = elt;
2581 if (NILP (current_buffer->enable_multibyte_characters)
2582 && STRING_MULTIBYTE (string))
2583 string = Fstring_make_unibyte (string);
2584 else if (!NILP (current_buffer->enable_multibyte_characters)
2585 && !STRING_MULTIBYTE (string))
2586 string = Fstring_make_multibyte (string);
2587
2588 if (BUFFERP (Vstandard_output))
2589 {
2590 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2591
2592 Fprinc (string, Qnil);
2593
2594 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2595
2596 Fput_text_property (startpos, endpos,
2597 Qmouse_face, intern ("highlight"),
2598 Vstandard_output);
2599 }
2600 else
2601 {
2602 Fprinc (string, Qnil);
2603 }
2604
2605 /* Output the annotation for this element. */
2606 if (CONSP (elt))
2607 {
2608 if (BUFFERP (Vstandard_output))
2609 {
2610 XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output)));
2611
2612 Fprinc (Fcar (Fcdr (elt)), Qnil);
2613
2614 XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output)));
2615
2616 Fset_text_properties (startpos, endpos, Qnil,
2617 Vstandard_output);
2618 }
2619 else
2620 {
2621 Fprinc (Fcar (Fcdr (elt)), Qnil);
2622 }
2623 }
2624
2625
2626 /* Update COLUMN for what we have output. */
2627 column += length;
2628
2629 /* If output is to a buffer, recompute COLUMN in a way
2630 that takes account of character widths. */
2631 if (BUFFERP (Vstandard_output))
2632 {
2633 tem = Fcurrent_column ();
2634 column = XINT (tem);
2635 }
2636
2637 first = 0;
2638 }
2639 }
2640
2641 if (BUFFERP (Vstandard_output))
2642 set_buffer_internal (old);
2643
2644 if (!NILP (Vrun_hooks))
2645 {
2646 int count1 = SPECPDL_INDEX ();
2647
2648 specbind (intern ("completion-common-substring"), common_substring);
2649 call1 (Vrun_hooks, intern ("completion-setup-hook"));
2650
2651 unbind_to (count1, Qnil);
2652 }
2653
2654 UNGCPRO;
2655
2656 return Qnil;
2657 }
2658
2659
2660 static Lisp_Object
2661 display_completion_list_1 (list)
2662 Lisp_Object list;
2663 {
2664 return Fdisplay_completion_list (list, Qnil);
2665 }
2666
2667 DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
2668 0, 0, "",
2669 doc: /* Display a list of possible completions of the current minibuffer contents. */)
2670 ()
2671 {
2672 Lisp_Object completions;
2673
2674 message ("Making completion list...");
2675 completions = Fall_completions (Fminibuffer_completion_contents (),
2676 Vminibuffer_completion_table,
2677 Vminibuffer_completion_predicate,
2678 Qt);
2679 clear_message (1, 0);
2680
2681 if (NILP (completions))
2682 {
2683 bitch_at_user ();
2684 temp_echo_area_glyphs (build_string (" [No completions]"));
2685 }
2686 else
2687 {
2688 /* Sort and remove duplicates. */
2689 Lisp_Object tmp = completions = Fsort (completions, Qstring_lessp);
2690 while (CONSP (tmp))
2691 {
2692 if (CONSP (XCDR (tmp))
2693 && !NILP (Fequal (XCAR (tmp), XCAR (XCDR (tmp)))))
2694 XSETCDR (tmp, XCDR (XCDR (tmp)));
2695 else
2696 tmp = XCDR (tmp);
2697 }
2698 internal_with_output_to_temp_buffer ("*Completions*",
2699 display_completion_list_1,
2700 completions);
2701 }
2702 return Qnil;
2703 }
2704 \f
2705 DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
2706 doc: /* Terminate minibuffer input. */)
2707 ()
2708 {
2709 if (CHARACTERP (last_command_char))
2710 internal_self_insert (XINT (last_command_char), 0);
2711 else
2712 bitch_at_user ();
2713
2714 return Fexit_minibuffer ();
2715 }
2716
2717 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
2718 doc: /* Terminate this minibuffer argument. */)
2719 ()
2720 {
2721 /* If the command that uses this has made modifications in the minibuffer,
2722 we don't want them to cause deactivation of the mark in the original
2723 buffer.
2724 A better solution would be to make deactivate-mark buffer-local
2725 (or to turn it into a list of buffers, ...), but in the mean time,
2726 this should do the trick in most cases. */
2727 Vdeactivate_mark = Qnil;
2728 Fthrow (Qexit, Qnil);
2729 }
2730
2731 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
2732 doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */)
2733 ()
2734 {
2735 return make_number (minibuf_level);
2736 }
2737
2738 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
2739 doc: /* Return the prompt string of the currently-active minibuffer.
2740 If no minibuffer is active, return nil. */)
2741 ()
2742 {
2743 return Fcopy_sequence (minibuf_prompt);
2744 }
2745
2746 \f
2747 /* Temporarily display STRING at the end of the current
2748 minibuffer contents. This is used to display things like
2749 "[No Match]" when the user requests a completion for a prefix
2750 that has no possible completions, and other quick, unobtrusive
2751 messages. */
2752
2753 extern Lisp_Object Vminibuffer_message_timeout;
2754
2755 void
2756 temp_echo_area_glyphs (string)
2757 Lisp_Object string;
2758 {
2759 int osize = ZV;
2760 int osize_byte = ZV_BYTE;
2761 int opoint = PT;
2762 int opoint_byte = PT_BYTE;
2763 Lisp_Object oinhibit;
2764 oinhibit = Vinhibit_quit;
2765
2766 /* Clear out any old echo-area message to make way for our new thing. */
2767 message (0);
2768
2769 SET_PT_BOTH (osize, osize_byte);
2770 insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 0);
2771 SET_PT_BOTH (opoint, opoint_byte);
2772 Vinhibit_quit = Qt;
2773
2774 if (NUMBERP (Vminibuffer_message_timeout))
2775 sit_for (Vminibuffer_message_timeout, 0, 2);
2776 else
2777 sit_for (Qt, 0, 2);
2778
2779 del_range_both (osize, osize_byte, ZV, ZV_BYTE, 1);
2780 SET_PT_BOTH (opoint, opoint_byte);
2781 if (!NILP (Vquit_flag))
2782 {
2783 Vquit_flag = Qnil;
2784 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
2785 }
2786 Vinhibit_quit = oinhibit;
2787 }
2788
2789 DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message,
2790 1, 1, 0,
2791 doc: /* Temporarily display STRING at the end of the minibuffer.
2792 The text is displayed for a period controlled by `minibuffer-message-timeout',
2793 or until the next input event arrives, whichever comes first. */)
2794 (string)
2795 Lisp_Object string;
2796 {
2797 CHECK_STRING (string);
2798 temp_echo_area_glyphs (string);
2799 return Qnil;
2800 }
2801 \f
2802 void
2803 init_minibuf_once ()
2804 {
2805 Vminibuffer_list = Qnil;
2806 staticpro (&Vminibuffer_list);
2807 }
2808
2809 void
2810 syms_of_minibuf ()
2811 {
2812 minibuf_level = 0;
2813 minibuf_prompt = Qnil;
2814 staticpro (&minibuf_prompt);
2815
2816 minibuf_save_list = Qnil;
2817 staticpro (&minibuf_save_list);
2818
2819 Qread_file_name_internal = intern ("read-file-name-internal");
2820 staticpro (&Qread_file_name_internal);
2821
2822 Qminibuffer_default = intern ("minibuffer-default");
2823 staticpro (&Qminibuffer_default);
2824 Fset (Qminibuffer_default, Qnil);
2825
2826 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
2827 staticpro (&Qminibuffer_completion_table);
2828
2829 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
2830 staticpro (&Qminibuffer_completion_confirm);
2831
2832 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
2833 staticpro (&Qminibuffer_completion_predicate);
2834
2835 staticpro (&last_exact_completion);
2836 last_exact_completion = Qnil;
2837
2838 staticpro (&last_minibuf_string);
2839 last_minibuf_string = Qnil;
2840
2841 Quser_variable_p = intern ("user-variable-p");
2842 staticpro (&Quser_variable_p);
2843
2844 Qminibuffer_history = intern ("minibuffer-history");
2845 staticpro (&Qminibuffer_history);
2846
2847 Qbuffer_name_history = intern ("buffer-name-history");
2848 staticpro (&Qbuffer_name_history);
2849 Fset (Qbuffer_name_history, Qnil);
2850
2851 Qminibuffer_setup_hook = intern ("minibuffer-setup-hook");
2852 staticpro (&Qminibuffer_setup_hook);
2853
2854 Qminibuffer_exit_hook = intern ("minibuffer-exit-hook");
2855 staticpro (&Qminibuffer_exit_hook);
2856
2857 Qhistory_length = intern ("history-length");
2858 staticpro (&Qhistory_length);
2859
2860 Qcurrent_input_method = intern ("current-input-method");
2861 staticpro (&Qcurrent_input_method);
2862
2863 Qactivate_input_method = intern ("activate-input-method");
2864 staticpro (&Qactivate_input_method);
2865
2866 Qcase_fold_search = intern ("case-fold-search");
2867 staticpro (&Qcase_fold_search);
2868
2869 Qread_expression_history = intern ("read-expression-history");
2870 staticpro (&Qread_expression_history);
2871
2872 DEFVAR_LISP ("read-buffer-function", &Vread_buffer_function,
2873 doc: /* If this is non-nil, `read-buffer' does its work by calling this function. */);
2874 Vread_buffer_function = Qnil;
2875
2876 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook,
2877 doc: /* Normal hook run just after entry to minibuffer. */);
2878 Vminibuffer_setup_hook = Qnil;
2879
2880 DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook,
2881 doc: /* Normal hook run just after exit from minibuffer. */);
2882 Vminibuffer_exit_hook = Qnil;
2883
2884 DEFVAR_LISP ("history-length", &Vhistory_length,
2885 doc: /* *Maximum length for history lists before truncation takes place.
2886 A number means that length; t means infinite. Truncation takes place
2887 just after a new element is inserted. Setting the `history-length'
2888 property of a history variable overrides this default. */);
2889 XSETFASTINT (Vhistory_length, 30);
2890
2891 DEFVAR_BOOL ("history-delete-duplicates", &history_delete_duplicates,
2892 doc: /* *Non-nil means to delete duplicates in history.
2893 If set to t when adding a new history element, all previous identical
2894 elements are deleted from the history list. */);
2895 history_delete_duplicates = 0;
2896
2897 DEFVAR_LISP ("history-add-new-input", &Vhistory_add_new_input,
2898 doc: /* *Non-nil means to add new elements in history.
2899 If set to nil, minibuffer reading functions don't add new elements to the
2900 history list, so it is possible to do this afterwards by calling
2901 `add-to-history' explicitly. */);
2902 Vhistory_add_new_input = Qt;
2903
2904 DEFVAR_LISP ("completion-auto-help", &Vcompletion_auto_help,
2905 doc: /* *Non-nil means automatically provide help for invalid completion input.
2906 Under Partial Completion mode, a non-nil, non-t value has a special meaning;
2907 see the doc string of `partial-completion-mode' for more details. */);
2908 Vcompletion_auto_help = Qt;
2909
2910 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
2911 doc: /* Non-nil means don't consider case significant in completion.
2912
2913 For file-name completion, the variable `read-file-name-completion-ignore-case'
2914 controls the behavior, rather than this variable. */);
2915 completion_ignore_case = 0;
2916
2917 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
2918 doc: /* *Non-nil means to allow minibuffer commands while in the minibuffer.
2919 This variable makes a difference whenever the minibuffer window is active. */);
2920 enable_recursive_minibuffers = 0;
2921
2922 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
2923 doc: /* Alist or obarray used for completion in the minibuffer.
2924 This becomes the ALIST argument to `try-completion' and `all-completions'.
2925 The value can also be a list of strings or a hash table.
2926
2927 The value may alternatively be a function, which is given three arguments:
2928 STRING, the current buffer contents;
2929 PREDICATE, the predicate for filtering possible matches;
2930 CODE, which says what kind of things to do.
2931 CODE can be nil, t or `lambda':
2932 nil -- return the best completion of STRING, or nil if there is none.
2933 t -- return a list of all possible completions of STRING.
2934 lambda -- return t if STRING is a valid completion as it stands. */);
2935 Vminibuffer_completion_table = Qnil;
2936
2937 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
2938 doc: /* Within call to `completing-read', this holds the PREDICATE argument. */);
2939 Vminibuffer_completion_predicate = Qnil;
2940
2941 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
2942 doc: /* Non-nil means to demand confirmation of completion before exiting minibuffer. */);
2943 Vminibuffer_completion_confirm = Qnil;
2944
2945 DEFVAR_LISP ("minibuffer-completing-file-name",
2946 &Vminibuffer_completing_file_name,
2947 doc: /* Non-nil and non-`lambda' means completing file names. */);
2948 Vminibuffer_completing_file_name = Qnil;
2949
2950 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
2951 doc: /* Value that `help-form' takes on inside the minibuffer. */);
2952 Vminibuffer_help_form = Qnil;
2953
2954 DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable,
2955 doc: /* History list symbol to add minibuffer values to.
2956 Each string of minibuffer input, as it appears on exit from the minibuffer,
2957 is added with
2958 (set minibuffer-history-variable
2959 (cons STRING (symbol-value minibuffer-history-variable))) */);
2960 XSETFASTINT (Vminibuffer_history_variable, 0);
2961
2962 DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position,
2963 doc: /* Current position of redoing in the history list. */);
2964 Vminibuffer_history_position = Qnil;
2965
2966 DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise,
2967 doc: /* *Non-nil means entering the minibuffer raises the minibuffer's frame.
2968 Some uses of the echo area also raise that frame (since they use it too). */);
2969 minibuffer_auto_raise = 0;
2970
2971 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list,
2972 doc: /* List of regexps that should restrict possible completions.
2973 The basic completion functions only consider a completion acceptable
2974 if it matches all regular expressions in this list, with
2975 `case-fold-search' bound to the value of `completion-ignore-case'.
2976 See Info node `(elisp)Basic Completion', for a description of these
2977 functions. */);
2978 Vcompletion_regexp_list = Qnil;
2979
2980 DEFVAR_BOOL ("minibuffer-allow-text-properties",
2981 &minibuffer_allow_text_properties,
2982 doc: /* Non-nil means `read-from-minibuffer' should not discard text properties.
2983 This also affects `read-string', but it does not affect `read-minibuffer',
2984 `read-no-blanks-input', or any of the functions that do minibuffer input
2985 with completion; they always discard text properties. */);
2986 minibuffer_allow_text_properties = 0;
2987
2988 DEFVAR_LISP ("minibuffer-prompt-properties", &Vminibuffer_prompt_properties,
2989 doc: /* Text properties that are added to minibuffer prompts.
2990 These are in addition to the basic `field' property, and stickiness
2991 properties. */);
2992 /* We use `intern' here instead of Qread_only to avoid
2993 initialization-order problems. */
2994 Vminibuffer_prompt_properties
2995 = Fcons (intern ("read-only"), Fcons (Qt, Qnil));
2996
2997 DEFVAR_LISP ("read-expression-map", &Vread_expression_map,
2998 doc: /* Minibuffer keymap used for reading Lisp expressions. */);
2999 Vread_expression_map = Qnil;
3000
3001 defsubr (&Sset_minibuffer_window);
3002 defsubr (&Sread_from_minibuffer);
3003 defsubr (&Seval_minibuffer);
3004 defsubr (&Sread_minibuffer);
3005 defsubr (&Sread_string);
3006 defsubr (&Sread_command);
3007 defsubr (&Sread_variable);
3008 defsubr (&Sinternal_complete_buffer);
3009 defsubr (&Sread_buffer);
3010 defsubr (&Sread_no_blanks_input);
3011 defsubr (&Sminibuffer_depth);
3012 defsubr (&Sminibuffer_prompt);
3013
3014 defsubr (&Sminibufferp);
3015 defsubr (&Sminibuffer_prompt_end);
3016 defsubr (&Sminibuffer_contents);
3017 defsubr (&Sminibuffer_contents_no_properties);
3018 defsubr (&Sminibuffer_completion_contents);
3019 defsubr (&Sdelete_minibuffer_contents);
3020
3021 defsubr (&Stry_completion);
3022 defsubr (&Sall_completions);
3023 defsubr (&Stest_completion);
3024 defsubr (&Sassoc_string);
3025 defsubr (&Scompleting_read);
3026 defsubr (&Sminibuffer_complete);
3027 defsubr (&Sminibuffer_complete_word);
3028 defsubr (&Sminibuffer_complete_and_exit);
3029 defsubr (&Sdisplay_completion_list);
3030 defsubr (&Sminibuffer_completion_help);
3031
3032 defsubr (&Sself_insert_and_exit);
3033 defsubr (&Sexit_minibuffer);
3034
3035 defsubr (&Sminibuffer_message);
3036 }
3037
3038 void
3039 keys_of_minibuf ()
3040 {
3041 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
3042 "abort-recursive-edit");
3043 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
3044 "exit-minibuffer");
3045 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
3046 "exit-minibuffer");
3047
3048 initial_define_key (Vminibuffer_local_ns_map, ' ',
3049 "exit-minibuffer");
3050 initial_define_key (Vminibuffer_local_ns_map, '\t',
3051 "exit-minibuffer");
3052 initial_define_key (Vminibuffer_local_ns_map, '?',
3053 "self-insert-and-exit");
3054
3055 initial_define_key (Vminibuffer_local_completion_map, '\t',
3056 "minibuffer-complete");
3057 initial_define_key (Vminibuffer_local_completion_map, ' ',
3058 "minibuffer-complete-word");
3059 initial_define_key (Vminibuffer_local_completion_map, '?',
3060 "minibuffer-completion-help");
3061
3062 Fdefine_key (Vminibuffer_local_filename_completion_map,
3063 build_string (" "), Qnil);
3064
3065 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
3066 "minibuffer-complete-and-exit");
3067 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
3068 "minibuffer-complete-and-exit");
3069
3070 Fdefine_key (Vminibuffer_local_must_match_filename_map,
3071 build_string (" "), Qnil);
3072 }
3073
3074 /* arch-tag: 8f69b601-fba3-484c-a6dd-ceaee54a7a73
3075 (do not change this comment) */