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.

diff --git a/lisp/help.el b/lisp/help.el
index 4541d6651930da4f7292e3ea6e582ceb7c2794a9..06d43857c2476dee07bb170b833215d03dd79268 100644 (file)
--- 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)))))
+
 \f
 (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 2076e29b6fbe70309082afbd683cd3cdf8c1c508..9d12c3a47d588d2d81485ea5e9470fd8bd257564 100644 (file)
--- 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);