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.
This commit is contained in:
Stefan Kangas 2020-10-18 00:02:55 +02:00
parent 5ad2bb0fa9
commit afde53cd81
2 changed files with 107 additions and 70 deletions

View file

@ -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))

View file

@ -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);