diff options
author | Stefan Kangas <stefankangas@gmail.com> | 2020-08-23 17:20:09 +0200 |
---|---|---|
committer | Stefan Kangas <stefan@marxist.se> | 2020-10-18 17:25:23 +0200 |
commit | 5ad2bb0fa95d9c9ae2387c963b453f695577450a (patch) | |
tree | a2c6d368a514288ecad2f2ef7c038a0ccf33adbe /lisp/help.el | |
parent | 647b1c5142d7a029a3124e0177112f16f84d3794 (diff) | |
download | emacs-5ad2bb0fa95d9c9ae2387c963b453f695577450a.tar.gz |
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.
Diffstat (limited to 'lisp/help.el')
-rw-r--r-- | lisp/help.el | 75 |
1 files changed, 73 insertions, 2 deletions
diff --git a/lisp/help.el b/lisp/help.el index 4541d665193..06d43857c24 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)) |