scratch/substitute-command-keys afde53c 5/8: Improve substitute-command-keys performance

[Stefan Kangas]

branch: scratch/substitute-command-keys
commit afde53cd81c7817c5b3187e60e7a49790e0af832
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    Improve substitute-command-keys performance
    
    The previous conversion of describe_vector from C to Lisp for the
    keymap and char table case lead to an unacceptable performance hit.
    Moving back to the C version, as we do here, makes this function
    around 50 times faster.
    
    The Lisp version of `substitute-command-keys' was benchmarked using
    the form `(documentation 'dired-mode)', which now takes less than 8 ms
    on my machine.  This is around 16 times slower than the previous C
    version.
    
    Thanks to Stefan Monnier for helpful pointers on benchmarking.
    
    * src/keymap.c (Fhelp__describe_vector): New defun to expose
    describe_vector to Lisp for keymaps and char tables.
    (syms_of_keymap): New defsubr for Fhelp__describe_vector.
    * lisp/help.el (describe-map): Use above defun instead of Lisp
    version.
    (help--describe-vector): Remove defun; keep it commented out for now.
---
 lisp/help.el | 142 ++++++++++++++++++++++++++++++-----------------------------
 src/keymap.c |  35 +++++++++++++++
 2 files changed, 107 insertions(+), 70 deletions(-)

diff --git a/lisp/help.el b/lisp/help.el
index 06d4385..e8dfbde 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1367,76 +1367,78 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as 
in
         ;; Next item in list.
         (setq vect (cdr vect))))))
 
