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