aboutsummaryrefslogtreecommitdiffstats
path: root/src/keymap.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/keymap.c')
-rw-r--r--src/keymap.c80
1 files changed, 60 insertions, 20 deletions
diff --git a/src/keymap.c b/src/keymap.c
index f28032d0f82..a55563a4e92 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -121,10 +121,11 @@ static void describe_command P_ ((Lisp_Object, Lisp_Object));
121static void describe_translation P_ ((Lisp_Object, Lisp_Object)); 121static void describe_translation P_ ((Lisp_Object, Lisp_Object));
122static void describe_map P_ ((Lisp_Object, Lisp_Object, 122static void describe_map P_ ((Lisp_Object, Lisp_Object,
123 void (*) P_ ((Lisp_Object, Lisp_Object)), 123 void (*) P_ ((Lisp_Object, Lisp_Object)),
124 int, Lisp_Object, Lisp_Object*, int)); 124 int, Lisp_Object, Lisp_Object*, int, int));
125static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object, 125static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
126 void (*) (Lisp_Object, Lisp_Object), int, 126 void (*) (Lisp_Object, Lisp_Object), int,
127 Lisp_Object, Lisp_Object, int *, int, int)); 127 Lisp_Object, Lisp_Object, int *,
128 int, int, int));
128static void silly_event_symbol_error P_ ((Lisp_Object)); 129static void silly_event_symbol_error P_ ((Lisp_Object));
129 130
130/* Keymap object support - constructors and predicates. */ 131/* Keymap object support - constructors and predicates. */
@@ -2835,7 +2836,7 @@ You type Translation\n\
2835 2836
2836 if (!NILP (Vkey_translation_map)) 2837 if (!NILP (Vkey_translation_map))
2837 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, 2838 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2838 "Key translations", nomenu, 1, 0); 2839 "Key translations", nomenu, 1, 0, 0);
2839 2840
2840 2841
2841 /* Print the (major mode) local map. */ 2842 /* Print the (major mode) local map. */
@@ -2848,7 +2849,7 @@ You type Translation\n\
2848 if (!NILP (start1)) 2849 if (!NILP (start1))
2849 { 2850 {
2850 describe_map_tree (start1, 1, shadow, prefix, 2851 describe_map_tree (start1, 1, shadow, prefix,
2851 "\f\nOverriding Bindings", nomenu, 0, 0); 2852 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2852 shadow = Fcons (start1, shadow); 2853 shadow = Fcons (start1, shadow);
2853 } 2854 }
2854 else 2855 else
@@ -2869,7 +2870,8 @@ You type Translation\n\
2869 if (!NILP (start1)) 2870 if (!NILP (start1))
2870 { 2871 {
2871 describe_map_tree (start1, 1, shadow, prefix, 2872 describe_map_tree (start1, 1, shadow, prefix,
2872 "\f\n`keymap' Property Bindings", nomenu, 0, 0); 2873 "\f\n`keymap' Property Bindings", nomenu,
2874 0, 0, 0);
2873 shadow = Fcons (start1, shadow); 2875 shadow = Fcons (start1, shadow);
2874 } 2876 }
2875 2877
@@ -2897,7 +2899,8 @@ You type Translation\n\
2897 p += sizeof (" Minor Mode Bindings") - 1; 2899 p += sizeof (" Minor Mode Bindings") - 1;
2898 *p = 0; 2900 *p = 0;
2899 2901
2900 describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); 2902 describe_map_tree (maps[i], 1, shadow, prefix,
2903 title, nomenu, 0, 0, 0);
2901 shadow = Fcons (maps[i], shadow); 2904 shadow = Fcons (maps[i], shadow);
2902 } 2905 }
2903 2906
@@ -2907,23 +2910,23 @@ You type Translation\n\
2907 { 2910 {
2908 if (EQ (start1, XBUFFER (buffer)->keymap)) 2911 if (EQ (start1, XBUFFER (buffer)->keymap))
2909 describe_map_tree (start1, 1, shadow, prefix, 2912 describe_map_tree (start1, 1, shadow, prefix,
2910 "\f\nMajor Mode Bindings", nomenu, 0, 0); 2913 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
2911 else 2914 else
2912 describe_map_tree (start1, 1, shadow, prefix, 2915 describe_map_tree (start1, 1, shadow, prefix,
2913 "\f\n`local-map' Property Bindings", 2916 "\f\n`local-map' Property Bindings",
2914 nomenu, 0, 0); 2917 nomenu, 0, 0, 0);
2915 2918
2916 shadow = Fcons (start1, shadow); 2919 shadow = Fcons (start1, shadow);
2917 } 2920 }
2918 } 2921 }
2919 2922
2920 describe_map_tree (current_global_map, 1, shadow, prefix, 2923 describe_map_tree (current_global_map, 1, shadow, prefix,
2921 "\f\nGlobal Bindings", nomenu, 0, 1); 2924 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
2922 2925
2923 /* Print the function-key-map translations under this prefix. */ 2926 /* Print the function-key-map translations under this prefix. */
2924 if (!NILP (Vfunction_key_map)) 2927 if (!NILP (Vfunction_key_map))
2925 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, 2928 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2926 "\f\nFunction key map translations", nomenu, 1, 0); 2929 "\f\nFunction key map translations", nomenu, 1, 0, 0);
2927 2930
2928 UNGCPRO; 2931 UNGCPRO;
2929 return Qnil; 2932 return Qnil;
@@ -2944,17 +2947,21 @@ You type Translation\n\
2944 so print strings and vectors differently. 2947 so print strings and vectors differently.
2945 2948
2946 If ALWAYS_TITLE is nonzero, print the title even if there are no maps 2949 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2947 to look through. */ 2950 to look through.
2951
2952 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
2953 don't omit it; instead, mention it but say it is shadowed. */
2948 2954
2949void 2955void
2950describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, 2956describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2951 always_title) 2957 always_title, mention_shadow)
2952 Lisp_Object startmap, shadow, prefix; 2958 Lisp_Object startmap, shadow, prefix;
2953 int partial; 2959 int partial;
2954 char *title; 2960 char *title;
2955 int nomenu; 2961 int nomenu;
2956 int transl; 2962 int transl;
2957 int always_title; 2963 int always_title;
2964 int mention_shadow;
2958{ 2965{
2959 Lisp_Object maps, orig_maps, seen, sub_shadows; 2966 Lisp_Object maps, orig_maps, seen, sub_shadows;
2960 struct gcpro gcpro1, gcpro2, gcpro3; 2967 struct gcpro gcpro1, gcpro2, gcpro3;
@@ -3056,7 +3063,7 @@ key binding\n\
3056 3063
3057 describe_map (Fcdr (elt), prefix, 3064 describe_map (Fcdr (elt), prefix,
3058 transl ? describe_translation : describe_command, 3065 transl ? describe_translation : describe_command,
3059 partial, sub_shadows, &seen, nomenu); 3066 partial, sub_shadows, &seen, nomenu, mention_shadow);
3060 3067
3061 skip: ; 3068 skip: ;
3062 } 3069 }
@@ -3136,7 +3143,8 @@ describe_translation (definition, args)
3136 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ 3143 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3137 3144
3138static void 3145static void
3139describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu) 3146describe_map (map, prefix, elt_describer, partial, shadow,
3147 seen, nomenu, mention_shadow)
3140 register Lisp_Object map; 3148 register Lisp_Object map;
3141 Lisp_Object prefix; 3149 Lisp_Object prefix;
3142 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); 3150 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
@@ -3144,6 +3152,7 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
3144 Lisp_Object shadow; 3152 Lisp_Object shadow;
3145 Lisp_Object *seen; 3153 Lisp_Object *seen;
3146 int nomenu; 3154 int nomenu;
3155 int mention_shadow;
3147{ 3156{
3148 Lisp_Object tail, definition, event; 3157 Lisp_Object tail, definition, event;
3149 Lisp_Object tem; 3158 Lisp_Object tem;
@@ -3173,9 +3182,10 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
3173 || CHAR_TABLE_P (XCAR (tail))) 3182 || CHAR_TABLE_P (XCAR (tail)))
3174 describe_vector (XCAR (tail), 3183 describe_vector (XCAR (tail),
3175 prefix, Qnil, elt_describer, partial, shadow, map, 3184 prefix, Qnil, elt_describer, partial, shadow, map,
3176 (int *)0, 0, 1); 3185 (int *)0, 0, 1, mention_shadow);
3177 else if (CONSP (XCAR (tail))) 3186 else if (CONSP (XCAR (tail)))
3178 { 3187 {
3188 int this_shadowed = 0;
3179 event = XCAR (XCAR (tail)); 3189 event = XCAR (XCAR (tail));
3180 3190
3181 /* Ignore bindings whose "prefix" are not really valid events. 3191 /* Ignore bindings whose "prefix" are not really valid events.
@@ -3204,7 +3214,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
3204 if (!NILP (shadow)) 3214 if (!NILP (shadow))
3205 { 3215 {
3206 tem = shadow_lookup (shadow, kludge, Qt); 3216 tem = shadow_lookup (shadow, kludge, Qt);
3207 if (!NILP (tem)) continue; 3217 if (!NILP (tem))
3218 {
3219 if (mention_shadow)
3220 this_shadowed = 1;
3221 else
3222 continue;
3223 }
3208 } 3224 }
3209 3225
3210 tem = Flookup_key (map, kludge, Qt); 3226 tem = Flookup_key (map, kludge, Qt);
@@ -3224,6 +3240,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
3224 elt_describer will take care of spacing out far enough 3240 elt_describer will take care of spacing out far enough
3225 for alignment purposes. */ 3241 for alignment purposes. */
3226 (*elt_describer) (definition, Qnil); 3242 (*elt_describer) (definition, Qnil);
3243
3244 if (this_shadowed)
3245 {
3246 SET_PT (PT - 1);
3247 insert_string (" (binding currently shadowed)");
3248 SET_PT (PT + 1);
3249 }
3227 } 3250 }
3228 else if (EQ (XCAR (tail), Qkeymap)) 3251 else if (EQ (XCAR (tail), Qkeymap))
3229 { 3252 {
@@ -3262,7 +3285,7 @@ DESCRIBER is the output function used; nil means use `princ'. */)
3262 specbind (Qstandard_output, Fcurrent_buffer ()); 3285 specbind (Qstandard_output, Fcurrent_buffer ());
3263 CHECK_VECTOR_OR_CHAR_TABLE (vector); 3286 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3264 describe_vector (vector, Qnil, describer, describe_vector_princ, 0, 3287 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3265 Qnil, Qnil, (int *)0, 0, 0); 3288 Qnil, Qnil, (int *)0, 0, 0, 0);
3266 3289
3267 return unbind_to (count, Qnil); 3290 return unbind_to (count, Qnil);
3268} 3291}
@@ -3304,7 +3327,8 @@ DESCRIBER is the output function used; nil means use `princ'. */)
3304static void 3327static void
3305describe_vector (vector, prefix, args, elt_describer, 3328describe_vector (vector, prefix, args, elt_describer,
3306 partial, shadow, entire_map, 3329 partial, shadow, entire_map,
3307 indices, char_table_depth, keymap_p) 3330 indices, char_table_depth, keymap_p,
3331 mention_shadow)
3308 register Lisp_Object vector; 3332 register Lisp_Object vector;
3309 Lisp_Object prefix, args; 3333 Lisp_Object prefix, args;
3310 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); 3334 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
@@ -3314,6 +3338,7 @@ describe_vector (vector, prefix, args, elt_describer,
3314 int *indices; 3338 int *indices;
3315 int char_table_depth; 3339 int char_table_depth;
3316 int keymap_p; 3340 int keymap_p;
3341 int mention_shadow;
3317{ 3342{
3318 Lisp_Object definition; 3343 Lisp_Object definition;
3319 Lisp_Object tem2; 3344 Lisp_Object tem2;
@@ -3397,6 +3422,7 @@ describe_vector (vector, prefix, args, elt_describer,
3397 3422
3398 for (i = from; i < to; i++) 3423 for (i = from; i < to; i++)
3399 { 3424 {
3425 int this_shadowed = 0;
3400 QUIT; 3426 QUIT;
3401 3427
3402 if (CHAR_TABLE_P (vector)) 3428 if (CHAR_TABLE_P (vector))
@@ -3456,7 +3482,13 @@ describe_vector (vector, prefix, args, elt_describer,
3456 3482
3457 tem = shadow_lookup (shadow, kludge, Qt); 3483 tem = shadow_lookup (shadow, kludge, Qt);
3458 3484
3459 if (!NILP (tem)) continue; 3485 if (!NILP (tem))
3486 {
3487 if (mention_shadow)
3488 this_shadowed = 1;
3489 else
3490 continue;
3491 }
3460 } 3492 }
3461 3493
3462 /* Ignore this definition if it is shadowed by an earlier 3494 /* Ignore this definition if it is shadowed by an earlier
@@ -3532,7 +3564,8 @@ describe_vector (vector, prefix, args, elt_describer,
3532 insert ("\n", 1); 3564 insert ("\n", 1);
3533 describe_vector (definition, prefix, args, elt_describer, 3565 describe_vector (definition, prefix, args, elt_describer,
3534 partial, shadow, entire_map, 3566 partial, shadow, entire_map,
3535 indices, char_table_depth + 1, keymap_p); 3567 indices, char_table_depth + 1, keymap_p,
3568 mention_shadow);
3536 continue; 3569 continue;
3537 } 3570 }
3538 3571
@@ -3606,6 +3639,13 @@ describe_vector (vector, prefix, args, elt_describer,
3606 elt_describer will take care of spacing out far enough 3639 elt_describer will take care of spacing out far enough
3607 for alignment purposes. */ 3640 for alignment purposes. */
3608 (*elt_describer) (definition, args); 3641 (*elt_describer) (definition, args);
3642
3643 if (this_shadowed)
3644 {
3645 SET_PT (PT - 1);
3646 insert_string (" (binding currently shadowed)");
3647 SET_PT (PT + 1);
3648 }
3609 } 3649 }
3610 3650
3611 /* For (sub) char-table, print `defalt' slot at last. */ 3651 /* For (sub) char-table, print `defalt' slot at last. */