Translate describe_map_tree to Lisp
This is the second step in converting substitute-command-keys to Lisp. * lisp/help.el (describe-map-tree): New Lisp version of describe_map_tree. (substitute-command-keys): Update to use above function. * src/keymap.c (Fdescribe_map): New defun to expose describe_map to Lisp. * src/keymap.c (syms_of_keymap): New variable 'help--keymaps-seen'; a temporary kludge planned for removal. New defsubr for Fdescribe_map.
This commit is contained in:
Stefan Kangas
parent
dcf9cd47ae
commit
afd31f9e62
2 changed files with 116 additions and 4 deletions
90
lisp/help.el
90
lisp/help.el
|
|
@ -1013,7 +1013,8 @@ Otherwise, return a new string (without any text properties)."
|
|||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(while (< (point) (point-max))
|
||||
(let ((orig-point (point))
|
||||
(let ((standard-output (current-buffer))
|
||||
(orig-point (point))
|
||||
end-point active-maps
|
||||
close generate-summary)
|
||||
(cond
|
||||
|
|
@ -1101,7 +1102,7 @@ Otherwise, return a new string (without any text properties)."
|
|||
;; If this one's not active, get nil.
|
||||
(let ((earlier-maps (cdr (memq this-keymap (reverse active-maps)))))
|
||||
(describe-map-tree this-keymap t (nreverse earlier-maps)
|
||||
nil nil t nil nil))))))))
|
||||
nil nil t nil nil t))))))))
|
||||
;; 2. Handle quotes.
|
||||
((and (eq (get-quoting-style) 'curve)
|
||||
(or (and (= (following-char) ?\`)
|
||||
|
|
@ -1117,6 +1118,91 @@ Otherwise, return a new string (without any text properties)."
|
|||
(t (forward-char 1)))))
|
||||
(buffer-string)))))
|
||||
|
||||
(defun describe-map-tree (startmap partial shadow prefix title no-menu
|
||||
transl always-title mention-shadow)
|
||||
"Insert a description of the key bindings in STARTMAP.
|
||||
This is followed by the key bindings of all maps reachable
|
||||
through STARTMAP.
|
||||
|
||||
If PARTIAL is non-nil, omit certain uninteresting commands
|
||||
\(such as `undefined').
|
||||
|
||||
If SHADOW is non-nil, it is a list of maps; don't mention keys
|
||||
which would be shadowed by any of them.
|
||||
|
||||
If PREFIX is non-nil, mention only keys that start with PREFIX.
|
||||
|
||||
If TITLE is non-nil, is a string to insert at the beginning.
|
||||
TITLE should not end with a colon or a newline; we supply that.
|
||||
|
||||
If NOMENU is non-nil, then omit menu-bar commands.
|
||||
|
||||
If TRANSL is non-nil, the definitions are actually key
|
||||
translations so print strings and vectors differently.
|
||||
|
||||
If ALWAYS_TITLE is non-nil, print the title even if there are no
|
||||
maps to look through.
|
||||
|
||||
If MENTION_SHADOW is non-nil, then when something is shadowed by
|
||||
SHADOW, don't omit it; instead, mention it but say it is
|
||||
shadowed.
|
||||
|
||||
Any inserted text ends in two newlines (used by
|
||||
`help-make-xrefs')."
|
||||
(let* ((amaps (accessible-keymaps startmap prefix))
|
||||
(orig-maps (if no-menu
|
||||
(progn
|
||||
;; Delete from MAPS each element that is for
|
||||
;; the menu bar.
|
||||
(let* ((tail amaps)
|
||||
result)
|
||||
(while tail
|
||||
(let ((elem (car tail)))
|
||||
(when (not (and (>= (length (car elem)) 1)
|
||||
(eq (elt (car elem) 0) 'menu-bar)))
|
||||
(setq result (append result (list elem)))))
|
||||
(setq tail (cdr tail)))
|
||||
result))
|
||||
amaps))
|
||||
(maps orig-maps)
|
||||
(print-title (or maps always-title)))
|
||||
;; Print title.
|
||||
(when print-title
|
||||
(princ (concat (if title
|
||||
(concat title
|
||||
(if prefix
|
||||
(concat " Starting With "
|
||||
(key-description prefix)))
|
||||
":\n"))
|
||||
"key binding\n"
|
||||
"--- -------\n")))
|
||||
;; Describe key bindings.
|
||||
(setq help--keymaps-seen nil)
|
||||
(while (consp maps)
|
||||
(let* ((elt (car maps))
|
||||
(elt-prefix (car elt))
|
||||
(sub-shadows (lookup-key shadow elt-prefix t)))
|
||||
(when (if (natnump sub-shadows)
|
||||
(prog1 t (setq sub-shadows nil))
|
||||
;; Describe this map iff elt_prefix is bound to a
|
||||
;; keymap, since otherwise it completely shadows this
|
||||
;; map.
|
||||
(or (keymapp sub-shadows)
|
||||
(null sub-shadows)
|
||||
(consp sub-shadows)
|
||||
(not (keymapp (car sub-shadows)))))
|
||||
;; Maps we have already listed in this loop shadow this map.
|
||||
(let ((tail orig-maps))
|
||||
(while (not (equal tail maps))
|
||||
(when (equal (car (car tail)) elt-prefix)
|
||||
(setq sub-shadows (cons (cdr (car tail)) sub-shadows)))
|
||||
(setq tail (cdr tail))))
|
||||
(describe-map (cdr elt) elt-prefix transl partial
|
||||
sub-shadows no-menu mention-shadow)))
|
||||
(setq maps (cdr maps)))
|
||||
(when print-title
|
||||
(princ "\n"))))
|
||||
|
||||
|
||||
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
|
||||
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
|
||||
|
|
|
|||
30
src/keymap.c
30
src/keymap.c
|
|
@ -2915,7 +2915,7 @@ You type Translation\n\
|
|||
|
||||
Any inserted text ends in two newlines (used by `help-make-xrefs'). */
|
||||
|
||||
DEFUN ("describe-map-tree", Fdescribe_map_tree, Sdescribe_map_tree, 1, 8, 0,
|
||||
DEFUN ("describe-map-tree-old", Fdescribe_map_tree_old, Sdescribe_map_tree_old, 1, 8, 0,
|
||||
doc: /* This is just temporary. */)
|
||||
(Lisp_Object startmap, Lisp_Object partial, Lisp_Object shadow,
|
||||
Lisp_Object prefix, Lisp_Object title, Lisp_Object nomenu,
|
||||
|
|
@ -3131,6 +3131,27 @@ describe_map_compare (const void *aa, const void *bb)
|
|||
return 0;
|
||||
}
|
||||
|
||||
DEFUN ("describe-map", Fdescribe_map, Sdescribe_map, 1, 7, 0,
|
||||
doc: /* This is a temporary definition preparing the transition
|
||||
of this function to Lisp. */)
|
||||
(Lisp_Object map, Lisp_Object prefix,
|
||||
Lisp_Object transl, Lisp_Object partial, Lisp_Object shadow,
|
||||
Lisp_Object nomenu, Lisp_Object mention_shadow)
|
||||
{
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
|
||||
bool b_transl = NILP(transl) ? false : true;
|
||||
bool b_partial = NILP (partial) ? false : true;
|
||||
bool b_nomenu = NILP (nomenu) ? false : true;
|
||||
bool b_mention_shadow = NILP (mention_shadow) ? false : true;
|
||||
describe_map (map, prefix,
|
||||
b_transl ? describe_translation : describe_command,
|
||||
b_partial, shadow, &Vhelp__keymaps_seen,
|
||||
b_nomenu, b_mention_shadow);
|
||||
|
||||
return unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
/* Describe the contents of map MAP, assuming that this map itself is
|
||||
reached by the sequence of prefix keys PREFIX (a string or vector).
|
||||
PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
|
||||
|
|
@ -3685,6 +3706,10 @@ exists, bindings using keys without modifiers (or only with meta) will
|
|||
be preferred. */);
|
||||
Vwhere_is_preferred_modifier = Qnil;
|
||||
where_is_preferred_modifier = 0;
|
||||
DEFVAR_LISP ("help--keymaps-seen", Vhelp__keymaps_seen,
|
||||
doc: /* List of seen keymaps.
|
||||
This is used for internal purposes only. */);
|
||||
Vhelp__keymaps_seen = Qnil;
|
||||
|
||||
DEFSYM (Qmenu_bar, "menu-bar");
|
||||
DEFSYM (Qmode_line, "mode-line");
|
||||
|
|
@ -3739,7 +3764,8 @@ be preferred. */);
|
|||
defsubr (&Scurrent_active_maps);
|
||||
defsubr (&Saccessible_keymaps);
|
||||
defsubr (&Skey_description);
|
||||
defsubr (&Sdescribe_map_tree);
|
||||
defsubr (&Sdescribe_map_tree_old);
|
||||
defsubr (&Sdescribe_map);
|
||||
defsubr (&Sdescribe_vector);
|
||||
defsubr (&Ssingle_key_description);
|
||||
defsubr (&Stext_char_description);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue