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

This code was written by Drew Adams with minor cleanups and stylistic
changes by Stefan Kangas.
Ref: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30660

* lisp/help-fns.el (describe-keymap): New function to show key
bindings for a given keymap.  (Bug#30660)
* lisp/help.el (help-map): Bind the new function to "C-h M".
* lisp/help.el (help-for-help-internal): Document what "C-h M" does
when user types "C-h C-h".
---
 lisp/help-fns.el | 66 ++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/help.el     |  2 ++
 2 files changed, 68 insertions(+)

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 90a3571520..b64bbbe4c6 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1390,6 +1390,72 @@ describe-categories
 	  (insert "\nThe parent category table is:")
 	  (describe-vector table 'help-describe-category-set))))))
 
+;;;###autoload
+(defun describe-keymap (keymap &optional search-symbols-p)
+  "Describe key bindings in KEYMAP.
+When called interactively, prompt for a variable that has a
+keymap value.  Completion is available for the variable name.
+
+If optional argument SEARCH-SYMBOLS-P is non-nil, and KEYMAP is
+not a symbol, search all variables for one whose value is KEYMAP
+and use that to describe the key bindings.  This makes it
+possible to not only see the bindings but also to identify the
+name of the keymap in question."
+  (interactive (list
+                (intern (completing-read "Keymap: " obarray
+                                         (lambda (m)
+                                           (and (boundp m)
+                                                (keymapp (symbol-value m))))
+                                         t nil 'variable-name-history))))
+  (unless (and (symbolp keymap)
+               (boundp keymap)
+               (keymapp (symbol-value keymap)))
+    (if (not (keymapp keymap))
+        (if (symbolp keymap)
+            (error "Not a keymap variable: %S" keymap)
+          (error "Not a keymap"))
+      (let ((sym nil))
+        (when search-symbols-p
+          (setq sym (catch 'describe-keymap
+                      (mapatoms (lambda (symb)
+                                  (when (and (boundp symb)
+                                             (eq (symbol-value symb) keymap)
+                                             (not (eq symb 'keymap))
+                                             (throw 'describe-keymap symb)))))
+                      nil)))
+        (unless sym
+          (setq sym (cl-gentemp "KEYMAP OBJECT (no variable) "))
+          (set sym keymap))
+        (setq keymap sym))))
+  ;; Follow aliasing.
+  (setq keymap (or (ignore-errors (indirect-variable keymap)) keymap))
+  (let* ((name (symbol-name keymap))
+         (doc (documentation-property keymap 'variable-documentation))
+         (file-name (find-lisp-object-file-name keymap 'defvar)))
+    (help-setup-xref (list #'describe-keymap keymap)
+                     (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (princ (format-message "%S" keymap))
+      (princ (format-message
+              " is a keymap variable defined in `%s'.\n\n"
+              (if (eq file-name 'C-source)
+                  "C source code"
+                (file-name-nondirectory file-name))))
+      (with-current-buffer standard-output
+        (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.
+      (with-current-buffer "*Help*"
+        (insert (substitute-command-keys (concat "\\{" name "}")))))))
+
 
 ;;; Replacements for old lib-src/ programs.  Don't seem especially useful.
 
diff --git a/lisp/help.el b/lisp/help.el
index e40178de96..18f1219ca0 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -96,6 +96,7 @@ help-map
     (define-key map "k" 'describe-key)
     (define-key map "l" 'view-lossage)
     (define-key map "m" 'describe-mode)
+    (define-key map "M" 'describe-keymap)
     (define-key map "o" 'describe-symbol)
     (define-key map "n" 'view-emacs-news)
     (define-key map "p" 'finder-by-keyword)
@@ -219,6 +220,7 @@ 'help-for-help
 L LANG-ENV  Describes a specific language environment, or RET for current.
 m           Display documentation of current minor modes and current major mode,
               including their special commands.
+M KEYMAP    Describe the given keymap and its bindings.
 n           Display news of recent Emacs changes.
 o SYMBOL    Display the given function or variable's documentation and value.
 p TOPIC     Find packages matching a given topic keyword.
-- 
2.22.0

