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