mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-05-03 11:41:41 -07:00
Code Issues Projects Releases Wiki Activity

Avoid excessive specbinding in all-completions

Browse source 
* src/minibuf.c (match_regexps):
(Ftry_completion):
(Fall_completions):
(Ftest_completion): Use fast_string_match_internal to match against
regexps in completion-regexp-list without having to bind
case-fold-search.
This commit is contained in:
Miha Rihtaršič 2021-10-19 18:41:13 +02:00 • committed by Lars Ingebrigtsen
parent 1fb8a1569d
commit 7a6cc97f3c
1 changed files with 32 additions and 73 deletions
Download patch file Download diff file Expand all files Collapse all files

105
src/minibuf.c
View file

@ -1545,6 +1545,27 @@ minibuf_conform_representation (Lisp_Object string, Lisp_Object basis)
return Fstring_make_multibyte (string);
}
static bool
match_regexps (Lisp_Object string, Lisp_Object regexps,
bool ignore_case)
{
ptrdiff_t val;
for (; CONSP (regexps); regexps = XCDR (regexps))
{
CHECK_STRING (XCAR (regexps));
val = fast_string_match_internal
(XCAR (regexps), string,
(ignore_case ? BVAR (current_buffer, case_canon_table) : Qnil));
if (val == -2)
error ("Stack overflow in regexp matcher");
if (val < 0)
return false;
}
return true;
}
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
@ -1578,6 +1599,7 @@ 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;
@ -1591,7 +1613,6 @@ is used to further constrain the set of candidates. */)
? list_table : function_table));
ptrdiff_t idx = 0, obsize = 0;
int matchcount = 0;
ptrdiff_t bindcount = -1;
Lisp_Object bucket, zero, end, tem;
CHECK_STRING (string);
@ -1670,27 +1691,10 @@ is used to further constrain the set of candidates. */)
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, Qnil);
if (NILP (tem))
break;
}
if (CONSP (regexps))
continue;
}
if (!match_regexps (eltstring, Vcompletion_regexp_list,
completion_ignore_case))
continue;
/* Ignore this element if there is a predicate
and the predicate doesn't like it. */
@ -1701,11 +1705,6 @@ is used to further constrain the set of candidates. */)
tem = Fcommandp (elt, Qnil);
else
{
if (bindcount >= 0)
{
unbind_to (bindcount, Qnil);
bindcount = -1;
}
tem = (type == hash_table
? call2 (predicate, elt,
HASH_VALUE (XHASH_TABLE (collection),
@ -1787,9 +1786,6 @@ is used to further constrain the set of candidates. */)
}
}
if (bindcount >= 0)
unbind_to (bindcount, Qnil);
if (NILP (bestmatch))
return Qnil; /* No completions found. */
/* If we are ignoring case, and there is no exact match,
@ -1849,7 +1845,6 @@ with a space are ignored unless STRING itself starts with a space. */)
: VECTORP (collection) ? 2
: NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
ptrdiff_t idx = 0, obsize = 0;
ptrdiff_t bindcount = -1;
Lisp_Object bucket, tem, zero;
CHECK_STRING (string);
@ -1934,27 +1929,10 @@ with a space are ignored unless STRING itself starts with a space. */)
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, Qnil);
if (NILP (tem))
break;
}
if (CONSP (regexps))
continue;
}
if (!match_regexps (eltstring, Vcompletion_regexp_list,
completion_ignore_case))
continue;
/* Ignore this element if there is a predicate
and the predicate doesn't like it. */
@ -1965,11 +1943,6 @@ with a space are ignored unless STRING itself starts with a space. */)
tem = Fcommandp (elt, Qnil);
else
{
if (bindcount >= 0)
{
unbind_to (bindcount, Qnil);
bindcount = -1;
}
tem = type == 3
? call2 (predicate, elt,
HASH_VALUE (XHASH_TABLE (collection), idx - 1))
@ -1982,9 +1955,6 @@ with a space are ignored unless STRING itself starts with a space. */)
}
}
if (bindcount >= 0)
unbind_to (bindcount, Qnil);
return Fnreverse (allmatches);
}
@ -2068,7 +2038,7 @@ 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;
Lisp_Object tail, tem = Qnil;
ptrdiff_t i = 0;
CHECK_STRING (string);
@ -2154,20 +2124,9 @@ the values STRING, PREDICATE and `lambda'. */)
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))
{
/* We can test against STRING, because if we got here, then
the element is equivalent to it. */
if (NILP (Fstring_match (XCAR (regexps), string, Qnil, Qnil)))
return unbind_to (count, Qnil);
}
unbind_to (count, Qnil);
}
if (!match_regexps (string, Vcompletion_regexp_list,
completion_ignore_case))
return Qnil;
/* Finally, check the predicate. */
if (!NILP (predicate))