comparison src/specifier.c @ 5125:b5df3737028a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 2ade80e8c640
children a9c41067dd88
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
1 /* Specifier implementation 1 /* Specifier implementation
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. 3 Copyright (C) 1995, 1996, 2002, 2005, 2010 Ben Wing.
4 Copyright (C) 1995 Sun Microsystems, Inc. 4 Copyright (C) 1995 Sun Microsystems, Inc.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
31 #include "lisp.h" 31 #include "lisp.h"
32 32
33 #include "buffer.h" 33 #include "buffer.h"
34 #include "chartab.h" 34 #include "chartab.h"
35 #include "device-impl.h" 35 #include "device-impl.h"
36 #include "elhash.h"
36 #include "frame.h" 37 #include "frame.h"
37 #include "glyphs.h" 38 #include "glyphs.h"
38 #include "opaque.h" 39 #include "opaque.h"
39 #include "rangetab.h" 40 #include "rangetab.h"
40 #include "specifier.h" 41 #include "specifier.h"
45 Lisp_Object Qremove_locale, Qremove_locale_type; 46 Lisp_Object Qremove_locale, Qremove_locale_type;
46 47
47 Lisp_Object Qconsole_type, Qdevice_class; 48 Lisp_Object Qconsole_type, Qdevice_class;
48 49
49 static Lisp_Object Vuser_defined_tags; 50 static Lisp_Object Vuser_defined_tags;
51 /* This is a hash table mapping charsets to "tag lists". A tag list here
52 is an assoc list mapping charset tags to size-two vectors (one for the
53 initial stage, one for the final stage) containing t or nil, indicating
54 whether the charset tag matches the charset for the given stage. These
55 values are determined at the time a charset tag is defined by calling
56 the charset predicate on all the existing charsets, and at the time a
57 charset is defined by calling the predicate on all existing charset
58 tags. */
50 static Lisp_Object Vcharset_tag_lists; 59 static Lisp_Object Vcharset_tag_lists;
51 60
52 typedef struct specifier_type_entry specifier_type_entry; 61 typedef struct specifier_type_entry specifier_type_entry;
53 struct specifier_type_entry 62 struct specifier_type_entry
54 { 63 {
283 specbind (Qprint_length, make_int (5)); 292 specbind (Qprint_length, make_int (5));
284 #endif 293 #endif
285 the_specs = Fspecifier_specs (obj, Qglobal, Qnil, Qnil); 294 the_specs = Fspecifier_specs (obj, Qglobal, Qnil, Qnil);
286 if (NILP (the_specs)) 295 if (NILP (the_specs))
287 /* there are no global specs */ 296 /* there are no global specs */
288 write_c_string (printcharfun, "<unspecified>"); 297 write_ascstring (printcharfun, "<unspecified>");
289 else 298 else
290 print_internal (the_specs, printcharfun, 1); 299 print_internal (the_specs, printcharfun, 1);
291 if (!NILP (sp->fallback)) 300 if (!NILP (sp->fallback))
292 { 301 {
293 write_fmt_string_lisp (printcharfun, " fallback=%S", 1, sp->fallback); 302 write_fmt_string_lisp (printcharfun, " fallback=%S", 1, sp->fallback);
301 finalize_specifier (void *header) 310 finalize_specifier (void *header)
302 { 311 {
303 Lisp_Specifier *sp = (Lisp_Specifier *) header; 312 Lisp_Specifier *sp = (Lisp_Specifier *) header;
304 if (!GHOST_SPECIFIER_P(sp) && sp->caching) 313 if (!GHOST_SPECIFIER_P(sp) && sp->caching)
305 { 314 {
306 xfree (sp->caching, struct specifier_caching *); 315 xfree (sp->caching);
307 sp->caching = 0; 316 sp->caching = 0;
308 } 317 }
309 } 318 }
310 #endif /* not NEW_GC */ 319 #endif /* not NEW_GC */
311 320
312 static int 321 static int
313 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 322 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
314 { 323 {
315 Lisp_Specifier *s1 = XSPECIFIER (obj1); 324 Lisp_Specifier *s1 = XSPECIFIER (obj1);
316 Lisp_Specifier *s2 = XSPECIFIER (obj2); 325 Lisp_Specifier *s2 = XSPECIFIER (obj2);
317 int retval; 326 int retval;
318 Lisp_Object old_inhibit_quit = Vinhibit_quit; 327 Lisp_Object old_inhibit_quit = Vinhibit_quit;
322 Vinhibit_quit = Qt; 331 Vinhibit_quit = Qt;
323 332
324 depth++; 333 depth++;
325 retval = 334 retval =
326 (s1->methods == s2->methods && 335 (s1->methods == s2->methods &&
327 internal_equal (s1->global_specs, s2->global_specs, depth) && 336 internal_equal_0 (s1->global_specs, s2->global_specs, depth, foldcase) &&
328 internal_equal (s1->device_specs, s2->device_specs, depth) && 337 internal_equal_0 (s1->device_specs, s2->device_specs, depth, foldcase) &&
329 internal_equal (s1->frame_specs, s2->frame_specs, depth) && 338 internal_equal_0 (s1->frame_specs, s2->frame_specs, depth, foldcase) &&
330 internal_equal (s1->window_specs, s2->window_specs, depth) && 339 internal_equal_0 (s1->window_specs, s2->window_specs, depth, foldcase) &&
331 internal_equal (s1->buffer_specs, s2->buffer_specs, depth) && 340 internal_equal_0 (s1->buffer_specs, s2->buffer_specs, depth, foldcase) &&
332 internal_equal (s1->fallback, s2->fallback, depth)); 341 internal_equal_0 (s1->fallback, s2->fallback, depth, foldcase));
333 342
334 if (retval && HAS_SPECMETH_P (s1, equal)) 343 if (retval && HAS_SPECMETH_P (s1, equal))
335 retval = SPECMETH (s1, equal, (obj1, obj2, depth - 1)); 344 retval = SPECMETH (s1, equal, (obj1, obj2, depth - 1));
336 345
337 Vinhibit_quit = old_inhibit_quit; 346 Vinhibit_quit = old_inhibit_quit;
972 981
973 return 1; 982 return 1;
974 } 983 }
975 984
976 static int 985 static int
977 charset_matches_specifier_tag_set_p (Lisp_Object charset, 986 charset_matches_specifier_tag_set_p (Lisp_Object charset, Lisp_Object tag_set,
978 Lisp_Object tag_set,
979 enum font_specifier_matchspec_stages 987 enum font_specifier_matchspec_stages
980 stage) 988 stage)
981 { 989 {
982 Lisp_Object rest; 990 Lisp_Object rest;
983 int res = 0; 991 int res = 0;
984 992
985 assert(stage != impossible); 993 assert(stage < NUM_MATCHSPEC_STAGES);
986 994
987 LIST_LOOP (rest, tag_set) 995 LIST_LOOP (rest, tag_set)
988 { 996 {
989 Lisp_Object tag = XCAR (rest); 997 Lisp_Object tag = XCAR (rest);
990 Lisp_Object assoc; 998 Lisp_Object assoc;
999 Lisp_Object tag_list = Fgethash (charset, Vcharset_tag_lists, Qnil);
991 1000
992 /* In the event that, during the creation of a charset, no specifier 1001 /* In the event that, during the creation of a charset, no specifier
993 tags exist for which CHARSET-PREDICATE has been specified, then 1002 tags exist for which CHARSET-PREDICATE has been specified, then
994 that charset's entry in Vcharset_tag_lists will be nil, and this 1003 that charset's entry in Vcharset_tag_lists will be nil, and this
995 charset shouldn't match. */ 1004 charset shouldn't match. */
996 1005
997 if (NILP (XVECTOR_DATA(Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) 1006 if (NILP (tag_list))
998 - MIN_LEADING_BYTE]))
999 { 1007 {
1000 return 0; 1008 return 0;
1001 } 1009 }
1002 1010
1003 /* Now, find out what the pre-calculated value is. */ 1011 /* Now, find out what the pre-calculated value is. */
1004 assoc = assq_no_quit(tag, 1012 assoc = assq_no_quit (tag, tag_list);
1005 XVECTOR_DATA(Vcharset_tag_lists) 1013
1006 [XCHARSET_LEADING_BYTE(charset) 1014 if (!(NILP (assoc)))
1007 - MIN_LEADING_BYTE]); 1015 {
1008 1016 assert (VECTORP (XCDR (assoc)));
1009 if (!(NILP(assoc)) && !(NILP(XCDR(assoc))))
1010 {
1011 assert(VECTORP(XCDR(assoc)));
1012 1017
1013 /* In the event that a tag specifies a charset, then the specifier 1018 /* In the event that a tag specifies a charset, then the specifier
1014 must match for (this stage and this charset) for all 1019 must match for (this stage and this charset) for all
1015 charset-specifying tags. */ 1020 charset-specifying tags. */
1016 if (NILP(XVECTOR_DATA(XCDR(assoc))[stage])) 1021 if (NILP (XVECTOR_DATA (XCDR (assoc))[stage]))
1017 { 1022 {
1018 /* It doesn't match for this tag, even though the tag 1023 /* It doesn't match for this tag, even though the tag
1019 specifies a charset. Return 0. */ 1024 specifies a charset. Return 0. */
1020 return 0; 1025 return 0;
1021 } 1026 }
1049 invalid_argument ("Invalid tag set", tag_set); 1054 invalid_argument ("Invalid tag set", tag_set);
1050 1055
1051 return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil; 1056 return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
1052 } 1057 }
1053 1058
1059 /* Call CHARSET_PREDICATE on CHARSET, evaluating it at both stages (initial
1060 and final) and returning a size-two vector of the results. */
1061
1062 static Lisp_Object
1063 call_charset_predicate (Lisp_Object charset_predicate, Lisp_Object charset)
1064 {
1065 struct gcpro gcpro1;
1066 Lisp_Object charpres = make_vector (NUM_MATCHSPEC_STAGES, Qnil);
1067 int max_args = XINT (Ffunction_max_args (charset_predicate));
1068 GCPRO1 (charpres);
1069
1070
1071 #define DEFINE_SPECIFIER_TAG_FROB(stage, enumstage) \
1072 do { \
1073 if (max_args > 1) \
1074 { \
1075 XVECTOR_DATA (charpres)[enumstage] = \
1076 call2_trapping_problems \
1077 ("Error during specifier tag charset predicate," \
1078 " stage " #stage, charset_predicate, \
1079 charset, Q##stage, 0); \
1080 } \
1081 else \
1082 { \
1083 XVECTOR_DATA (charpres)[enumstage] = \
1084 call1_trapping_problems \
1085 ("Error during specifier tag charset predicate," \
1086 " stage " #stage, charset_predicate, \
1087 charset, 0); \
1088 } \
1089 \
1090 if (UNBOUNDP (XVECTOR_DATA (charpres)[enumstage])) \
1091 { \
1092 XVECTOR_DATA (charpres)[enumstage] = Qnil; \
1093 } \
1094 else if (!NILP (XVECTOR_DATA (charpres)[enumstage])) \
1095 { \
1096 /* Don't want refs to random other objects. */ \
1097 XVECTOR_DATA (charpres)[enumstage] = Qt; \
1098 } \
1099 } while (0)
1100
1101 DEFINE_SPECIFIER_TAG_FROB (initial, STAGE_INITIAL);
1102 DEFINE_SPECIFIER_TAG_FROB (final, STAGE_FINAL);
1103
1104 #undef DEFINE_SPECIFIER_TAG_FROB
1105
1106 UNGCPRO;
1107
1108 return charpres;
1109 }
1110
1054 Lisp_Object 1111 Lisp_Object
1055 define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate, 1112 define_specifier_tag (Lisp_Object tag, Lisp_Object device_predicate,
1056 Lisp_Object charset_predicate) 1113 Lisp_Object charset_predicate)
1057 { 1114 {
1058 Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags), 1115 Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags),
1059 concons, devcons, charpres = Qnil; 1116 concons, devcons;
1060 int recompute_devices = 0, recompute_charsets = 0, i, max_args = -1; 1117 int recompute_devices = 0, recompute_charsets = 0;
1061 1118
1062 if (NILP (assoc)) 1119 if (NILP (assoc))
1063 { 1120 {
1064 recompute_devices = recompute_charsets = 1; 1121 recompute_devices = recompute_charsets = 1;
1065 Vuser_defined_tags = Fcons (list3 (tag, device_predicate, 1122 Vuser_defined_tags = Fcons (list3 (tag, device_predicate,
1071 /* Initially set the value to t in case of error 1128 /* Initially set the value to t in case of error
1072 in device_predicate */ 1129 in device_predicate */
1073 DEVICE_USER_DEFINED_TAGS (d) = 1130 DEVICE_USER_DEFINED_TAGS (d) =
1074 Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d)); 1131 Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d));
1075 } 1132 }
1076
1077 if (!NILP (charset_predicate))
1078 {
1079 max_args = XINT(Ffunction_max_args(charset_predicate));
1080 if (max_args < 1)
1081 {
1082 invalid_argument
1083 ("Charset predicate must be able to take an argument", tag);
1084 }
1085 }
1086 } 1133 }
1087 else if (!NILP (device_predicate) && !NILP (XCADR (assoc))) 1134 else if (!NILP (device_predicate) && !NILP (XCADR (assoc)))
1088 { 1135 {
1089 recompute_devices = 1; 1136 recompute_devices = 1;
1090 XCDR (assoc) = list2(device_predicate, charset_predicate); 1137 XCDR (assoc) = list2 (device_predicate, charset_predicate);
1091 } 1138 }
1092 else if (!NILP (charset_predicate) || !NILP(XCADDR (assoc))) 1139 else if (!NILP (charset_predicate) || !NILP (XCADDR (assoc)))
1093 { 1140 {
1094 max_args = XINT(Ffunction_max_args(charset_predicate));
1095 if (max_args < 1)
1096 {
1097 invalid_argument
1098 ("Charset predicate must be able to take an argument", tag);
1099 }
1100
1101 /* If there exists a charset_predicate for the tag currently (even if 1141 /* If there exists a charset_predicate for the tag currently (even if
1102 the new charset_predicate is nil), or if we're adding one, we need 1142 the new charset_predicate is nil), or if we're adding one, we need
1103 to recompute. This contrasts with the device predicates, where we 1143 to recompute. This contrasts with the device predicates, where we
1104 don't need to recompute if the old and new device predicates are 1144 don't need to recompute if the old and new device predicates are
1105 both nil. */ 1145 both nil. */
1106 1146
1107 recompute_charsets = 1; 1147 recompute_charsets = 1;
1108 XCDR (assoc) = list2(device_predicate, charset_predicate); 1148 XCDR (assoc) = list2 (device_predicate, charset_predicate);
1109 } 1149 }
1110 1150
1111 /* Recompute the tag values for all devices and charsets, if necessary. In 1151 /* Recompute the tag values for all devices and charsets, if necessary. In
1112 the special case where both the old and new device_predicates are nil, 1152 the special case where both the old and new device_predicates are nil,
1113 we know that we don't have to do it for the device. (It's probably 1153 we know that we don't have to do it for the device. (It's probably
1131 } 1171 }
1132 } 1172 }
1133 1173
1134 if (recompute_charsets) 1174 if (recompute_charsets)
1135 { 1175 {
1136 if (NILP(charset_predicate)) 1176
1137 { 1177 LIST_LOOP_2 (charset_name, Fcharset_list ())
1138 charpres = Qnil; 1178 {
1139 } 1179 Lisp_Object charset = Fget_charset (charset_name);
1140 1180 Lisp_Object tag_list = Fgethash (charset, Vcharset_tag_lists, Qnil);
1141 for (i = 0; i < NUM_LEADING_BYTES; ++i) 1181 Lisp_Object charpres;
1142 { 1182
1143 if (NILP(charset_by_leading_byte(MIN_LEADING_BYTE + i))) 1183 if (NILP (charset_predicate))
1184 continue;
1185
1186 charpres = call_charset_predicate (charset_predicate, charset);
1187
1188 assoc = assq_no_quit (tag, tag_list);
1189 if (!NILP (assoc))
1144 { 1190 {
1145 continue; 1191 assert (CONSP (assoc));
1146 }
1147
1148 assoc = assq_no_quit (tag,
1149 XVECTOR_DATA(Vcharset_tag_lists)[i]);
1150
1151 if (!NILP(charset_predicate))
1152 {
1153 struct gcpro gcpro1;
1154 charpres = make_vector(impossible, Qnil);
1155 GCPRO1 (charpres);
1156
1157 /* If you want to extend the number of stages available, here
1158 in setup_charset_initial_specifier_tags, and in specifier.h
1159 is where you want to go. */
1160
1161 #define DEFINE_SPECIFIER_TAG_FROB(stage) do { \
1162 if (max_args > 1) \
1163 { \
1164 XVECTOR_DATA(charpres)[stage] = \
1165 call2_trapping_problems \
1166 ("Error during specifier tag charset predicate," \
1167 " stage " #stage, charset_predicate, \
1168 charset_by_leading_byte(MIN_LEADING_BYTE + i), \
1169 Q##stage, 0); \
1170 } \
1171 else \
1172 { \
1173 XVECTOR_DATA(charpres)[stage] = \
1174 call1_trapping_problems \
1175 ("Error during specifier tag charset predicate," \
1176 " stage " #stage, charset_predicate, \
1177 charset_by_leading_byte(MIN_LEADING_BYTE + i), \
1178 0); \
1179 } \
1180 \
1181 if (UNBOUNDP(XVECTOR_DATA(charpres)[stage])) \
1182 { \
1183 XVECTOR_DATA(charpres)[stage] = Qnil; \
1184 } \
1185 else if (!NILP(XVECTOR_DATA(charpres)[stage])) \
1186 { \
1187 /* Don't want refs to random other objects. */ \
1188 XVECTOR_DATA(charpres)[stage] = Qt; \
1189 } \
1190 } while (0)
1191
1192 DEFINE_SPECIFIER_TAG_FROB (initial);
1193 DEFINE_SPECIFIER_TAG_FROB (final);
1194
1195 #undef DEFINE_SPECIFIER_TAG_FROB
1196
1197 UNGCPRO;
1198 }
1199
1200 if (!NILP(assoc))
1201 {
1202 assert(CONSP(assoc));
1203 XCDR (assoc) = charpres; 1192 XCDR (assoc) = charpres;
1204 } 1193 }
1205 else 1194 else
1206 { 1195 {
1207 XVECTOR_DATA(Vcharset_tag_lists)[i] 1196 Fputhash (charset, Fcons (Fcons (tag, charpres), tag_list),
1208 = Fcons(Fcons(tag, charpres), 1197 Vcharset_tag_lists);
1209 XVECTOR_DATA (Vcharset_tag_lists)[i]);
1210 } 1198 }
1211 } 1199 }
1212 } 1200 }
1213 return Qt; 1201 return Qt;
1214 } 1202 }
1249 available as a built-in specifier tag; this is probably something we should 1237 available as a built-in specifier tag; this is probably something we should
1250 change. 1238 change.
1251 */ 1239 */
1252 (tag, device_predicate, charset_predicate)) 1240 (tag, device_predicate, charset_predicate))
1253 { 1241 {
1254 int max_args;
1255
1256 CHECK_SYMBOL (tag); 1242 CHECK_SYMBOL (tag);
1257 if (valid_device_class_p (tag) || 1243 if (valid_device_class_p (tag) ||
1258 valid_console_type_p (tag) || 1244 valid_console_type_p (tag) ||
1259 EQ (tag, Qinitial) || EQ (tag, Qfinal)) 1245 EQ (tag, Qinitial) || EQ (tag, Qfinal))
1260 invalid_change ("Cannot redefine built-in specifier tags", tag); 1246 invalid_change ("Cannot redefine built-in specifier tags", tag);
1263 if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal)) 1249 if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
1264 invalid_change ("Cannot define nil, t, `all', or `global'", tag); 1250 invalid_change ("Cannot define nil, t, `all', or `global'", tag);
1265 1251
1266 if (!NILP (charset_predicate)) 1252 if (!NILP (charset_predicate))
1267 { 1253 {
1268 max_args = XINT(Ffunction_max_args(charset_predicate)); 1254 Lisp_Object min_args = Ffunction_min_args (charset_predicate);
1269 if (max_args != 1) 1255 Lisp_Object max_args = Ffunction_max_args (charset_predicate);
1256 if (!(INTP (min_args) && XINT (min_args) == 1 &&
1257 INTP (max_args) && XINT (max_args) == 1))
1270 { 1258 {
1271 /* We only allow the stage argument to be specifed from C. */ 1259 /* We only allow the stage argument to be specifed from C. */
1272 invalid_change ("Charset predicate must take one argument", 1260 invalid_change ("Charset predicate must take one argument",
1273 tag); 1261 tag);
1274 } 1262 }
1323 Lisp_Object rest, charset_predicate, tag, new_value; 1311 Lisp_Object rest, charset_predicate, tag, new_value;
1324 Lisp_Object charset_tag_list = Qnil; 1312 Lisp_Object charset_tag_list = Qnil;
1325 1313
1326 LIST_LOOP (rest, Vuser_defined_tags) 1314 LIST_LOOP (rest, Vuser_defined_tags)
1327 { 1315 {
1328 tag = XCAR(XCAR(rest)); 1316 tag = XCAR (XCAR (rest));
1329 charset_predicate = XCADDR(XCAR (rest)); 1317 charset_predicate = XCADDR (XCAR (rest));
1330 1318
1331 if (NILP(charset_predicate)) 1319 if (NILP (charset_predicate))
1332 { 1320 {
1333 continue; 1321 continue;
1334 } 1322 }
1335 1323
1336 new_value = make_vector(impossible, Qnil); 1324 new_value = call_charset_predicate (charset_predicate, charset);
1337 1325 charset_tag_list = Fcons (Fcons (tag, new_value), charset_tag_list);
1338 #define SETUP_CHARSET_TAGS_FROB(stage) do { \ 1326 }
1339 \ 1327
1340 XVECTOR_DATA(new_value)[stage] = call2_trapping_problems \ 1328 Fputhash (charset, charset_tag_list, Vcharset_tag_lists);
1341 ("Error during specifier tag charset predicate," \
1342 " stage " #stage, \
1343 charset_predicate, charset, Q##stage, 0); \
1344 \
1345 if (UNBOUNDP(XVECTOR_DATA(new_value)[stage])) \
1346 { \
1347 XVECTOR_DATA(new_value)[stage] = Qnil; \
1348 } \
1349 else if (!NILP(XVECTOR_DATA(new_value)[stage])) \
1350 { \
1351 /* Don't want random other objects hanging around. */ \
1352 XVECTOR_DATA(new_value)[stage] = Qt; \
1353 } \
1354 \
1355 } while (0)
1356
1357 SETUP_CHARSET_TAGS_FROB (initial);
1358 SETUP_CHARSET_TAGS_FROB (final);
1359 /* More later? */
1360
1361 #undef SETUP_CHARSET_TAGS_FROB
1362
1363 charset_tag_list = Fcons(Fcons(tag, new_value), charset_tag_list);
1364 }
1365
1366 XVECTOR_DATA
1367 (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset) - MIN_LEADING_BYTE]
1368 = charset_tag_list;
1369 } 1329 }
1370 1330
1371 /* VM calls this, in vm-multiple-frames-possible-p, in the event that you're 1331 /* VM calls this, in vm-multiple-frames-possible-p, in the event that you're
1372 considering taking it out. */ 1332 considering taking it out. */
1373 1333
2802 /* This function can GC */ 2762 /* This function can GC */
2803 Lisp_Specifier *sp; 2763 Lisp_Specifier *sp;
2804 Lisp_Object device, charset = Qnil, rest; 2764 Lisp_Object device, charset = Qnil, rest;
2805 int count = specpdl_depth (), respected_charsets = 0; 2765 int count = specpdl_depth (), respected_charsets = 0;
2806 struct gcpro gcpro1, gcpro2; 2766 struct gcpro gcpro1, gcpro2;
2807 enum font_specifier_matchspec_stages stage = initial; 2767 enum font_specifier_matchspec_stages stage = STAGE_INITIAL;
2808 #ifdef DEBUG_XEMACS
2809 int non_ascii;
2810 #endif
2811 2768
2812 GCPRO2 (specifier, inst_list); 2769 GCPRO2 (specifier, inst_list);
2813 2770
2814 sp = XSPECIFIER (specifier); 2771 sp = XSPECIFIER (specifier);
2815 device = DOMAIN_DEVICE (domain); 2772 device = DOMAIN_DEVICE (domain);
2820 redisplay we need to make sure that quits are ignored. Otherwise 2777 redisplay we need to make sure that quits are ignored. Otherwise
2821 Fsignal will abort. */ 2778 Fsignal will abort. */
2822 specbind (Qinhibit_quit, Qt); 2779 specbind (Qinhibit_quit, Qt);
2823 2780
2824 #ifdef MULE 2781 #ifdef MULE
2825 if (CONSP(matchspec) && (CHARSETP(Ffind_charset(XCAR(matchspec))))) 2782 /* #### FIXME Does this font-specific stuff need to be here and not in
2826 { 2783 the font-specifier-specific code? --ben */
2827 charset = Ffind_charset(XCAR(matchspec)); 2784 if (CONSP (matchspec) && (CHARSETP (Ffind_charset (XCAR (matchspec)))))
2785 {
2786 charset = Ffind_charset (XCAR (matchspec));
2828 2787
2829 #ifdef DEBUG_XEMACS 2788 #ifdef DEBUG_XEMACS
2830 /* This is mostly to have somewhere to set debug breakpoints. */ 2789 /* This is mostly to have somewhere to set debug breakpoints. */
2831 if (!EQ(charset, Vcharset_ascii)) 2790 if (!EQ (charset, Vcharset_ascii))
2832 { 2791 {
2833 non_ascii = 1; 2792 (void) 0;
2834 } 2793 }
2835 #endif /* DEBUG_XEMACS */ 2794 #endif /* DEBUG_XEMACS */
2836 2795
2837 if (!NILP(XCDR(matchspec))) 2796 if (!NILP (XCDR (matchspec)))
2838 { 2797 {
2839 2798
2840 #define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ 2799 #define FROB(new_stage, enumstage) \
2841 { \ 2800 if (EQ (Q##new_stage, XCDR (matchspec))) \
2842 stage = new_stage; \ 2801 { \
2802 stage = enumstage; \
2843 } 2803 }
2844 2804
2845 FROB(initial) 2805 FROB (initial, STAGE_INITIAL)
2846 else FROB(final) 2806 else FROB (final, STAGE_FINAL)
2847 else assert(0); 2807 else assert(0);
2848 #undef FROB 2808 #undef FROB
2849 2809
2850 } 2810 }
2851 } 2811 }
3538 recompute_cached_specifier_everywhere_mapfun (struct window *w, 3498 recompute_cached_specifier_everywhere_mapfun (struct window *w,
3539 void *closure) 3499 void *closure)
3540 { 3500 {
3541 Lisp_Object specifier = Qnil; 3501 Lisp_Object specifier = Qnil;
3542 3502
3543 specifier = VOID_TO_LISP (closure); 3503 specifier = GET_LISP_FROM_VOID (closure);
3544 recompute_one_cached_specifier_in_window (specifier, w); 3504 recompute_one_cached_specifier_in_window (specifier, w);
3545 return 0; 3505 return 0;
3546 } 3506 }
3547 3507
3548 static void 3508 static void
3558 if (XSPECIFIER (specifier)->caching->offset_into_struct_window) 3518 if (XSPECIFIER (specifier)->caching->offset_into_struct_window)
3559 { 3519 {
3560 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) 3520 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
3561 map_windows (XFRAME (XCAR (frmcons)), 3521 map_windows (XFRAME (XCAR (frmcons)),
3562 recompute_cached_specifier_everywhere_mapfun, 3522 recompute_cached_specifier_everywhere_mapfun,
3563 LISP_TO_VOID (specifier)); 3523 STORE_LISP_IN_VOID (specifier));
3564 } 3524 }
3565 3525
3566 if (XSPECIFIER (specifier)->caching->offset_into_struct_frame) 3526 if (XSPECIFIER (specifier)->caching->offset_into_struct_frame)
3567 { 3527 {
3568 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) 3528 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
3913 staticpro (&Vuser_defined_tags); 3873 staticpro (&Vuser_defined_tags);
3914 3874
3915 Vunlock_ghost_specifiers = Qnil; 3875 Vunlock_ghost_specifiers = Qnil;
3916 staticpro (&Vunlock_ghost_specifiers); 3876 staticpro (&Vunlock_ghost_specifiers);
3917 3877
3918 Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil); 3878 Vcharset_tag_lists =
3879 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3919 staticpro (&Vcharset_tag_lists); 3880 staticpro (&Vcharset_tag_lists);
3920 } 3881 }