4.3BSD - /usr/src/new/emacs/src/minibuf.c

   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: }

Defined functions

Defined variables

Defined struct's

Defined macros