Translate describe_vector to Lisp
* lisp/help.el (help--describe-vector): New Lisp implementation of describe_vector. * src/keymap.c (Fdescribe_vector_internal): Remove defun. (syms_of_keymap): Remove defsubr for Fdescribe_vector_internal.
This commit is contained in:
parent
647b1c5142
commit
5ad2bb0fa9
2 changed files with 73 additions and 25 deletions
75
lisp/help.el
75
lisp/help.el
|
@ -1277,8 +1277,8 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
|
|||
done vect)
|
||||
(while (and (consp tail) (not done))
|
||||
(cond ((or (vectorp (car tail)) (char-table-p (car tail)))
|
||||
(describe-vector-internal (car tail) prefix transl partial
|
||||
shadow map t mention-shadow))
|
||||
(help--describe-vector (car tail) prefix transl partial
|
||||
shadow map mention-shadow))
|
||||
((consp (car tail))
|
||||
(let ((event (caar tail))
|
||||
definition this-shadowed)
|
||||
|
@ -1367,6 +1367,77 @@ 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)))))
|
||||
|
||||
|
||||
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
|
||||
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
|
||||
|
|
23
src/keymap.c
23
src/keymap.c
|
@ -3328,28 +3328,6 @@ DESCRIBER is the output function used; nil means use `princ'. */)
|
|||
return unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
DEFUN ("describe-vector-internal", Fdescribe_vector_internal, Sdescribe_vector_internal, 8, 8, 0,
|
||||
doc: /* Insert a description of contents of VECTOR. */)
|
||||
(Lisp_Object vector, Lisp_Object prefix, Lisp_Object transl,
|
||||
Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map,
|
||||
Lisp_Object keymap_p, 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_keymap_p = NILP (keymap_p) ? 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,
|
||||
b_keymap_p, 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.
|
||||
|
@ -3749,7 +3727,6 @@ be preferred. */);
|
|||
defsubr (&Skey_description);
|
||||
defsubr (&Skeymap__get_keyelt);
|
||||
defsubr (&Sdescribe_vector);
|
||||
defsubr (&Sdescribe_vector_internal);
|
||||
defsubr (&Ssingle_key_description);
|
||||
defsubr (&Stext_char_description);
|
||||
defsubr (&Swhere_is_internal);
|
||||
|
|
Loading…
Add table
Reference in a new issue