Commit d230367f authored by Stefan Kangas's avatar Stefan Kangas

Translate describe_map_tree to Lisp

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 'internal--seen'; a
temporary kludge planned for removal.  New defsubr for Fdescribe_map.
* test/lisp/help-tests.el: Minor cleanups.
parent 4052d20a
Pipeline #5602 passed with stage
in 57 minutes and 35 seconds
......@@ -1014,7 +1014,8 @@ Otherwise, return a new string."
(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
......@@ -1100,7 +1101,7 @@ Otherwise, return a new string."
;; 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) ?\`)
......@@ -1118,6 +1119,91 @@ Otherwise, return a new string."
;; (if (string= string (buffer-string)) string (buffer-string))
(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 internal--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))
......
......@@ -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, &Vinternal_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 ("internal--seen", Vinternal_seen,
doc: /* List of seen keymaps.
This is used for internal purposes only. */);
Vinternal_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);
......
......@@ -195,12 +195,15 @@ M-s next-matching-history-element
(let ((map (make-keymap)))
(define-key map "x" 'foo-original)
map))
(define-derived-mode help-tests-major-mode nil
"Major mode for testing shadowing.")
(defvar help-tests-minor-mode-map
(let ((map (make-keymap)))
(define-key map "x" 'foo-shadow)
map))
(define-minor-mode help-tests-minor-mode
"Minor mode for testing shadowing.")
......@@ -256,7 +259,7 @@ key binding
(with-temp-buffer
(c-mode)
(outline-minor-mode)
(test-re "\\{cc-mode-map}" ".*"))))
(test-re "\\{c-mode-map}" ".*"))))
(provide 'help-tests)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment