Return to minibuf.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src

Annotation of 43BSD/contrib/emacs/src/minibuf.c, revision 1.1

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.