Mercurial > hg > xemacs-beta
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 } |