bug#30660: mention describe-bindings on (info "(emacs) Keymaps")

[Stefan Kangas]

Eli Zaretskii <eliz@gnu.org> writes:

> Does the pseudo-code at the beginning of "Searching Keymaps" give any
> ideas?

It does, yes.

The pseudo-code only gives us the *value* of the keymap.  This is
probably part of the reason why Drew wanted us to be able to find
keymap *symbols* from values.  I have added a separate function
help-fns-find-keymap-name to get the symbol from the value based on
his code.

I'm not sure exactly where the new functions in the second patch
should go, so I just kept them in help-fns.el.  I suspect people might
want to use at least help-fns-find-keymap-name outside of help-fns.el,
so maybe we could find a better place to add them (and better names?).

Attached is an updated patchset.  The first patch is as before,
updated with the above doc fix, and the second patch adds the
reasonable default you asked for.  WDYT?

Best regards,
Stefan Kangas

>From be09c3a807239804284430cd316530235b48da19 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Sat, 24 Aug 2019 01:02:04 +0200
Subject: [PATCH 1/2] Add new help command describe-keymap

* lisp/help-fns.el (describe-keymap): New command to show key bindings
for a given keymap.  (Bug#30660)
* doc/emacs/help.texi (Misc Help): Document the new command.
* doc/lispref/keymaps.texi (Scanning Keymaps): Add a cross-reference
to the above documentation.
* etc/NEWS: Announce the new command.

* test/lisp/help-fns-tests.el (help-fns-test-describe-keymap/symbol)
(help-fns-test-describe-keymap/value)
(help-fns-test-describe-keymap/not-keymap)
(help-fns-test-describe-keymap/let-bound)
(help-fns-test-describe-keymap/dynamically-bound-no-file): New tests.

Co-authored-by: Drew Adams <drew.adams@oracle.com>
---
 doc/emacs/help.texi         |  5 ++++
 doc/lispref/keymaps.texi    |  7 +++--
 etc/NEWS                    |  5 ++++
 lisp/help-fns.el            | 59 +++++++++++++++++++++++++++++++++++++
 test/lisp/help-fns-tests.el | 28 ++++++++++++++++++
 5 files changed, 102 insertions(+), 2 deletions(-)

diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index fce6720b93..49c53c5cbc 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -601,6 +601,11 @@ Misc Help
 which marks a defun.  However, @w{@kbd{@key{ESC} @key{F1}}} and
 @w{@kbd{@key{ESC} ?}} work fine.)
 
+@findex describe-keymap
+Finally, @kbd{M-x describe-keymap} prompts for the name of a keymap,
+with completion, and displays a listing of all key bindings in that
+keymap.
+
 @node Help Files
 @section Help Files
 
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 259efea324..4d513132e9 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1846,8 +1846,11 @@ Scanning Keymaps
 @cindex scanning keymaps
 @cindex keymaps, scanning
 
