Mercurial > hg > xemacs-beta

comparison src/keymap.c @ 5350:94bbd4792049

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el 2011-02-05 Aidan Kehoe <kehoea@parhasard.net> * fns.c: * fns.c (check_lss_key, check_lss_key_car): New. * fns.c (check_string_lessp_key check_string_lessp_key_car): New. * fns.c (get_merge_predicate): New. * fns.c (list_merge): * fns.c (array_merge): * fns.c (list_array_merge_into_list): * fns.c (list_list_merge_into_array): * fns.c (list_array_merge_into_array): * fns.c (Fmerge): * fns.c (list_sort): * fns.c (array_sort): * fns.c (FsortX): * fns.c (syms_of_fns): * lisp.h: Move #'sort, #'merge to using the same test approach as is used in the functions that take TEST, TEST-NOT and KEY arguments. This allows us to avoid the Ffuncall() overhead when the most common PREDICATE arguments are supplied, in particular #'< and #'string-lessp. * fontcolor-msw.c (sort_font_list_function): * fontcolor-msw.c (mswindows_enumerate_fonts): * dired.c: * dired.c (Fdirectory_files): * fileio.c: * fileio.c (build_annotations): * fileio.c (syms_of_fileio): * keymap.c: * keymap.c (keymap_submaps): * keymap.c (map_keymap_sort_predicate): * keymap.c (describe_map_sort_predicate): * keymap.c (describe_map): Change the various C predicates passed to list_sort () and list_merge () to fit the new calling convention, returning non-zero if the first argument is less than the second, zero otherwise.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 05 Feb 2011 12:04:34 +0000
parents 71ee43b8a74d
children cc7d0e19173c
comparison
equal deleted inserted replaced
5349:239193591765 5350:94bbd4792049
735 if (!NILP (Fkeymapp (value))) 735 if (!NILP (Fkeymapp (value)))
736 *result_locative = Fcons (Fcons (key, value), *result_locative); 736 *result_locative = Fcons (Fcons (key, value), *result_locative);
737 return 0; 737 return 0;
738 } 738 }
739 739
740 static Lisp_Object map_keymap_sort_predicate (Lisp_Object obj1, 740 static Boolint map_keymap_sort_predicate (Lisp_Object pred, Lisp_Object key,
741 Lisp_Object obj2, 741 Lisp_Object obj1, Lisp_Object obj2);
742 Lisp_Object pred, 742
743 Lisp_Object key_func);
744 743
745 static Lisp_Object 744 static Lisp_Object
746 keymap_submaps (Lisp_Object keymap) 745 keymap_submaps (Lisp_Object keymap)
747 { 746 {
748 /* This function can GC */ 747 /* This function can GC */
762 result = Qnil; 761 result = Qnil;
763 elisp_maphash (keymap_submaps_mapper, k->table, 762 elisp_maphash (keymap_submaps_mapper, k->table,
764 &keymap_submaps_closure); 763 &keymap_submaps_closure);
765 /* keep it sorted so that the result of accessible-keymaps is ordered */ 764 /* keep it sorted so that the result of accessible-keymaps is ordered */
766 k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate, 765 k->sub_maps_cache = list_sort (result, map_keymap_sort_predicate,
767 Qnil, Qidentity); 766 Qnil, Qnil);
768 UNGCPRO; 767 UNGCPRO;
769 } 768 }
770 return k->sub_maps_cache; 769 return k->sub_maps_cache;
771 } 770 }
772 771
2894 2893
2895 2894
2896 /* used by map_keymap_sorted(), describe_map_sort_predicate(), 2895 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2897 and keymap_submaps(). 2896 and keymap_submaps().
2898 */ 2897 */
2899 static Lisp_Object 2898 static Boolint
2900 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, 2899 map_keymap_sort_predicate (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key),
2901 Lisp_Object UNUSED (pred), 2900 Lisp_Object obj1, Lisp_Object obj2)
2902 Lisp_Object UNUSED (key_func))
2903 { 2901 {
2904 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. 2902 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2905 */ 2903 */
2906 int bit1, bit2; 2904 int bit1, bit2;
2907 int sym1_p = 0; 2905 int sym1_p = 0;
2910 2908
2911 obj1 = XCAR (obj1); 2909 obj1 = XCAR (obj1);
2912 obj2 = XCAR (obj2); 2910 obj2 = XCAR (obj2);
2913 2911
2914 if (EQ (obj1, obj2)) 2912 if (EQ (obj1, obj2))
2915 return Qnil; 2913 return 0;
2916 bit1 = MODIFIER_HASH_KEY_BITS (obj1); 2914 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2917 bit2 = MODIFIER_HASH_KEY_BITS (obj2); 2915 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2918 2916
2919 /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by 2917 /* If either is a symbol with a Qcharacter_of_keysym property, then sort
2920 that code instead of alphabetically. 2918 it by that code instead of alphabetically.
2921 */ 2919 */
2922 if (! bit1 && SYMBOLP (obj1)) 2920 if (! bit1 && SYMBOLP (obj1))
2923 { 2921 {
2924 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil); 2922 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil);
2925 if (CHAR_OR_CHAR_INTP (code)) 2923 if (CHAR_OR_CHAR_INTP (code))
2940 } 2938 }
2941 } 2939 }
2942 2940
2943 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ 2941 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2944 if (XTYPE (obj1) != XTYPE (obj2)) 2942 if (XTYPE (obj1) != XTYPE (obj2))
2945 return SYMBOLP (obj2) ? Qt : Qnil; 2943 return SYMBOLP (obj2);
2946 2944
2947 if (! bit1 && CHARP (obj1)) /* they're both ASCII */ 2945 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2948 { 2946 {
2949 int o1 = XCHAR (obj1); 2947 int o1 = XCHAR (obj1);
2950 int o2 = XCHAR (obj2); 2948 int o2 = XCHAR (obj2);
2951 if (o1 == o2 && /* If one started out as a symbol and the */ 2949 if (o1 == o2 && /* If one started out as a symbol and the */
2952 sym1_p != sym2_p) /* other didn't, the symbol comes last. */ 2950 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2953 return sym2_p ? Qt : Qnil; 2951 return sym2_p;
2954 2952
2955 return o1 < o2 ? Qt : Qnil; /* else just compare them */ 2953 return o1 < o2; /* else just compare them */
2956 } 2954 }
2957 2955
2958 /* else they're both symbols. If they're both buckys, then order them. */ 2956 /* else they're both symbols. If they're both buckys, then order them. */
2959 if (bit1 && bit2) 2957 if (bit1 && bit2)
2960 return bit1 < bit2 ? Qt : Qnil; 2958 return bit1 < bit2;
2961 2959
2962 /* if only one is a bucky, then it comes later */ 2960 /* if only one is a bucky, then it comes later */
2963 if (bit1 || bit2) 2961 if (bit1 || bit2)
2964 return bit2 ? Qt : Qnil; 2962 return bit2;
2965 2963
2966 /* otherwise, string-sort them. */ 2964 /* otherwise, string-sort them. */
2967 { 2965 {
2968 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); 2966 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name);
2969 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); 2967 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name);
2970 return 0 > qxestrcmp (s1, s2) ? Qt : Qnil; 2968 return 0 > qxestrcmp (s1, s2);
2971 } 2969 }
2972 } 2970 }
2973 2971
2974 2972
2975 /* used by map_keymap() */ 2973 /* used by map_keymap() */
4085 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)), 4083 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
4086 binding), 4084 binding),
4087 *(closure->list)); 4085 *(closure->list));
4088 } 4086 }
4089 4087
4090 4088 static Boolint
4091 static Lisp_Object 4089 describe_map_sort_predicate (Lisp_Object pred, Lisp_Object key_func,
4092 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, 4090 Lisp_Object obj1, Lisp_Object obj2)
4093 Lisp_Object pred, Lisp_Object key_func) 4091
4094 { 4092 {
4095 /* obj1 and obj2 are conses of the form 4093 /* obj1 and obj2 are conses of the form
4096 ( ( <keysym> . <modifiers> ) . <binding> ) 4094 ( ( <keysym> . <modifiers> ) . <binding> )
4097 keysym and modifiers are used, binding is ignored. 4095 keysym and modifiers are used, binding is ignored.
4098 */ 4096 */
4100 obj1 = XCAR (obj1); 4098 obj1 = XCAR (obj1);
4101 obj2 = XCAR (obj2); 4099 obj2 = XCAR (obj2);
4102 bit1 = XINT (XCDR (obj1)); 4100 bit1 = XINT (XCDR (obj1));
4103 bit2 = XINT (XCDR (obj2)); 4101 bit2 = XINT (XCDR (obj2));
4104 if (bit1 != bit2) 4102 if (bit1 != bit2)
4105 return bit1 < bit2 ? Qt : Qnil; 4103 return bit1 < bit2;
4106 else 4104 else
4107 return map_keymap_sort_predicate (obj1, obj2, pred, key_func); 4105 return map_keymap_sort_predicate (obj1, obj2, pred, key_func);
4108 } 4106 }
4109 4107
4110 /* Elide 2 or more consecutive numeric keysyms bound to the same thing, 4108 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4210 traverse_keymaps (keymap, Qnil, 4208 traverse_keymaps (keymap, Qnil,
4211 describe_map_parent_mapper, &describe_map_closure); 4209 describe_map_parent_mapper, &describe_map_closure);
4212 4210
4213 if (!NILP (list)) 4211 if (!NILP (list))
4214 { 4212 {
4215 list = list_sort (list, describe_map_sort_predicate, Qnil, Qidentity); 4213 list = list_sort (list, describe_map_sort_predicate, Qnil, Qnil);
4216 buffer_insert_ascstring (buf, "\n"); 4214 buffer_insert_ascstring (buf, "\n");
4217 while (!NILP (list)) 4215 while (!NILP (list))
4218 { 4216 {
4219 Lisp_Object elt = XCAR (XCAR (list)); 4217 Lisp_Object elt = XCAR (XCAR (list));
4220 Lisp_Object keysym = XCAR (elt); 4218 Lisp_Object keysym = XCAR (elt);