Subject: bug#9293: say what they are shadowed by

From: Stefan Kangas <[email-masked]>
Date: Fri, 13 Nov 2020 11:37:49 -0800

tags 9293 + patch
thanks

Stefan Kangas <[email-masked]> writes:

> So in conclusion the output here should probably be:
>
>   0 .. 9	digit-argument
>   e		tar-extract  (binding currently shadowed)
>   f		tar-extract

I've attached three patches.  The first fixes the bug with broken
ranges, the second one fixes the incorrect shadowing by the same
command, and the third one takes care of the feature request.

Using the original recipe, I now get:

0 .. 9		digit-argument
e		tar-extract  (currently shadowed by ‘View-exit’)
f		tar-extract

Comments?
From ecc913fe599488c1878118de4283fd6134ff50cf Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
Date: Fri, 13 Nov 2020 15:28:29 +0100
Subject: [PATCH 1/3] Don't show key ranges if shadowed by different commands

* src/keymap.c (describe_vector): Make sure found consecutive keys
are either not shadowed or, if they are, that they are shadowed by
the same command.  (Bug#9293)
* test/src/keymap-tests.el
(help--describe-vector/bug-9293-one-shadowed-in-range): New test.
---
 src/keymap.c             | 22 ++++++++++++++++++----
 test/src/keymap-tests.el | 27 +++++++++++++++++++++++++++
 2 files changed, 45 insertions(+), 4 deletions(-)

diff --git a/src/keymap.c b/src/keymap.c
index 181dcdad3a..4616f27c25 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3085,6 +3085,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
   for (i = from; ; i++)
     {
       bool this_shadowed = 0;
+      Lisp_Object shadowed_by = NULL;
       int range_beg, range_end;
       Lisp_Object val;
 
@@ -3127,11 +3128,9 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
       /* If this binding is shadowed by some other map, ignore it.  */
       if (!NILP (shadow))
 	{
-	  Lisp_Object tem;
-
-	  tem = shadow_lookup (shadow, kludge, Qt, 0);
+	  shadowed_by = shadow_lookup (shadow, kludge, Qt, 0);
 
-	  if (!NILP (tem))
+	  if (!NILP (shadowed_by))
 	    {
 	      if (mention_shadow)
 		this_shadowed = 1;
@@ -3186,6 +3185,21 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
 	       && !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)
+	{
+	  Lisp_Object tem;
+	  Lisp_Object key = make_nil_vector (1);
+	  for (int j = starting_i + 1; j <= i; j++)
+	    {
+	      ASET (key, 0, make_fixnum (j));
+	      tem = shadow_lookup (shadow, key, Qt, 0);
+	      if (NILP (Fequal (tem, shadowed_by)))
+		i = j - 1;
+	    }
+	}
+
       /* If we have a range of more than one character,
 	 print where the range reaches to.  */
 
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index e3dd8420d7..b230958b36 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -170,6 +170,33 @@ keymap-where-is-internal/preferred-modifier-is-a-string
             (where-is-internal 'execute-extended-command global-map t))
           [#x8000078])))
 
+
+;;;; describe_vector
+
+(ert-deftest help--describe-vector/bug-9293-one-shadowed-in-range ()
+  "Check that we only show a range if shadowed by the same command."
+  (let ((orig-map (let ((map (make-keymap)))
+                    (define-key map "e" 'foo)
+                    (define-key map "f" 'foo)
+                    (define-key map "g" 'foo)
+                    (define-key map "h" 'foo)
+                    map))
+        (shadow-map (let ((map (make-keymap)))
+                      (define-key map "f" 'bar)
+                      map)))
+    (with-temp-buffer
+      (help--describe-vector (cadr orig-map) nil #'help--describe-command
+                             t shadow-map orig-map t)
+      (should (equal (buffer-string)
+                     "
+e		foo
+f		foo  (binding currently shadowed)
+g .. h		foo
+")))))
+
+
+;;;; apropos-internal
+
 (ert-deftest keymap-apropos-internal ()
   (should (equal (apropos-internal "^next-line$") '(next-line)))
   (should (>= (length (apropos-internal "^help")) 100))
-- 
2.29.2

From 4ef177d0133d1e97b13b8dcfe98c3093ac02d897 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
Date: Fri, 13 Nov 2020 15:28:34 +0100
Subject: [PATCH 2/3] Don't shadow bindings by the same command

* src/keymap.c (describe_vector): Do not say binding is shadowed if
the other key binding points to the same command.  (Bug#9293)
* test/src/keymap-tests.el
(help--describe-vector/bug-9293-same-command-does-not-shadow): New
test.
---
 src/keymap.c             |  2 +-
 test/src/keymap-tests.el | 24 ++++++++++++++++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/src/keymap.c b/src/keymap.c
index 4616f27c25..174ee4fd50 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3130,7 +3130,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
 	{
 	  shadowed_by = shadow_lookup (shadow, kludge, Qt, 0);
 
-	  if (!NILP (shadowed_by))
+	  if (!NILP (shadowed_by) && !EQ (shadowed_by, definition))
 	    {
 	      if (mention_shadow)
 		this_shadowed = 1;
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index b230958b36..340227311c 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -194,6 +194,30 @@ help--describe-vector/bug-9293-one-shadowed-in-range
 g .. h		foo
 ")))))
 
+(ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow ()
+  "Check that a command can't be shadowed by the same command."
+  (let ((range-map
+         (let ((map (make-keymap)))
+           (define-key map "0" 'foo)
+           (define-key map "1" 'foo)
+           (define-key map "2" 'foo)
+           (define-key map "3" 'foo)
+           map))
+        (shadow-map
+         (let ((map (make-keymap)))
+           (define-key map "0" 'foo)
+           (define-key map "1" 'foo)
+           (define-key map "2" 'foo)
+           (define-key map "3" 'foo)
+           map)))
+   (with-temp-buffer
+     (help--describe-vector (cadr range-map) nil #'help--describe-command
+                            t shadow-map range-map t)
+     (should (equal (buffer-string)
+                    "
+0 .. 3		foo
+")))))
+
 
 ;;;; apropos-internal
 
-- 
2.29.2

From 8761a55b751cf2a208496d3441e35c9699127732 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
Date: Fri, 13 Nov 2020 19:15:21 +0100
Subject: [PATCH 3/3] Say which command shadows a key binding

* src/keymap.c (describe_vector): Say which command shadows this
binding.  (Bug#9293)
* test/src/keymap-tests.el
(help--describe-vector/bug-9293-one-shadowed-in-range): Adapt
test.
---
 src/keymap.c             | 8 +++++++-
 test/src/keymap-tests.el | 5 +++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/keymap.c b/src/keymap.c
index 174ee4fd50..72141bdd5a 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3223,7 +3223,13 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
       if (this_shadowed)
 	{
 	  SET_PT (PT - 1);
-	  insert_string ("  (binding currently shadowed)");
+	  static char const fmt[] = "  (currently shadowed by `%s')";
+	  USE_SAFE_ALLOCA;
+	  char *buffer = SAFE_ALLOCA (sizeof fmt +
+				      SBYTES (SYMBOL_NAME (shadowed_by)));
+	  esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by)));
+	  insert_string (buffer);
+	  SAFE_FREE();
 	  SET_PT (PT + 1);
 	}
     }
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 340227311c..f62589f74b 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -183,14 +183,15 @@ help--describe-vector/bug-9293-one-shadowed-in-range
                     map))
         (shadow-map (let ((map (make-keymap)))
                       (define-key map "f" 'bar)
-                      map)))
+                      map))
+        (text-quoting-style 'grave))
     (with-temp-buffer
       (help--describe-vector (cadr orig-map) nil #'help--describe-command
                              t shadow-map orig-map t)
       (should (equal (buffer-string)
                      "
 e		foo
-f		foo  (binding currently shadowed)
+f		foo  (currently shadowed by `bar')
 g .. h		foo
 ")))))
 
-- 
2.29.2