-  This section describes functions used to scan all the current keymaps
-for the sake of printing help information.
+  This section describes functions used to scan all the current
+keymaps for the sake of printing help information.  To display the
+bindings in a particular keymap, you can use the
+@code{describe-keymap} command (@pxref{Misc Help, , Other Help
+Commands, emacs, The GNU Emacs Manual})
 
 @defun accessible-keymaps keymap &optional prefix
 This function returns a list of all the keymaps that can be reached (via
diff --git a/etc/NEWS b/etc/NEWS
index 73ed3d739e..e4ed0e0bf6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -44,6 +44,11 @@ It was declared obsolete in Emacs 27.1.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+** Help
+
++++
+*** New command 'describe-keymap' describes keybindings in a keymap.
+
 ---
 ** The sb-image.el library is now marked obsolete.
 This file was a compatibility kludge which is no longer needed.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0e2ae6b3c3..017bb3ae74 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1562,6 +1562,65 @@ describe-categories
          (insert "\nThe parent category table is:")
          (describe-vector table 'help-describe-category-set))))))
 
+;;;###autoload
+(defun describe-keymap (keymap)
+  "Describe key bindings in KEYMAP.
+When called interactively, prompt for a variable that has a
+keymap value."
+  (interactive (list
+                (intern (completing-read "Keymap: " obarray
+                                         (lambda (m)
+                                           (and (boundp m)
+                                                (keymapp (symbol-value m))))
+                                         t nil 'variable-name-history))))
+  (let (used-gentemp)
+    (unless (and (symbolp keymap)
+                 (boundp keymap)
+                 (keymapp (symbol-value keymap)))
+      (when (not (keymapp keymap))
+        (if (symbolp keymap)
+            (error "Not a keymap variable: %S" keymap)
+          (error "Not a keymap")))
+      (let ((sym nil))
+        (unless sym
+          (setq sym (cl-gentemp "KEYMAP OBJECT (no variable) "))
+          (setq used-gentemp t)
+          (set sym keymap))
+        (setq keymap sym)))
+    ;; Follow aliasing.
+    (setq keymap (or (ignore-errors (indirect-variable keymap)) keymap))
+    (help-setup-xref (list #'describe-keymap keymap)
+                     (called-interactively-p 'interactive))
+    (let* ((name (symbol-name keymap))
+           (doc (documentation-property keymap 'variable-documentation))
+           (file-name (find-lisp-object-file-name keymap 'defvar)))
+      (with-help-window (help-buffer)
+        (with-current-buffer standard-output
+          (unless used-gentemp
+            (princ (format-message "%S is a keymap variable" keymap))
+            (if (not file-name)
+                (princ ".\n\n")
+              (princ (format-message
+                      " defined in `%s'.\n\n"
+                      (if (eq file-name 'C-source)
+                          "C source code"
+                        (file-name-nondirectory file-name))))
+              (save-excursion
+                (re-search-backward (substitute-command-keys
+                                     "`\\([^`']+\\)'")
+                                    nil t)
+                (help-xref-button 1 'help-variable-def
+                                  keymap file-name))))
+          (when (and (not (equal "" doc)) doc)
+            (princ "Documentation:\n")
+            (princ (format-message "%s\n\n" doc)))
+          ;; Use `insert' instead of `princ', so control chars (e.g. \377)
+          ;; insert correctly.
+          (insert (substitute-command-keys (concat "\\{" name "}"))))))
+    ;; Cleanup.
+    (when used-gentemp
+      (makunbound keymap))))
+
 
 ;;; Replacements for old lib-src/ programs.  Don't seem especially useful.
 
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 4c808d8372..1ac27fef3a 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -123,4 +123,32 @@ help-fns-test-describe-symbol
     (goto-char (point-min))
     (should (looking-at "^font-lock-comment-face is "))))
 
+
+;;; Tests for describe-keymap
+(ert-deftest help-fns-test-describe-keymap/symbol ()
+  (describe-keymap 'minibuffer-local-must-match-map)
+  (with-current-buffer "*Help*"
+    (should (looking-at "^minibuffer-local-must-match-map is"))))
+
+(ert-deftest help-fns-test-describe-keymap/value ()
+  (describe-keymap minibuffer-local-must-match-map)
+  (with-current-buffer "*Help*"
+    (should (looking-at "^key"))))
+
+(ert-deftest help-fns-test-describe-keymap/not-keymap ()
+  (should-error (describe-keymap nil))
+  (should-error (describe-keymap emacs-version)))
+
+(ert-deftest help-fns-test-describe-keymap/let-bound ()
+  (let ((foobar minibuffer-local-must-match-map))
+    (describe-keymap foobar)
+    (with-current-buffer "*Help*"
+      (should (looking-at "^key")))))
+
+(ert-deftest help-fns-test-describe-keymap/dynamically-bound-no-file ()
+  (setq help-fns-test--describe-keymap-foo minibuffer-local-must-match-map)
+  (describe-keymap 'help-fns-test--describe-keymap-foo)
+  (with-current-buffer "*Help*"
+    (should (looking-at "^help-fns-test--describe-keymap-foo is"))))
+
 ;;; help-fns-tests.el ends here
-- 
2.20.1

>From 3a7a39f241dcb1988abd47dff0070b2abca20c02 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Sun, 19 Jan 2020 00:17:42 +0100
Subject: [PATCH 2/2] Provide default for describe-keymap prompt

* lisp/help-fns.el (describe-keymap): Provide a reasonable
default for prompt.  (Bug#30660)
(help-fns-find-keymap-name)
(help-fns--most-relevant-active-keymap): New functions.

* test/lisp/help-fns-tests.el
(help-fns-test-find-keymap-name): New test.
---
 lisp/help-fns.el            | 50 ++++++++++++++++++++++++++++++++-----
 test/lisp/help-fns-tests.el |  9 +++++++
 2 files changed, 53 insertions(+), 6 deletions(-)

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 017bb3ae74..36c2a8b186 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1562,17 +1562,55 @@ describe-categories
          (insert "\nThe parent category table is:")
          (describe-vector table 'help-describe-category-set))))))
 
+(defun help-fns-find-keymap-name (keymap)
+  "Find the name of the variable with value KEYMAP.
+Return nil if KEYMAP is not a valid keymap, or if there is no
+variable with value KEYMAP."
+  (when (keymapp keymap)
+    (let ((name (catch 'found-keymap
+                  (mapatoms (lambda (symb)
+                              (when (and (boundp symb)
+                                         (eq (symbol-value symb) keymap)
+                                         (not (eq symb 'keymap))
+                                         (throw 'found-keymap symb)))))
+                  nil)))
+      ;; Follow aliasing.
+      (or (ignore-errors (indirect-variable name)) name))))
+
+(defun help-fns--most-relevant-active-keymap ()
+  "Return the name of the most relevant active keymap.
+The heuristic to determine which keymap is most likely to be
+relevant to a user follows this order:
+
+1. 'keymap' text property at point
+2. 'local-map' text property at point
+3. the `current-local-map'
+
+This is used to set the default value for the interactive prompt
+in `describe-keymap'.  See also `Searching the Active Keymaps'."
+  (help-fns-find-keymap-name (or (get-char-property (point) 'keymap)
+                         (if (get-text-property (point) 'local-map)
+                             (get-char-property (point) 'local-map)
+                           (current-local-map)))))
+
 ;;;###autoload
 (defun describe-keymap (keymap)
   "Describe key bindings in KEYMAP.
 When called interactively, prompt for a variable that has a
 keymap value."
-  (interactive (list
-                (intern (completing-read "Keymap: " obarray
-                                         (lambda (m)
-                                           (and (boundp m)
-                                                (keymapp (symbol-value m))))
-                                         t nil 'variable-name-history))))
+  (interactive
+   (let* ((km (help-fns--most-relevant-active-keymap))
+          (val (completing-read
+                (format "Keymap (default %s): " km)
+                obarray
+                (lambda (m) (and (boundp m) (keymapp (symbol-value m))))
+                t nil 'keymap-name-history
+                (symbol-name km))))
+     (unless (equal val "")
+       (setq km (intern val)))
+     (unless (and km (keymapp (symbol-value km)))
+       (user-error "Not a keymap: %s" km))
+     (list km)))
   (let (used-gentemp)
     (unless (and (symbolp keymap)
                  (boundp keymap)
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 1ac27fef3a..89f732d244 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -125,6 +125,15 @@ help-fns-test-describe-symbol
 
 
 ;;; Tests for describe-keymap
+(ert-deftest help-fns-test-find-keymap-name ()
+  (should (equal (help-fns-find-keymap-name lisp-mode-map) 'lisp-mode-map))
+  ;; Follow aliasing.
+  (unwind-protect
+      (progn
+        (defvaralias 'foo-test-map 'lisp-mode-map)
+        (should (equal (help-fns-find-keymap-name foo-test-map) 
'lisp-mode-map)))
+    (makunbound 'foo-test-map)))
+
 (ert-deftest help-fns-test-describe-keymap/symbol ()
   (describe-keymap 'minibuffer-local-must-match-map)
   (with-current-buffer "*Help*"
-- 
2.20.1