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.

diff --git a/lisp/help.el b/lisp/help.el
index 06d43857c2476dee07bb170b833215d03dd79268..e8dfbdef74ab247d8eb563908dcf2ffc95a5907e 100644 (file)
--- 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)))))
 
 \f
 (declare-function x-display-pixel-height "xfns.c" (&optional terminal))

diff --git a/src/keymap.c b/src/keymap.c
index 9d12c3a47d588d2d81485ea5e9470fd8bd257564..5ae8da6a05ad09021d665187ce56dad101378984 100644 (file)
--- 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);