master 330228d 2/3: Provide default for describe-keymap prompt

[Stefan Kangas]

branch: master
commit 330228d5c71981d3e2d39387d5222c3670c467c6
Author: Stefan Kangas <address@hidden>
Commit: Stefan Kangas <address@hidden>

    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 017bb3a..36c2a8b 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1562,17 +1562,55 @@ BUFFER should be a buffer or a buffer name."
          (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 1d6c062..d2dc3d2 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -125,6 +125,15 @@ Return first line of the output of (describe-function-1 
FUNC)."
 
 
 ;;; 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*"