[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/substitute-command-keys 5ad2bb0 4/8: Translate describe_vector t
From: |
Stefan Kangas |
Subject: |
scratch/substitute-command-keys 5ad2bb0 4/8: Translate describe_vector to Lisp |
Date: |
Sun, 18 Oct 2020 11:54:25 -0400 (EDT) |
branch: scratch/substitute-command-keys
commit 5ad2bb0fa95d9c9ae2387c963b453f695577450a
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefan@marxist.se>
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.
---
lisp/help.el | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
src/keymap.c | 23 -------------------
2 files changed, 73 insertions(+), 25 deletions(-)
diff --git a/lisp/help.el b/lisp/help.el
index 4541d66..06d4385 100644
--- a/lisp/help.el
+++ b/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))
diff --git a/src/keymap.c b/src/keymap.c
index 2076e29..9d12c3a 100644
--- a/src/keymap.c
+++ b/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);
- branch scratch/substitute-command-keys created (now 420023a), Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys dcf9cd4 1/8: Add new Lisp implementation of substitute-command-keys, Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys afd31f9 2/8: Translate describe_map_tree to Lisp, Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys afde53c 5/8: Improve substitute-command-keys performance, Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys 5ad2bb0 4/8: Translate describe_vector to Lisp,
Stefan Kangas <=
- scratch/substitute-command-keys 8a14413 6/8: Prefer Lisp version of describe-map-tree, Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys ef5a604 7/8: Remove C version of substitute-command-keys, Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys 420023a 8/8: Prefer Lisp version of describer in help--describe-vector, Stefan Kangas, 2020/10/18
- scratch/substitute-command-keys 647b1c5 3/8: Translate describe_map to Lisp, Stefan Kangas, 2020/10/18