![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to minibuf.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src|
Return to minibuf.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* Minibuffer input and completion.
2: Copyright (C) 1985 Richard M. Stallman.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include <ctype.h>
23: #include "config.h"
24: #include "lisp.h"
25: #include "commands.h"
26: #include "buffer.h"
27: #include "window.h"
28: #include "syntax.h"
29: #include "dispextern.h"
30:
31: #define min(a, b) ((a) < (b) ? (a) : (b))
32:
33: /* List of buffers for use as minibuffers.
34: The first element of the list is used for the outermost minibuffer invocation,
35: the next element is used for a recursive minibuffer invocation, etc.
36: The list is extended at the end as deeped minibuffer recursions are encountered. */
37: Lisp_Object Vminibuffer_list;
38:
39: struct minibuf_save_data
40: {
41: char *prompt;
42: int prompt_width;
43: Lisp_Object help_form;
44: };
45:
46: int minibuf_save_vector_size;
47: struct minibuf_save_data *minibuf_save_vector;
48:
49: int auto_help; /* Nonzero means display completion help for invalid input */
50:
51: /* Fread_minibuffer leaves the input, as a string, here */
52: Lisp_Object last_minibuf_string;
53:
54: /* Nonzero means let functions called when within a minibuffer
55: invoke recursive minibuffers (to read arguments, or whatever) */
56: int enable_recursive_minibuffers;
57:
58: /* help-form is bound to this while in the minibuffer. */
59:
60: Lisp_Object Vminibuffer_help_form;
61:
62: /* Nonzero means completion ignores case. */
63:
64: int completion_ignore_case;
65:
66: Lisp_Object Quser_variable_p;
67:
68: /* Width in columns of current minibuffer prompt. */
69:
70: extern int minibuf_prompt_width;
71:
72: /* Actual minibuffer invocation. */
73:
74: void read_minibuf_string_unwind ();
75: Lisp_Object get_minibuffer ();
76: Lisp_Object read_minibuf ();
77:
78: Lisp_Object
79: read_minibuf_string (map, prefix, prompt)
80: Lisp_Object map;
81: Lisp_Object prefix;
82: Lisp_Object prompt;
83: {
84: return read_minibuf (map, prefix, prompt, 0);
85: }
86:
87:
88: Lisp_Object
89: read_minibuf (map, prefix, prompt, expflag)
90: Lisp_Object map;
91: Lisp_Object prefix;
92: Lisp_Object prompt;
93: int expflag;
94: {
95: Lisp_Object val;
96: int count = specpdl_ptr - specpdl;
97:
98: if (!enable_recursive_minibuffers &&
99: (EQ (selected_window, minibuf_window)))
100: error ("Command attempted to use minibuffer while in minibuffer");
101:
102: if (MinibufDepth == minibuf_save_vector_size)
103: minibuf_save_vector =
104: (struct minibuf_save_data *) xrealloc (minibuf_save_vector,
105: (minibuf_save_vector_size *= 2) * sizeof (struct minibuf_save_data));
106: minibuf_save_vector[MinibufDepth].prompt = minibuf_prompt;
107: minibuf_save_vector[MinibufDepth].help_form = Vhelp_form;
108: minibuf_save_vector[MinibufDepth].prompt_width = minibuf_prompt_width;
109: minibuf_prompt_width = 0;
110:
111: record_unwind_protect (save_window_restore, save_window_save ());
112:
113: val = bf_cur->directory;
114: Fset_buffer (get_minibuffer (MinibufDepth + 1));
115: bf_cur->directory = val;
116:
117: Fshow_buffer (minibuf_window, Fcurrent_buffer ());
118: Fselect_window (minibuf_window);
119: XFASTINT (XWINDOW (minibuf_window)->hscroll) = 0;
120:
121: Ferase_buffer ();
122: MinibufDepth++;
123: record_unwind_protect (read_minibuf_string_unwind, Qnil);
124:
125: if (!NULL (prefix))
126: Finsert (1, &prefix);
127:
128: minibuf_prompt = (char *) alloca (XSTRING (prompt)->size + 1);
129: bcopy (XSTRING (prompt)->data, minibuf_prompt, XSTRING (prompt)->size + 1);
130: minibuf_message = 0;
131:
132: Vhelp_form = Vminibuffer_help_form;
133: bf_cur->keymap = map;
134: Frecursive_edit ();
135:
136: /* If cursor is on the minibuffer line,
137: show the user we have exited by putting it in column 0. */
138: if (cursY >= XFASTINT (XWINDOW (minibuf_window)->top)
139: && !noninteractive)
140: {
141: cursX = 0;
142: update_screen (1, 1);
143: }
144:
145: /* Make minibuffer contents into a string */
146: val = make_string (&CharAt (1), bf_s1 + bf_s2);
147: bcopy (bf_p2 + bf_s1 + 1,
148: XSTRING (val)->data + bf_s1,
149: bf_s2);
150:
151: last_minibuf_string = val;
152:
153: /* If Lisp form desired instead of string, read buffer contents */
154: if (expflag)
155: {
156: SetPoint (1);
157: val = Fread (Fcurrent_buffer ());
158: }
159:
160: unbind_to (count);
161: return val;
162: }
163:
164: /* Return a buffer to be used as the minibuffer at depth `depth'.
165: depth = 0 is the lowest allowed argument, and that is the value
166: used for nonrecursive minibuffer invocations */
167:
168: Lisp_Object
169: get_minibuffer (depth)
170: int depth;
171: {
172: Lisp_Object tail, num, buf;
173: char name[14];
174: extern Lisp_Object nconc2 ();
175:
176: XFASTINT (num) = depth;
177: tail = Fnthcdr (num, Vminibuffer_list);
178: if (NULL (tail))
179: {
180: tail = Fcons (Qnil, Qnil);
181: Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
182: }
183: buf = Fcar (tail);
184: if (NULL (buf) || NULL (XBUFFER (buf)->name))
185: {
186: sprintf (name, " *Minibuf-%d*", depth);
187: buf = Fget_buffer_create (build_string (name));
188: XCONS (tail)->car = buf;
189: }
190: else
191: reset_buffer (XBUFFER (buf));
192: return buf;
193: }
194:
195: /* This function is called on exiting minibuffer, whether normally or not,
196: and it restores the current window, buffer, etc. */
197:
198: void
199: read_minibuf_string_unwind ()
200: {
201: Ferase_buffer ();
202:
203: /* If this was a recursive minibuffer,
204: tie the minibuffer window back to the outer level minibuffer buffer */
205: MinibufDepth--;
206: /* Make sure minibuffer window is erased, not ignored */
207: windows_or_buffers_changed++;
208: XFASTINT (XWINDOW (minibuf_window)->last_modified) = 0;
209:
210: /* Restore prompt from outer minibuffer */
211: minibuf_prompt = minibuf_save_vector[MinibufDepth].prompt;
212: minibuf_prompt_width = minibuf_save_vector[MinibufDepth].prompt_width;
213: Vhelp_form = minibuf_save_vector[MinibufDepth].help_form;
214: }
215:
216: DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 4, 0,
217: "Read a string from the minibuffer, prompting with string PROMPT.\n\
218: If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
219: to be inserted into the minibuffer before reading input.\n\
220: Third arg KEYMAP is a keymap to use whilst reading; the default is\n\
221: minibuffer-local-map.\n\
222: If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
223: and return that object (ie (car (read-from-string <input-string>)))")
224: (prompt, initial_input, keymap, read)
225: Lisp_Object prompt, initial_input, keymap, read;
226: {
227: CHECK_STRING (prompt, 0);
228: if (!NULL (initial_input))
229: CHECK_STRING (initial_input, 1);
230: if (NULL (keymap))
231: keymap = Vminibuffer_local_map;
232: else
233: keymap = get_keymap (keymap,2);
234: return read_minibuf (keymap, initial_input, prompt, !NULL(read));
235: }
236:
237: DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
238: "Return a Lisp object read using the minibuffer.\n\
239: Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
240: is a string to insert in the minibuffer before reading.")
241: (prompt, initial_contents)
242: Lisp_Object prompt, initial_contents;
243: {
244: CHECK_STRING (prompt, 0);
245: if (!NULL (initial_contents))
246: CHECK_STRING (initial_contents, 1)
247: return read_minibuf (Vminibuffer_local_map, initial_contents, prompt, 1);
248: }
249:
250: DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
251: "Return value of Lisp expression read using the minibuffer.\n\
252: Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
253: is a string to insert in the minibuffer before reading.")
254: (prompt, initial_contents)
255: Lisp_Object prompt, initial_contents;
256: {
257: return Feval (Fread_minibuffer (prompt, initial_contents));
258: }
259:
260: /* Functions that use the minibuffer to read various things. */
261:
262: DEFUN ("read-string", Fread_string, Sread_string, 1, 2, 0,
263: "Read a string from the minibuffer, prompting with string PROMPT.\n\
264: If non-nil second arg INITIAL-INPUT is a string to insert before reading.")
265: (prompt, initial_input)
266: Lisp_Object prompt, initial_input;
267: {
268: return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil);
269: }
270:
271: DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 2, 2, 0,
272: "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
273: Prompt with PROMPT, and provide INIT as an initial value of the input string.")
274: (prompt, init)
275: Lisp_Object prompt, init;
276: {
277: CHECK_STRING (prompt, 0);
278: CHECK_STRING (init, 1);
279:
280: return read_minibuf_string (Vminibuffer_local_ns_map, init, prompt);
281: }
282:
283: DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
284: "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
285: Prompts with PROMPT.")
286: (prompt)
287: Lisp_Object prompt;
288: {
289: return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil),
290: Qnil);
291: }
292:
293: #ifdef NOTDEF
294: DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
295: "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
296: Prompts with PROMPT.")
297: (prompt)
298: Lisp_Object prompt;
299: {
300: return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil),
301: Qnil);
302: }
303: #endif /* NOTDEF */
304:
305: DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
306: "One arg PROMPT, a string. Read the name of a user variable and return\n\
307: it as a symbol. Prompts with PROMPT.\n\
308: A user variable is one whose documentation starts with a \"*\" character.")
309: (prompt)
310: Lisp_Object prompt;
311: {
312: return Fintern (Fcompleting_read (prompt, Vobarray,
313: Quser_variable_p, Qt, Qnil),
314: Qnil);
315: }
316:
317: DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
318: "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
319: Prompts with PROMPT.\n\
320: Optional second arg is value to return if user enters an empty line.\n\
321: If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
322: (prompt, def, require_match)
323: Lisp_Object prompt, def, require_match;
324: {
325: Lisp_Object tem;
326: Lisp_Object args[3];
327: struct gcpro gcpro1;
328:
329: if (XTYPE (def) == Lisp_Buffer)
330: def = XBUFFER (def)->name;
331: if (!NULL (def))
332: {
333: args[0] = build_string ("%s(default %s) ");
334: args[1] = prompt;
335: args[2] = def;
336: prompt = Fformat (3, args);
337: }
338: GCPRO1 (def);
339: tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil);
340: UNGCPRO;
341: if (XSTRING (tem)->size)
342: return tem;
343: return def;
344: }
345:
346: DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
347: "Return common substring of all completions of STRING in ALIST.\n\
348: Each car of each element of ALIST is tested to see if it begins with STRING.\n\
349: All that match are compared together; the longest initial sequence\n\
350: common to all matches is returned as a string.\n\
351: If there is no match at all, nil is returned.\n\
352: For an exact match, t is returned.\n\
353: \n\
354: ALIST can be an obarray instead of an alist.\n\
355: Then the print names of all symbols in the obarray are the possible matches.\n\
356: \n\
357: If optional third argument PREDICATE is non-nil,\n\
358: it is used to test each possible match.\n\
359: The match is a candidate only if PREDICATE returns non-nil.\n\
360: The argument given to PREDICATE is the alist element or the symbol from the obarray.")
361: (string, alist, pred)
362: Lisp_Object string, alist, pred;
363: {
364: Lisp_Object bestmatch, tail, elt, eltstring;
365: int bestmatchsize;
366: int compare, matchsize;
367: int list = LISTP (alist);
368: int index, obsize;
369: int matchcount = 0;
370: Lisp_Object bucket, zero, end, tem;
371:
372: CHECK_STRING (string, 0);
373: if (!list && XTYPE (alist) != Lisp_Vector)
374: return call3 (alist, string, pred, Qnil);
375:
376: bestmatch = Qnil;
377:
378: if (list)
379: tail = alist;
380: else
381: {
382: index = 0;
383: obsize = XVECTOR (alist)->size;
384: bucket = XVECTOR (alist)->contents[index];
385: }
386:
387: while (1)
388: {
389: /* Get the next element of the alist or obarray. */
390: /* Exit the loop if the elements are all used up. */
391: /* elt gets the alist element or symbol.
392: eltstring gets the name to check as a completion. */
393:
394: if (list)
395: {
396: if (NULL (tail))
397: break;
398: elt = Fcar (tail);
399: eltstring = Fcar (elt);
400: tail = Fcdr (tail);
401: }
402: else
403: {
404: if (XSYMBOL (bucket))
405: {
406: elt = bucket;
407: eltstring = Fsymbol_name (elt);
408: XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
409: }
410: else if (++index >= obsize)
411: break;
412: else
413: {
414: bucket = XVECTOR (alist)->contents[index];
415: continue;
416: }
417: }
418:
419: /* Is this element a possible completion? */
420:
421: if (XTYPE (eltstring) == Lisp_String &&
422: XSTRING (string)->size <= XSTRING (eltstring)->size &&
423: -1 == scmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size))
424: {
425: /* Yes. */
426: /* Ignore this element if there is a predicate and the predicate doesn't like it. */
427:
428: if (!NULL (pred))
429: {
430: if (EQ (pred, Qcommandp))
431: tem = Fcommandp (elt);
432: else
433: {
434: tem = call1 (pred, elt);
435: }
436: if (NULL (tem)) continue;
437: }
438:
439: /* Update computation of how much all possible completions match */
440:
441: matchcount++;
442: if (NULL (bestmatch))
443: bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
444: else
445: {
446: compare = min (bestmatchsize, XSTRING (eltstring)->size);
447: matchsize = scmp (XSTRING (bestmatch)->data,
448: XSTRING (eltstring)->data,
449: compare);
450: bestmatchsize = (matchsize >= 0) ? matchsize : compare;
451: }
452: }
453: }
454:
455: if (NULL (bestmatch))
456: return Qnil; /* No completions found */
457: if (matchcount == 1 && bestmatchsize == XSTRING (string)->size)
458: return Qt;
459:
460: XFASTINT (zero) = 0; /* Else extract the part in which */
461: XFASTINT (end) = bestmatchsize; /* all completions agree */
462: return Fsubstring (bestmatch, zero, end);
463: }
464:
465: /* Like strncmp but ignores case differences if appropriate.
466: Also return value is different:
467: -1 if strings match,
468: else number of chars that match at the beginning. */
469:
470: #define cvt(c) (islower (c) ? c + 'A' - 'a' : c)
471:
472: scmp (s1, s2, len)
473: register char *s1, *s2;
474: int len;
475: {
476: register int l = len;
477:
478: if (completion_ignore_case)
479: {
480: while (l && *s1 && cvt (*s1) == cvt (*s2))
481: {
482: l--;
483: s1++;
484: s2++;
485: }
486: }
487: else
488: {
489: while (l && *s1 && *s1 == *s2)
490: {
491: l--;
492: s1++;
493: s2++;
494: }
495: }
496: if (l == 0 || (*s1 == 0 && *s2 == 0))
497: return -1;
498: else return len - l;
499: }
500:
501: DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 3, 0,
502: "Search for partial matches to STRING in ALIST.\n\
503: Each car of each element of ALIST is tested to see if it begins with STRING.\n\
504: The value is a list of all the strings from ALIST that match.\n\
505: ALIST can be an obarray instead of an alist.\n\
506: Then the print names of all symbols in the obarray are the possible matches.\n\
507: \n\
508: If optional third argument PREDICATE is non-nil,\n\
509: it is used to test each possible match.\n\
510: The match is a candidate only if PREDICATE returns non-nil.\n\
511: The argument given to PREDICATE is the alist element or the symbol from the obarray.")
512: (string, alist, pred)
513: Lisp_Object string, alist, pred;
514: {
515: Lisp_Object tail, elt, eltstring;
516: Lisp_Object allmatches;
517: int list = LISTP (alist);
518: int index, obsize;
519: Lisp_Object bucket, tem;
520:
521: CHECK_STRING (string, 0);
522: if (!list && XTYPE (alist) != Lisp_Vector)
523: {
524: return call3 (alist, string, pred, Qt);
525: }
526: allmatches = Qnil;
527:
528: if (list)
529: tail = alist;
530: else
531: {
532: index = 0;
533: obsize = XVECTOR (alist)->size;
534: bucket = XVECTOR (alist)->contents[index];
535: }
536:
537: while (1)
538: {
539: /* Get the next element of the alist or obarray. */
540: /* Exit the loop if the elements are all used up. */
541: /* elt gets the alist element or symbol.
542: eltstring gets the name to check as a completion. */
543:
544: if (list)
545: {
546: if (NULL (tail))
547: break;
548: elt = Fcar (tail);
549: eltstring = Fcar (elt);
550: tail = Fcdr (tail);
551: }
552: else
553: {
554: if (XSYMBOL (bucket))
555: {
556: elt = bucket;
557: eltstring = Fsymbol_name (elt);
558: XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
559: }
560: else if (++index >= obsize)
561: break;
562: else
563: {
564: bucket = XVECTOR (alist)->contents[index];
565: continue;
566: }
567: }
568:
569: /* Is this element a possible completion? */
570:
571: if (XTYPE (eltstring) == Lisp_String &&
572: XSTRING (string)->size <= XSTRING (eltstring)->size &&
573: XSTRING (eltstring)->data[0] != ' ' &&
574: -1 == scmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size))
575: {
576: /* Yes. */
577: /* Ignore this element if there is a predicate and the predicate doesn't like it. */
578:
579: if (!NULL (pred))
580: {
581: if (EQ (pred, Qcommandp))
582: tem = Fcommandp (elt);
583: else
584: tem = call1 (pred, elt);
585: if (NULL (tem)) continue;
586: }
587: /* Ok => put it on the list. */
588: allmatches = Fcons (eltstring, allmatches);
589: }
590: }
591:
592: return Fnreverse (allmatches);
593: }
594:
595: Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
596: Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
597: Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
598:
599: DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 5, 0,
600: "Read a string in the minibuffer, with completion.\n\
601: Args are PROMPT, TABLE, PREDICATE, REQUIRE-MATCH and INITIAL-INPUT.\n\
602: PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
603: TABLE is an alist whose elements' cars are strings, or an obarray (see try-completion).\n\
604: PREDICATE limits completion to a subset of TABLE; see try-completion for details.\n\
605: If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
606: the input is (or completes to) an element of TABLE.\n\
607: If it is also not t, Return does not exit if it does non-null completion.\n\
608: If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
609: Case is ignored if ambient value of completion-ignore-case is non-nil.")
610: (prompt, table, pred, require_match, init)
611: Lisp_Object prompt, table, pred, require_match, init;
612: {
613: Lisp_Object val;
614: int count = specpdl_ptr - specpdl;
615: specbind (Qminibuffer_completion_table, table);
616: specbind (Qminibuffer_completion_predicate, pred);
617: specbind (Qminibuffer_completion_confirm,
618: EQ (require_match, Qt) ? Qnil : Qt);
619: val = read_minibuf_string (NULL (require_match)
620: ? Vminibuffer_local_completion_map
621: : Vminibuffer_local_must_match_map,
622: init, prompt);
623: unbind_to (count);
624: return val;
625: }
626:
627: temp_minibuf_message (m)
628: char *m;
629: {
630: int osize = NumCharacters + 1;
631: Lisp_Object oinhibit;
632: oinhibit = Vinhibit_quit;
633:
634: SetPoint (osize);
635: InsStr (m);
636: SetPoint (osize);
637: Vinhibit_quit = Qt;
638: Fsit_for (make_number (2));
639: del_range (point, NumCharacters + 1);
640: if (!NULL (Vquit_flag))
641: {
642: Vquit_flag = Qnil;
643: unread_command_char = Ctl ('g');
644: }
645: Vinhibit_quit = oinhibit;
646: }
647:
648: Lisp_Object Fminibuffer_completion_help ();
649:
650: /* returns:
651: * 0 no possible completion
652: * 1 was already an exact and unique completion
653: * 3 was already an exact completion
654: * 4 completed to an exact completion
655: * 5 some completion happened
656: * 6 no completion happened
657: */
658: int
659: do_completion ()
660: {
661: Lisp_Object completion, tem;
662: int completedp = 0;
663:
664: completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
665: Vminibuffer_completion_predicate);
666: if (NULL (completion))
667: {
668: Ding ();
669: temp_minibuf_message (" [No match]");
670: return 0;
671: }
672:
673: if (EQ (completion, Qt)) /* exact and unique match */
674: return 1;
675:
676: /* compiler bug */
677: tem = Fstring_equal (completion, Fbuffer_string());
678: if (completedp = NULL (tem))
679: {
680: Ferase_buffer (); /* Some completion happened */
681: Finsert (1, &completion);
682: }
683:
684: /* It did find a match. Do we match some possibility exactly now? */
685: if (LISTP (Vminibuffer_completion_table))
686: tem = Fassoc (Fbuffer_string (), Vminibuffer_completion_table);
687: else if (XTYPE (Vminibuffer_completion_table) == Lisp_Vector)
688: {
689: /* the primitive used by Fintern_soft */
690: extern Lisp_Object oblookup ();
691:
692: tem = Fbuffer_string ();
693: /* Bypass intern-soft as that loses for nil */
694: tem = oblookup (Vminibuffer_completion_table,
695: XSTRING (tem)->data, XSTRING (tem)->size);
696: if (XTYPE (tem) != Lisp_Symbol)
697: tem = Qnil;
698: else if (!NULL (Vminibuffer_completion_predicate))
699: tem = call1 (Vminibuffer_completion_predicate, tem);
700: else
701: tem = Qt;
702: }
703: else
704: tem = call3 (Vminibuffer_completion_table,
705: Fbuffer_string (),
706: Vminibuffer_completion_predicate,
707: Qlambda);
708:
709: if (NULL (tem))
710: { /* not an exact match */
711: if (completedp)
712: return 5;
713: else if (auto_help)
714: Fminibuffer_completion_help ();
715: else
716: temp_minibuf_message (" [Next char not unique]");
717: return 6;
718: }
719: else
720: return (completedp ? 4 : 3);
721: }
722:
723:
724: DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
725: "Complete the minibuffer contents as far as possible.")
726: ()
727: {
728: register int i = do_completion ();
729: switch (i)
730: {
731: case 0:
732: return Qnil;
733:
734: case 1:
735: temp_minibuf_message(" [Sole completion]");
736: break;
737:
738: case 3:
739: temp_minibuf_message(" [Complete, but not unique]");
740: break;
741: }
742: return Qt;
743: }
744:
745: DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
746: Sminibuffer_complete_and_exit, 0, 0, "",
747: "Complete the minibuffer contents, and maybe exit.\n\
748: Exit if the name is valid with no completion needed.\n\
749: If name was completed to a valid match,\n\
750: a repetition of this command will exit.")
751: ()
752: {
753: register int i;
754:
755: /* Allow user to specify null string */
756: if (NumCharacters == 0)
757: goto exit;
758:
759: i = do_completion ();
760: switch (i)
761: {
762: case 1:
763: case 3:
764: goto exit;
765:
766: case 4:
767: if (!NULL (Vminibuffer_completion_confirm))
768: {
769: temp_minibuf_message(" [Confirm]");
770: return Qnil;
771: }
772: else
773: goto exit;
774:
775: default:
776: return Qnil;
777: }
778: exit:
779: Fthrow (Qexit, Qnil);
780: /* NOTREACHED */
781: }
782:
783: DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
784: 0, 0, "",
785: "Complete the minibuffer contents at most a single word.")
786: ()
787: {
788: Lisp_Object completion, tem;
789: register unsigned char *b;
790: register unsigned char *p;
791: register int i;
792:
793: /* We keep calling Fbuffer_string
794: rather than arrange for GC to hold onto a pointer to
795: one of the strings thus made. */
796:
797: completion = Ftry_completion (Fbuffer_string (),
798: Vminibuffer_completion_table,
799: Vminibuffer_completion_predicate);
800: if (NULL (completion))
801: {
802: Ding ();
803: temp_minibuf_message (" [No match]");
804: return Qnil;
805: }
806: if (EQ (completion, Qt))
807: return Qnil;
808:
809: tem = Fbuffer_string ();
810: b = XSTRING (tem)->data;
811: i = NumCharacters - XSTRING (completion)->size;
812: p = XSTRING (completion)->data;
813: if (i > 0 ||
814: 0 <= scmp (b, p, NumCharacters))
815: {
816: i = 1;
817: /* Set buffer to longest match of buffer tail and completion head. */
818: while (0 <= scmp (b + i, p, NumCharacters - i))
819: i++;
820: del_range (1, i + 1);
821: SetPoint (NumCharacters + 1);
822: }
823:
824: i = NumCharacters;
825:
826: /* If completion finds next char not unique,
827: consider adding a space or a hyphen */
828: if (i == XSTRING (completion)->size)
829: {
830: tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
831: Vminibuffer_completion_table,
832: Vminibuffer_completion_predicate);
833: if (XTYPE (tem) == Lisp_String)
834: completion = tem;
835: else
836: {
837: tem = Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
838: Vminibuffer_completion_table,
839: Vminibuffer_completion_predicate);
840: if (XTYPE (tem) == Lisp_String)
841: completion = tem;
842: }
843: }
844:
845: /* Now find first word-break in the stuff found by completion.
846: i gets index in string of where to stop completing. */
847: p = XSTRING (completion)->data;
848:
849: for (; i < XSTRING (completion)->size; i++)
850: if (SYNTAX (p[i]) != Sword) break;
851: if (i < XSTRING (completion)->size)
852: i = i + 1;
853:
854: /* If got no characters, print help for user. */
855:
856: if (i == NumCharacters)
857: {
858: if (auto_help)
859: Fminibuffer_completion_help ();
860: return Qnil;
861: }
862:
863: /* Otherwise insert in minibuffer the chars we got */
864:
865: Ferase_buffer ();
866: InsCStr (p, i);
867: return Qt;
868: }
869:
870: Lisp_Object
871: minibuffer_completion_help_1 (completions)
872: Lisp_Object completions;
873: {
874: register Lisp_Object tail;
875: register int i;
876: struct buffer *old = bf_cur;
877: SetBfp (XBUFFER (Vstandard_output));
878:
879: if (NULL (completions))
880: InsStr ("There are no possible completions of what you have typed.");
881: else
882: {
883: InsStr ("Possible completions are:");
884: for (tail = completions, i = 0; !NULL (tail); tail = Fcdr (tail), i++)
885: {
886: /* this needs fixing for the case of long completions
887: and/or narrow windows */
888: /* Sadly, the window it will appear in is not known
889: until after the text has been made. */
890: if (i & 1)
891: Findent_to (make_number (35), make_number (1));
892: else
893: Fterpri (Qnil);
894: Fprinc (Fcar (tail), Qnil);
895: }
896: }
897: SetBfp (old);
898: return Qnil;
899: }
900:
901: DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
902: 0, 0, "",
903: "Display a list of possible completions of the current minibuffer contents.")
904: ()
905: {
906: Lisp_Object completions;
907: message ("Making completion list...");
908: completions = Fall_completions (Fbuffer_string (), Vminibuffer_completion_table,
909: Vminibuffer_completion_predicate);
910: minibuf_message = 0;
911: if (NULL (completions))
912: { Ding ();
913: temp_minibuf_message (" [No completions]"); }
914: else
915: internal_with_output_to_temp_buffer (" *Completions*",
916: minibuffer_completion_help_1,
917: Fsort (completions, Qstring_lessp));
918: return Qnil;
919: }
920:
921: DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
922: "Terminate minibuffer input.")
923: ()
924: {
925: SelfInsert (last_command_char);
926: Fthrow (Qexit, Qnil);
927: }
928:
929: DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
930: "Terminate this minibuffer argument.")
931: ()
932: {
933: Fthrow (Qexit, Qnil);
934: }
935:
936: init_minibuf_once ()
937: {
938: Vminibuffer_list = Qnil;
939: staticpro (&Vminibuffer_list);
940: }
941:
942: syms_of_minibuf ()
943: {
944: MinibufDepth = 0;
945: minibuf_prompt = 0;
946: minibuf_save_vector_size = 5;
947: minibuf_save_vector = (struct minibuf_save_data *) malloc (5 * sizeof (struct minibuf_save_data));
948:
949: Qminibuffer_completion_table = intern ("minibuffer-completion-table");
950: staticpro (&Qminibuffer_completion_table);
951:
952: Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
953: staticpro (&Qminibuffer_completion_confirm);
954:
955: Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
956: staticpro (&Qminibuffer_completion_predicate);
957:
958: staticpro (&last_minibuf_string);
959: last_minibuf_string = Qnil;
960:
961: Quser_variable_p = intern ("user-variable-p");
962: staticpro (&Quser_variable_p);
963:
964:
965:
966: DefBoolVar ("completion-auto-help", &auto_help,
967: "*Non-nil means automatically provide help for invalid completion input.");
968: auto_help = 1;
969:
970: DefBoolVar ("completion-ignore-case", &completion_ignore_case,
971: "Non-nil means don't consider case significant in completion.");
972: completion_ignore_case = 0;
973:
974: DefBoolVar ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
975: "*Non-nil means to allow minibuffers to invoke commands which use\n\
976: recursive minibuffers.");
977: enable_recursive_minibuffers = 0;
978:
979: DefLispVar ("minibuffer-completion-table", &Vminibuffer_completion_table,
980: "Alist or obarray used for completion in the minibuffer.");
981: Vminibuffer_completion_table = Qnil;
982:
983: DefLispVar ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
984: "Holds PREDICATE argument to completing-read.");
985: Vminibuffer_completion_predicate = Qnil;
986:
987: DefLispVar ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
988: "Non-nil => demand confirmation of completion before exiting minibuffer.");
989: Vminibuffer_completion_confirm = Qnil;
990:
991: DefLispVar ("minibuffer-help-form", &Vminibuffer_help_form,
992: "Value that help-form takes on inside the minibuffer.");
993: Vminibuffer_help_form = Qnil;
994:
995: defsubr (&Sread_from_minibuffer);
996: defsubr (&Seval_minibuffer);
997: defsubr (&Sread_minibuffer);
998: defsubr (&Sread_string);
999: defalias (&Sread_string, "read-input");
1000: defsubr (&Sread_command);
1001: defsubr (&Sread_variable);
1002: defsubr (&Sread_buffer);
1003: defsubr (&Sread_no_blanks_input);
1004:
1005: defsubr (&Stry_completion);
1006: defsubr (&Sall_completions);
1007: defsubr (&Scompleting_read);
1008: defsubr (&Sminibuffer_complete);
1009: defsubr (&Sminibuffer_complete_word);
1010: defsubr (&Sminibuffer_complete_and_exit);
1011: defsubr (&Sminibuffer_completion_help);
1012:
1013: defsubr (&Sself_insert_and_exit);
1014: defsubr (&Sexit_minibuffer);
1015:
1016: }
1017:
1018: keys_of_minibuf ()
1019: {
1020: ndefkey (Vminibuffer_local_map, Ctl ('g'), "abort-recursive-edit");
1021: ndefkey (Vminibuffer_local_map, Ctl ('m'), "exit-minibuffer");
1022: ndefkey (Vminibuffer_local_map, Ctl ('j'), "exit-minibuffer");
1023:
1024: ndefkey (Vminibuffer_local_ns_map, Ctl ('g'), "abort-recursive-edit");
1025: ndefkey (Vminibuffer_local_ns_map, Ctl ('m'), "exit-minibuffer");
1026: ndefkey (Vminibuffer_local_ns_map, Ctl ('j'), "exit-minibuffer");
1027:
1028: ndefkey (Vminibuffer_local_ns_map, ' ', "exit-minibuffer");
1029: ndefkey (Vminibuffer_local_ns_map, '\t', "exit-minibuffer");
1030: ndefkey (Vminibuffer_local_ns_map, '?', "self-insert-and-exit");
1031:
1032: ndefkey (Vminibuffer_local_completion_map, Ctl ('g'), "abort-recursive-edit");
1033: ndefkey (Vminibuffer_local_completion_map, Ctl ('m'), "exit-minibuffer");
1034: ndefkey (Vminibuffer_local_completion_map, Ctl ('j'), "exit-minibuffer");
1035: ndefkey (Vminibuffer_local_completion_map, '\t', "minibuffer-complete");
1036: ndefkey (Vminibuffer_local_completion_map, ' ', "minibuffer-complete-word");
1037: ndefkey (Vminibuffer_local_completion_map, '?', "minibuffer-completion-help");
1038:
1039: ndefkey (Vminibuffer_local_must_match_map, Ctl ('g'), "abort-recursive-edit");
1040: ndefkey (Vminibuffer_local_must_match_map, Ctl ('m'), "minibuffer-complete-and-exit");
1041: ndefkey (Vminibuffer_local_must_match_map, Ctl ('j'), "minibuffer-complete-and-exit");
1042: ndefkey (Vminibuffer_local_must_match_map, '\t', "minibuffer-complete");
1043: ndefkey (Vminibuffer_local_must_match_map, ' ', "minibuffer-complete-word");
1044: ndefkey (Vminibuffer_local_must_match_map, '?', "minibuffer-completion-help");
1045: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.