Translate describe_map to Lisp

Third step in converting substitute-command-keys to Lisp.

* lisp/help.el (describe-map): New Lisp version of describe_map.
(help--describe-map-compare, help--describe-translation)
(help--describe-command, help--shadow-lookup): New helper
functions for describe-map.
(help--keymaps-seen, help--previous-description-column): New
variables.
* src/keymap.c
(Fkeymap__get_keyelt): New defun to expose get_keyelt to Lisp.
(Fdescribe_map_tree_old, Fdescribe_map): Remove defuns.
(Fdescribe_vector_internal): New defun to expose describe_vector to
Lisp in a way usable by describe-map.
(syms_of_keymap): New defsubrs for Fkeymap__get_keyelt and
Fdescribe_vector_internal.  Remove defsubrs for Fdescribe_map_tree_old
and Fdescribe_map.  Remove 'help--keymaps-seen'.

* test/lisp/help-tests.el
(help-tests-substitute-command-keys/shadow): Extend test.
(help-tests-substitute-command-keys/test-mode)
(help-tests-substitute-command-keys/compare-all)
(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.

1 files changed, 133 insertions, 2 deletions

diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 048b6c325e4..aff5d1853a6 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -194,6 +194,17 @@ M-s		next-matching-history-element
 (defvar help-tests-major-mode-map
   (let ((map (make-keymap)))
     (define-key map "x" 'foo-original)
+    (define-key map "1" 'foo-range)
+    (define-key map "2" 'foo-range)
+    (define-key map "3" 'foo-range)
+    (define-key map "4" 'foo-range)
+    (define-key map (kbd "C-e") 'foo-something)
+    (define-key map '[F1] 'foo-function-key1)
+    (define-key map "(" 'short-range)
+    (define-key map ")" 'short-range)
+    (define-key map "a" 'foo-other-range)
+    (define-key map "b" 'foo-other-range)
+    (define-key map "c" 'foo-other-range)
     map))
 
 (define-derived-mode help-tests-major-mode nil
@@ -202,12 +213,13 @@ M-s		next-matching-history-element
 (defvar help-tests-minor-mode-map
   (let ((map (make-keymap)))
     (define-key map "x" 'foo-shadow)
+    (define-key map (kbd "C-e") 'foo-shadow)
     map))
 
 (define-minor-mode help-tests-minor-mode
   "Minor mode for testing shadowing.")
 
-(ert-deftest help-tests-substitute-command-keys/shadow ()
+(ert-deftest help-tests-substitute-command-keys/test-mode ()
   (with-substitute-command-keys-test
    (with-temp-buffer
      (help-tests-major-mode)
@@ -216,17 +228,35 @@ M-s		next-matching-history-element
 key             binding
 ---             -------
 
+( .. )		short-range
+1 .. 4		foo-range
+a .. c		foo-other-range
+
+C-e		foo-something
 x		foo-original
+<F1>		foo-function-key1
+
+"))))
 
-")
+(ert-deftest help-tests-substitute-command-keys/shadow ()
+  (with-substitute-command-keys-test
+   (with-temp-buffer
+     (help-tests-major-mode)
      (help-tests-minor-mode)
      (test "\\{help-tests-major-mode-map}"
            "\
 key             binding
 ---             -------
 
+( .. )		short-range
+1 .. 4		foo-range
+a .. c		foo-other-range
+
+C-e		foo-something
+  (this binding is currently shadowed)
 x		foo-original
   (this binding is currently shadowed)
+<F1>		foo-function-key1
 
 "))))
 
@@ -247,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
+  (this binding is currently shadowed)
+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 ()
@@ -261,6 +383,15 @@ key             binding
      (outline-minor-mode)
      (test-re "\\{c-mode-map}" ".*"))))
 
+(ert-deftest help-tests-substitute-command-keys/compare-all ()
+  (let (keymaps)
+    (mapatoms (lambda (var)
+                (when (keymapp var)
+                  (push var keymaps))))
+    (dolist (keymap keymaps)
+      (with-substitute-command-keys-test
+       (test-re (concat "\\{" (symbol-name keymap) "}") ".*")))))
+
 (provide 'help-tests)
 
 ;;; help-tests.el ends here