Commit b88e82fd authored by Richard M. Stallman's avatar Richard M. Stallman

(describe_map_tree): New arg MENTION_SHADOW. Calls changed.

(describe_map, describe_vector): Likewise.  When it's 1,
don't omit shadowed bindings, instead mark them as shadowed.
parent e679a3c1
...@@ -120,10 +120,11 @@ static void describe_command P_ ((Lisp_Object, Lisp_Object)); ...@@ -120,10 +120,11 @@ static void describe_command P_ ((Lisp_Object, Lisp_Object));
static void describe_translation P_ ((Lisp_Object, Lisp_Object)); static void describe_translation P_ ((Lisp_Object, Lisp_Object));
static void describe_map P_ ((Lisp_Object, Lisp_Object, static void describe_map P_ ((Lisp_Object, Lisp_Object,
void (*) P_ ((Lisp_Object, Lisp_Object)), void (*) P_ ((Lisp_Object, Lisp_Object)),
int, Lisp_Object, Lisp_Object*, int)); int, Lisp_Object, Lisp_Object*, int, int));
static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object, static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
void (*) (Lisp_Object, Lisp_Object), int, void (*) (Lisp_Object, Lisp_Object), int,
Lisp_Object, Lisp_Object, int *, int, int)); Lisp_Object, Lisp_Object, int *,
int, int, int));
static void silly_event_symbol_error P_ ((Lisp_Object)); static void silly_event_symbol_error P_ ((Lisp_Object));
/* Keymap object support - constructors and predicates. */ /* Keymap object support - constructors and predicates. */
...@@ -2834,7 +2835,7 @@ You type Translation\n\ ...@@ -2834,7 +2835,7 @@ You type Translation\n\
if (!NILP (Vkey_translation_map)) if (!NILP (Vkey_translation_map))
describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
"Key translations", nomenu, 1, 0); "Key translations", nomenu, 1, 0, 0);
/* Print the (major mode) local map. */ /* Print the (major mode) local map. */
...@@ -2847,7 +2848,7 @@ You type Translation\n\ ...@@ -2847,7 +2848,7 @@ You type Translation\n\
if (!NILP (start1)) if (!NILP (start1))
{ {
describe_map_tree (start1, 1, shadow, prefix, describe_map_tree (start1, 1, shadow, prefix,
"\f\nOverriding Bindings", nomenu, 0, 0); "\f\nOverriding Bindings", nomenu, 0, 0, 0);
shadow = Fcons (start1, shadow); shadow = Fcons (start1, shadow);
} }
else else
...@@ -2868,7 +2869,8 @@ You type Translation\n\ ...@@ -2868,7 +2869,8 @@ You type Translation\n\
if (!NILP (start1)) if (!NILP (start1))
{ {
describe_map_tree (start1, 1, shadow, prefix, describe_map_tree (start1, 1, shadow, prefix,
"\f\n`keymap' Property Bindings", nomenu, 0, 0); "\f\n`keymap' Property Bindings", nomenu,
0, 0, 0);
shadow = Fcons (start1, shadow); shadow = Fcons (start1, shadow);
} }
...@@ -2896,7 +2898,8 @@ You type Translation\n\ ...@@ -2896,7 +2898,8 @@ You type Translation\n\
p += sizeof (" Minor Mode Bindings") - 1; p += sizeof (" Minor Mode Bindings") - 1;
*p = 0; *p = 0;
describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); describe_map_tree (maps[i], 1, shadow, prefix,
title, nomenu, 0, 0, 0);
shadow = Fcons (maps[i], shadow); shadow = Fcons (maps[i], shadow);
} }
...@@ -2906,23 +2909,23 @@ You type Translation\n\ ...@@ -2906,23 +2909,23 @@ You type Translation\n\
{ {
if (EQ (start1, XBUFFER (buffer)->keymap)) if (EQ (start1, XBUFFER (buffer)->keymap))
describe_map_tree (start1, 1, shadow, prefix, describe_map_tree (start1, 1, shadow, prefix,
"\f\nMajor Mode Bindings", nomenu, 0, 0); "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
else else
describe_map_tree (start1, 1, shadow, prefix, describe_map_tree (start1, 1, shadow, prefix,
"\f\n`local-map' Property Bindings", "\f\n`local-map' Property Bindings",
nomenu, 0, 0); nomenu, 0, 0, 0);
shadow = Fcons (start1, shadow); shadow = Fcons (start1, shadow);
} }
} }
describe_map_tree (current_global_map, 1, shadow, prefix, describe_map_tree (current_global_map, 1, shadow, prefix,
"\f\nGlobal Bindings", nomenu, 0, 1); "\f\nGlobal Bindings", nomenu, 0, 1, 0);
/* Print the function-key-map translations under this prefix. */ /* Print the function-key-map translations under this prefix. */
if (!NILP (Vfunction_key_map)) if (!NILP (Vfunction_key_map))
describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
"\f\nFunction key map translations", nomenu, 1, 0); "\f\nFunction key map translations", nomenu, 1, 0, 0);
UNGCPRO; UNGCPRO;
return Qnil; return Qnil;
...@@ -2943,17 +2946,21 @@ You type Translation\n\ ...@@ -2943,17 +2946,21 @@ You type Translation\n\
so print strings and vectors differently. so print strings and vectors differently.
If ALWAYS_TITLE is nonzero, print the title even if there are no maps If ALWAYS_TITLE is nonzero, print the title even if there are no maps
to look through. */ to look through.
If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
don't omit it; instead, mention it but say it is shadowed. */
void void
describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
always_title) always_title, mention_shadow)
Lisp_Object startmap, shadow, prefix; Lisp_Object startmap, shadow, prefix;
int partial; int partial;
char *title; char *title;
int nomenu; int nomenu;
int transl; int transl;
int always_title; int always_title;
int mention_shadow;
{ {
Lisp_Object maps, orig_maps, seen, sub_shadows; Lisp_Object maps, orig_maps, seen, sub_shadows;
struct gcpro gcpro1, gcpro2, gcpro3; struct gcpro gcpro1, gcpro2, gcpro3;
...@@ -3055,7 +3062,7 @@ key binding\n\ ...@@ -3055,7 +3062,7 @@ key binding\n\
describe_map (Fcdr (elt), prefix, describe_map (Fcdr (elt), prefix,
transl ? describe_translation : describe_command, transl ? describe_translation : describe_command,
partial, sub_shadows, &seen, nomenu); partial, sub_shadows, &seen, nomenu, mention_shadow);
skip: ; skip: ;
} }
...@@ -3135,7 +3142,8 @@ describe_translation (definition, args) ...@@ -3135,7 +3142,8 @@ describe_translation (definition, args)
PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
static void static void
describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu) describe_map (map, prefix, elt_describer, partial, shadow,
seen, nomenu, mention_shadow)
register Lisp_Object map; register Lisp_Object map;
Lisp_Object prefix; Lisp_Object prefix;
void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
...@@ -3143,6 +3151,7 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu) ...@@ -3143,6 +3151,7 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
Lisp_Object shadow; Lisp_Object shadow;
Lisp_Object *seen; Lisp_Object *seen;
int nomenu; int nomenu;
int mention_shadow;
{ {
Lisp_Object tail, definition, event; Lisp_Object tail, definition, event;
Lisp_Object tem; Lisp_Object tem;
...@@ -3172,9 +3181,10 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu) ...@@ -3172,9 +3181,10 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
|| CHAR_TABLE_P (XCAR (tail))) || CHAR_TABLE_P (XCAR (tail)))
describe_vector (XCAR (tail), describe_vector (XCAR (tail),
prefix, Qnil, elt_describer, partial, shadow, map, prefix, Qnil, elt_describer, partial, shadow, map,
(int *)0, 0, 1); (int *)0, 0, 1, mention_shadow);
else if (CONSP (XCAR (tail))) else if (CONSP (XCAR (tail)))
{ {
int this_shadowed = 0;
event = XCAR (XCAR (tail)); event = XCAR (XCAR (tail));
/* Ignore bindings whose "prefix" are not really valid events. /* Ignore bindings whose "prefix" are not really valid events.
...@@ -3203,7 +3213,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu) ...@@ -3203,7 +3213,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
if (!NILP (shadow)) if (!NILP (shadow))
{ {
tem = shadow_lookup (shadow, kludge, Qt); tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue; if (!NILP (tem))
{
if (mention_shadow)
this_shadowed = 1;
else
continue;
}
} }
tem = Flookup_key (map, kludge, Qt); tem = Flookup_key (map, kludge, Qt);
...@@ -3223,6 +3239,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu) ...@@ -3223,6 +3239,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
elt_describer will take care of spacing out far enough elt_describer will take care of spacing out far enough
for alignment purposes. */ for alignment purposes. */
(*elt_describer) (definition, Qnil); (*elt_describer) (definition, Qnil);
if (this_shadowed)
{
SET_PT (PT - 1);
insert_string (" (binding currently shadowed)");
SET_PT (PT + 1);
}
} }
else if (EQ (XCAR (tail), Qkeymap)) else if (EQ (XCAR (tail), Qkeymap))
{ {
...@@ -3261,7 +3284,7 @@ DESCRIBER is the output function used; nil means use `princ'. */) ...@@ -3261,7 +3284,7 @@ DESCRIBER is the output function used; nil means use `princ'. */)
specbind (Qstandard_output, Fcurrent_buffer ()); specbind (Qstandard_output, Fcurrent_buffer ());
CHECK_VECTOR_OR_CHAR_TABLE (vector); CHECK_VECTOR_OR_CHAR_TABLE (vector);
describe_vector (vector, Qnil, describer, describe_vector_princ, 0, describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
Qnil, Qnil, (int *)0, 0, 0); Qnil, Qnil, (int *)0, 0, 0, 0);
return unbind_to (count, Qnil); return unbind_to (count, Qnil);
} }
...@@ -3303,7 +3326,8 @@ DESCRIBER is the output function used; nil means use `princ'. */) ...@@ -3303,7 +3326,8 @@ DESCRIBER is the output function used; nil means use `princ'. */)
static void static void
describe_vector (vector, prefix, args, elt_describer, describe_vector (vector, prefix, args, elt_describer,
partial, shadow, entire_map, partial, shadow, entire_map,
indices, char_table_depth, keymap_p) indices, char_table_depth, keymap_p,
mention_shadow)
register Lisp_Object vector; register Lisp_Object vector;
Lisp_Object prefix, args; Lisp_Object prefix, args;
void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
...@@ -3313,6 +3337,7 @@ describe_vector (vector, prefix, args, elt_describer, ...@@ -3313,6 +3337,7 @@ describe_vector (vector, prefix, args, elt_describer,
int *indices; int *indices;
int char_table_depth; int char_table_depth;
int keymap_p; int keymap_p;
int mention_shadow;
{ {
Lisp_Object definition; Lisp_Object definition;
Lisp_Object tem2; Lisp_Object tem2;
...@@ -3396,6 +3421,7 @@ describe_vector (vector, prefix, args, elt_describer, ...@@ -3396,6 +3421,7 @@ describe_vector (vector, prefix, args, elt_describer,
for (i = from; i < to; i++) for (i = from; i < to; i++)
{ {
int this_shadowed = 0;
QUIT; QUIT;
if (CHAR_TABLE_P (vector)) if (CHAR_TABLE_P (vector))
...@@ -3455,7 +3481,13 @@ describe_vector (vector, prefix, args, elt_describer, ...@@ -3455,7 +3481,13 @@ describe_vector (vector, prefix, args, elt_describer,
tem = shadow_lookup (shadow, kludge, Qt); tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue; if (!NILP (tem))
{
if (mention_shadow)
this_shadowed = 1;
else
continue;
}
} }
/* Ignore this definition if it is shadowed by an earlier /* Ignore this definition if it is shadowed by an earlier
...@@ -3531,7 +3563,8 @@ describe_vector (vector, prefix, args, elt_describer, ...@@ -3531,7 +3563,8 @@ describe_vector (vector, prefix, args, elt_describer,
insert ("\n", 1); insert ("\n", 1);
describe_vector (definition, prefix, args, elt_describer, describe_vector (definition, prefix, args, elt_describer,
partial, shadow, entire_map, partial, shadow, entire_map,
indices, char_table_depth + 1, keymap_p); indices, char_table_depth + 1, keymap_p,
mention_shadow);
continue; continue;
} }
...@@ -3605,6 +3638,13 @@ describe_vector (vector, prefix, args, elt_describer, ...@@ -3605,6 +3638,13 @@ describe_vector (vector, prefix, args, elt_describer,
elt_describer will take care of spacing out far enough elt_describer will take care of spacing out far enough
for alignment purposes. */ for alignment purposes. */
(*elt_describer) (definition, args); (*elt_describer) (definition, args);
if (this_shadowed)
{
SET_PT (PT - 1);
insert_string (" (binding currently shadowed)");
SET_PT (PT + 1);
}
} }
/* For (sub) char-table, print `defalt' slot at last. */ /* For (sub) char-table, print `defalt' slot at last. */
......
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