From afde53cd81c7817c5b3187e60e7a49790e0af832 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 18 Oct 2020 00:02:55 +0200 Subject: [PATCH] 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 06d43857c24..e8dfbdef74a 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 9d12c3a47d5..5ae8da6a05a 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); -- 2.39.2