Mercurial > hg > xemacs-beta

comparison src/faces.c @ 3659:98af8a976fc3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-11-05 22:31:31 by aidan] Support specifying fonts for particular character sets in Mule; support translation to ISO 10646-1 for Mule character sets without an otherwise matching font; move to a vector of X11-charset-X11-registry instead of a regex for the charset-registry property.
author aidan
date Sun, 05 Nov 2006 22:31:46 +0000
parents ad2f4ae9895b
children 3ef0aaf3dc34
comparison
equal deleted inserted replaced
3658:0db1aaedbbef 3659:98af8a976fc3
70 Lisp_Object Vtemporary_faces_cache; 70 Lisp_Object Vtemporary_faces_cache;
71 71
72 Lisp_Object Vbuilt_in_face_specifiers; 72 Lisp_Object Vbuilt_in_face_specifiers;
73 73
74 74
75 #ifdef DEBUG_XEMACS
76 Fixnum debug_x_faces;
77 #endif
78
79 #if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901)
80
81 #ifdef DEBUG_XEMACS
82 # define DEBUG_FACES(FORMAT, ...) \
83 do { if (debug_x_faces) stderr_out(FORMAT, __VA_ARGS__); } while (0)
84 #else /* DEBUG_XEMACS */
85 # define DEBUG_FACES(format, ...)
86 #endif /* DEBUG_XEMACS */
87
88 #elif defined(__GNUC__)
89
90 #ifdef DEBUG_XEMACS
91 # define DEBUG_FACES(format, args...) \
92 do { if (debug_x_faces) stderr_out(format, args ); } while (0)
93 #else /* DEBUG_XEMACS */
94 # define DEBUG_FACES(format, args...)
95 #endif /* DEBUG_XEMACS */
96
97 #else /* defined(__STDC_VERSION__) [...] */
98 # define DEBUG_FACES (void)
99 #endif
75 100
76 static Lisp_Object 101 static Lisp_Object
77 mark_face (Lisp_Object obj) 102 mark_face (Lisp_Object obj)
78 { 103 {
79 Lisp_Face *face = XFACE (obj); 104 Lisp_Face *face = XFACE (obj);
552 577
553 Lisp_Object 578 Lisp_Object
554 face_property_matching_instance (Lisp_Object face, Lisp_Object property, 579 face_property_matching_instance (Lisp_Object face, Lisp_Object property,
555 Lisp_Object charset, Lisp_Object domain, 580 Lisp_Object charset, Lisp_Object domain,
556 Error_Behavior errb, int no_fallback, 581 Error_Behavior errb, int no_fallback,
557 Lisp_Object depth) 582 Lisp_Object depth,
583 enum font_specifier_matchspec_stages stage)
558 { 584 {
559 Lisp_Object retval; 585 Lisp_Object retval;
560 Lisp_Object matchspec = Qunbound; 586 Lisp_Object matchspec = Qunbound;
561 struct gcpro gcpro1; 587 struct gcpro gcpro1;
562 588
563 if (!NILP (charset)) 589 if (!NILP (charset))
564 matchspec = noseeum_cons (charset, Qnil); 590 matchspec = noseeum_cons (charset,
591 stage == initial ? Qinitial : Qfinal);
592
565 GCPRO1 (matchspec); 593 GCPRO1 (matchspec);
566 retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec, 594 retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec,
567 domain, errb, no_fallback, depth); 595 domain, errb, no_fallback, depth);
568 if (UNBOUNDP (retval))
569 {
570 if (CONSP (matchspec))
571 Fsetcdr (matchspec, Qt);
572 retval = specifier_instance_no_quit (Fget (face, property, Qnil),
573 matchspec, domain, errb,
574 no_fallback, depth);
575 }
576 UNGCPRO; 596 UNGCPRO;
577 if (CONSP (matchspec)) 597 if (CONSP (matchspec))
578 free_cons (matchspec); 598 free_cons (matchspec);
579 599
580 if (UNBOUNDP (retval) && !no_fallback) 600 if (UNBOUNDP (retval) && !no_fallback && final == stage)
581 { 601 {
582 if (EQ (property, Qfont)) 602 if (EQ (property, Qfont))
583 { 603 {
584 if (NILP (memq_no_quit (charset, 604 if (NILP (memq_no_quit (charset,
585 XFACE (face)->charsets_warned_about))) 605 XFACE (face)->charsets_warned_about)))
586 { 606 {
587 #ifdef MULE
588 if (!UNBOUNDP (charset)) 607 if (!UNBOUNDP (charset))
589 warn_when_safe 608 warn_when_safe
590 (Qfont, Qnotice, 609 (Qfont, Qnotice,
591 "Unable to instantiate font for charset %s, face %s", 610 "Unable to instantiate font for charset %s, face %s",
592 XSTRING_DATA (symbol_name 611 XSTRING_DATA (symbol_name
593 (XSYMBOL (XCHARSET_NAME (charset)))), 612 (XSYMBOL (XCHARSET_NAME (charset)))),
594 XSTRING_DATA (symbol_name 613 XSTRING_DATA (symbol_name
595 (XSYMBOL (XFACE (face)->name)))); 614 (XSYMBOL (XFACE (face)->name))));
596 else
597 #endif
598 warn_when_safe (Qfont, Qnotice,
599 "Unable to instantiate font for face %s",
600 XSTRING_DATA (symbol_name
601 (XSYMBOL (XFACE (face)->name))));
602 XFACE (face)->charsets_warned_about = 615 XFACE (face)->charsets_warned_about =
603 Fcons (charset, XFACE (face)->charsets_warned_about); 616 Fcons (charset, XFACE (face)->charsets_warned_about);
604 } 617 }
605 retval = Vthe_null_font_instance; 618 retval = Vthe_null_font_instance;
606 } 619 }
1069 ensure_face_cachel_contains_charset (struct face_cachel *cachel, 1082 ensure_face_cachel_contains_charset (struct face_cachel *cachel,
1070 Lisp_Object domain, Lisp_Object charset) 1083 Lisp_Object domain, Lisp_Object charset)
1071 { 1084 {
1072 Lisp_Object new_val; 1085 Lisp_Object new_val;
1073 Lisp_Object face = cachel->face; 1086 Lisp_Object face = cachel->face;
1074 int bound = 1; 1087 int bound = 1, final_stage = 0;
1075 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; 1088 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1076 1089
1077 if (!UNBOUNDP (cachel->font[offs]) 1090 if (!UNBOUNDP (cachel->font[offs]) &&
1078 && cachel->font_updated[offs]) 1091 bit_vector_bit(FACE_CACHEL_FONT_UPDATED (cachel), offs))
1079 return cachel->font[offs]; 1092 return cachel->font[offs];
1080 1093
1081 if (UNBOUNDP (face)) 1094 if (UNBOUNDP (face))
1082 { 1095 {
1083 /* a merged face. */ 1096 /* a merged face. */
1084 int i; 1097 int i;
1085 struct window *w = XWINDOW (domain); 1098 struct window *w = XWINDOW (domain);
1086 1099
1087 new_val = Qunbound; 1100 new_val = Qunbound;
1088 cachel->font_specified[offs] = 0; 1101 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 0);
1102
1089 for (i = 0; i < cachel->nfaces; i++) 1103 for (i = 0; i < cachel->nfaces; i++)
1090 { 1104 {
1091 struct face_cachel *oth; 1105 struct face_cachel *oth;
1092 1106
1093 oth = Dynarr_atp (w->face_cachels, 1107 oth = Dynarr_atp (w->face_cachels,
1094 FACE_CACHEL_FINDEX_UNSAFE (cachel, i)); 1108 FACE_CACHEL_FINDEX_UNSAFE (cachel, i));
1095 /* Tout le monde aime la recursion */ 1109 /* Tout le monde aime la recursion */
1096 ensure_face_cachel_contains_charset (oth, domain, charset); 1110 ensure_face_cachel_contains_charset (oth, domain, charset);
1097 1111
1098 if (oth->font_specified[offs]) 1112 if (bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(oth), offs))
1099 { 1113 {
1100 new_val = oth->font[offs]; 1114 new_val = oth->font[offs];
1101 cachel->font_specified[offs] = 1; 1115 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1);
1116 set_bit_vector_bit
1117 (FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs,
1118 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(oth), offs));
1102 break; 1119 break;
1103 } 1120 }
1104 } 1121 }
1105 1122
1106 if (!cachel->font_specified[offs]) 1123 if (!bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs))
1107 /* need to do the default face. */ 1124 /* need to do the default face. */
1108 { 1125 {
1109 struct face_cachel *oth = 1126 struct face_cachel *oth =
1110 Dynarr_atp (w->face_cachels, DEFAULT_INDEX); 1127 Dynarr_atp (w->face_cachels, DEFAULT_INDEX);
1111 ensure_face_cachel_contains_charset (oth, domain, charset); 1128 ensure_face_cachel_contains_charset (oth, domain, charset);
1112 1129
1113 new_val = oth->font[offs]; 1130 new_val = oth->font[offs];
1114 } 1131 }
1115 1132
1116 if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val)) 1133 if (!UNBOUNDP (cachel->font[offs]) &&
1134 !EQ (cachel->font[offs], new_val))
1117 cachel->dirty = 1; 1135 cachel->dirty = 1;
1118 cachel->font_updated[offs] = 1; 1136 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1);
1119 cachel->font[offs] = new_val; 1137 cachel->font[offs] = new_val;
1138 DEBUG_FACES("just recursed on the unbound face, returning "
1139 "something %s\n", UNBOUNDP(new_val) ? "not bound"
1140 : "bound");
1120 return new_val; 1141 return new_val;
1121 } 1142 }
1122 1143
1123 new_val = face_property_matching_instance (face, Qfont, charset, domain, 1144 do {
1124 /* #### look into error flag */ 1145
1125 ERROR_ME_DEBUG_WARN, 1, Qzero); 1146 /* Lookup the face, specifying the initial stage and that fallbacks
1126 if (UNBOUNDP (new_val)) 1147 shouldn't happen. */
1127 { 1148 new_val = face_property_matching_instance (face, Qfont, charset, domain,
1128 bound = 0; 1149 /* ERROR_ME_DEBUG_WARN is
1129 new_val = face_property_matching_instance (face, Qfont, 1150 fine here. */
1130 charset, domain, 1151 ERROR_ME_DEBUG_WARN, 1, Qzero,
1131 /* #### look into error 1152 initial);
1132 flag */ 1153 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
1133 ERROR_ME_DEBUG_WARN, 0, 1154 "result was something %s\n",
1134 Qzero); 1155 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
1135 } 1156 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
1157 UNBOUNDP(new_val) ? "not bound" : "bound");
1158
1159 if (!UNBOUNDP (new_val)) break;
1160
1161 bound = 0;
1162 /* Lookup the face again, this time allowing the fallback. If this
1163 succeeds, it'll give a font intended for the script in question,
1164 which is preferable to translating to ISO10646-1 and using the
1165 fixed-with fallback. */
1166 new_val = face_property_matching_instance (face, Qfont,
1167 charset, domain,
1168 ERROR_ME_DEBUG_WARN, 0,
1169 Qzero,
1170 initial);
1171
1172 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
1173 "allow fallback, result was something %s\n",
1174 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
1175 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
1176 UNBOUNDP(new_val) ? "not bound" : "bound");
1177
1178 if (!UNBOUNDP(new_val))
1179 {
1180 break;
1181 }
1182
1183 bound = 1;
1184 /* Try the face itself with the final-stage specifiers. */
1185 new_val = face_property_matching_instance (face, Qfont,
1186 charset, domain,
1187 ERROR_ME_DEBUG_WARN, 1,
1188 Qzero,
1189 final);
1190
1191 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, "
1192 "result was something %s\n",
1193 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
1194 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
1195 UNBOUNDP(new_val) ? "not bound" : "bound");
1196 /* Tell X11 redisplay that it should translate to iso10646-1. */
1197 if (!UNBOUNDP(new_val))
1198 {
1199 final_stage = 1;
1200 break;
1201 }
1202
1203 bound = 0;
1204
1205 /* Lookup the face again, this time both allowing the fallback and
1206 allowing its final stage to be used. */
1207 new_val = face_property_matching_instance (face, Qfont,
1208 charset, domain,
1209 ERROR_ME_DEBUG_WARN, 0,
1210 Qzero,
1211 final);
1212
1213 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
1214 "allow fallback, result was something %s\n",
1215 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
1216 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
1217 UNBOUNDP(new_val) ? "not bound" : "bound");
1218 if (!UNBOUNDP(new_val))
1219 {
1220 /* Tell X11 redisplay that it should translate to iso10646-1. */
1221 final_stage = 1;
1222 break;
1223 }
1224 } while (0);
1225
1136 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs])) 1226 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
1137 cachel->dirty = 1; 1227 cachel->dirty = 1;
1138 cachel->font_updated[offs] = 1; 1228
1229 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1);
1230 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs,
1231 final_stage);
1232 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs,
1233 (bound || EQ (face, Vdefault_face)));
1139 cachel->font[offs] = new_val; 1234 cachel->font[offs] = new_val;
1140 cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
1141 return new_val; 1235 return new_val;
1142 } 1236 }
1143 1237
1144 /* Ensure that the given cachel contains updated fonts for all 1238 /* Ensure that the given cachel contains updated fonts for all
1145 the charsets specified. */ 1239 the charsets specified. */
1370 1464
1371 static void 1465 static void
1372 merge_face_cachel_data (struct window *w, face_index findex, 1466 merge_face_cachel_data (struct window *w, face_index findex,
1373 struct face_cachel *cachel) 1467 struct face_cachel *cachel)
1374 { 1468 {
1469 int offs;
1470
1375 #define FINDEX_FIELD(field) \ 1471 #define FINDEX_FIELD(field) \
1376 Dynarr_atp (w->face_cachels, findex)->field 1472 Dynarr_atp (w->face_cachels, findex)->field
1377 1473
1378 #define FROB(field) \ 1474 #define FROB(field) \
1379 do { \ 1475 do { \
1393 FROB (strikethru); 1489 FROB (strikethru);
1394 FROB (highlight); 1490 FROB (highlight);
1395 FROB (dim); 1491 FROB (dim);
1396 FROB (reverse); 1492 FROB (reverse);
1397 FROB (blinking); 1493 FROB (blinking);
1398 /* And do ASCII, of course. */ 1494
1399 { 1495 for (offs = 0; offs < NUM_LEADING_BYTES; ++offs)
1400 int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE; 1496 {
1401 1497 if (!(bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs))
1402 if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs])) 1498 && bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED
1403 { 1499 (Dynarr_atp(w->face_cachels, findex)), offs))
1404 cachel->font[offs] = FINDEX_FIELD (font[offs]); 1500 {
1405 cachel->font_specified[offs] = 1; 1501 cachel->font[offs] = FINDEX_FIELD (font[offs]);
1406 cachel->dirty = 1; 1502 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1);
1407 } 1503 /* Also propagate whether we're translating to Unicode for the
1408 } 1504 given face. */
1409 1505 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs,
1506 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE
1507 (Dynarr_atp(w->face_cachels,
1508 findex)), offs));
1509 cachel->dirty = 1;
1510 }
1511 }
1410 #undef FROB 1512 #undef FROB
1411 #undef FINDEX_FIELD 1513 #undef FINDEX_FIELD
1412 1514
1413 cachel->updated = 1; 1515 cachel->updated = 1;
1414 } 1516 }
1431 for (i = 0; i < NUM_LEADING_BYTES; i++) 1533 for (i = 0; i < NUM_LEADING_BYTES; i++)
1432 cachel->font[i] = Qunbound; 1534 cachel->font[i] = Qunbound;
1433 } 1535 }
1434 cachel->display_table = Qunbound; 1536 cachel->display_table = Qunbound;
1435 cachel->background_pixmap = Qunbound; 1537 cachel->background_pixmap = Qunbound;
1538 FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified);
1539 FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated);
1436 } 1540 }
1437 1541
1438 /* Retrieve the index to a cachel for window W that corresponds to 1542 /* Retrieve the index to a cachel for window W that corresponds to
1439 the specified face. If necessary, add a new element to the 1543 the specified face. If necessary, add a new element to the
1440 cache. */ 1544 cache. */
1503 int elt; 1607 int elt;
1504 1608
1505 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) 1609 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
1506 { 1610 {
1507 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt); 1611 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
1508 int i;
1509 1612
1510 cachel->updated = 0; 1613 cachel->updated = 0;
1511 for (i = 0; i < NUM_LEADING_BYTES; i++) 1614 memset(FACE_CACHEL_FONT_UPDATED(cachel)->bits, 0,
1512 cachel->font_updated[i] = 0; 1615 BIT_VECTOR_LONG_STORAGE (NUM_LEADING_BYTES));
1513 } 1616 }
1514 } 1617 }
1515 1618
1516 #ifdef MEMORY_USAGE_STATS 1619 #ifdef MEMORY_USAGE_STATS
1517 1620
1894 UNGCPRO; 1997 UNGCPRO;
1895 1998
1896 return new_name; 1999 return new_name;
1897 } 2000 }
1898 2001
2002 #ifdef MULE
2003
2004 Lisp_Object Qone_dimensional, Qtwo_dimensional;
2005
2006 DEFUN ("specifier-tag-one-dimensional-p",
2007 Fspecifier_tag_one_dimensional_p,
2008 2, 2, 0, /*
2009 Return non-nil if (charset-dimension CHARSET) is 1.
2010
2011 Used by the X11 platform font code; see `define-specifier-tag'. You
2012 shouldn't ever need to call this yourself.
2013 */
2014 (charset, UNUSED(stage)))
2015 {
2016 CHECK_CHARSET(charset);
2017 return (1 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil;
2018 }
2019
2020 DEFUN ("specifier-tag-two-dimensional-p",
2021 Fspecifier_tag_two_dimensional_p,
2022 2, 2, 0, /*
2023 Return non-nil if (charset-dimension CHARSET) is 2.
2024
2025 Used by the X11 platform font code; see `define-specifier-tag'. You
2026 shouldn't ever need to call this yourself.
2027 */
2028 (charset, UNUSED(stage)))
2029 {
2030 CHECK_CHARSET(charset);
2031 return (2 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil;
2032 }
2033
2034 DEFUN ("specifier-tag-final-stage-p",
2035 Fspecifier_tag_final_stage_p,
2036 2, 2, 0, /*
2037 Return non-nil if STAGE is 'final.
2038
2039 Used by the X11 platform font code for giving fallbacks; see
2040 `define-specifier-tag'. You shouldn't ever need to call this.
2041 */
2042 (UNUSED(charset), stage))
2043 {
2044 return EQ(stage, Qfinal) ? Qt : Qnil;
2045 }
2046
2047 DEFUN ("specifier-tag-initial-stage-p",
2048 Fspecifier_tag_initial_stage_p,
2049 2, 2, 0, /*
2050 Return non-nil if STAGE is 'initial.
2051
2052 Used by the X11 platform font code for giving fallbacks; see
2053 `define-specifier-tag'. You shouldn't ever need to call this.
2054 */
2055 (UNUSED(charset), stage))
2056 {
2057 return EQ(stage, Qinitial) ? Qt : Qnil;
2058 }
2059
2060 DEFUN ("specifier-tag-encode-as-utf-8-p",
2061 Fspecifier_tag_encode_as_utf_8_p,
2062 2, 2, 0, /*
2063 Return t if and only if (charset-property CHARSET 'encode-as-utf-8)).
2064
2065 Used by the X11 platform font code; see `define-specifier-tag'. You
2066 shouldn't ever need to call this.
2067 */
2068 (charset, UNUSED(stage)))
2069 {
2070 /* Used to check that the stage was initial too. */
2071 CHECK_CHARSET(charset);
2072 return XCHARSET_ENCODE_AS_UTF_8(charset) ? Qt : Qnil;
2073 }
2074
2075 #endif /* MULE */
2076
1899 2077
1900 void 2078 void
1901 syms_of_faces (void) 2079 syms_of_faces (void)
1902 { 2080 {
1903 INIT_LRECORD_IMPLEMENTATION (face); 2081 INIT_LRECORD_IMPLEMENTATION (face);
1914 DEFSUBR (Fface_name); 2092 DEFSUBR (Fface_name);
1915 DEFSUBR (Fbuilt_in_face_specifiers); 2093 DEFSUBR (Fbuilt_in_face_specifiers);
1916 DEFSUBR (Fface_list); 2094 DEFSUBR (Fface_list);
1917 DEFSUBR (Fmake_face); 2095 DEFSUBR (Fmake_face);
1918 DEFSUBR (Fcopy_face); 2096 DEFSUBR (Fcopy_face);
2097
2098 #ifdef MULE
2099 DEFSYMBOL (Qone_dimensional);
2100 DEFSYMBOL (Qtwo_dimensional);
2101 /* I would much prefer these were in Lisp. */
2102 DEFSUBR (Fspecifier_tag_one_dimensional_p);
2103 DEFSUBR (Fspecifier_tag_two_dimensional_p);
2104 DEFSUBR (Fspecifier_tag_initial_stage_p);
2105 DEFSUBR (Fspecifier_tag_final_stage_p);
2106 DEFSUBR (Fspecifier_tag_encode_as_utf_8_p);
2107 #endif /* MULE */
1919 2108
1920 DEFSYMBOL (Qfacep); 2109 DEFSYMBOL (Qfacep);
1921 DEFSYMBOL (Qforeground); 2110 DEFSYMBOL (Qforeground);
1922 DEFSYMBOL (Qbackground); 2111 DEFSYMBOL (Qbackground);
1923 /* Qfont defined in general.c */ 2112 /* Qfont defined in general.c */
1977 Vright_margin_face = Qnil; 2166 Vright_margin_face = Qnil;
1978 staticpro (&Vtext_cursor_face); 2167 staticpro (&Vtext_cursor_face);
1979 Vtext_cursor_face = Qnil; 2168 Vtext_cursor_face = Qnil;
1980 staticpro (&Vpointer_face); 2169 staticpro (&Vpointer_face);
1981 Vpointer_face = Qnil; 2170 Vpointer_face = Qnil;
2171
2172 #ifdef DEBUG_XEMACS
2173 DEFVAR_INT ("debug-x-faces", &debug_x_faces /*
2174 If non-zero, display debug information about X faces
2175 */ );
2176 debug_x_faces = 0;
2177 #endif
1982 2178
1983 { 2179 {
1984 Lisp_Object syms[20]; 2180 Lisp_Object syms[20];
1985 int n = 0; 2181 int n = 0;
1986 2182
2044 { 2240 {
2045 Lisp_Object inst_list = Qnil; 2241 Lisp_Object inst_list = Qnil;
2046 2242
2047 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) 2243 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK)
2048 2244
2245 #ifdef HAVE_GTK
2246 Lisp_Object device_symbol = Qgtk;
2247 #else
2248 Lisp_Object device_symbol = Qx;
2249 #endif
2250
2251 #ifdef MULE
2252
2049 const Ascbyte *fonts[] = 2253 const Ascbyte *fonts[] =
2050 { 2254 {
2051 #ifdef USE_XFT 2255 #ifdef USE_XFT
2052 /************** Xft fonts *************/ 2256 /************** Xft fonts *************/
2053 2257
2054 /* Note that fontconfig can search for several font families in one 2258 /* Note that fontconfig can search for several font families in one
2055 call. We should use this facility. */ 2259 call. We should use this facility. */
2056 "monospace-12", /* Western #### add encoding info? */ 2260 "Monospace-12",
2057 /* do we need to worry about non-Latin characters for monospace? 2261 /* do we need to worry about non-Latin characters for monospace?
2058 No, at least in Debian's implementation of Xft. 2262 No, at least in Debian's implementation of Xft.
2059 We should recommend that "gothic" and "mincho" aliases be created? */ 2263 We should recommend that "gothic" and "mincho" aliases be created? */
2060 "Sazanami Mincho-12", /* Japanese #### add encoding info? */ 2264 "Sazanami Mincho-12",
2265 /* Japanese #### add encoding info? */
2061 /* Arphic for Chinese? */ 2266 /* Arphic for Chinese? */
2062 /* Korean */ 2267 /* Korean */
2063 #else 2268 #else
2064 2269 /* The default Japanese fonts installed with XFree86 4.0 use this
2065 /************** ISO-8859 fonts *************/ 2270 point size, and the -misc-fixed fonts (which look really bad with
2066 2271 Han characters) don't. We need to prefer the former. */
2067 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", 2272 "-*-*-medium-r-*-*-*-150-*-*-c-*-*-*",
2068 /* under USE_XFT, we always succeed, so let's not waste the effort */ 2273 /* And the Chinese ones, maddeningly, use this one. (But on 4.0, while
2069 "-*-fixed-medium-r-*-*-*-120-*-*-*-*-iso8859-*", 2274 XListFonts returns them, XLoadQueryFont on the fully-specified XLFD
2070 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*", 2275 corresponding to one of them fails!) */
2071 "-*-fixed-*-r-*-*-*-120-*-*-*-*-iso8859-*", 2276 "-*-*-medium-r-*-*-*-160-*-*-c-*-*-*",
2072 /* Next try for any "medium" charcell or monospaced iso8859 font. */ 2277 "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*",
2073 "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
2074 "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
2075 /* Next try for any charcell or monospaced iso8859 font. */
2076 "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
2077 "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
2078
2079 /* Repeat, any size */
2080 "-*-courier-medium-r-*-*-*-*-*-*-*-*-iso8859-*",
2081 "-*-fixed-medium-r-*-*-*-*-*-*-*-*-iso8859-*",
2082 "-*-courier-*-r-*-*-*-*-*-*-*-*-iso8859-*",
2083 "-*-fixed-*-r-*-*-*-*-*-*-*-*-iso8859-*",
2084 /* Next try for any "medium" charcell or monospaced iso8859 font. */
2085 "-*-*-medium-r-*-*-*-*-*-*-m-*-iso8859-*",
2086 "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-*",
2087 /* Next try for any charcell or monospaced iso8859 font. */
2088 "-*-*-*-r-*-*-*-*-*-*-m-*-iso8859-*",
2089 "-*-*-*-r-*-*-*-*-*-*-c-*-iso8859-*",
2090
2091 /* Non-proportional fonts -- last resort. */
2092 "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
2093 "-*-*-*-r-*-*-*-*-*-*-*-*-iso8859-*",
2094 "-*-*-*-*-*-*-*-*-*-*-*-*-iso8859-*",
2095
2096 /************* Japanese fonts ************/
2097
2098 /* Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun */
2099 "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0",
2100 "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0",
2101 "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0",
2102
2103 /* Other Japanese fonts */
2104 "-*-fixed-medium-r-*--*-jisx0201.1976-*",
2105 "-*-fixed-medium-r-*--*-jisx0208.1983-*",
2106 "-*-fixed-medium-r-*--*-jisx0212*-*",
2107 "-*-*-*-r-*--*-jisx0201.1976-*",
2108 "-*-*-*-r-*--*-jisx0208.1983-*",
2109 "-*-*-*-r-*--*-jisx0212*-*",
2110
2111 /************* Chinese fonts ************/
2112
2113 "-*-*-medium-r-*--*-gb2312.1980-*",
2114 "-*-fixed-medium-r-*--*-cns11643*-*",
2115
2116 "-*-fixed-medium-r-*--*-big5*-*,"
2117 "-*-fixed-medium-r-*--*-sisheng_cwnn-0",
2118
2119 /************* Korean fonts *************/
2120
2121 "-*-mincho-medium-r-*--*-ksc5601.1987-*",
2122
2123 /************* Thai fonts **************/
2124
2125 "-*-fixed-medium-r-*--*-tis620.2529-1",
2126
2127 /************* Other fonts (nonstandard) *************/
2128
2129 "-*-fixed-medium-r-*--*-viscii1.1-1",
2130 "-*-fixed-medium-r-*--*-mulearabic-*",
2131 "-*-fixed-medium-r-*--*-muleipa-*",
2132 "-*-fixed-medium-r-*--*-ethio-*",
2133
2134 /************* Unicode fonts **************/
2135
2136 /* #### We don't yet support Unicode fonts, but doing so would not be
2137 hard because all the machinery has already been added for Windows
2138 support. We need to do this:
2139
2140 (1) Add "stage 2" support in find_charset_font()/etc.; this finds
2141 an appropriate Unicode font after all the charset-specific fonts
2142 have been checked. This should look at the per-char font info and
2143 check whether we have support for some of the chars in the
2144 charset. (#### Bogus, but that's the way it currently works)
2145
2146 sjt sez: With Xft/fontconfig that information is available as a
2147 language support property. The character set (actually a bit
2148 vector) is also available. So what we need to do is to map charset
2149 -> language (Mule redesign Phase 1) and eventually use language
2150 information in the buffer, then map to charsets (Phase 2) at font
2151 instantiation time.
2152
2153 (2) Record in the font instance a flag indicating when we're
2154 dealing with a Unicode font.
2155
2156 (3) Notice this flag in separate_textual_runs() and translate the
2157 text into Unicode if so.
2158 */
2159
2160 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso10646-1",
2161 "-*-fixed-medium-r-*-*-*-120-*-*-*-*-iso10646-1",
2162 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso10646-1",
2163 "-*-fixed-*-r-*-*-*-120-*-*-*-*-iso10646-1",
2164 /* Next try for any "medium" charcell or monospaced iso8859 font. */
2165 "-*-*-medium-r-*-*-*-120-*-*-m-*-iso10646-1",
2166 "-*-*-medium-r-*-*-*-120-*-*-c-*-iso10646-1",
2167 /* Next try for any charcell or monospaced iso8859 font. */
2168 "-*-*-*-r-*-*-*-120-*-*-m-*-iso10646-1",
2169 "-*-*-*-r-*-*-*-120-*-*-c-*-iso10646-1",
2170
2171 /* Repeat, any size */
2172 "-*-courier-medium-r-*-*-*-*-*-*-*-*-iso10646-1",
2173 "-*-fixed-medium-r-*-*-*-*-*-*-*-*-iso10646-1",
2174 "-*-courier-*-r-*-*-*-*-*-*-*-*-iso10646-1",
2175 "-*-fixed-*-r-*-*-*-*-*-*-*-*-iso10646-1",
2176 /* Next try for any "medium" charcell or monospaced iso8859 font. */
2177 "-*-*-medium-r-*-*-*-*-*-*-m-*-iso10646-1",
2178 "-*-*-medium-r-*-*-*-*-*-*-c-*-iso10646-1",
2179 /* Next try for any charcell or monospaced iso8859 font. */
2180 "-*-*-*-r-*-*-*-*-*-*-m-*-iso10646-1",
2181 "-*-*-*-r-*-*-*-*-*-*-c-*-iso10646-1",
2182
2183 /* Non-proportional fonts -- last resort. */
2184 "-*-*-*-r-*-*-*-120-*-*-*-*-iso10646-1",
2185 "-*-*-*-r-*-*-*-*-*-*-*-*-iso10646-1",
2186 "-*-*-*-*-*-*-*-*-*-*-*-*-iso10646-1",
2187
2188 /*********** Last resort ***********/
2189
2190 /* Boy, we sure are losing now. Try the above, but in any encoding. */
2191 "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
2192 "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
2193 "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
2194 "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
2195 /* Hello? Please? */
2196 "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
2197 "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
2198 "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
2199 "*"
2200 #endif 2278 #endif
2201 }; 2279 };
2202 const Ascbyte **fontptr; 2280 const Ascbyte **fontptr;
2203 2281
2204 #ifdef HAVE_X_WINDOWS 2282 /* Define some specifier tags for classes of character sets. Combining
2283 these allows for distinct fallback fonts for distinct dimensions of
2284 character sets and stages. */
2285
2286 define_specifier_tag(Qtwo_dimensional, Qnil,
2287 intern ("specifier-tag-two-dimensional-p"));
2288
2289 define_specifier_tag(Qone_dimensional, Qnil,
2290 intern ("specifier-tag-one-dimensional-p"));
2291
2292 define_specifier_tag(Qinitial, Qnil,
2293 intern ("specifier-tag-initial-stage-p"));
2294
2295 define_specifier_tag(Qfinal, Qnil,
2296 intern ("specifier-tag-final-stage-p"));
2297
2298 define_specifier_tag (Qencode_as_utf_8, Qnil,
2299 intern("specifier-tag-encode-as-utf-8-p"));
2300
2301 #endif /* MULE */
2302
2303 inst_list =
2304 Fcons
2305 (Fcons
2306 (list1 (device_symbol),
2307 build_string ("*")),
2308 inst_list);
2309
2310 #ifdef MULE
2311
2312 /* For Han characters and Ethiopic, we want the misc-fixed font used to
2313 be distinct from that for alphabetic scripts, because the font
2314 specified below is distractingly ugly when used for Han characters
2315 (this is slightly less so) and because its coverage isn't up to
2316 handling them (well, chiefly, it's not up to handling Ethiopic--we do
2317 have charset-specific fallbacks for the East Asian charsets.) */
2318 inst_list =
2319 Fcons
2320 (Fcons
2321 (list3(device_symbol, Qtwo_dimensional, Qfinal),
2322 build_string
2323 ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")),
2324 inst_list);
2325
2326 /* Use Markus Kuhn's version of misc-fixed as the font for the font for
2327 when a given charset's registries can't be found and redisplay for
2328 that charset falls back to iso10646-1. */
2329
2330 inst_list =
2331 Fcons
2332 (Fcons
2333 (list3(device_symbol, Qone_dimensional, Qfinal),
2334 build_string
2335 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
2336 inst_list);
2337
2205 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) 2338 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
2206 inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)), 2339 inst_list = Fcons (Fcons (list3 (device_symbol,
2340 Qtwo_dimensional, Qinitial),
2341 build_string (*fontptr)),
2207 inst_list); 2342 inst_list);
2208 #endif /* HAVE_X_WINDOWS */ 2343
2209 2344 /* We need to set the font for the JIT-ucs-charsets separately from the
2210 #ifdef HAVE_GTK 2345 final stage, since otherwise it picks up the two-dimensional
2211 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) 2346 specification (see specifier-tag-two-dimensional-initial-stage-p
2212 inst_list = Fcons (Fcons (list1 (Qgtk), build_string (*fontptr)), 2347 above). They also use Markus Kuhn's ISO 10646-1 fixed fonts for
2213 inst_list); 2348 redisplay. */
2214 #endif /* HAVE_GTK */ 2349
2350 inst_list =
2351 Fcons
2352 (Fcons
2353 (list3(device_symbol, Qencode_as_utf_8, Qinitial),
2354 build_string
2355 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
2356 inst_list);
2357
2358 #endif /* MULE */
2359
2360 /* Needed to make sure that charsets with non-specified fonts don't
2361 use bold and oblique first if medium and regular are available. */
2362 inst_list =
2363 Fcons
2364 (Fcons
2365 (list1 (device_symbol),
2366 build_string ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")),
2367 inst_list);
2368
2369 /* With a Cygwin XFree86 install, this returns the best (clearest,
2370 most readable) font I can find when scaling of bitmap fonts is
2371 turned on, as it is by default. (WHO IN THE NAME OF CHRIST THOUGHT
2372 THAT WAS A GOOD IDEA?!?!) The other fonts that used to be specified
2373 here gave horrendous results. */
2374
2375 inst_list =
2376 Fcons
2377 (Fcons
2378 (list1 (device_symbol),
2379 build_string ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")),
2380 inst_list);
2381
2215 #endif /* HAVE_X_WINDOWS || HAVE_GTK */ 2382 #endif /* HAVE_X_WINDOWS || HAVE_GTK */
2216 2383
2217 #ifdef HAVE_TTY 2384 #ifdef HAVE_TTY
2218 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")), 2385 inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
2219 inst_list); 2386 inst_list);