comparison src/objects-msw.c @ 872:79c6ff3eef26

[xemacs-hg @ 2002-06-20 21:18:01 by ben] font changes etc.; some 21.4 changes mule/mule-msw-init-late.el: Specify charset->windows-registry conversion. mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c. cl-macs.el: Document better. font-lock.el: Move Lisp function regexp to lisp-mode.el. lisp-mode.el: Various indentation fixes: Handle flet functions better. Handle argument lists in defuns and flets. Handle quoted lists, e.g. property lists -- don't indent like function calls. Distinguish between lambdas and other lists. lisp-mode.el: Handle this form. faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code: -- Fix lots of bogus code in msw-faces.el, msw-font-menu.el, font-menu.el that was "truenaming" font specs -- i.e. in the process of frobbing a particular field in a general user-specified font spec with wildcarded fields, sticking in particular values for all the remaining wildcarded fields. This bug was rampant everywhere except in x-faces.el (the oldest and only correctly written code). This also means that we need to work with font names at all times and not font instances, because a font instance is essentially a truenamed font. -- Total rewrite of extremely junky code in msw-faces.el. Work with names as well as font instances, and return names; stop truenaming when canonicalizing and frobbing; fix handling of the combined style field, i.e. weight/slant (also fixed in font.el). -- Totally rewrite the frobbing functions in faces.el. This time, we frob all the instantiators rather than just computing a single instance value and working backwards. That way, e.g., `bold' will work for all charsets that have bold available, rather than only for whatever charset was part of the computed font instance (another example of the truename virus). Also fix up code to look at the fallbacks (all of them) when no global value present, so we don't need to put something in the global value. Intelligently handle a request to frob a buffer locale, rather than signalling an error. When frobbing instantiators, try hard to figure out what device type is associated with them, and frob each according to its own proper device type. Correctly handle inheritance vectors given as instantiators. Preserve existing tags when putting back frobbed instantiators. Extract out general specifier-frobbing code into specifier.el. Document everything cleanly. Do lots of other things better, etc. -- Don't duplicatively set a global specification for the default font -- it's already in the fallback and we no longer need a default global specification present. Delete various code in x-faces.el and msw-faces.el that duplicated the lists of fonts in faces.c. -- init-global-faces was not being called at all under MS Windows! Major bogosity. That caused device-specific values to get stuck into all the fonts, making it very hard to change them -- setting global specs caused nothing to happen. -- Correct weight names in font.el. -- Lots more font fixups in objects*.c. Printer.el: Warning fix. specifier.el: Add more args to map-specifier. Add various "heuristic" specifier functions to aid in creation of specifier-munging code such as in faces.el. subr.el: New functions. lwlib.c: Fix warning. config.inc.samp: Clean up, add args to control fastcall (not yet supported! the changes needed are in another ws of mine), profile support, vc6 support, union-type. xemacs.dsp, xemacs.mak: Semi-major overhaul. Fix bug where dump-id was always getting recomputed, forcing a redump even when nothing changed. Add support for fastcall. Support edit-and-continue (on by default) with vc6. Use incremental linking when doing a debug compilation. Add support for profiling. Consolidate the various debug flags. Partial support for "batch-compiling" -- compiling many files on a single invocation of the compiler. Doesn't seem to help that much for me, so it's not finished or enabled by default. Remove HAVE_MSW_C_DIRED, we always do. Correct some sloppy use of directories. s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine HAVE_MMAP). s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32 variants (Cygwin, native, MinGW). Both of these are properly used in another ws. alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made: (1) Separation of various header files into an external and an internal version, similar to the existing separation of process.h and procimpl.h. Eventually this should be done for all Lisp objects. The external version has the same name as currently; the internal adds -impl. The external file has XFOO() macros for objects, but the structure is opaque and defined only in the internal file. It's now reasonable to move all prototypes in lisp.h into the appropriate external file, and this should be done. Currently, separation has been done on extents.h, objects*.h, console.h, device.h, frame.h, and window.h. For c/d/f/w, the most basic properties are available in the external header file, with the macros resolving to functions. In the internal header file, the macros are redefined to directly access the structure. Also, the global MARK_FOO_CHANGED macros have been made into functions so that they can be accessed without needing to include lots of -impl headers -- they are used in almost exclusively in non-time-critical functions, and take up enough time that the function overhead will be negligible. Similarly, the function overhead from making the basic properties mentioned above into functions is negligible, and code that does heavy accessing of c/d/f/w structures inevitably ends up needing the internal header files, anyway. (2) More face changes. -- Major rewrite of objects-msw.c. Now handles wildcard specs properly, rather than "truenaming" (or even worse, signalling an error, which previously happened with some of the fallbacks if you tried to use them in make-font-instance!). -- Split charset matching of fonts into two stages -- one to find a font specifically designed for a particular charset (by examining its registry), the second to find a Unicode font that can support the charset. This needs to proceed as two complete, separate instantiations in order to work properly (otherwise many of the fonts in the HELLO page look wrong). This should also make it easy to support iso10646 (Unicode) fonts under X. -- All default values for fonts are now completely specified in the fallbacks. Stuff from mule-x-init.el has all been moved here, merged with the existing specs, and totally rethought so you get sensible results. (HELLO now looks much better!). -- Generalize the "default X/GTK device" stuff into a per-device-type "default device". -- Add mswindows-{set-}charset-registry. In time, charset<->code-page conversion functions will be removed. -- Wrap protective code around calls to compute device specifier tags, and do this computation before calling the face initialization code because the latter may need these tags to be correctly updated. (3) Other changes. EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes. config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of #ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside! eval.c: Let detailed backtraces be detailed. specifier.c: Don't override user's print-string-length/print-length settings. glyphs.c: New function image-instance-instantiator. config.h.in, sysdep.c: Changes for fastcall. sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP NEEDS TO GO IN, TOO. search.c: Fix *evil* crash due to incorrect synching of syntax-cache code with 21.1. THIS SHOULD GO INTO 21.4.
author ben
date Thu, 20 Jun 2002 21:19:10 +0000
parents 804517e16990
children a1e328407366
comparison
equal deleted inserted replaced
871:732270854293 872:79c6ff3eef26
36 /* TODO: palette handling */ 36 /* TODO: palette handling */
37 37
38 #include <config.h> 38 #include <config.h>
39 #include "lisp.h" 39 #include "lisp.h"
40 40
41 #include "console-msw.h" 41 #include "console-msw-impl.h"
42 #include "objects-msw.h" 42 #include "objects-msw-impl.h"
43 43
44 #include "buffer.h" 44 #include "buffer.h"
45 #include "charset.h" 45 #include "charset.h"
46 #include "device.h" 46 #include "device-impl.h"
47 #include "elhash.h" 47 #include "elhash.h"
48 #include "insdel.h" 48 #include "insdel.h"
49 #include "opaque.h" 49 #include "opaque.h"
50 50
51 typedef struct colormap_t 51 typedef struct colormap_t
749 {"Ultra Bold" , FW_ULTRABOLD}, 749 {"Ultra Bold" , FW_ULTRABOLD},
750 {"Heavy" , FW_HEAVY}, 750 {"Heavy" , FW_HEAVY},
751 {"Black" , FW_BLACK} 751 {"Black" , FW_BLACK}
752 }; 752 };
753 753
754 /* Default charset first, no synonyms allowed because these names are 754 /* Default charset must be listed first, no synonyms allowed because these
755 * matched against the names reported by win32 by match_font() */ 755 * names are matched against the names reported by win32 by match_font() */
756 static const fontmap_t charset_map[] = 756 static const fontmap_t charset_map[] =
757 { 757 {
758 {"Western" , ANSI_CHARSET}, /* Latin 1 */ 758 {"Western" , ANSI_CHARSET}, /* Latin 1 */
759 {"Central European" , EASTEUROPE_CHARSET}, 759 {"Central European" , EASTEUROPE_CHARSET},
760 {"Cyrillic" , RUSSIAN_CHARSET}, 760 {"Cyrillic" , RUSSIAN_CHARSET},
1140 if (i == countof (charset_map)) 1140 if (i == countof (charset_map))
1141 return 1; 1141 return 1;
1142 1142
1143 /* Add the font name to the list if not already there */ 1143 /* Add the font name to the list if not already there */
1144 fontname_lispstr = build_intstring (fontname); 1144 fontname_lispstr = build_intstring (fontname);
1145 if (NILP (Fmember (fontname_lispstr, font_enum->list))) 1145 if (NILP (Fassoc (fontname_lispstr, font_enum->list)))
1146 font_enum->list = Fcons (fontname_lispstr, font_enum->list); 1146 font_enum->list =
1147 Fcons (Fcons (fontname_lispstr,
1148 /* TMPF_FIXED_PITCH is backwards from what you expect!
1149 If set, it means NOT fixed pitch. */
1150 (lpntme->ntmTm.tmPitchAndFamily & TMPF_FIXED_PITCH) ?
1151 Qnil : Qt),
1152 font_enum->list);
1147 1153
1148 return 1; 1154 return 1;
1149 } 1155 }
1150 1156
1151 static int CALLBACK 1157 static int CALLBACK
1155 /* This function gets called once per facename per character set. 1161 /* This function gets called once per facename per character set.
1156 * We call a second callback to enumerate the fonts in each facename */ 1162 * We call a second callback to enumerate the fonts in each facename */
1157 return qxeEnumFontFamiliesEx (font_enum->hdc, &lpelfe->elfLogFont, 1163 return qxeEnumFontFamiliesEx (font_enum->hdc, &lpelfe->elfLogFont,
1158 (FONTENUMPROCW) font_enum_callback_2, 1164 (FONTENUMPROCW) font_enum_callback_2,
1159 (LPARAM) font_enum, 0); 1165 (LPARAM) font_enum, 0);
1166 }
1167
1168 /* Function for sorting lists of fonts as obtained from
1169 mswindows_enumerate_fonts(). These come in a known format:
1170 "family::::charset" for TrueType fonts, "family::size::charset"
1171 otherwise. */
1172
1173 static int
1174 sort_font_list_function (Lisp_Object obj1, Lisp_Object obj2,
1175 Lisp_Object pred)
1176 {
1177 Ibyte *font1, *font2;
1178 Ibyte *c1, *c2;
1179 int t1, t2;
1180
1181 /*
1182 1. fixed over proportional.
1183 2. Western over other charsets.
1184 3. TrueType over non-TrueType.
1185 4. Within non-TrueType, sizes closer to 10pt over sizes farther from 10pt.
1186 5. Courier New over other families.
1187 */
1188
1189 /* The sort function should return > 0 if OBJ1 < OBJ2, < 0 otherwise.
1190 NOTE: This is backwards from the way qsort() works. */
1191
1192 t1 = !NILP (XCDR (obj1));
1193 t2 = !NILP (XCDR (obj2));
1194
1195 if (t1 && !t2)
1196 return 1;
1197 if (t2 && !t1)
1198 return -1;
1199
1200 font1 = XSTRING_DATA (XCAR (obj1));
1201 font2 = XSTRING_DATA (XCAR (obj2));
1202
1203 c1 = qxestrrchr (font1, ':');
1204 c2 = qxestrrchr (font2, ':');
1205
1206 t1 = !qxestrcasecmp_c (c1 + 1, "western");
1207 t2 = !qxestrcasecmp_c (c2 + 1, "western");
1208
1209 if (t1 && !t2)
1210 return 1;
1211 if (t2 && !t1)
1212 return -1;
1213
1214 c1 -= 2;
1215 c2 -= 2;
1216 t1 = *c1 == ':';
1217 t2 = *c2 == ':';
1218
1219 if (t1 && !t2)
1220 return 1;
1221 if (t2 && !t1)
1222 return -1;
1223
1224 if (!t1 && !t2)
1225 {
1226 while (isdigit (*c1))
1227 c1--;
1228 while (isdigit (*c2))
1229 c2--;
1230
1231 t1 = qxeatoi (c1 + 1) - 10;
1232 t2 = qxeatoi (c2 + 1) - 10;
1233
1234 if (abs (t1) < abs (t2))
1235 return 1;
1236 else if (abs (t2) < abs (t1))
1237 return -1;
1238 else if (t1 < t2)
1239 /* Prefer a smaller font over a larger one just as far away
1240 because the smaller one won't upset the total line height if it's
1241 just a few chars. */
1242 return 1;
1243 }
1244
1245 t1 = !qxestrncasecmp_c (font1, "courier new:", 12);
1246 t2 = !qxestrncasecmp_c (font2, "courier new:", 12);
1247
1248 if (t1 && !t2)
1249 return 1;
1250 if (t2 && !t1)
1251 return -1;
1252
1253 return -1;
1160 } 1254 }
1161 1255
1162 /* 1256 /*
1163 * Enumerate the available on the HDC fonts and return a list of string 1257 * Enumerate the available on the HDC fonts and return a list of string
1164 * font names. 1258 * font names.
1180 is not what we want. We aren't supporting NT 3.5x, so no need to 1274 is not what we want. We aren't supporting NT 3.5x, so no need to
1181 worry about this not existing. */ 1275 worry about this not existing. */
1182 qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1, 1276 qxeEnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROCW) font_enum_callback_1,
1183 (LPARAM) (&font_enum), 0); 1277 (LPARAM) (&font_enum), 0);
1184 1278
1185 return font_enum.list; 1279 return list_sort (font_enum.list, Qnil, sort_font_list_function);
1186 } 1280 }
1187 1281
1188 static HFONT 1282 static HFONT
1189 mswindows_create_font_variant (Lisp_Font_Instance *f, 1283 mswindows_create_font_variant (Lisp_Font_Instance *f,
1190 int under, int strike) 1284 int under, int strike)
1318 1412
1319 1413
1320 static void 1414 static void
1321 mswindows_finalize_font_instance (Lisp_Font_Instance *f); 1415 mswindows_finalize_font_instance (Lisp_Font_Instance *f);
1322 1416
1323 static HFONT 1417 /* Parse the font spec in NAMESTR. Maybe issue errors, according to ERRB;
1324 create_hfont_from_font_spec (const Ibyte *namestr, 1418 NAME_FOR_ERRORS is the Lisp string to use when issuing errors. Store
1325 HDC hdc, 1419 the five parts of the font spec into the given strings, which should be
1326 Lisp_Object name_for_errors, 1420 declared as
1327 Lisp_Object device_font_list, 1421
1328 Error_Behavior errb) 1422 Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], points[8];
1329 { 1423 Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE];
1330 LOGFONTW logfont; 1424
1425 If LOGFONT is given, store the necessary information in LOGFONT to
1426 create a font object. If LOGFONT is given, HDC must also be given;
1427 else, NULL can be given for both.
1428
1429 Return 1 if ok, 0 if error.
1430 */
1431 static int
1432 parse_font_spec (const Ibyte *namestr,
1433 HDC hdc,
1434 Lisp_Object name_for_errors,
1435 Error_Behavior errb,
1436 LOGFONTW *logfont,
1437 Ibyte *fontname,
1438 Ibyte *weight,
1439 Ibyte *points,
1440 Ibyte *effects,
1441 Ibyte *charset)
1442 {
1331 int fields, i; 1443 int fields, i;
1332 int pt; 1444 int pt;
1333 Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8]; 1445 Ibyte *style;
1334 Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE];
1335 Ibyte *c; 1446 Ibyte *c;
1336 HFONT hfont;
1337 1447
1338 /* 1448 /*
1339 * mswindows fonts look like: 1449 * mswindows fonts look like:
1340 * fontname[:[weight ][style][:pointsize[:effects]]][:charset] 1450 * fontname[:[weight ][style][:pointsize[:effects]]][:charset]
1341 * The font name field shouldn't be empty. 1451 * The font name field shouldn't be empty.
1346 * Courier New 1456 * Courier New
1347 * maximal: 1457 * maximal:
1348 * Courier New:Bold Italic:10:underline strikeout:western 1458 * Courier New:Bold Italic:10:underline strikeout:western
1349 */ 1459 */
1350 1460
1461 fontname[0] = 0;
1462 weight[0] = 0;
1463 points[0] = 0;
1464 effects[0] = 0;
1465 charset[0] = 0;
1466
1467 if (logfont)
1468 xzero (*logfont);
1469
1351 fields = sscanf ((CIbyte *) namestr, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", 1470 fields = sscanf ((CIbyte *) namestr, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s",
1352 fontname, weight, points, effects, charset); 1471 fontname, weight, points, effects, charset);
1353 1472
1354 /* This function is implemented in a fairly ad-hoc manner. 1473 /* This function is implemented in a fairly ad-hoc manner.
1355 * The general idea is to validate and canonicalize each of the above fields 1474 * The general idea is to validate and canonicalize each of the above fields
1359 1478
1360 if (fields < 0) 1479 if (fields < 0)
1361 { 1480 {
1362 maybe_signal_error (Qinvalid_argument, "Invalid font", name_for_errors, 1481 maybe_signal_error (Qinvalid_argument, "Invalid font", name_for_errors,
1363 Qfont, errb); 1482 Qfont, errb);
1364 return NULL; 1483 return 0;
1365 } 1484 }
1366 1485
1367 if (fields > 0 && qxestrlen (fontname)) 1486 if (fields > 0 && qxestrlen (fontname))
1368 { 1487 {
1369 Extbyte *extfontname; 1488 Extbyte *extfontname;
1370 1489
1371 C_STRING_TO_TSTR (fontname, extfontname); 1490 C_STRING_TO_TSTR (fontname, extfontname);
1372 xetcsncpy ((Extbyte *) logfont.lfFaceName, extfontname, LF_FACESIZE - 1); 1491 if (logfont)
1373 logfont.lfFaceName[LF_FACESIZE - 1] = 0; 1492 {
1374 } 1493 xetcsncpy ((Extbyte *) logfont->lfFaceName, extfontname,
1375 else 1494 LF_FACESIZE - 1);
1376 { 1495 logfont->lfFaceName[LF_FACESIZE - 1] = 0;
1377 maybe_signal_error (Qinvalid_argument, "Must specify a font name", 1496 }
1378 name_for_errors, Qfont, errb);
1379 return NULL;
1380 } 1497 }
1381 1498
1382 /* weight */ 1499 /* weight */
1383 if (fields < 2) 1500 if (fields < 2)
1384 qxestrcpy_c (weight, fontweight_map[0].name); 1501 qxestrcpy_c (weight, fontweight_map[0].name);
1385 1502
1386 /* Maybe split weight into weight and style */ 1503 /* Maybe split weight into weight and style */
1387 if ((c = qxestrchr (weight, ' '))) 1504 if ((c = qxestrchr (weight, ' ')))
1388 { 1505 {
1389 *c = '\0'; 1506 *c = '\0';
1390 style = c + 1; 1507 style = c + 1;
1391 } 1508 }
1392 else 1509 else
1393 style = NULL; 1510 style = NULL;
1394 1511
1395 for (i = 0; i < countof (fontweight_map); i++) 1512 for (i = 0; i < countof (fontweight_map); i++)
1396 if (!qxestrcasecmp_c (weight, fontweight_map[i].name)) 1513 if (!qxestrcasecmp_c (weight, fontweight_map[i].name))
1397 { 1514 {
1398 logfont.lfWeight = fontweight_map[i].value; 1515 if (logfont)
1516 logfont->lfWeight = fontweight_map[i].value;
1399 break; 1517 break;
1400 } 1518 }
1401 if (i == countof (fontweight_map)) /* No matching weight */ 1519 if (i == countof (fontweight_map)) /* No matching weight */
1402 { 1520 {
1403 if (!style) 1521 if (!style)
1404 { 1522 {
1405 logfont.lfWeight = FW_REGULAR; 1523 if (logfont)
1524 logfont->lfWeight = FW_REGULAR;
1406 style = weight; /* May have specified style without weight */ 1525 style = weight; /* May have specified style without weight */
1407 } 1526 }
1408 else 1527 else
1409 { 1528 {
1410 maybe_signal_error (Qinvalid_constant, "Invalid font weight", 1529 maybe_signal_error (Qinvalid_constant, "Invalid font weight",
1411 name_for_errors, Qfont, errb); 1530 name_for_errors, Qfont, errb);
1412 return NULL; 1531 return 0;
1413 } 1532 }
1414 } 1533 }
1415 1534
1416 if (style) 1535 if (style)
1417 { 1536 {
1418 /* #### what about oblique? */ 1537 /* #### what about oblique? */
1419 if (qxestrcasecmp_c (style, "italic") == 0) 1538 if (qxestrcasecmp_c (style, "italic") == 0)
1420 logfont.lfItalic = TRUE; 1539 {
1540 if (logfont)
1541 logfont->lfItalic = TRUE;
1542 }
1421 else 1543 else
1422 { 1544 {
1423 maybe_signal_error (Qinvalid_constant, 1545 maybe_signal_error (Qinvalid_constant,
1424 "Invalid font weight or style", 1546 "Invalid font weight or style",
1425 name_for_errors, Qfont, errb); 1547 name_for_errors, Qfont, errb);
1426 return NULL; 1548 return 0;
1427 } 1549 }
1428 1550
1429 /* Glue weight and style together again */ 1551 /* Glue weight and style together again */
1430 if (weight != style) 1552 if (weight != style)
1431 *c = ' '; 1553 *c = ' ';
1432 } 1554 }
1433 else 1555 else if (logfont)
1434 logfont.lfItalic = FALSE; 1556 logfont->lfItalic = FALSE;
1435 1557
1436 if (fields < 3) 1558 if (fields < 3 || !qxestrcmp_c (points, ""))
1437 pt = 10; /* #### Should we reject strings that don't specify a size? */ 1559 ;
1438 else if ((pt = qxeatoi (points)) == 0) 1560 else if (points[0] == '0' ||
1561 qxestrspn (points, "0123456789") < qxestrlen (points))
1439 { 1562 {
1440 maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", 1563 maybe_signal_error (Qinvalid_argument, "Invalid font pointsize",
1441 name_for_errors, Qfont, errb); 1564 name_for_errors, Qfont, errb);
1442 return NULL; 1565 return 0;
1443 } 1566 }
1444 1567 else
1445 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ 1568 {
1446 logfont.lfHeight = -MulDiv (pt, GetDeviceCaps (hdc, LOGPIXELSY), 72); 1569 pt = qxeatoi (points);
1447 logfont.lfWidth = 0; 1570
1571 if (logfont)
1572 {
1573 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform
1574 SDK */
1575 logfont->lfHeight = -MulDiv (pt, GetDeviceCaps (hdc, LOGPIXELSY),
1576 72);
1577 logfont->lfWidth = 0;
1578 }
1579 }
1448 1580
1449 /* Effects */ 1581 /* Effects */
1450 logfont.lfUnderline = FALSE; 1582 if (logfont)
1451 logfont.lfStrikeOut = FALSE; 1583 {
1584 logfont->lfUnderline = FALSE;
1585 logfont->lfStrikeOut = FALSE;
1586 }
1587
1452 if (fields >= 4 && effects[0] != '\0') 1588 if (fields >= 4 && effects[0] != '\0')
1453 { 1589 {
1454 Ibyte *effects2; 1590 Ibyte *effects2;
1591 int underline = FALSE, strikeout = FALSE;
1455 1592
1456 /* Maybe split effects into effects and effects2 */ 1593 /* Maybe split effects into effects and effects2 */
1457 if ((c = qxestrchr (effects, ' '))) 1594 if ((c = qxestrchr (effects, ' ')))
1458 { 1595 {
1459 *c = '\0'; 1596 *c = '\0';
1461 } 1598 }
1462 else 1599 else
1463 effects2 = NULL; 1600 effects2 = NULL;
1464 1601
1465 if (qxestrcasecmp_c (effects, "underline") == 0) 1602 if (qxestrcasecmp_c (effects, "underline") == 0)
1466 logfont.lfUnderline = TRUE; 1603 underline = TRUE;
1467 else if (qxestrcasecmp_c (effects, "strikeout") == 0) 1604 else if (qxestrcasecmp_c (effects, "strikeout") == 0)
1468 logfont.lfStrikeOut = TRUE; 1605 strikeout = TRUE;
1469 else 1606 else
1470 { 1607 {
1471 maybe_signal_error (Qinvalid_constant, "Invalid font effect", 1608 maybe_signal_error (Qinvalid_constant, "Invalid font effect",
1472 name_for_errors, Qfont, errb); 1609 name_for_errors, Qfont, errb);
1473 return NULL; 1610 return 0;
1474 } 1611 }
1475 1612
1476 if (effects2 && effects2[0] != '\0') 1613 if (effects2 && effects2[0] != '\0')
1477 { 1614 {
1478 if (qxestrcasecmp_c (effects2, "underline") == 0) 1615 if (qxestrcasecmp_c (effects2, "underline") == 0)
1479 logfont.lfUnderline = TRUE; 1616 underline = TRUE;
1480 else if (qxestrcasecmp_c (effects2, "strikeout") == 0) 1617 else if (qxestrcasecmp_c (effects2, "strikeout") == 0)
1481 logfont.lfStrikeOut = TRUE; 1618 strikeout = TRUE;
1482 else 1619 else
1483 { 1620 {
1484 maybe_signal_error (Qinvalid_constant, "Invalid font effect", 1621 maybe_signal_error (Qinvalid_constant, "Invalid font effect",
1485 name_for_errors, Qfont, errb); 1622 name_for_errors, Qfont, errb);
1486 return NULL; 1623 return 0;
1487 } 1624 }
1488 } 1625 }
1489 1626
1490 /* Regenerate sanitised effects string */ 1627 /* Regenerate sanitized effects string */
1491 if (logfont.lfUnderline) 1628 if (underline)
1492 { 1629 {
1493 if (logfont.lfStrikeOut) 1630 if (strikeout)
1494 qxestrcpy_c (effects, "underline strikeout"); 1631 qxestrcpy_c (effects, "underline strikeout");
1495 else 1632 else
1496 qxestrcpy_c (effects, "underline"); 1633 qxestrcpy_c (effects, "underline");
1497 } 1634 }
1498 else if (logfont.lfStrikeOut) 1635 else if (strikeout)
1499 qxestrcpy_c (effects, "strikeout"); 1636 qxestrcpy_c (effects, "strikeout");
1500 } 1637
1501 else 1638 if (logfont)
1502 effects[0] = '\0'; 1639 {
1640 logfont->lfUnderline = underline;
1641 logfont->lfStrikeOut = strikeout;
1642 }
1643 }
1503 1644
1504 /* Charset */ 1645 /* Charset */
1505 /* charset can be specified even if earlier fields haven't been */ 1646 /* charset can be specified even if earlier fields haven't been */
1506 if (fields < 5) 1647 if (fields < 5)
1507 { 1648 {
1509 (c = qxestrchr (c + 1, ':')) && (c = qxestrchr (c + 1, ':'))) 1650 (c = qxestrchr (c + 1, ':')) && (c = qxestrchr (c + 1, ':')))
1510 { 1651 {
1511 qxestrncpy (charset, c + 1, LF_FACESIZE); 1652 qxestrncpy (charset, c + 1, LF_FACESIZE);
1512 charset[LF_FACESIZE - 1] = '\0'; 1653 charset[LF_FACESIZE - 1] = '\0';
1513 } 1654 }
1514 else 1655 }
1515 qxestrcpy_c (charset, charset_map[0].name); 1656
1516 } 1657 /* NOTE: If you give a blank charset spec, we will normally not get here
1517 1658 under Mule unless we explicitly call `make-font-instance'! This is
1518 for (i = 0; i < countof (charset_map); i++) 1659 because the C code instantiates fonts using particular charsets, by
1519 if (!qxestrcasecmp_c (charset, charset_map[i].name)) 1660 way of specifier_matching_instance(). Before instantiating the font,
1520 { 1661 font_instantiate() calls the devmeth find_matching_font(), which gets
1521 logfont.lfCharSet = charset_map[i].value; 1662 a truename font spec with the registry (i.e. the charset spec) filled
1522 break; 1663 in appropriately to the charset. */
1523 } 1664 if (!qxestrcmp_c (charset, ""))
1524 1665 ;
1525 if (i == countof (charset_map)) /* No matching charset */ 1666 else
1526 { 1667 {
1527 maybe_signal_error (Qinvalid_argument, "Invalid charset", 1668 for (i = 0; i < countof (charset_map); i++)
1528 name_for_errors, Qfont, errb); 1669 if (!qxestrcasecmp_c (charset, charset_map[i].name))
1529 return NULL; 1670 {
1530 } 1671 if (logfont)
1531 1672 logfont->lfCharSet = charset_map[i].value;
1532 /* Misc crud */ 1673 break;
1533 logfont.lfEscapement = logfont.lfOrientation = 0; 1674 }
1675
1676 if (i == countof (charset_map)) /* No matching charset */
1677 {
1678 maybe_signal_error (Qinvalid_argument, "Invalid charset",
1679 name_for_errors, Qfont, errb);
1680 return 0;
1681 }
1682 }
1683
1684 if (logfont)
1685 {
1686 /* Misc crud */
1534 #if 1 1687 #if 1
1535 logfont.lfOutPrecision = OUT_DEFAULT_PRECIS; 1688 logfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
1536 logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS; 1689 logfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
1537 logfont.lfQuality = DEFAULT_QUALITY; 1690 logfont->lfQuality = DEFAULT_QUALITY;
1538 #else 1691 #else
1539 logfont.lfOutPrecision = OUT_STROKE_PRECIS; 1692 logfont->lfOutPrecision = OUT_STROKE_PRECIS;
1540 logfont.lfClipPrecision = CLIP_STROKE_PRECIS; 1693 logfont->lfClipPrecision = CLIP_STROKE_PRECIS;
1541 logfont.lfQuality = PROOF_QUALITY; 1694 logfont->lfQuality = PROOF_QUALITY;
1542 #endif 1695 #endif
1543 /* Default to monospaced if the specified fontname doesn't exist. */ 1696 /* Default to monospaced if the specified fontname doesn't exist. */
1544 logfont.lfPitchAndFamily = FF_MODERN; 1697 logfont->lfPitchAndFamily = FF_MODERN;
1545 1698 }
1546 /* Windows will silently substitute a default font if the fontname specifies 1699
1547 a non-existent font. This is bad for screen fonts because it doesn't 1700 return 1;
1548 allow higher-level code to see the error and to act appropriately. 1701 }
1549 For instance complex_vars_of_faces() sets up a fallback list of fonts 1702
1550 for the default face. */ 1703 /*
1704 mswindows fonts look like:
1705 [fontname[:style[:pointsize[:effects]]]][:charset]
1706 A maximal mswindows font spec looks like:
1707 Courier New:Bold Italic:10:underline strikeout:Western
1708
1709 A missing weight/style field is the same as Regular, and a missing
1710 effects field is left alone, and means no effects; but a missing
1711 fontname, pointsize or charset field means any will do. We prefer
1712 Courier New, 10, Western. See sort function above. */
1713
1714 static HFONT
1715 create_hfont_from_font_spec (const Ibyte *namestr,
1716 HDC hdc,
1717 Lisp_Object name_for_errors,
1718 Lisp_Object device_font_list,
1719 Error_Behavior errb,
1720 Lisp_Object *truename_ret)
1721 {
1722 LOGFONTW logfont;
1723 HFONT hfont;
1724 Ibyte fontname[LF_FACESIZE], weight[LF_FACESIZE], points[8];
1725 Ibyte effects[LF_FACESIZE], charset[LF_FACESIZE];
1726 Ibyte truename[MSW_FONTSIZE];
1727 Ibyte truername[MSW_FONTSIZE];
1728
1729 /* Windows will silently substitute a default font if the fontname
1730 specifies a non-existent font. This is bad for screen fonts because
1731 it doesn't allow higher-level code to see the error and to act
1732 appropriately. For instance complex_vars_of_faces() sets up a
1733 fallback list of fonts for the default face. Instead, we look at all
1734 the possibilities and pick one that works, handling missing pointsize
1735 and charset fields appropriately.
1736
1737 For printer fonts, we used to go ahead and let Windows choose the
1738 font, and for those devices, then, DEVICE_FONT_LIST would be nil.
1739 However, this causes problems with the font-matching code below, which
1740 needs a list of fonts so it can pick the right one for Mule.
1741
1742 Thus, the code below to handle a nil DEVICE_FONT_LIST is not currently
1743 used. */
1551 1744
1552 if (!NILP (device_font_list)) 1745 if (!NILP (device_font_list))
1553 { 1746 {
1554 Lisp_Object fonttail; 1747 Lisp_Object fonttail = Qnil;
1555 Ibyte truename[MSW_FONTSIZE]; 1748
1556 1749 if (!parse_font_spec (namestr, 0, name_for_errors,
1557 qxesprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, 1750 errb, 0, fontname, weight, points,
1558 charset); 1751 effects, charset))
1559 LIST_LOOP (fonttail, device_font_list) 1752 return 0;
1753
1754 /* The fonts in the device font list always specify fontname and
1755 charset, but often times not the size; so if we don't have the
1756 size specified either, do a round with size 10 so we'll always end
1757 up with a size in the truename (if we fail this one but succeed
1758 the next one, we'll have chosen a non-TrueType font, and in those
1759 cases the size is specified in the font list item. */
1760
1761 if (!points[0])
1560 { 1762 {
1561 if (match_font (XSTRING_DATA (XCAR (fonttail)), truename, 1763 qxesprintf (truename, "%s:%s:10:%s:%s",
1562 NULL)) 1764 fontname, weight, effects, charset);
1563 break; 1765
1564 } 1766 LIST_LOOP (fonttail, device_font_list)
1767 {
1768 if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))),
1769 truename, truername))
1770 break;
1771 }
1772 }
1773
1774 if (NILP (fonttail))
1775 {
1776 qxesprintf (truename, "%s:%s:%s:%s:%s",
1777 fontname, weight, points, effects, charset);
1778
1779 LIST_LOOP (fonttail, device_font_list)
1780 {
1781 if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))),
1782 truename, truername))
1783 break;
1784 }
1785 }
1786
1565 if (NILP (fonttail)) 1787 if (NILP (fonttail))
1566 { 1788 {
1567 maybe_signal_error (Qinvalid_argument, "No matching font", 1789 maybe_signal_error (Qinvalid_argument, "No matching font",
1568 name_for_errors, Qfont, errb); 1790 name_for_errors, Qfont, errb);
1569 return NULL; 1791 return 0;
1570 } 1792 }
1571 } 1793
1794 if (!parse_font_spec (truername, hdc, name_for_errors,
1795 ERROR_ME_DEBUG_WARN, &logfont, fontname, weight,
1796 points, effects, charset))
1797 signal_error (Qinternal_error, "Bad value in device font list?",
1798 build_intstring (truername));
1799 }
1800 else if (!parse_font_spec (namestr, hdc, name_for_errors,
1801 errb, &logfont, fontname, weight, points,
1802 effects, charset))
1803 return 0;
1572 1804
1573 if ((hfont = qxeCreateFontIndirect (&logfont)) == NULL) 1805 if ((hfont = qxeCreateFontIndirect (&logfont)) == NULL)
1574 { 1806 {
1575 maybe_signal_error (Qgui_error, "Couldn't create font", 1807 maybe_signal_error (Qgui_error, "Couldn't create font",
1576 name_for_errors, Qfont, errb); 1808 name_for_errors, Qfont, errb);
1577 return NULL; 1809 return 0;
1578 } 1810 }
1579 1811
1812 /* #### Truename will not have all its fields filled in when we have no
1813 list of fonts. Doesn't really matter now, since we always have one.
1814 See above. */
1815 qxesprintf (truename, "%s:%s:%s:%s:%s", fontname, weight,
1816 points, effects, charset);
1817
1818 *truename_ret = build_intstring (truename);
1580 return hfont; 1819 return hfont;
1581 } 1820 }
1582
1583 1821
1584 /* 1822 /*
1585 * This is a work horse for both mswindows_initialize_font_instance and 1823 * This is a work horse for both mswindows_initialize_font_instance and
1586 * msprinter_initialize_font_instance. 1824 * msprinter_initialize_font_instance.
1587 */ 1825 */
1591 Error_Behavior errb) 1829 Error_Behavior errb)
1592 { 1830 {
1593 HFONT hfont, hfont2; 1831 HFONT hfont, hfont2;
1594 TEXTMETRICW metrics; 1832 TEXTMETRICW metrics;
1595 Ibyte *namestr = XSTRING_DATA (name); 1833 Ibyte *namestr = XSTRING_DATA (name);
1834 Lisp_Object truename;
1596 1835
1597 hfont = create_hfont_from_font_spec (namestr, hdc, name, device_font_list, 1836 hfont = create_hfont_from_font_spec (namestr, hdc, name, device_font_list,
1598 errb); 1837 errb, &truename);
1838 f->truename = truename;
1599 f->data = xnew_and_zero (struct mswindows_font_instance_data); 1839 f->data = xnew_and_zero (struct mswindows_font_instance_data);
1600 FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0) = hfont; 1840 FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0) = hfont;
1601 1841
1602 /* Some underlined fonts have the descent of one pixel more than their 1842 /* Some underlined fonts have the descent of one pixel more than their
1603 non-underlined counterparts. Font variants though are assumed to have 1843 non-underlined counterparts. Font variants though are assumed to have
1604 identical metrics. So get the font metrics from the underlined variant 1844 identical metrics. So get the font metrics from the underlined variant
1605 of the font */ 1845 of the font */
1698 1938
1699 LIST_LOOP (fonttail, font_list) 1939 LIST_LOOP (fonttail, font_list)
1700 { 1940 {
1701 Ibyte fontname[MSW_FONTSIZE]; 1941 Ibyte fontname[MSW_FONTSIZE];
1702 1942
1703 if (match_font (XSTRING_DATA (XCAR (fonttail)), XSTRING_DATA (pattern), 1943 if (match_font (XSTRING_DATA (XCAR (XCAR (fonttail))),
1944 XSTRING_DATA (pattern),
1704 fontname)) 1945 fontname))
1705 result = Fcons (build_intstring (fontname), result); 1946 result = Fcons (build_intstring (fontname), result);
1706 } 1947 }
1707 1948
1708 return Fnreverse (result); 1949 return Fnreverse (result);
1709 } 1950 }
1710 1951
1711 /* Fill in missing parts of a font spec. This is primarily intended as a
1712 * helper function for the functions below.
1713 * mswindows fonts look like:
1714 * fontname[:[weight][ style][:pointsize[:effects]]][:charset]
1715 * A minimal mswindows font spec looks like:
1716 * Courier New
1717 * A maximal mswindows font spec looks like:
1718 * Courier New:Bold Italic:10:underline strikeout:Western
1719 * Missing parts of the font spec should be filled in with these values:
1720 * Courier New:Regular:10::Western */
1721 static Lisp_Object 1952 static Lisp_Object
1722 mswindows_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) 1953 mswindows_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb)
1723 { 1954 {
1724 /* #### does not handle charset at end!!! charset can be given even 1955 return f->truename;
1725 when previous fields are not.
1726
1727 #### does not canonicalize given fields! needs to be merged
1728 with initialize_font_instance(). */
1729
1730 int nsep = 0;
1731 Ibyte *ptr = (Ibyte *) XSTRING_DATA (f->name);
1732 Ibyte *name = (Ibyte *) ALLOCA (XSTRING_LENGTH (f->name) + 19);
1733
1734 qxestrcpy (name, ptr);
1735
1736 while ((ptr = qxestrchr (ptr, ':')) != 0)
1737 {
1738 ptr++;
1739 nsep++;
1740 }
1741
1742 switch (nsep)
1743 {
1744 case 0:
1745 qxestrcat_c (name, ":Regular:10::Western");
1746 break;
1747 case 1:
1748 qxestrcat_c (name, ":10::Western");
1749 break;
1750 case 2:
1751 qxestrcat_c (name, "::Western");
1752 break;
1753 case 3:
1754 qxestrcat_c (name, ":Western");
1755 break;
1756 default:;
1757 }
1758
1759 return build_intstring (name);
1760 } 1956 }
1761 1957
1762 #ifdef MULE 1958 #ifdef MULE
1763 1959
1764 static int 1960 static int
1765 mswindows_font_spec_matches_charset_stage_1 (const Ibyte *font_charset, 1961 mswindows_font_spec_matches_charset_stage_1 (struct device *d,
1766 Lisp_Object charset) 1962 Lisp_Object charset,
1767 { 1963 const Ibyte *nonreloc,
1768 int i, ms_charset = 0; 1964 Lisp_Object reloc,
1769 CHARSETINFO info; 1965 Bytecount offset,
1770 int font_code_page; 1966 Bytecount length)
1771 Lisp_Object charset_code_page; 1967 {
1772 1968 int i;
1773 /* Get code page from the font spec */ 1969 Lisp_Object charset_registry;
1774 1970 const Ibyte *font_charset;
1775 for (i = 0; i < countof (charset_map); i++)
1776 if (qxestrcasecmp_c (font_charset, charset_map[i].name) == 0)
1777 {
1778 ms_charset = charset_map[i].value;
1779 break;
1780 }
1781 if (i == countof (charset_map))
1782 return 0;
1783
1784 /* For border-glyph use */
1785 if (ms_charset == SYMBOL_CHARSET)
1786 ms_charset = ANSI_CHARSET;
1787
1788 if (!TranslateCharsetInfo ((DWORD *) ms_charset, &info, TCI_SRCCHARSET))
1789 return 0;
1790
1791 font_code_page = info.ciACP;
1792
1793 /* Get code page for the charset */
1794 charset_code_page = Fmswindows_charset_code_page (charset);
1795 if (!INTP (charset_code_page))
1796 return 0;
1797
1798 return font_code_page == XINT (charset_code_page);
1799 }
1800
1801 static int
1802 mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset,
1803 const Ibyte *nonreloc,
1804 Lisp_Object reloc,
1805 Bytecount offset, Bytecount length)
1806 {
1807 const Ibyte *the_nonreloc = nonreloc; 1971 const Ibyte *the_nonreloc = nonreloc;
1808 int i;
1809 const Ibyte *c; 1972 const Ibyte *c;
1810 Bytecount the_length = length; 1973 Bytecount the_length = length;
1811
1812 /* The idea is that, when trying to find a suitable font for a character,
1813 we first see if the character comes from one of the known charsets
1814 listed above; if so, we try to find a font which is declared as being of
1815 that charset (that's the last element of the font spec). If so, this
1816 means that the font is specifically designed for the charset, and we
1817 prefer it. However, there are only a limited number of defined
1818 charsets, and new ones aren't being defined; so if we fail the first
1819 stage, we search through each font looking at the Unicode subranges it
1820 supports, to see if the character comes from that subrange.
1821 */
1822 1974
1823 if (UNBOUNDP (charset)) 1975 if (UNBOUNDP (charset))
1824 return 1; 1976 return 1;
1825 1977
1826 if (!the_nonreloc) 1978 if (!the_nonreloc)
1837 newc++; 1989 newc++;
1838 the_length -= (newc - c); 1990 the_length -= (newc - c);
1839 c = newc; 1991 c = newc;
1840 } 1992 }
1841 1993
1842 if (i >= 4 && mswindows_font_spec_matches_charset_stage_1 (c, charset)) 1994 if (i < 4)
1995 return 0;
1996
1997 font_charset = c;
1998
1999 /* For border-glyph use */
2000 if (!qxestrcasecmp_c (font_charset, "symbol"))
2001 font_charset = (const Ibyte *) "western";
2002
2003 /* Get code page for the charset */
2004 charset_registry = Fmswindows_charset_registry (charset);
2005 if (!STRINGP (charset_registry))
2006 return 0;
2007
2008 return !qxestrcasecmp (XSTRING_DATA (charset_registry), font_charset);
2009 }
2010
2011 /*
2012
2013 1. handle standard mapping and inheritance vectors properly in Face-frob-property.
2014 2. finish impl of mswindows-charset-registry.
2015 3. see if everything works under fixup, now that i copied the stuff over.
2016 4. consider generalizing Face-frob-property to frob-specifier.
2017 5. maybe extract some of the flets out of Face-frob-property as useful specifier frobbing.
2018 6. eventually this stuff's got to be checked in!!!!
2019 */
2020
2021 static int
2022 mswindows_font_spec_matches_charset_stage_2 (struct device *d,
2023 Lisp_Object charset,
2024 const Ibyte *nonreloc,
2025 Lisp_Object reloc,
2026 Bytecount offset,
2027 Bytecount length)
2028 {
2029 const Ibyte *the_nonreloc = nonreloc;
2030 FONTSIGNATURE fs;
2031 FONTSIGNATURE *fsp = &fs;
2032 struct gcpro gcpro1;
2033 Lisp_Object fontsig;
2034 Bytecount the_length = length;
2035 int i;
2036
2037 if (UNBOUNDP (charset))
1843 return 1; 2038 return 1;
1844 2039
1845 /* Stage 2. */ 2040 if (!the_nonreloc)
2041 the_nonreloc = XSTRING_DATA (reloc);
2042 fixup_internal_substring (nonreloc, reloc, offset, &the_length);
2043 the_nonreloc += offset;
2044
2045 /* Get the list of Unicode subranges corresponding to the font. This
2046 is contained inside of FONTSIGNATURE data, obtained by calling
2047 GetTextCharsetInfo on a font object, which we need to create from the
2048 spec. See if the FONTSIGNATURE data is already cached. If not, get
2049 it and cache it. */
2050 if (!STRINGP (reloc) || the_nonreloc != XSTRING_DATA (reloc))
2051 reloc = build_intstring (the_nonreloc);
2052 GCPRO1 (reloc);
2053 fontsig = Fgethash (reloc, Vfont_signature_data, Qunbound);
2054
2055 if (!UNBOUNDP (fontsig))
2056 {
2057 fsp = (FONTSIGNATURE *) XOPAQUE_DATA (fontsig);
2058 UNGCPRO;
2059 }
2060 else
2061 {
2062 HDC hdc = CreateCompatibleDC (NULL);
2063 Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (d);
2064 Lisp_Object truename;
2065 HFONT hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil,
2066 font_list,
2067 ERROR_ME_DEBUG_WARN,
2068 &truename);
2069
2070 if (!hfont || !(hfont = (HFONT) SelectObject (hdc, hfont)))
2071 {
2072 nope:
2073 DeleteDC (hdc);
2074 UNGCPRO;
2075 return 0;
2076 }
2077
2078 if (GetTextCharsetInfo (hdc, &fs, 0) == DEFAULT_CHARSET)
2079 {
2080 SelectObject (hdc, hfont);
2081 goto nope;
2082 }
2083 SelectObject (hdc, hfont);
2084 DeleteDC (hdc);
2085 Fputhash (reloc, make_opaque (&fs, sizeof (fs)), Vfont_signature_data);
2086 UNGCPRO;
2087 }
2088
1846 { 2089 {
1847 FONTSIGNATURE fs; 2090 int lowlim, highlim;
1848 FONTSIGNATURE *fsp = &fs; 2091 int dim, j, cp = -1;
1849 struct gcpro gcpro1; 2092
1850 Lisp_Object fontsig; 2093 /* Try to find a Unicode char in the charset. #### This is somewhat
1851 2094 bogus. See below.
1852 /* Get the list of Unicode subranges corresponding to the font. This 2095
1853 is contained inside of FONTSIGNATURE data, obtained by calling 2096 #### Cache me baby!!!!!!!!!!!!!
1854 GetTextCharsetInfo on a font object, which we need to create from the 2097 */
1855 spec. See if the FONTSIGNATURE data is already cached. If not, get 2098 get_charset_limits (charset, &lowlim, &highlim);
1856 it and cache it. */ 2099 dim = XCHARSET_DIMENSION (charset);
1857 if (!STRINGP (reloc) || the_nonreloc != XSTRING_DATA (reloc)) 2100
1858 reloc = build_intstring (the_nonreloc); 2101 if (dim == 1)
1859 GCPRO1 (reloc);
1860 fontsig = Fgethash (reloc, Vfont_signature_data, Qunbound);
1861
1862 if (!UNBOUNDP (fontsig))
1863 { 2102 {
1864 fsp = (FONTSIGNATURE *) XOPAQUE_DATA (fontsig); 2103 for (i = lowlim; i <= highlim; i++)
1865 UNGCPRO; 2104 if ((cp = ichar_to_unicode (make_ichar (charset, i, 0))) >= 0)
2105 break;
1866 } 2106 }
1867 else 2107 else
1868 { 2108 {
1869 HDC hdc = CreateCompatibleDC (NULL); 2109 for (i = lowlim; i <= highlim; i++)
1870 Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (d); 2110 for (j = lowlim; j <= highlim; j++)
1871 HFONT hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil, 2111 if ((cp = ichar_to_unicode (make_ichar (charset, i, j))) >= 0)
1872 font_list, 2112 break;
1873 ERROR_ME_DEBUG_WARN); 2113 }
1874 2114
1875 if (!hfont || !(hfont = (HFONT) SelectObject (hdc, hfont))) 2115 if (cp < 0)
2116 return 0;
2117
2118 /* Check to see, for each subrange supported by the font,
2119 whether the Unicode char is within that subrange. If any match,
2120 the font supports the char (whereby, the charset, bogusly). */
2121
2122 for (i = 0; i < 128; i++)
2123 {
2124 if (fsp->fsUsb[i >> 5] & (1 << (i & 32)))
1876 { 2125 {
1877 nope: 2126 for (j = 0; j < unicode_subrange_table[i].no_subranges; j++)
1878 DeleteDC (hdc); 2127 if (cp >= unicode_subrange_table[i].subranges[j].start &&
1879 UNGCPRO; 2128 cp <= unicode_subrange_table[i].subranges[j].end)
1880 return 0; 2129 return 1;
1881 } 2130 }
1882
1883 if (GetTextCharsetInfo (hdc, &fs, 0) == DEFAULT_CHARSET)
1884 {
1885 SelectObject (hdc, hfont);
1886 goto nope;
1887 }
1888 SelectObject (hdc, hfont);
1889 DeleteDC (hdc);
1890 Fputhash (reloc, make_opaque (&fs, sizeof (fs)), Vfont_signature_data);
1891 UNGCPRO;
1892 } 2131 }
1893 2132
1894 { 2133 return 0;
1895 int lowlim, highlim;
1896 int dim, j, cp = -1;
1897
1898 /* Try to find a Unicode char in the charset. #### This is somewhat
1899 bogus. We should really be doing these checks on the char level,
1900 not the charset level. There's no guarantee that a charset covers
1901 a single Unicode range. Furthermore, this is extremely wasteful.
1902 We should be doing this when we're about to redisplay and already
1903 have the Unicode codepoints in hand.
1904
1905 #### Cache me baby!!!!!!!!!!!!!
1906 */
1907 get_charset_limits (charset, &lowlim, &highlim);
1908 dim = XCHARSET_DIMENSION (charset);
1909
1910 if (dim == 1)
1911 {
1912 for (i = lowlim; i <= highlim; i++)
1913 if ((cp = ichar_to_unicode (make_ichar (charset, i, 0))) >= 0)
1914 break;
1915 }
1916 else
1917 {
1918 for (i = lowlim; i <= highlim; i++)
1919 for (j = lowlim; j <= highlim; j++)
1920 if ((cp = ichar_to_unicode (make_ichar (charset, i, j))) >= 0)
1921 break;
1922 }
1923
1924 if (cp < 0)
1925 return 0;
1926
1927 /* Check to see, for each subrange supported by the font,
1928 whether the Unicode char is within that subrange. If any match,
1929 the font supports the char (whereby, the charset, bogusly). */
1930
1931 for (i = 0; i < 128; i++)
1932 {
1933 if (fsp->fsUsb[i >> 5] & (1 << (i & 32)))
1934 {
1935 for (j = 0; j < unicode_subrange_table[i].no_subranges; j++)
1936 if (cp >= unicode_subrange_table[i].subranges[j].start &&
1937 cp <= unicode_subrange_table[i].subranges[j].end)
1938 return 1;
1939 }
1940 }
1941
1942 return 0;
1943 }
1944 } 2134 }
1945 } 2135 }
1946 2136
1947 /* find a font spec that matches font spec FONT and also matches 2137 /*
2138 Given a truename font spec, does it match CHARSET?
2139
2140 We try two stages:
2141
2142 -- First see if the charset corresponds to one of the predefined Windows
2143 charsets; if so, we see if the registry (that's the last element of the
2144 font spec) is that same charset. If so, this means that the font is
2145 specifically designed for the charset, and we prefer it.
2146
2147 -- However, there are only a limited number of defined Windows charsets,
2148 and new ones aren't being defined; so if we fail the first stage, we find
2149 a character from the charset with a Unicode equivalent, and see if the
2150 font can display this character. we do that by retrieving the Unicode
2151 ranges that the font supports, to see if the character comes from that
2152 subrange.
2153
2154 #### Note: We really want to be doing all these checks at the character
2155 level, not the charset level. There's no guarantee that a charset covers
2156 a single Unicode range. Furthermore, this is extremely wasteful. We
2157 should be doing this when we're about to redisplay and already have the
2158 Unicode codepoints in hand.
2159 */
2160
2161 static int
2162 mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset,
2163 const Ibyte *nonreloc,
2164 Lisp_Object reloc,
2165 Bytecount offset, Bytecount length,
2166 int stage)
2167 {
2168 return stage ?
2169 mswindows_font_spec_matches_charset_stage_2 (d, charset, nonreloc,
2170 reloc, offset, length)
2171 : mswindows_font_spec_matches_charset_stage_1 (d, charset, nonreloc,
2172 reloc, offset, length);
2173 }
2174
2175
2176 /* Find a font spec that matches font spec FONT and also matches
1948 (the registry of) CHARSET. */ 2177 (the registry of) CHARSET. */
2178
1949 static Lisp_Object 2179 static Lisp_Object
1950 mswindows_find_charset_font (Lisp_Object device, Lisp_Object font, 2180 mswindows_find_charset_font (Lisp_Object device, Lisp_Object font,
1951 Lisp_Object charset) 2181 Lisp_Object charset, int stage)
1952 { 2182 {
1953 Lisp_Object fontlist, fonttail; 2183 Lisp_Object fontlist, fonttail;
1954 2184
2185 /* If FONT specifies a particular charset, this will only list fonts with
2186 that charset; otherwise, it will list fonts with all charsets. */
1955 fontlist = mswindows_list_fonts (font, device); 2187 fontlist = mswindows_list_fonts (font, device);
1956 LIST_LOOP (fonttail, fontlist) 2188
1957 { 2189 if (!stage)
1958 if (mswindows_font_spec_matches_charset 2190 {
1959 (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1)) 2191 LIST_LOOP (fonttail, fontlist)
1960 return XCAR (fonttail); 2192 {
1961 } 2193 if (mswindows_font_spec_matches_charset_stage_1
2194 (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1))
2195 return XCAR (fonttail);
2196 }
2197 }
2198 else
2199 {
2200 LIST_LOOP (fonttail, fontlist)
2201 {
2202 if (mswindows_font_spec_matches_charset_stage_2
2203 (XDEVICE (device), charset, 0, XCAR (fonttail), 0, -1))
2204 return XCAR (fonttail);
2205 }
2206 }
2207
1962 return Qnil; 2208 return Qnil;
1963 } 2209 }
1964 2210
1965 #endif /* MULE */ 2211 #endif /* MULE */
1966 2212