X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/536aa4668198bf4851356a8e3a57b7f8969014c3..becf0483bf5ca42b0aab7533ed02ff21cc509c1a:/src/minibuf.c diff --git a/src/minibuf.c b/src/minibuf.c index 8b742cf88c..5df56a5f98 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -205,7 +205,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt) } val = Fcar (expr_and_pos); - RETURN_UNGCPRO (val); + return val; } @@ -231,7 +231,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, val = Qnil; size = 100; len = 0; - line = xmalloc (size); + line = xmalloc_atomic (size); while ((c = getchar ()) != '\n') { @@ -377,13 +377,14 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, bool allow_props, bool inherit_input_method) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); Lisp_Object mini_frame, ambient_dir, minibuffer, input_method; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; Lisp_Object enable_multibyte; EMACS_INT pos = 0; /* String to add to the history. */ Lisp_Object histstring; + Lisp_Object histval; Lisp_Object empty_minibuf; Lisp_Object dummy, frame; @@ -395,7 +396,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, in previous recursive minibuffer, but was not set explicitly to t for this invocation, so set it to nil in this minibuffer. Save the old value now, before we change it. */ - specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name); + specbind (intern ("minibuffer-completing-file-name"), + Vminibuffer_completing_file_name); if (EQ (Vminibuffer_completing_file_name, Qlambda)) Vminibuffer_completing_file_name = Qnil; @@ -460,7 +462,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, expflag, histvar, histpos, defalt, allow_props, inherit_input_method); UNGCPRO; - return unbind_to (count, val); + dynwind_end (); + return val; } /* Choose the minibuffer window and frame, and take action on them. */ @@ -535,6 +538,14 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, if (!NILP (Vminibuffer_completing_file_name)) Vminibuffer_completing_file_name = Qlambda; + /* If variable is unbound, make it nil. */ + histval = find_symbol_value (Vminibuffer_history_variable); + if (EQ (histval, Qunbound)) + { + Fset (Vminibuffer_history_variable, Qnil); + histval = Qnil; + } + if (inherit_input_method) { /* `current-input-method' is buffer local. So, remember it in @@ -615,7 +626,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Erase the buffer. */ { - ptrdiff_t count1 = SPECPDL_INDEX (); + dynwind_begin (); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -637,7 +648,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Fadd_text_properties (make_number (BEG), make_number (PT), Vminibuffer_prompt_properties, Qnil); } - unbind_to (count1, Qnil); + dynwind_end (); } minibuf_prompt_width = current_column (); @@ -703,13 +714,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, { /* If the caller wanted to save the value read on a history list, then do so if the value is not already the front of the list. */ - Lisp_Object histval; - - /* If variable is unbound, make it nil. */ - - histval = find_symbol_value (Vminibuffer_history_variable); - if (EQ (histval, Qunbound)) - Fset (Vminibuffer_history_variable, Qnil); /* The value of the history variable must be a cons or nil. Other values are unacceptable. We silently ignore these values. */ @@ -750,7 +754,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* The appropriate frame will get selected in set-window-configuration. */ UNGCPRO; - return unbind_to (count, val); + dynwind_end (); + return val; } /* Return a buffer to be used as the minibuffer at depth `depth'. @@ -784,7 +789,7 @@ get_minibuffer (EMACS_INT depth) } else { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); /* We have to empty both overlay lists. Otherwise we end up with overlays that think they belong to this buffer while the buffer doesn't know about them any more. */ @@ -796,7 +801,7 @@ get_minibuffer (EMACS_INT depth) call0 (intern ("minibuffer-inactive-mode")); else Fkill_all_local_variables (); - unbind_to (count, Qnil); + dynwind_end (); } return buf; @@ -850,14 +855,14 @@ read_minibuf_unwind (void) /* Erase the minibuffer we were using at this level. */ { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); /* Prevent error in erase-buffer. */ specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); old_deactivate_mark = Vdeactivate_mark; Ferase_buffer (); Vdeactivate_mark = old_deactivate_mark; - unbind_to (count, Qnil); + dynwind_end (); } /* When we get to the outmost level, make sure we resize the @@ -980,7 +985,7 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits (Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); /* Just in case we're in a recursive minibuffer, make it clear that the previous minibuffer's completion table does not apply to the new @@ -993,7 +998,8 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits inherit_input_method); if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value)) val = CONSP (default_value) ? XCAR (default_value) : default_value; - return unbind_to (count, val); + dynwind_end (); + return val; } DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0, @@ -1090,7 +1096,7 @@ function, instead of the usual behavior. */) Lisp_Object args[4], result; char *s; ptrdiff_t len; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); if (BUFFERP (def)) def = BVAR (XBUFFER (def), name); @@ -1139,464 +1145,8 @@ function, instead of the usual behavior. */) args[3] = require_match; result = Ffuncall (4, args); } - return unbind_to (count, result); -} - -static Lisp_Object -minibuf_conform_representation (Lisp_Object string, Lisp_Object basis) -{ - if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis)) - return string; - - if (STRING_MULTIBYTE (string)) - return Fstring_make_unibyte (string); - else - return Fstring_make_multibyte (string); -} - -DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, - doc: /* Return common substring of all completions of STRING in COLLECTION. -Test each possible completion specified by COLLECTION -to see if it begins with STRING. The possible completions may be -strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. -All that match STRING are compared together; the longest initial sequence -common to all these matches is the return value. -If there is no match at all, the return value is nil. -For a unique match which is exact, the return value is t. - -If COLLECTION is an alist, the keys (cars of elements) are the -possible completions. If an element is not a cons cell, then the -element itself is the possible completion. -If COLLECTION is a hash-table, all the keys that are strings or symbols -are the possible completions. -If COLLECTION is an obarray, the names of all symbols in the obarray -are the possible completions. - -COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and nil. -Whatever it returns becomes the value of `try-completion'. - -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. */) - (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) -{ - Lisp_Object bestmatch, tail, elt, eltstring; - /* Size in bytes of BESTMATCH. */ - ptrdiff_t bestmatchsize = 0; - /* These are in bytes, too. */ - ptrdiff_t compare, matchsize; - enum { function_table, list_table, obarray_table, hash_table} - type = (HASH_TABLE_P (collection) ? hash_table - : VECTORP (collection) ? obarray_table - : ((NILP (collection) - || (CONSP (collection) && !FUNCTIONP (collection))) - ? list_table : function_table)); - ptrdiff_t idx = 0, obsize = 0; - int matchcount = 0; - ptrdiff_t bindcount = -1; - Lisp_Object bucket, zero, end, tem; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - CHECK_STRING (string); - if (type == function_table) - return call3 (collection, string, predicate, Qnil); - - bestmatch = bucket = Qnil; - zero = make_number (0); - - /* If COLLECTION is not a list, set TAIL just for gc pro. */ - tail = collection; - if (type == obarray_table) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } - - while (1) - { - /* Get the next element of the alist, obarray, or hash-table. */ - /* Exit the loop if the elements are all used up. */ - /* elt gets the alist element or symbol. - eltstring gets the name to check as a completion. */ - - if (type == list_table) - { - if (!CONSP (tail)) - break; - elt = XCAR (tail); - eltstring = CONSP (elt) ? XCAR (elt) : elt; - tail = XCDR (tail); - } - else if (type == obarray_table) - { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) - break; - else - { - bucket = AREF (collection, idx); - continue; - } - } - else /* if (type == hash_table) */ - { - while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && NILP (HASH_HASH (XHASH_TABLE (collection), idx))) - idx++; - if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) - break; - else - elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++); - } - - /* Is this element a possible completion? */ - - if (SYMBOLP (eltstring)) - eltstring = Fsymbol_name (eltstring); - - if (STRINGP (eltstring) - && SCHARS (string) <= SCHARS (eltstring) - && (tem = Fcompare_strings (eltstring, zero, - make_number (SCHARS (string)), - string, zero, Qnil, - completion_ignore_case ? Qt : Qnil), - EQ (Qt, tem))) - { - /* Yes. */ - Lisp_Object regexps; - - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } - - /* Ignore this element if there is a predicate - and the predicate doesn't like it. */ - - if (!NILP (predicate)) - { - if (EQ (predicate, Qcommandp)) - tem = Fcommandp (elt, Qnil); - else - { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } - GCPRO4 (tail, string, eltstring, bestmatch); - tem = (type == hash_table - ? call2 (predicate, elt, - HASH_VALUE (XHASH_TABLE (collection), - idx - 1)) - : call1 (predicate, elt)); - UNGCPRO; - } - if (NILP (tem)) continue; - } - - /* Update computation of how much all possible completions match */ - - if (NILP (bestmatch)) - { - matchcount = 1; - bestmatch = eltstring; - bestmatchsize = SCHARS (eltstring); - } - else - { - compare = min (bestmatchsize, SCHARS (eltstring)); - tem = Fcompare_strings (bestmatch, zero, - make_number (compare), - eltstring, zero, - make_number (compare), - completion_ignore_case ? Qt : Qnil); - matchsize = EQ (tem, Qt) ? compare : eabs (XINT (tem)) - 1; - - if (completion_ignore_case) - { - /* If this is an exact match except for case, - use it as the best match rather than one that is not an - exact match. This way, we get the case pattern - of the actual match. */ - if ((matchsize == SCHARS (eltstring) - && matchsize < SCHARS (bestmatch)) - || - /* If there is more than one exact match ignoring case, - and one of them is exact including case, - prefer that one. */ - /* If there is no exact match ignoring case, - prefer a match that does not change the case - of the input. */ - ((matchsize == SCHARS (eltstring)) - == - (matchsize == SCHARS (bestmatch)) - && (tem = Fcompare_strings (eltstring, zero, - make_number (SCHARS (string)), - string, zero, - Qnil, - Qnil), - EQ (Qt, tem)) - && (tem = Fcompare_strings (bestmatch, zero, - make_number (SCHARS (string)), - string, zero, - Qnil, - Qnil), - ! EQ (Qt, tem)))) - bestmatch = eltstring; - } - if (bestmatchsize != SCHARS (eltstring) - || bestmatchsize != matchsize) - /* Don't count the same string multiple times. */ - matchcount += matchcount <= 1; - bestmatchsize = matchsize; - if (matchsize <= SCHARS (string) - /* If completion-ignore-case is non-nil, don't - short-circuit because we want to find the best - possible match *including* case differences. */ - && !completion_ignore_case - && matchcount > 1) - /* No need to look any further. */ - break; - } - } - } - - if (bindcount >= 0) { - unbind_to (bindcount, Qnil); - bindcount = -1; - } - - if (NILP (bestmatch)) - return Qnil; /* No completions found. */ - /* If we are ignoring case, and there is no exact match, - and no additional text was supplied, - don't change the case of what the user typed. */ - if (completion_ignore_case && bestmatchsize == SCHARS (string) - && SCHARS (bestmatch) > bestmatchsize) - return minibuf_conform_representation (string, bestmatch); - - /* Return t if the supplied string is an exact match (counting case); - it does not require any change to be made. */ - if (matchcount == 1 && !NILP (Fequal (bestmatch, string))) - return Qt; - - XSETFASTINT (zero, 0); /* Else extract the part in which */ - XSETFASTINT (end, bestmatchsize); /* all completions agree. */ - return Fsubstring (bestmatch, zero, end); -} - -DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0, - doc: /* Search for partial matches to STRING in COLLECTION. -Test each of the possible completions specified by COLLECTION -to see if it begins with STRING. The possible completions may be -strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. -The value is a list of all the possible completions that match STRING. - -If COLLECTION is an alist, the keys (cars of elements) are the -possible completions. If an element is not a cons cell, then the -element itself is the possible completion. -If COLLECTION is a hash-table, all the keys that are strings or symbols -are the possible completions. -If COLLECTION is an obarray, the names of all symbols in the obarray -are the possible completions. - -COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and t. -Whatever it returns becomes the value of `all-completions'. - -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. - -An obsolete optional fourth argument HIDE-SPACES is still accepted for -backward compatibility. If non-nil, strings in COLLECTION that start -with a space are ignored unless STRING itself starts with a space. */) - (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate, Lisp_Object hide_spaces) -{ - Lisp_Object tail, elt, eltstring; - Lisp_Object allmatches; - int type = HASH_TABLE_P (collection) ? 3 - : VECTORP (collection) ? 2 - : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); - ptrdiff_t idx = 0, obsize = 0; - ptrdiff_t bindcount = -1; - Lisp_Object bucket, tem, zero; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - CHECK_STRING (string); - if (type == 0) - return call3 (collection, string, predicate, Qt); - allmatches = bucket = Qnil; - zero = make_number (0); - - /* If COLLECTION is not a list, set TAIL just for gc pro. */ - tail = collection; - if (type == 2) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } - - while (1) - { - /* Get the next element of the alist, obarray, or hash-table. */ - /* Exit the loop if the elements are all used up. */ - /* elt gets the alist element or symbol. - eltstring gets the name to check as a completion. */ - - if (type == 1) - { - if (!CONSP (tail)) - break; - elt = XCAR (tail); - eltstring = CONSP (elt) ? XCAR (elt) : elt; - tail = XCDR (tail); - } - else if (type == 2) - { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) - break; - else - { - bucket = AREF (collection, idx); - continue; - } - } - else /* if (type == 3) */ - { - while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && NILP (HASH_HASH (XHASH_TABLE (collection), idx))) - idx++; - if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) - break; - else - elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++); - } - - /* Is this element a possible completion? */ - - if (SYMBOLP (eltstring)) - eltstring = Fsymbol_name (eltstring); - - if (STRINGP (eltstring) - && SCHARS (string) <= SCHARS (eltstring) - /* If HIDE_SPACES, reject alternatives that start with space - unless the input starts with space. */ - && (NILP (hide_spaces) - || (SBYTES (string) > 0 - && SREF (string, 0) == ' ') - || SREF (eltstring, 0) != ' ') - && (tem = Fcompare_strings (eltstring, zero, - make_number (SCHARS (string)), - string, zero, - make_number (SCHARS (string)), - completion_ignore_case ? Qt : Qnil), - EQ (Qt, tem))) - { - /* Yes. */ - Lisp_Object regexps; - - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } - - /* Ignore this element if there is a predicate - and the predicate doesn't like it. */ - - if (!NILP (predicate)) - { - if (EQ (predicate, Qcommandp)) - tem = Fcommandp (elt, Qnil); - else - { - if (bindcount >= 0) { - unbind_to (bindcount, Qnil); - bindcount = -1; - } - GCPRO4 (tail, eltstring, allmatches, string); - tem = type == 3 - ? call2 (predicate, elt, - HASH_VALUE (XHASH_TABLE (collection), idx - 1)) - : call1 (predicate, elt); - UNGCPRO; - } - if (NILP (tem)) continue; - } - /* Ok => put it on the list. */ - allmatches = Fcons (eltstring, allmatches); - } - } - - if (bindcount >= 0) { - unbind_to (bindcount, Qnil); - bindcount = -1; - } - - return Fnreverse (allmatches); + dynwind_end (); + return result; } DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0, @@ -1671,170 +1221,6 @@ See also `completing-read-function'. */) return Ffuncall (9, args); } -/* Test whether TXT is an exact completion. */ -DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0, - doc: /* Return non-nil if STRING is a valid completion. -Takes the same arguments as `all-completions' and `try-completion'. -If COLLECTION is a function, it is called with three arguments: -the values STRING, PREDICATE and `lambda'. */) - (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) -{ - Lisp_Object regexps, tail, tem = Qnil; - ptrdiff_t i = 0; - - CHECK_STRING (string); - - if (NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection))) - { - tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil); - if (NILP (tem)) - return Qnil; - } - else if (VECTORP (collection)) - { - /* Bypass intern-soft as that loses for nil. */ - tem = oblookup (collection, - SSDATA (string), - SCHARS (string), - SBYTES (string)); - if (!SYMBOLP (tem)) - { - if (STRING_MULTIBYTE (string)) - string = Fstring_make_unibyte (string); - else - string = Fstring_make_multibyte (string); - - tem = oblookup (collection, - SSDATA (string), - SCHARS (string), - SBYTES (string)); - } - - if (completion_ignore_case && !SYMBOLP (tem)) - { - for (i = ASIZE (collection) - 1; i >= 0; i--) - { - tail = AREF (collection, i); - if (SYMBOLP (tail)) - while (1) - { - if (EQ (Fcompare_strings (string, make_number (0), Qnil, - Fsymbol_name (tail), - make_number (0) , Qnil, Qt), - Qt)) - { - tem = tail; - break; - } - if (XSYMBOL (tail)->next == 0) - break; - XSETSYMBOL (tail, XSYMBOL (tail)->next); - } - } - } - - if (!SYMBOLP (tem)) - return Qnil; - } - else if (HASH_TABLE_P (collection)) - { - struct Lisp_Hash_Table *h = XHASH_TABLE (collection); - Lisp_Object key = Qnil; - i = hash_lookup (h, string, NULL); - if (i >= 0) - tem = HASH_KEY (h, i); - else - for (i = 0; i < HASH_TABLE_SIZE (h); ++i) - if (!NILP (HASH_HASH (h, i)) - && (key = HASH_KEY (h, i), - SYMBOLP (key) ? key = Fsymbol_name (key) : key, - STRINGP (key)) - && EQ (Fcompare_strings (string, make_number (0), Qnil, - key, make_number (0) , Qnil, - completion_ignore_case ? Qt : Qnil), - Qt)) - { - tem = key; - break; - } - if (!STRINGP (tem)) - return Qnil; - } - else - return call3 (collection, string, predicate, Qlambda); - - /* Reject this element if it fails to match all the regexps. */ - if (CONSP (Vcompletion_regexp_list)) - { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil); - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (NILP (Fstring_match (XCAR (regexps), - SYMBOLP (tem) ? string : tem, - Qnil))) - return unbind_to (count, Qnil); - } - unbind_to (count, Qnil); - } - - /* Finally, check the predicate. */ - if (!NILP (predicate)) - { - return HASH_TABLE_P (collection) - ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i)) - : call1 (predicate, tem); - } - else - return Qt; -} - -static Lisp_Object Qmetadata; - -DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0, - doc: /* Perform completion on buffer names. -STRING and PREDICATE have the same meanings as in `try-completion', -`all-completions', and `test-completion'. - -If FLAG is nil, invoke `try-completion'; if it is t, invoke -`all-completions'; otherwise invoke `test-completion'. */) - (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag) -{ - if (NILP (flag)) - return Ftry_completion (string, Vbuffer_alist, predicate); - else if (EQ (flag, Qt)) - { - Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil); - if (SCHARS (string) > 0) - return res; - else - { /* Strip out internal buffers. */ - Lisp_Object bufs = res; - /* First, look for a non-internal buffer in `res'. */ - while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ') - bufs = XCDR (bufs); - if (NILP (bufs)) - return (EQ (Flength (res), Flength (Vbuffer_alist)) - /* If all bufs are internal don't strip them out. */ - ? res : bufs); - res = bufs; - while (CONSP (XCDR (bufs))) - if (SREF (XCAR (XCDR (bufs)), 0) == ' ') - XSETCDR (bufs, XCDR (XCDR (bufs))); - else - bufs = XCDR (bufs); - return res; - } - } - else if (EQ (flag, Qlambda)) - return Ftest_completion (string, Vbuffer_alist, predicate); - else if (EQ (flag, Qmetadata)) - return list2 (Qmetadata, Fcons (Qcategory, Qbuffer)); - else - return Qnil; -} - /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0, @@ -1901,6 +1287,8 @@ init_minibuf_once (void) void syms_of_minibuf (void) { +#include "minibuf.x" + minibuf_level = 0; minibuf_prompt = Qnil; staticpro (&minibuf_prompt); @@ -1931,7 +1319,6 @@ syms_of_minibuf (void) DEFSYM (Qcurrent_input_method, "current-input-method"); DEFSYM (Qactivate_input_method, "activate-input-method"); DEFSYM (Qcase_fold_search, "case-fold-search"); - DEFSYM (Qmetadata, "metadata"); DEFVAR_LISP ("read-expression-history", Vread_expression_history, doc: /* A history list for arguments that are Lisp expressions to evaluate. @@ -2075,28 +1462,4 @@ properties. */); /* We use `intern' here instead of Qread_only to avoid initialization-order problems. */ Vminibuffer_prompt_properties = list2 (intern_c_string ("read-only"), Qt); - - defsubr (&Sactive_minibuffer_window); - defsubr (&Sset_minibuffer_window); - defsubr (&Sread_from_minibuffer); - defsubr (&Sread_string); - defsubr (&Sread_command); - defsubr (&Sread_variable); - defsubr (&Sinternal_complete_buffer); - defsubr (&Sread_buffer); - defsubr (&Sread_no_blanks_input); - defsubr (&Sminibuffer_depth); - defsubr (&Sminibuffer_prompt); - - defsubr (&Sminibufferp); - defsubr (&Sminibuffer_prompt_end); - defsubr (&Sminibuffer_contents); - defsubr (&Sminibuffer_contents_no_properties); - defsubr (&Sminibuffer_completion_contents); - - defsubr (&Stry_completion); - defsubr (&Sall_completions); - defsubr (&Stest_completion); - defsubr (&Sassoc_string); - defsubr (&Scompleting_read); }