-(defun help--describe-vector
-    (vector prefix transl partial shadow entire-map mention-shadow)
-  "Insert in the current buffer a description of the contents of VECTOR.
-
-PREFIX a prefix key which leads to the keymap that this vector is
-in.
-
-If PARTIAL, it means do not mention suppressed commands
-(that assumes the vector is in a keymap).
-
-SHADOW is a list of keymaps that shadow this map.  If it is
-non-nil, look up the key in those maps and don't mention it if it
-is defined by any of them.
-
-ENTIRE-MAP is the vector in which this vector appears.
-If the definition in effect in the whole map does not match
-the one in this vector, we ignore this one."
-  ;; Converted from describe_vector in keymap.c.
-  (let* ((first t)
-         (idx 0))
-    (while (< idx (length vector))
-      (let* ((val (aref vector idx))
-             (definition (keymap--get-keyelt val nil))
-             (start-idx idx)
-             this-shadowed
-             found-range)
-        (when (and definition
-                   ;; Don't mention suppressed commands.
-                   (not (and partial
-                             (symbolp definition)
-                             (get definition 'suppress-keymap)))
-                   ;; If this binding is shadowed by some other map,
-                   ;; ignore it.
-                   (not (and shadow
-                             (help--shadow-lookup shadow (vector start-idx) t 
nil)
-                             (if mention-shadow
-                                 (prog1 nil (setq this-shadowed t))
-                               t)))
-                   ;; Ignore this definition if it is shadowed by an earlier
-                   ;; one in the same keymap.
-                   (not (and entire-map
-                             (not (eq (lookup-key entire-map (vector 
start-idx) t)
-                                      definition)))))
-          (when first
-            (insert "\n")
-            (setq first nil))
-          (when (and prefix (> (length prefix) 0))
-            (insert (format "%s" prefix)))
-          (insert (key-description (vector start-idx) prefix))
-          ;; Find all consecutive characters or rows that have the
-          ;; same definition.
-          (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
-                        definition)
-            (setq found-range t)
-            (setq idx (1+ idx)))
-          ;; If we have a range of more than one character,
-          ;; print where the range reaches to.
-          (when found-range
-            (insert " .. ")
-            (when (and prefix (> (length prefix) 0))
-              (insert (format "%s" prefix)))
-            (insert (key-description (vector idx) prefix)))
-          (if transl
-              (help--describe-translation definition)
-            (help--describe-command definition))
-          (when this-shadowed
-            (goto-char (1- (point)))
-            (insert "  (binding currently shadowed)")
-            (goto-char (1+ (point))))))
-      (setq idx (1+ idx)))))
+;;;; This Lisp version is 100 times slower than its C equivalent:
+;;
+;; (defun help--describe-vector
+;;     (vector prefix transl partial shadow entire-map mention-shadow)
+;;   "Insert in the current buffer a description of the contents of VECTOR.
+;;
+;; PREFIX a prefix key which leads to the keymap that this vector is
+;; in.
+;;
+;; If PARTIAL, it means do not mention suppressed commands
+;; (that assumes the vector is in a keymap).
+;;
+;; SHADOW is a list of keymaps that shadow this map.  If it is
+;; non-nil, look up the key in those maps and don't mention it if it
+;; is defined by any of them.
+;;
+;; ENTIRE-MAP is the vector in which this vector appears.
+;; If the definition in effect in the whole map does not match
+;; the one in this vector, we ignore this one."
+;;   ;; Converted from describe_vector in keymap.c.
+;;   (let* ((first t)
+;;          (idx 0))
+;;     (while (< idx (length vector))
+;;       (let* ((val (aref vector idx))
+;;              (definition (keymap--get-keyelt val nil))
+;;              (start-idx idx)
+;;              this-shadowed
+;;              found-range)
+;;         (when (and definition
+;;                    ;; Don't mention suppressed commands.
+;;                    (not (and partial
+;;                              (symbolp definition)
+;;                              (get definition 'suppress-keymap)))
+;;                    ;; If this binding is shadowed by some other map,
+;;                    ;; ignore it.
+;;                    (not (and shadow
+;;                              (help--shadow-lookup shadow (vector start-idx) 
t nil)
+;;                              (if mention-shadow
+;;                                  (prog1 nil (setq this-shadowed t))
+;;                                t)))
+;;                    ;; Ignore this definition if it is shadowed by an earlier
+;;                    ;; one in the same keymap.
+;;                    (not (and entire-map
+;;                              (not (eq (lookup-key entire-map (vector 
start-idx) t)
+;;                                       definition)))))
+;;           (when first
+;;             (insert "\n")
+;;             (setq first nil))
+;;           (when (and prefix (> (length prefix) 0))
+;;             (insert (format "%s" prefix)))
+;;           (insert (key-description (vector start-idx) prefix))
+;;           ;; Find all consecutive characters or rows that have the
+;;           ;; same definition.
+;;           (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
+;;                         definition)
+;;             (setq found-range t)
+;;             (setq idx (1+ idx)))
+;;           ;; If we have a range of more than one character,
+;;           ;; print where the range reaches to.
+;;           (when found-range
+;;             (insert " .. ")
+;;             (when (and prefix (> (length prefix) 0))
+;;               (insert (format "%s" prefix)))
+;;             (insert (key-description (vector idx) prefix)))
+;;           (if transl
+;;               (help--describe-translation definition)
+;;             (help--describe-command definition))
+;;           (when this-shadowed
+;;             (goto-char (1- (point)))
+;;             (insert "  (binding currently shadowed)")
+;;             (goto-char (1+ (point))))))
+;;       (setq idx (1+ idx)))))
 
 
 (declare-function x-display-pixel-height "xfns.c" (&optional terminal))
diff --git a/src/keymap.c b/src/keymap.c
index 9d12c3a..5ae8da6 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3328,6 +3328,40 @@ DESCRIBER is the output function used; nil means use 
`princ'.  */)
   return unbind_to (count, Qnil);
 }
 
+DEFUN ("help--describe-vector", Fhelp__describe_vector, 
Shelp__describe_vector, 7, 7, 0,
+       doc: /* Insert in the current buffer a description of the contents of 
VECTOR.
+
+PREFIX is a string describing the key which leads to the keymap that
+this vector is in.
+
+If PARTIAL, it means do not mention suppressed commands.
+
+SHADOW is a list of keymaps that shadow this map.
+If it is non-nil, look up the key in those maps and don't mention it
+if it is defined by any of them.
+
+ENTIRE-MAP is the keymap in which this vector appears.
+If the definition in effect in the whole map does not match
+the one in this keymap, we ignore this one.  */)
+  (Lisp_Object vector, Lisp_Object prefix, Lisp_Object transl,
+   Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map,
+   Lisp_Object mention_shadow)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+  specbind (Qstandard_output, Fcurrent_buffer ());
+  CHECK_VECTOR_OR_CHAR_TABLE (vector);
+
+  bool b_transl = NILP (transl) ? false : true;
+  bool b_partial = NILP (partial) ? false : true;
+  bool b_mention_shadow = NILP (mention_shadow) ? false : true;
+
+  describe_vector (vector, prefix, Qnil,
+                  b_transl ? describe_translation : describe_command,
+                  b_partial, shadow, entire_map,
+                  true, b_mention_shadow);
+  return unbind_to (count, Qnil);
+}
+
 /* Insert in the current buffer a description of the contents of VECTOR.
    We call ELT_DESCRIBER to insert the description of one value found
    in VECTOR.
@@ -3726,6 +3760,7 @@ be preferred.  */);
   defsubr (&Saccessible_keymaps);
   defsubr (&Skey_description);
   defsubr (&Skeymap__get_keyelt);
+  defsubr (&Shelp__describe_vector);
   defsubr (&Sdescribe_vector);
   defsubr (&Ssingle_key_description);
   defsubr (&Stext_char_description);