Mercurial > hg > xemacs-beta
comparison src/keymap.c @ 5470:0af042a0c116
Merge with trunk.
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Mon, 07 Feb 2011 21:22:17 +0100 |
parents | 308d34e9f07d cc7d0e19173c |
children | 56144c8593a8 |
comparison
equal
deleted
inserted
replaced
5469:2a8a04f73c15 | 5470:0af042a0c116 |
---|---|
733 if (!NILP (Fkeymapp (value))) | 733 if (!NILP (Fkeymapp (value))) |
734 *result_locative = Fcons (Fcons (key, value), *result_locative); | 734 *result_locative = Fcons (Fcons (key, value), *result_locative); |
735 return 0; | 735 return 0; |
736 } | 736 } |
737 | 737 |
738 static Lisp_Object map_keymap_sort_predicate (Lisp_Object obj1, | 738 static Boolint map_keymap_sort_predicate (Lisp_Object pred, Lisp_Object key, |
739 Lisp_Object obj2, | 739 Lisp_Object obj1, Lisp_Object obj2); |
740 Lisp_Object pred, | 740 |
741 Lisp_Object key_func); | |
742 | 741 |
743 static Lisp_Object | 742 static Lisp_Object |
744 keymap_submaps (Lisp_Object keymap) | 743 keymap_submaps (Lisp_Object keymap) |
745 { | 744 { |
746 /* This function can GC */ | 745 /* This function can GC */ |
760 result = Qnil; | 759 result = Qnil; |
761 elisp_maphash (keymap_submaps_mapper, k->table, | 760 elisp_maphash (keymap_submaps_mapper, k->table, |
762 &keymap_submaps_closure); | 761 &keymap_submaps_closure); |
763 /* keep it sorted so that the result of accessible-keymaps is ordered */ | 762 /* keep it sorted so that the result of accessible-keymaps is ordered */ |
764 k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate, | 763 k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate, |
765 Qnil, Qidentity); | 764 Qnil, Qnil); |
766 UNGCPRO; | 765 UNGCPRO; |
767 } | 766 } |
768 return k->sub_maps_cache; | 767 return k->sub_maps_cache; |
769 } | 768 } |
770 | 769 |
2892 | 2891 |
2893 | 2892 |
2894 /* used by map_keymap_sorted(), describe_map_sort_predicate(), | 2893 /* used by map_keymap_sorted(), describe_map_sort_predicate(), |
2895 and keymap_submaps(). | 2894 and keymap_submaps(). |
2896 */ | 2895 */ |
2897 static Lisp_Object | 2896 static Boolint |
2898 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | 2897 map_keymap_sort_predicate (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key), |
2899 Lisp_Object UNUSED (pred), | 2898 Lisp_Object obj1, Lisp_Object obj2) |
2900 Lisp_Object UNUSED (key_func)) | |
2901 { | 2899 { |
2902 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. | 2900 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. |
2903 */ | 2901 */ |
2904 int bit1, bit2; | 2902 int bit1, bit2; |
2905 int sym1_p = 0; | 2903 int sym1_p = 0; |
2908 | 2906 |
2909 obj1 = XCAR (obj1); | 2907 obj1 = XCAR (obj1); |
2910 obj2 = XCAR (obj2); | 2908 obj2 = XCAR (obj2); |
2911 | 2909 |
2912 if (EQ (obj1, obj2)) | 2910 if (EQ (obj1, obj2)) |
2913 return Qnil; | 2911 return 0; |
2914 bit1 = MODIFIER_HASH_KEY_BITS (obj1); | 2912 bit1 = MODIFIER_HASH_KEY_BITS (obj1); |
2915 bit2 = MODIFIER_HASH_KEY_BITS (obj2); | 2913 bit2 = MODIFIER_HASH_KEY_BITS (obj2); |
2916 | 2914 |
2917 /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by | 2915 /* If either is a symbol with a Qcharacter_of_keysym property, then sort |
2918 that code instead of alphabetically. | 2916 it by that code instead of alphabetically. |
2919 */ | 2917 */ |
2920 if (! bit1 && SYMBOLP (obj1)) | 2918 if (! bit1 && SYMBOLP (obj1)) |
2921 { | 2919 { |
2922 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil); | 2920 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil); |
2923 if (CHAR_OR_CHAR_INTP (code)) | 2921 if (CHAR_OR_CHAR_INTP (code)) |
2938 } | 2936 } |
2939 } | 2937 } |
2940 | 2938 |
2941 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ | 2939 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ |
2942 if (XTYPE (obj1) != XTYPE (obj2)) | 2940 if (XTYPE (obj1) != XTYPE (obj2)) |
2943 return SYMBOLP (obj2) ? Qt : Qnil; | 2941 return SYMBOLP (obj2); |
2944 | 2942 |
2945 if (! bit1 && CHARP (obj1)) /* they're both ASCII */ | 2943 if (! bit1 && CHARP (obj1)) /* they're both ASCII */ |
2946 { | 2944 { |
2947 int o1 = XCHAR (obj1); | 2945 int o1 = XCHAR (obj1); |
2948 int o2 = XCHAR (obj2); | 2946 int o2 = XCHAR (obj2); |
2949 if (o1 == o2 && /* If one started out as a symbol and the */ | 2947 if (o1 == o2 && /* If one started out as a symbol and the */ |
2950 sym1_p != sym2_p) /* other didn't, the symbol comes last. */ | 2948 sym1_p != sym2_p) /* other didn't, the symbol comes last. */ |
2951 return sym2_p ? Qt : Qnil; | 2949 return sym2_p; |
2952 | 2950 |
2953 return o1 < o2 ? Qt : Qnil; /* else just compare them */ | 2951 return o1 < o2; /* else just compare them */ |
2954 } | 2952 } |
2955 | 2953 |
2956 /* else they're both symbols. If they're both buckys, then order them. */ | 2954 /* else they're both symbols. If they're both buckys, then order them. */ |
2957 if (bit1 && bit2) | 2955 if (bit1 && bit2) |
2958 return bit1 < bit2 ? Qt : Qnil; | 2956 return bit1 < bit2; |
2959 | 2957 |
2960 /* if only one is a bucky, then it comes later */ | 2958 /* if only one is a bucky, then it comes later */ |
2961 if (bit1 || bit2) | 2959 if (bit1 || bit2) |
2962 return bit2 ? Qt : Qnil; | 2960 return bit2; |
2963 | 2961 |
2964 /* otherwise, string-sort them. */ | 2962 /* otherwise, string-sort them. */ |
2965 { | 2963 { |
2966 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); | 2964 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); |
2967 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); | 2965 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); |
2968 return 0 > qxestrcmp (s1, s2) ? Qt : Qnil; | 2966 return 0 > qxestrcmp (s1, s2); |
2969 } | 2967 } |
2970 } | 2968 } |
2971 | 2969 |
2972 | 2970 |
2973 /* used by map_keymap() */ | 2971 /* used by map_keymap() */ |
4083 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)), | 4081 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)), |
4084 binding), | 4082 binding), |
4085 *(closure->list)); | 4083 *(closure->list)); |
4086 } | 4084 } |
4087 | 4085 |
4088 | 4086 static Boolint |
4089 static Lisp_Object | 4087 describe_map_sort_predicate (Lisp_Object pred, Lisp_Object key_func, |
4090 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | 4088 Lisp_Object obj1, Lisp_Object obj2) |
4091 Lisp_Object pred, Lisp_Object key_func) | 4089 |
4092 { | 4090 { |
4093 /* obj1 and obj2 are conses of the form | 4091 /* obj1 and obj2 are conses of the form |
4094 ( ( <keysym> . <modifiers> ) . <binding> ) | 4092 ( ( <keysym> . <modifiers> ) . <binding> ) |
4095 keysym and modifiers are used, binding is ignored. | 4093 keysym and modifiers are used, binding is ignored. |
4096 */ | 4094 */ |
4098 obj1 = XCAR (obj1); | 4096 obj1 = XCAR (obj1); |
4099 obj2 = XCAR (obj2); | 4097 obj2 = XCAR (obj2); |
4100 bit1 = XINT (XCDR (obj1)); | 4098 bit1 = XINT (XCDR (obj1)); |
4101 bit2 = XINT (XCDR (obj2)); | 4099 bit2 = XINT (XCDR (obj2)); |
4102 if (bit1 != bit2) | 4100 if (bit1 != bit2) |
4103 return bit1 < bit2 ? Qt : Qnil; | 4101 return bit1 < bit2; |
4104 else | 4102 else |
4105 return map_keymap_sort_predicate (obj1, obj2, pred, key_func); | 4103 return map_keymap_sort_predicate (pred, key_func, obj1, obj2); |
4106 } | 4104 } |
4107 | 4105 |
4108 /* Elide 2 or more consecutive numeric keysyms bound to the same thing, | 4106 /* Elide 2 or more consecutive numeric keysyms bound to the same thing, |
4109 or 2 or more symbolic keysyms that are bound to the same thing and | 4107 or 2 or more symbolic keysyms that are bound to the same thing and |
4110 have consecutive character-set-properties. | 4108 have consecutive character-set-properties. |
4208 traverse_keymaps (keymap, Qnil, | 4206 traverse_keymaps (keymap, Qnil, |
4209 describe_map_parent_mapper, &describe_map_closure); | 4207 describe_map_parent_mapper, &describe_map_closure); |
4210 | 4208 |
4211 if (!NILP (list)) | 4209 if (!NILP (list)) |
4212 { | 4210 { |
4213 list = list_sort (list, describe_map_sort_predicate, Qnil, Qidentity); | 4211 list = list_sort (list, describe_map_sort_predicate, Qnil, Qnil); |
4214 buffer_insert_ascstring (buf, "\n"); | 4212 buffer_insert_ascstring (buf, "\n"); |
4215 while (!NILP (list)) | 4213 while (!NILP (list)) |
4216 { | 4214 { |
4217 Lisp_Object elt = XCAR (XCAR (list)); | 4215 Lisp_Object elt = XCAR (XCAR (list)); |
4218 Lisp_Object keysym = XCAR (elt); | 4216 Lisp_Object keysym = XCAR (elt); |