Substitute key bindings correctly in manual

The Sphinx Emacs Lisp extension assumed all \[command] key sequence
substitutions in documentation strings are preceded by a \<mapvar>
sequence specifying the keymap, unlike substitute-command-keys which is
used when accessing docstrings within Emacs.

With this commit the actual substitute-command-keys function is used
when building docstringdb.json, instead of the Python reimplementation.
The drawback is that docstringdb.json now contains partial Sphinx
markup.

1 files changed, 30 insertions, 49 deletions

diff --git a/scripts/evil-extract-docstrings b/scripts/evil-extract-docstrings
index ed72109..06afa43 100755
--- a/scripts/evil-extract-docstrings
+++ b/scripts/evil-extract-docstrings
@@ -7,53 +7,34 @@
 (require 'json)
 (require 'help)
 
-(defun keymap-funcs (map)
-  (let (funcs)
-    (dolist (elt (cdr map))
-      (when (consp elt)
-        (cond
-         ((and (cdr elt) (symbolp (cdr elt)))
-          (push (cdr elt) funcs))
-         ((keymapp (cdr elt))
-          (setq funcs (append (keymap-funcs (cdr elt)) funcs))))))
-    funcs))
+(defun mark-command-keys (string)
+  "Mark key bindings in STRING with the \":kbd:\" Sphinx role."
+  (when string
+    (cl-loop
+     for prev = 0 then pos until (>= prev (length string))
+     for pos = (next-single-property-change prev 'face string (length string))
+     concat
+     (let ((s (substring string prev pos)))
+       (if (eq (get-text-property prev 'face string) 'help-key-binding)
+           (format ":kbd:`%s`" s)
+         s)))))
 
-(defun keymap-bindings (map)
-  (let ((funcs (keymap-funcs map))
-        bindings)
-    (dolist (func funcs)
-      (unless (memq func '(undefined))
-        ;; (push (cons func (key-description (where-is-internal func map t))) bindings)
-        ;; (message (format "%s %s" func (key-description (where-is-internal func map t))))
-        (push (cons func (key-description (where-is-internal func map t))) bindings)))
-    bindings))
-
-(with-temp-file (expand-file-name "../doc/docstringdb.json" cur-path)
-  (let (vars)
-    (mapatoms
-     (lambda (sym)
-       (when (string-prefix-p "evil-" (symbol-name sym))
-         (let ((default (car (get sym 'standard-value))))
-           (while (and (consp default) (memq (car default) '(function quote)))
-             (setq default (cadr default)))
-           (when (eq 'funcall (car-safe default))
-             (setq default (eval default)))
-           ;; (when (and (boundp sym) (keymapp (symbol-value sym)))
-           ;;   (message (format "%S" sym)))
-           (push `(,sym (default . ,(cond
-                                     ((consp default) (format "%S" default))
-                                     ((symbolp default) (symbol-name default))
-                                     (t default)))
-                        (local . ,(local-variable-if-set-p sym))
-                        (default-type . ,(type-of default))
-                        (var-docstring . ,(documentation-property sym 'variable-documentation 'raw))
-                        (fn-docstring . ,(ignore-errors (documentation sym 'raw)))
-                        (arglist . ,(help-function-arglist sym))
-                        (functionp . ,(functionp sym))
-                        (macrop . ,(macrop sym))
-                        (keymap-inv . ,(and (boundp sym)
-                                            (keymapp (symbol-value sym))
-                                            (keymap-bindings (symbol-value sym)))))
-                 vars)))))
-    (let ((json-encoding-pretty-print t))
-      (insert (json-encode vars)))))
+(let (vars)
+  (mapatoms
+   (lambda (sym)
+     (when (string-prefix-p "evil-" (symbol-name sym))
+       (let ((default (eval (car (get sym 'standard-value)))))
+         (push `(,sym (default . ,(cond
+                                   ((consp default) (format "%S" default))
+                                   ((symbolp default) (symbol-name default))
+                                   (t default)))
+                      (local . ,(local-variable-if-set-p sym))
+                      (default-type . ,(type-of default))
+                      (var-docstring . ,(mark-command-keys (documentation-property sym 'variable-documentation)))
+                      (fn-docstring . ,(ignore-errors (mark-command-keys (documentation sym))))
+                      (arglist . ,(help-function-arglist sym))
+                      (functionp . ,(functionp sym))
+                      (macrop . ,(macrop sym)))
+               vars)))))
+  (with-temp-file (expand-file-name "../doc/docstringdb.json" cur-path)
+    (insert (json-encode vars))))