Mercurial > hg > xemacs-beta

comparison src/fontcolor-msw.c @ 5182:2e528066e2fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'sort*, #'fill, #'merge to C from cl-seq.el. lisp/ChangeLog addition: 2010-04-01 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el (fill, sort*, merge): Move these functions to fns.c. (stable-sort): Make this docstring reflect the argument names used in the #'sort* docstring. * cl-macs.el (stable-sort): Make #'stable-sort exactly equivalent to #'sort* in compiled code. * bytecomp.el (byte-compile-maybe-add-*): New macro, for functions like #'sort and #'mapcar that, to be strictly compatible, should only take two args, but in our implementation can take more, because they're aliases of #'sort* and #'mapcar*. (byte-compile-mapcar, byte-compile-sort, byte-compile-fillarray): Use this new macro. (map-into): Add a byte-compile method for #'map-into in passing. * apropos.el (apropos-print): Use #'sort* with a :key argument, now it's in C. * compat.el (extent-at): Ditto. * register.el (list-registers): Ditto. * package-ui.el (pui-list-packages): Ditto. * help.el (sorted-key-descriptions): Ditto. src/ChangeLog addition: 2010-03-31 Aidan Kehoe <kehoea@parhasard.net> * fns.c (STRING_DATA_TO_OBJECT_ARRAY) (BIT_VECTOR_TO_OBJECT_ARRAY, c_merge_predicate_key) (c_merge_predicate_nokey, list_merge, array_merge) (list_array_merge_into_list, list_list_merge_into_array) (list_array_merge_into_array, CHECK_KEY_ARGUMENT, Fmerge) (list_sort, array_sort, FsortX): Move #'sort*, #'fill, #'merge from cl-seq.el to C, extending the implementations of Fsort, Ffillarray, and merge() to do so. * keymap.c (keymap_submaps, map_keymap_sort_predicate) (describe_map_sort_predicate): Change the calling semantics of the C sort predicates to return a non-nil Lisp object if the first argument is less than the second, rather than C integers. * fontcolor-msw.c (sort_font_list_function): * fileio.c (build_annotations): * dired.c (Fdirectory_files): * abbrev.c (Finsert_abbrev_table_description): Call list_sort instead of Fsort, list_merge instead of merge() in these functions. man/ChangeLog addition: 2010-04-01 Aidan Kehoe <kehoea@parhasard.net> * lispref/lists.texi (Rearrangement): Update the documentation of #'sort here, now that it accepts any type of sequence and the KEY keyword argument. (Though this is probably now the wrong place for this function, given that.)
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 01 Apr 2010 20:22:50 +0100
parents 8b2f75cecb89
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5181:a00bfbd64e0a 5182:2e528066e2fc
1170 /* Function for sorting lists of fonts as obtained from 1170 /* Function for sorting lists of fonts as obtained from
1171 mswindows_enumerate_fonts(). These come in a known format: 1171 mswindows_enumerate_fonts(). These come in a known format:
1172 "family::::charset" for TrueType fonts, "family::size::charset" 1172 "family::::charset" for TrueType fonts, "family::size::charset"
1173 otherwise. */ 1173 otherwise. */
1174 1174
1175 static int 1175 static Lisp_Object
1176 sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2, 1176 sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2,
1177 Lisp_Object UNUSED (pred)) 1177 Lisp_Object UNUSED (pred),
1178 Lisp_Object UNUSED (key_function))
1178 { 1179 {
1179 Ibyte *font1, *font2; 1180 Ibyte *font1, *font2;
1180 Ibyte *c1, *c2; 1181 Ibyte *c1, *c2;
1181 int t1, t2; 1182 int t1, t2;
1182 1183
1186 3. TrueType over non-TrueType. 1187 3. TrueType over non-TrueType.
1187 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt. 1188 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt.
1188 5. Courier New over other families. 1189 5. Courier New over other families.
1189 */ 1190 */
1190 1191
1191 /* The sort function should return > 0 if OBJ1 < OBJ2, < 0 otherwise. 1192 /* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise.
1192 NOTE: This is backwards from the way qsort() works. */ 1193 NOTE: This is backwards from the way qsort() works. */
1193 1194
1194 t1 = !NILP (XCDR (obj1)); 1195 t1 = !NILP (XCDR (obj1));
1195 t2 = !NILP (XCDR (obj2)); 1196 t2 = !NILP (XCDR (obj2));
1196 1197
1197 if (t1 && !t2) 1198 if (t1 && !t2)
1198 return 1; 1199 return Qt;
1199 if (t2 && !t1) 1200 if (t2 && !t1)
1200 return -1; 1201 return Qnil;
1201 1202
1202 font1 = XSTRING_DATA (XCAR (obj1)); 1203 font1 = XSTRING_DATA (XCAR (obj1));
1203 font2 = XSTRING_DATA (XCAR (obj2)); 1204 font2 = XSTRING_DATA (XCAR (obj2));
1204 1205
1205 c1 = qxestrrchr (font1, ':'); 1206 c1 = qxestrrchr (font1, ':');
1207 1208
1208 t1 = !qxestrcasecmp_ascii (c1 + 1, "western"); 1209 t1 = !qxestrcasecmp_ascii (c1 + 1, "western");
1209 t2 = !qxestrcasecmp_ascii (c2 + 1, "western"); 1210 t2 = !qxestrcasecmp_ascii (c2 + 1, "western");
1210 1211
1211 if (t1 && !t2) 1212 if (t1 && !t2)
1212 return 1; 1213 return Qt;
1213 if (t2 && !t1) 1214 if (t2 && !t1)
1214 return -1; 1215 return Qnil;
1215 1216
1216 c1 -= 2; 1217 c1 -= 2;
1217 c2 -= 2; 1218 c2 -= 2;
1218 t1 = *c1 == ':'; 1219 t1 = *c1 == ':';
1219 t2 = *c2 == ':'; 1220 t2 = *c2 == ':';
1220 1221
1221 if (t1 && !t2) 1222 if (t1 && !t2)
1222 return 1; 1223 return Qt;
1223 if (t2 && !t1) 1224 if (t2 && !t1)
1224 return -1; 1225 return Qnil;
1225 1226
1226 if (!t1 && !t2) 1227 if (!t1 && !t2)
1227 { 1228 {
1228 while (isdigit (*c1)) 1229 while (isdigit (*c1))
1229 c1--; 1230 c1--;
1232 1233
1233 t1 = qxeatoi (c1 + 1) - 10; 1234 t1 = qxeatoi (c1 + 1) - 10;
1234 t2 = qxeatoi (c2 + 1) - 10; 1235 t2 = qxeatoi (c2 + 1) - 10;
1235 1236
1236 if (abs (t1) < abs (t2)) 1237 if (abs (t1) < abs (t2))
1237 return 1; 1238 return Qt;
1238 else if (abs (t2) < abs (t1)) 1239 else if (abs (t2) < abs (t1))
1239 return -1; 1240 return Qnil;
1240 else if (t1 < t2) 1241 else if (t1 < t2)
1241 /* Prefer a smaller font over a larger one just as far away 1242 /* Prefer a smaller font over a larger one just as far away
1242 because the smaller one won't upset the total line height if it's 1243 because the smaller one won't upset the total line height if it's
1243 just a few chars. */ 1244 just a few chars. */
1244 return 1; 1245 return Qt;
1245 } 1246 }
1246 1247
1247 t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12); 1248 t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12);
1248 t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12); 1249 t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12);
1249 1250
1250 if (t1 && !t2) 1251 if (t1 && !t2)
1251 return 1; 1252 return Qt;
1252 if (t2 && !t1) 1253 if (t2 && !t1)
1253 return -1; 1254 return Qnil;
1254 1255
1255 return -1; 1256 return Qnil;
1256 } 1257 }
1257 1258
1258 /* 1259 /*
1259 * Enumerate the available on the HDC fonts and return a list of string 1260 * Enumerate the available on the HDC fonts and return a list of string
1260 * font names. 1261 * font names.
1276 is not what we want. We aren't supporting NT 3.5x, so no need to 1277 is not what we want. We aren't supporting NT 3.5x, so no need to
1277 worry about this not existing. */ 1278 worry about this not existing. */
1278 qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1, 1279 qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1,
1279 (LPARAM) (&font_enum), 0); 1280 (LPARAM) (&font_enum), 0);
1280 1281
1281 return list_sort (font_enum.list, Qnil, sort_font_list_function); 1282 return list_sort (font_enum.list, sort_font_list_function, Qnil, Qidentity);
1282 } 1283 }
1283 1284
1284 static HFONT 1285 static HFONT
1285 mswindows_create_font_variant (Lisp_Font_Instance *f, 1286 mswindows_create_font_variant (Lisp_Font_Instance *f,
1286 int under, int strike) 1287 int under, int strike)