Mercurial > hg > xemacs-beta

comparison src/fontcolor-msw.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 6c8f5574d4a1
children 0af042a0c116
comparison
equal deleted inserted replaced
5349:239193591765 5350:94bbd4792049
1196 /* Function for sorting lists of fonts as obtained from 1196 /* Function for sorting lists of fonts as obtained from
1197 mswindows_enumerate_fonts(). These come in a known format: 1197 mswindows_enumerate_fonts(). These come in a known format:
1198 "family::::charset" for TrueType fonts, "family::size::charset" 1198 "family::::charset" for TrueType fonts, "family::size::charset"
1199 otherwise. */ 1199 otherwise. */
1200 1200
1201 static Lisp_Object 1201 static Boolint
1202 sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2, 1202 sort_font_list_function (Lisp_Object UNUSED (pred), Lisp_Object UNUSED (key),
1203 Lisp_Object UNUSED (pred), 1203 Lisp_Object obj1, Lisp_Object obj2)
1204 Lisp_Object UNUSED (key_function))
1205 { 1204 {
1206 Ibyte *font1, *font2; 1205 Ibyte *font1, *font2;
1207 Ibyte *c1, *c2; 1206 Ibyte *c1, *c2;
1208 int t1, t2; 1207 int t1, t2;
1209 1208
1213 3. TrueType over non-TrueType. 1212 3. TrueType over non-TrueType.
1214 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt. 1213 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt.
1215 5. Courier New over other families. 1214 5. Courier New over other families.
1216 */ 1215 */
1217 1216
1218 /* The sort function should return non-nil if OBJ1 < OBJ2, nil otherwise. 1217 /* The sort function should return non-zero if OBJ1 < OBJ2, zero
1219 NOTE: This is backwards from the way qsort() works. */ 1218 otherwise. */
1220 1219
1221 t1 = !NILP (XCDR (obj1)); 1220 t1 = !NILP (XCDR (obj1));
1222 t2 = !NILP (XCDR (obj2)); 1221 t2 = !NILP (XCDR (obj2));
1223 1222
1224 if (t1 && !t2) 1223 if (t1 && !t2)
1225 return Qt; 1224 return 1;
1226 if (t2 && !t1) 1225 if (t2 && !t1)
1227 return Qnil; 1226 return 0;
1228 1227
1229 font1 = XSTRING_DATA (XCAR (obj1)); 1228 font1 = XSTRING_DATA (XCAR (obj1));
1230 font2 = XSTRING_DATA (XCAR (obj2)); 1229 font2 = XSTRING_DATA (XCAR (obj2));
1231 1230
1232 c1 = qxestrrchr (font1, ':'); 1231 c1 = qxestrrchr (font1, ':');
1234 1233
1235 t1 = !qxestrcasecmp_ascii (c1 + 1, "western"); 1234 t1 = !qxestrcasecmp_ascii (c1 + 1, "western");
1236 t2 = !qxestrcasecmp_ascii (c2 + 1, "western"); 1235 t2 = !qxestrcasecmp_ascii (c2 + 1, "western");
1237 1236
1238 if (t1 && !t2) 1237 if (t1 && !t2)
1239 return Qt; 1238 return 1;
1240 if (t2 && !t1) 1239 if (t2 && !t1)
1241 return Qnil; 1240 return 0;
1242 1241
1243 c1 -= 2; 1242 c1 -= 2;
1244 c2 -= 2; 1243 c2 -= 2;
1245 t1 = *c1 == ':'; 1244 t1 = *c1 == ':';
1246 t2 = *c2 == ':'; 1245 t2 = *c2 == ':';
1247 1246
1248 if (t1 && !t2) 1247 if (t1 && !t2)
1249 return Qt; 1248 return 1;
1250 if (t2 && !t1) 1249 if (t2 && !t1)
1251 return Qnil; 1250 return 0;
1252 1251
1253 if (!t1 && !t2) 1252 if (!t1 && !t2)
1254 { 1253 {
1255 while (isdigit (*c1)) 1254 while (isdigit (*c1))
1256 c1--; 1255 c1--;
1259 1258
1260 t1 = qxeatoi (c1 + 1) - 10; 1259 t1 = qxeatoi (c1 + 1) - 10;
1261 t2 = qxeatoi (c2 + 1) - 10; 1260 t2 = qxeatoi (c2 + 1) - 10;
1262 1261
1263 if (abs (t1) < abs (t2)) 1262 if (abs (t1) < abs (t2))
1264 return Qt; 1263 return 1;
1265 else if (abs (t2) < abs (t1)) 1264 else if (abs (t2) < abs (t1))
1266 return Qnil; 1265 return 0;
1267 else if (t1 < t2) 1266 else if (t1 < t2)
1268 /* Prefer a smaller font over a larger one just as far away 1267 /* Prefer a smaller font over a larger one just as far away
1269 because the smaller one won't upset the total line height if it's 1268 because the smaller one won't upset the total line height if it's
1270 just a few chars. */ 1269 just a few chars. */
1271 return Qt; 1270 return 1;
1272 } 1271 }
1273 1272
1274 t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12); 1273 t1 = !qxestrncasecmp_ascii (font1, "courier new:", 12);
1275 t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12); 1274 t2 = !qxestrncasecmp_ascii (font2, "courier new:", 12);
1276 1275
1277 if (t1 && !t2) 1276 if (t1 && !t2)
1278 return Qt; 1277 return 1;
1279 if (t2 && !t1) 1278 if (t2 && !t1)
1280 return Qnil; 1279 return 0;
1281 1280
1282 return Qnil; 1281 return 0;
1283 } 1282 }
1284 1283
1285 /* 1284 /*
1286 * Enumerate the available on the HDC fonts and return a list of string 1285 * Enumerate the available on the HDC fonts and return a list of string
1287 * font names. 1286 * font names.