master 11d6d6c: Fix performance degradation in commands that describe key bindings

[Eli Zaretskii]

branch: master
commit 11d6d6c3ea8d3f131b0b21db6e51a66d8b20d40e
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    Fix performance degradation in commands that describe key bindings
    
    * src/keymap.c (syms_of_keymap)
    <describe-bindings-check-shadowing-in-ranges>: New variable.
    (describe_vector): Check shadowing of consecutive keys only if
    'describe-bindings-check-shadowing-in-ranges' is non-nil.  Remove
    redundant second loop when VECTOR is a char-table.  Improve
    comments.  Patch by Stefan Kangas <stefan@marxist.se>.  (Bug#45379)
    
    * test/src/keymap-tests.el
    (help--describe-vector/bug-9293-one-shadowed-in-range): Adapt the
    test case for the new variable.
---
 src/keymap.c             | 61 +++++++++++++++++++++++++++++++-----------------
 test/src/keymap-tests.el |  3 ++-
 2 files changed, 41 insertions(+), 23 deletions(-)

diff --git a/src/keymap.c b/src/keymap.c
index fb8ecea..be45d2b 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2935,7 +2935,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, 
Lisp_Object args,
   Lisp_Object suppress = Qnil;
   bool first = true;
   /* Range of elements to be handled.  */
-  int from, to, stop;
+  int to, stop;
 
   if (!keymap_p)
     {
@@ -2955,17 +2955,19 @@ describe_vector (Lisp_Object vector, Lisp_Object 
prefix, Lisp_Object args,
   if (partial)
     suppress = intern ("suppress-keymap");
 
-  from = 0;
+  /* STOP is a boundary between normal characters (-#x3FFF7F) and
+     8-bit characters (#x3FFF80-), used below when VECTOR is a
+     char-table.  */
   if (CHAR_TABLE_P (vector))
     stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
   else
     stop = to = ASIZE (vector);
 
-  for (int i = from; ; i++)
+  for (int i = 0; ; i++)
     {
       bool this_shadowed = false;
       Lisp_Object shadowed_by = Qnil;
-      int range_beg, range_end;
+      int range_beg;
       Lisp_Object val, tem2;
 
       maybe_quit ();
@@ -2981,6 +2983,10 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, 
Lisp_Object args,
 
       if (CHAR_TABLE_P (vector))
        {
+         /* Find the value in VECTOR for the first character in the
+            range [RANGE_BEG..STOP), and update the range to include
+            only the characters whose value is the same as that of
+            the first in the range.  */
          range_beg = i;
          i = stop - 1;
          val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
@@ -3039,33 +3045,26 @@ describe_vector (Lisp_Object vector, Lisp_Object 
prefix, Lisp_Object args,
       insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
 
       /* Find all consecutive characters or rows that have the same
-        definition.  But, if VECTOR is a char-table, we had better
-        put a boundary between normal characters (-#x3FFF7F) and
-        8-bit characters (#x3FFF80-).  */
-      if (CHAR_TABLE_P (vector))
+        definition.  */
+      if (!CHAR_TABLE_P (vector))
        {
          while (i + 1 < stop
-                && (range_beg = i + 1, range_end = stop - 1,
-                  val = char_table_ref_and_range (vector, range_beg,
-                                                  &range_beg, &range_end),
-                  tem2 = get_keyelt (val, 0),
-                  !NILP (tem2))
+                && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
+                    !NILP (tem2))
                 && !NILP (Fequal (tem2, definition)))
-           i = range_end;
+           i++;
        }
-      else
-       while (i + 1 < stop
-              && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
-                  !NILP (tem2))
-              && !NILP (Fequal (tem2, definition)))
-         i++;
 
       /* Make sure found consecutive keys are either not shadowed or,
         if they are, that they are shadowed by the same command.  */
-      if (CHAR_TABLE_P (vector) && i != starting_i)
+      if (!NILP (Vdescribe_bindings_check_shadowing_in_ranges)
+         && CHAR_TABLE_P (vector) && i != starting_i
+         && (!EQ (Vdescribe_bindings_check_shadowing_in_ranges,
+                  Qignore_self_insert)
+             || !EQ (definition, Qself_insert_command)))
        {
          Lisp_Object key = make_nil_vector (1);
-         for (int j = starting_i + 1; j <= i; j++)
+         for (int j = range_beg + 1; j <= i; j++)
            {
              ASET (key, 0, make_fixnum (j));
              Lisp_Object tem = shadow_lookup (shadow, key, Qt, 0);
@@ -3181,6 +3180,24 @@ be preferred.  */);
   Vwhere_is_preferred_modifier = Qnil;
   where_is_preferred_modifier = 0;
 
+  DEFVAR_LISP ("describe-bindings-check-shadowing-in-ranges",
+              Vdescribe_bindings_check_shadowing_in_ranges,
+              doc: /* If non-nil, consider command shadowing when describing 
ranges of keys.
+If the value is t, describing bindings of consecutive keys will not
+report them as a single range if they are shadowed by different
+minor-mode commands.
+If the value is `ignore-self-insert', assume that consecutive keys
+bound to `self-insert-command' are not all shadowed; this speeds up
+commands such as \\[describe-bindings] and \\[describe-mode], but could miss 
some shadowing.
+Any other non-nil value is treated is t.
+
+Beware: setting this non-nil could potentially slow down commands
+that describe key bindings.  That is why the default is nil.  */);
+  Vdescribe_bindings_check_shadowing_in_ranges = Qnil;
+
+  DEFSYM (Qself_insert_command, "self-insert-command");
+  DEFSYM (Qignore_self_insert, "ignore-self-insert");
+
   DEFSYM (Qmenu_bar, "menu-bar");
   DEFSYM (Qmode_line, "mode-line");
 
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index a9b0cb5..68b42c3 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -269,7 +269,8 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
         (shadow-map (let ((map (make-keymap)))
                       (define-key map "f" 'bar)
                       map))
-        (text-quoting-style 'grave))
+        (text-quoting-style 'grave)
+        (describe-bindings-check-shadowing-in-ranges 'ignore-self-insert))
     (with-temp-buffer
       (help--describe-vector (cadr orig-map) nil #'help--describe-command
                              t shadow-map orig-map t)