- return unbind_to (count, result);
-}
-\f
-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)
- && (!SYMBOLP (XCAR (collection))
- || NILP (XCAR (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);
-}
-\f
-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)
- && (!SYMBOLP (XCAR (collection))
- || NILP (XCAR (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);