comparison src/specifier.c @ 5678:b0d40183ac79

GC protect a freshly-consed list, define_specifier_tag(). src/ChangeLog addition: 2012-08-12 Aidan Kehoe <kehoea@parhasard.net> * specifier.c (define_specifier_tag): GC protect the list that Fcharset_list () gave back, it's freshly consed. Clear the alist entries for this tag in CHARSET's tag list if the charset_predicate is nil, so re-creating a charset tag works more effectively. * specifier.c (Fdefine_specifier_tag): Device-type-specific tags *are* available, even if that device type isn't; see specifier.el.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 12 Aug 2012 11:32:36 +0100
parents 56144c8593a8
children 0f2338afbabf
comparison
equal deleted inserted replaced
5677:febc025c4e0c 5678:b0d40183ac79
1160 } 1160 }
1161 } 1161 }
1162 1162
1163 if (recompute_charsets) 1163 if (recompute_charsets)
1164 { 1164 {
1165 1165 GC_EXTERNAL_LIST_LOOP_2 (charset_name, Fcharset_list ())
1166 LIST_LOOP_2 (charset_name, Fcharset_list ())
1167 { 1166 {
1168 Lisp_Object charset = Fget_charset (charset_name); 1167 Lisp_Object charset = Fget_charset (charset_name);
1169 Lisp_Object tag_list = Fgethash (charset, Vcharset_tag_lists, Qnil); 1168 Lisp_Object tag_list = Fgethash (charset, Vcharset_tag_lists, Qnil);
1170 Lisp_Object charpres; 1169 Lisp_Object charpres;
1171 1170
1172 if (NILP (charset_predicate)) 1171 if (NILP (charset_predicate))
1173 continue; 1172 {
1173 Fputhash (charset, remassq_no_quit (tag, tag_list),
1174 Vcharset_tag_lists);
1175 continue;
1176 }
1174 1177
1175 charpres = call_charset_predicate (charset_predicate, charset); 1178 charpres = call_charset_predicate (charset_predicate, charset);
1176 1179
1177 assoc = assq_no_quit (tag, tag_list); 1180 assoc = assq_no_quit (tag, tag_list);
1178 if (!NILP (assoc)) 1181 if (!NILP (assoc))
1184 { 1187 {
1185 Fputhash (charset, Fcons (Fcons (tag, charpres), tag_list), 1188 Fputhash (charset, Fcons (Fcons (tag, charpres), tag_list),
1186 Vcharset_tag_lists); 1189 Vcharset_tag_lists);
1187 } 1190 }
1188 } 1191 }
1192 END_GC_EXTERNAL_LIST_LOOP (charset_name);
1189 } 1193 }
1190 return Qt; 1194 return Qt;
1191 } 1195 }
1192 1196
1193 DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 3, 0, /* 1197 DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 3, 0, /*
1220 it on the second pass, where character set information is ignored. 1224 it on the second pass, where character set information is ignored.
1221 1225
1222 You can redefine an existing user-defined specifier tag. However, you 1226 You can redefine an existing user-defined specifier tag. However, you
1223 cannot redefine most of the built-in specifier tags \(the device types and 1227 cannot redefine most of the built-in specifier tags \(the device types and
1224 classes, `initial', and `final') or the symbols nil, t, `all', or `global'. 1228 classes, `initial', and `final') or the symbols nil, t, `all', or `global'.
1225 Note that if a device type is not supported in this XEmacs, it will not be
1226 available as a built-in specifier tag; this is probably something we should
1227 change.
1228 */ 1229 */
1229 (tag, device_predicate, charset_predicate)) 1230 (tag, device_predicate, charset_predicate))
1230 { 1231 {
1231 CHECK_SYMBOL (tag); 1232 CHECK_SYMBOL (tag);
1232 if (valid_device_class_p (tag) || 1233 if (valid_device_class_p (tag) ||