scratch/substitute-command-keys 2ae5c30: Fix mention-shadow arg in describe-map and add tests

[Stefan Kangas]

branch: scratch/substitute-command-keys
commit 2ae5c30eb68d1bbd9ee7a2583559f8fa9e1fa20c
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>

    Fix mention-shadow arg in describe-map and add tests
    
    * lisp/help.el (describe-map): Fix mention-shadow arg.  Doc fix.
    * test/lisp/help-tests.el (help-tests-describe-map-tree/no-menu-t)
    (help-tests-describe-map-tree/no-menu-nil)
    (help-tests-describe-map-tree/mention-shadow-t)
    (help-tests-describe-map-tree/mention-shadow-nil)
    (help-tests-describe-map-tree/partial-t)
    (help-tests-describe-map-tree/partial-nil): New tests.
---
 lisp/help.el            | 12 ++++---
 test/lisp/help-tests.el | 92 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 99 insertions(+), 5 deletions(-)

diff --git a/lisp/help.el b/lisp/help.el
index 59d8c5b..a4e8cd7 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1264,11 +1264,12 @@ Return nil if the key sequence is too long."
           (t nil))))
 
 (defun describe-map (map prefix transl partial shadow nomenu mention-shadow)
-  "Describe the contents of map MAP.
-Assume that this map itself is reached by the sequence of prefix
-keys PREFIX (a string or vector).
+  "Describe the contents of keymap MAP.
+Assume that this keymap itself is reached by the sequence of
+prefix keys PREFIX (a string or vector).
 
-PARTIAL, SHADOW, NOMENU are as in `describe_map_tree'."
+TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
+`describe-map-tree'."
   ;; Converted from describe_map in keymap.c.
   (let* ((suppress (and partial 'suppress-keymap))
          (map (keymap-canonicalize map))
@@ -1305,7 +1306,8 @@ PARTIAL, SHADOW, NOMENU are as in `describe_map_tree'."
                                 ;; Avoid generating duplicate
                                 ;; entries if the shadowed binding
                                 ;; has the same definition.
-                                ((setq this-shadowed t))
+                                ((and mention-shadow (not (eq tem definition)))
+                                 (setq this-shadowed t))
                                 (t nil))))
                     (push (list event definition this-shadowed) vect))))
             ((eq (car tail) 'keymap)
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index a5aad15..9011f9f 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -277,6 +277,98 @@ key             binding
 
 ")))))
 
+(ert-deftest help-tests-describe-map-tree/no-menu-t ()
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+          (map '(keymap . ((1 . foo)
+                           (menu-bar keymap
+                                     (foo menu-item "Foo" foo
+                                          :enable mark-active
+                                          :help "Help text"))))))
+      (describe-map-tree map nil nil nil nil t nil nil nil)
+      (should (equal (buffer-string) "key             binding
+---             -------
+
+C-a            foo
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/no-menu-nil ()
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+          (map '(keymap . ((1 . foo)
+                           (menu-bar keymap
+                                     (foo menu-item "Foo" foo
+                                          :enable mark-active
+                                          :help "Help text"))))))
+      (describe-map-tree map nil nil nil nil nil nil nil nil)
+      (should (equal (buffer-string) "key             binding
+---             -------
+
+C-a            foo
+<menu-bar>     Prefix Command
+
+<menu-bar> <foo>               foo
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/mention-shadow-t ()
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+          (map '(keymap . ((1 . foo)
+                           (2 . bar))))
+          (shadow-maps '((keymap . ((1 . baz))))))
+      (describe-map-tree map t shadow-maps nil nil t nil nil t)
+      (should (equal (buffer-string) "key             binding
+---             -------
+
+C-a            foo
+  (that binding is currently shadowed by another mode)
+C-b            bar
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/mention-shadow-nil ()
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+          (map '(keymap . ((1 . foo)
+                           (2 . bar))))
+          (shadow-maps '((keymap . ((1 . baz))))))
+      (describe-map-tree map t shadow-maps nil nil t nil nil nil)
+      (should (equal (buffer-string) "key             binding
+---             -------
+
+C-b            bar
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/partial-t ()
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+          (map '(keymap . ((1 . foo)
+                           (2 . undefined)))))
+      (describe-map-tree map t nil nil nil nil nil nil nil)
+      (should (equal (buffer-string) "key             binding
+---             -------
+
+C-a            foo
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/partial-nil ()
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+          (map '(keymap . ((1 . foo)
+                           (2 . undefined)))))
+      (describe-map-tree map nil nil nil nil nil nil nil nil)
+      (should (equal (buffer-string) "key             binding
+---             -------
+
+C-a            foo
+C-b            undefined
+
+")))))
+
 ;; TODO: This is a temporary test that should be removed together with
 ;; substitute-command-keys-old.
 (ert-deftest help-tests-substitute-command-keys/compare ()