Mercurial > hg > xemacs-beta

comparison src/fontcolor.c @ 5178:97eb4942aec8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Mon, 29 Mar 2010 21:28:13 -0500
parents src/objects.c@88bd4f3ef8e4 src/objects.c@8b2f75cecb89
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5177:b785049378e3 5178:97eb4942aec8
1 /* Generic Objects and Functions. 1 /* Generic Objects and Functions.
2 Copyright (C) 1995 Free Software Foundation, Inc. 2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing. 4 Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing.
5 Copyright (C) 2010 Didier Verna
5 6
6 This file is part of XEmacs. 7 This file is part of XEmacs.
7 8
8 XEmacs is free software; you can redistribute it and/or modify it 9 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 10 under the terms of the GNU General Public License as published by the
101 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, 102 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
102 int escapeflag) 103 int escapeflag)
103 { 104 {
104 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 105 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
105 if (print_readably) 106 if (print_readably)
106 printing_unreadable_lcrecord (obj, 0); 107 printing_unreadable_lisp_object (obj, 0);
107 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name); 108 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name);
108 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); 109 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device);
109 if (!NILP (c->device)) /* Vthe_null_color_instance */ 110 if (!NILP (c->device)) /* Vthe_null_color_instance */
110 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, 111 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
111 (c, printcharfun, escapeflag)); 112 (c, printcharfun, escapeflag));
112 write_fmt_string (printcharfun, " 0x%x>", c->header.uid); 113 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
113 } 114 }
114 115
115 static void 116 static void
116 finalize_color_instance (void *header, int for_disksave) 117 finalize_color_instance (Lisp_Object obj)
117 { 118 {
118 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; 119 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
119 120
120 if (!NILP (c->device)) 121 if (!NILP (c->device))
121 { 122 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
122 if (for_disksave) finalose (c);
123 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
124 }
125 } 123 }
126 124
127 static int 125 static int
128 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, 126 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
129 int UNUSED (foldcase)) 127 int UNUSED (foldcase))
148 !d ? LISP_HASH (obj) 146 !d ? LISP_HASH (obj)
149 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), 147 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth),
150 LISP_HASH (obj))); 148 LISP_HASH (obj)));
151 } 149 }
152 150
153 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, 151 DEFINE_NODUMP_LISP_OBJECT ("color-instance", color_instance,
154 0, /*dumpable-flag*/ 152 mark_color_instance, print_color_instance,
155 mark_color_instance, print_color_instance, 153 finalize_color_instance, color_instance_equal,
156 finalize_color_instance, color_instance_equal, 154 color_instance_hash,
157 color_instance_hash, 155 color_instance_description,
158 color_instance_description, 156 Lisp_Color_Instance);
159 Lisp_Color_Instance);
160 157
161 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* 158 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
162 Return a new `color-instance' object named NAME (a string). 159 Return a new `color-instance' object named NAME (a string).
163 160
164 Optional argument DEVICE specifies the device this object applies to 161 Optional argument DEVICE specifies the device this object applies to
175 these objects are GCed, the underlying window-system data (e.g. X object) 172 these objects are GCed, the underlying window-system data (e.g. X object)
176 is deallocated as well. 173 is deallocated as well.
177 */ 174 */
178 (name, device, noerror)) 175 (name, device, noerror))
179 { 176 {
177 Lisp_Object obj;
180 Lisp_Color_Instance *c; 178 Lisp_Color_Instance *c;
181 int retval; 179 int retval;
182 180
183 CHECK_STRING (name); 181 CHECK_STRING (name);
184 device = wrap_device (decode_device (device)); 182 device = wrap_device (decode_device (device));
185 183
186 c = ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); 184 obj = ALLOC_NORMAL_LISP_OBJECT (color_instance);
185 c = XCOLOR_INSTANCE (obj);
187 c->name = name; 186 c->name = name;
188 c->device = device; 187 c->device = device;
189 c->data = 0; 188 c->data = 0;
190 c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device)); 189 c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device));
191 190
193 (c, name, device, 192 (c, name, device,
194 decode_error_behavior_flag (noerror))); 193 decode_error_behavior_flag (noerror)));
195 if (!retval) 194 if (!retval)
196 return Qnil; 195 return Qnil;
197 196
198 return wrap_color_instance (c); 197 return obj;
199 } 198 }
200 199
201 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* 200 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
202 Return non-nil if OBJECT is a color instance. 201 Return non-nil if OBJECT is a color instance.
203 */ 202 */
318 static void 317 static void
319 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 318 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
320 { 319 {
321 Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 320 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
322 if (print_readably) 321 if (print_readably)
323 printing_unreadable_lcrecord (obj, 0); 322 printing_unreadable_lisp_object (obj, 0);
324 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name); 323 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name);
325 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); 324 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
326 if (!NILP (f->device)) 325 if (!NILP (f->device))
327 { 326 {
328 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, 327 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
329 (f, printcharfun, escapeflag)); 328 (f, printcharfun, escapeflag));
330 329
331 } 330 }
332 write_fmt_string (printcharfun, " 0x%x>", f->header.uid); 331 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
333 } 332 }
334 333
335 static void 334 static void
336 finalize_font_instance (void *header, int for_disksave) 335 finalize_font_instance (Lisp_Object obj)
337 { 336 {
338 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; 337 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
339 338
340 if (!NILP (f->device)) 339 if (!NILP (f->device))
341 { 340 {
342 if (for_disksave) finalose (f);
343 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); 341 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
344 } 342 }
345 } 343 }
346 344
347 /* Fonts are equal if they resolve to the same name. 345 /* Fonts are equal if they resolve to the same name.
366 return internal_hash (font_instance_truename_internal 364 return internal_hash (font_instance_truename_internal
367 (obj, ERROR_ME_DEBUG_WARN), 365 (obj, ERROR_ME_DEBUG_WARN),
368 depth + 1); 366 depth + 1);
369 } 367 }
370 368
371 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, 369 DEFINE_NODUMP_LISP_OBJECT ("font-instance", font_instance,
372 0, /*dumpable-flag*/ 370 mark_font_instance, print_font_instance,
373 mark_font_instance, print_font_instance, 371 finalize_font_instance, font_instance_equal,
374 finalize_font_instance, font_instance_equal, 372 font_instance_hash, font_instance_description,
375 font_instance_hash, font_instance_description, 373 Lisp_Font_Instance);
376 Lisp_Font_Instance);
377 374
378 375
379 /* #### Why is this exposed to Lisp? Used in: 376 /* #### Why is this exposed to Lisp? Used in:
380 x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft, 377 x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft,
381 x-font-menu-load-font-core, mswindows-font-menu-load-font, 378 x-font-menu-load-font-core, mswindows-font-menu-load-font,
392 you drop all pointers to it and allow it to be garbage collected. When 389 you drop all pointers to it and allow it to be garbage collected. When
393 these objects are GCed, the underlying GUI data is deallocated as well. 390 these objects are GCed, the underlying GUI data is deallocated as well.
394 */ 391 */
395 (name, device, noerror, charset)) 392 (name, device, noerror, charset))
396 { 393 {
394 Lisp_Object obj;
397 Lisp_Font_Instance *f; 395 Lisp_Font_Instance *f;
398 int retval = 0; 396 int retval = 0;
399 Error_Behavior errb = decode_error_behavior_flag (noerror); 397 Error_Behavior errb = decode_error_behavior_flag (noerror);
400 398
401 if (ERRB_EQ (errb, ERROR_ME)) 399 if (ERRB_EQ (errb, ERROR_ME))
403 else if (!STRINGP (name)) 401 else if (!STRINGP (name))
404 return Qnil; 402 return Qnil;
405 403
406 device = wrap_device (decode_device (device)); 404 device = wrap_device (decode_device (device));
407 405
408 f = ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); 406 obj = ALLOC_NORMAL_LISP_OBJECT (font_instance);
407 f = XFONT_INSTANCE (obj);
409 f->name = name; 408 f->name = name;
410 f->truename = Qnil; 409 f->truename = Qnil;
411 f->device = device; 410 f->device = device;
412 411
413 f->data = 0; 412 f->data = 0;
424 (f, name, device, errb)); 423 (f, name, device, errb));
425 424
426 if (!retval) 425 if (!retval)
427 return Qnil; 426 return Qnil;
428 427
429 return wrap_font_instance (f); 428 return obj;
430 } 429 }
431 430
432 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* 431 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
433 Return non-nil if OBJECT is a font instance. 432 Return non-nil if OBJECT is a font instance.
434 */ 433 */
1210 { 1209 {
1211 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil; 1210 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
1212 } 1211 }
1213 1212
1214 1213
1214 /*****************************************************************************
1215 Face Background Placement Object
1216 ****************************************************************************/
1217 Lisp_Object Qabsolute, Qrelative;
1218
1219 static const struct memory_description
1220 face_background_placement_specifier_description[] = {
1221 { XD_LISP_OBJECT, offsetof (struct face_background_placement_specifier,
1222 face) },
1223 { XD_END }
1224 };
1225
1226 DEFINE_SPECIFIER_TYPE_WITH_DATA (face_background_placement);
1227 Lisp_Object Qface_background_placement;
1228
1229 static void
1230 face_background_placement_create (Lisp_Object obj)
1231 {
1232 Lisp_Specifier *face_background_placement
1233 = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
1234
1235 FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = Qnil;
1236 }
1237
1238 static void
1239 face_background_placement_mark (Lisp_Object obj)
1240 {
1241 Lisp_Specifier *face_background_placement
1242 = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
1243
1244 mark_object
1245 (FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement));
1246 }
1247
1248 /* No equal or hash methods; ignore the face the background-placement is based
1249 off of for `equal' */
1250
1251 extern Lisp_Object Qbackground_placement;
1252
1253 static Lisp_Object
1254 face_background_placement_instantiate (Lisp_Object UNUSED (specifier),
1255 Lisp_Object UNUSED (matchspec),
1256 Lisp_Object domain,
1257 Lisp_Object instantiator,
1258 Lisp_Object depth,
1259 int no_fallback)
1260 {
1261 /* When called, we're inside of call_with_suspended_errors(),
1262 so we can freely error. */
1263 if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
1264 return instantiator;
1265 else if (VECTORP (instantiator))
1266 {
1267 assert (XVECTOR_LENGTH (instantiator) == 1);
1268
1269 return FACE_PROPERTY_INSTANCE_1
1270 (Fget_face (XVECTOR_DATA (instantiator)[0]),
1271 Qbackground_placement, domain, ERROR_ME, no_fallback, depth);
1272 }
1273 else
1274 ABORT (); /* Eh? */
1275
1276 return Qunbound;
1277 }
1278
1279 static void
1280 face_background_placement_validate (Lisp_Object instantiator)
1281 {
1282 if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
1283 return;
1284 else if (VECTORP (instantiator) &&
1285 (XVECTOR_LENGTH (instantiator) == 1))
1286 {
1287 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
1288
1289 Fget_face (face); /* just to check that the face exists -- dvl */
1290 }
1291 else if (VECTORP (instantiator))
1292 sferror ("Wrong length for background-placement inheritance spec",
1293 instantiator);
1294 else
1295 invalid_argument
1296 ("\
1297 Background-placement instantiator must be absolute, relative or vector",
1298 instantiator);
1299 }
1300
1301 static void
1302 face_background_placement_after_change (Lisp_Object specifier,
1303 Lisp_Object locale)
1304 {
1305 Lisp_Object face
1306 = FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE
1307 (XFACE_BACKGROUND_PLACEMENT_SPECIFIER (specifier));
1308
1309 if (!NILP (face))
1310 {
1311 face_property_was_changed (face, Qbackground_placement, locale);
1312 if (BUFFERP (locale))
1313 XBUFFER (locale)->buffer_local_face_property = 1;
1314 }
1315 }
1316
1317 void
1318 set_face_background_placement_attached_to (Lisp_Object obj, Lisp_Object face)
1319 {
1320 Lisp_Specifier *face_background_placement
1321 = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
1322
1323 FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = face;
1324 }
1325
1326 DEFUN ("face-background-placement-specifier-p", Fface_background_placement_specifier_p, 1, 1, 0, /*
1327 Return non-nil if OBJECT is a face-background-placement specifier.
1328
1329 See `make-face-background-placement-specifier' for a description of possible
1330 face-background-placement instantiators.
1331 */
1332 (object))
1333 {
1334 return FACE_BACKGROUND_PLACEMENT_SPECIFIERP (object) ? Qt : Qnil;
1335 }
1336
1337
1215 /************************************************************************/ 1338 /************************************************************************/
1216 /* initialization */ 1339 /* initialization */
1217 /************************************************************************/ 1340 /************************************************************************/
1218 1341
1219 void 1342 void
1220 syms_of_fontcolor (void) 1343 syms_of_fontcolor (void)
1221 { 1344 {
1222 INIT_LRECORD_IMPLEMENTATION (color_instance); 1345 INIT_LISP_OBJECT (color_instance);
1223 INIT_LRECORD_IMPLEMENTATION (font_instance); 1346 INIT_LISP_OBJECT (font_instance);
1224 1347
1225 DEFSUBR (Fcolor_specifier_p); 1348 DEFSUBR (Fcolor_specifier_p);
1226 DEFSUBR (Ffont_specifier_p); 1349 DEFSUBR (Ffont_specifier_p);
1227 DEFSUBR (Fface_boolean_specifier_p); 1350 DEFSUBR (Fface_boolean_specifier_p);
1351 DEFSUBR (Fface_background_placement_specifier_p);
1228 1352
1229 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep); 1353 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
1230 DEFSUBR (Fmake_color_instance); 1354 DEFSUBR (Fmake_color_instance);
1231 DEFSUBR (Fcolor_instance_p); 1355 DEFSUBR (Fcolor_instance_p);
1232 DEFSUBR (Fcolor_instance_name); 1356 DEFSUBR (Fcolor_instance_name);
1247 DEFSUBR (Ffont_instance_properties); 1371 DEFSUBR (Ffont_instance_properties);
1248 DEFSUBR (Ffont_list); 1372 DEFSUBR (Ffont_list);
1249 1373
1250 /* Qcolor, Qfont defined in general.c */ 1374 /* Qcolor, Qfont defined in general.c */
1251 DEFSYMBOL (Qface_boolean); 1375 DEFSYMBOL (Qface_boolean);
1376
1377 DEFSYMBOL (Qface_background_placement);
1378 DEFSYMBOL (Qabsolute);
1379 DEFSYMBOL (Qrelative);
1252 } 1380 }
1253 1381
1254 void 1382 void
1255 specifier_type_create_fontcolor (void) 1383 specifier_type_create_fontcolor (void)
1256 { 1384 {
1257 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); 1385 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
1258 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); 1386 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
1259 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean", 1387 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
1260 "face-boolean-specifier-p"); 1388 "face-boolean-specifier-p");
1389 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_background_placement,
1390 "face-background-placement",
1391 "\
1392 face-background-placement-specifier-p");
1261 1393
1262 SPECIFIER_HAS_METHOD (color, instantiate); 1394 SPECIFIER_HAS_METHOD (color, instantiate);
1263 SPECIFIER_HAS_METHOD (font, instantiate); 1395 SPECIFIER_HAS_METHOD (font, instantiate);
1264 SPECIFIER_HAS_METHOD (face_boolean, instantiate); 1396 SPECIFIER_HAS_METHOD (face_boolean, instantiate);
1397 SPECIFIER_HAS_METHOD (face_background_placement, instantiate);
1265 1398
1266 SPECIFIER_HAS_METHOD (color, validate); 1399 SPECIFIER_HAS_METHOD (color, validate);
1267 SPECIFIER_HAS_METHOD (font, validate); 1400 SPECIFIER_HAS_METHOD (font, validate);
1268 SPECIFIER_HAS_METHOD (face_boolean, validate); 1401 SPECIFIER_HAS_METHOD (face_boolean, validate);
1402 SPECIFIER_HAS_METHOD (face_background_placement, validate);
1269 1403
1270 SPECIFIER_HAS_METHOD (color, create); 1404 SPECIFIER_HAS_METHOD (color, create);
1271 SPECIFIER_HAS_METHOD (font, create); 1405 SPECIFIER_HAS_METHOD (font, create);
1272 SPECIFIER_HAS_METHOD (face_boolean, create); 1406 SPECIFIER_HAS_METHOD (face_boolean, create);
1407 SPECIFIER_HAS_METHOD (face_background_placement, create);
1273 1408
1274 SPECIFIER_HAS_METHOD (color, mark); 1409 SPECIFIER_HAS_METHOD (color, mark);
1275 SPECIFIER_HAS_METHOD (font, mark); 1410 SPECIFIER_HAS_METHOD (font, mark);
1276 SPECIFIER_HAS_METHOD (face_boolean, mark); 1411 SPECIFIER_HAS_METHOD (face_boolean, mark);
1412 SPECIFIER_HAS_METHOD (face_background_placement, mark);
1277 1413
1278 SPECIFIER_HAS_METHOD (color, after_change); 1414 SPECIFIER_HAS_METHOD (color, after_change);
1279 SPECIFIER_HAS_METHOD (font, after_change); 1415 SPECIFIER_HAS_METHOD (font, after_change);
1280 SPECIFIER_HAS_METHOD (face_boolean, after_change); 1416 SPECIFIER_HAS_METHOD (face_boolean, after_change);
1417 SPECIFIER_HAS_METHOD (face_background_placement, after_change);
1281 1418
1282 #ifdef MULE 1419 #ifdef MULE
1283 SPECIFIER_HAS_METHOD (font, validate_matchspec); 1420 SPECIFIER_HAS_METHOD (font, validate_matchspec);
1284 #endif 1421 #endif
1285 } 1422 }
1288 reinit_specifier_type_create_fontcolor (void) 1425 reinit_specifier_type_create_fontcolor (void)
1289 { 1426 {
1290 REINITIALIZE_SPECIFIER_TYPE (color); 1427 REINITIALIZE_SPECIFIER_TYPE (color);
1291 REINITIALIZE_SPECIFIER_TYPE (font); 1428 REINITIALIZE_SPECIFIER_TYPE (font);
1292 REINITIALIZE_SPECIFIER_TYPE (face_boolean); 1429 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
1430 REINITIALIZE_SPECIFIER_TYPE (face_background_placement);
1293 } 1431 }
1294 1432
1295 void 1433 void
1296 reinit_vars_of_fontcolor (void) 1434 reinit_vars_of_fontcolor (void)
1297 { 1435 {
1298 staticpro_nodump (&Vthe_null_color_instance);
1299 { 1436 {
1300 Lisp_Color_Instance *c = 1437 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (color_instance);
1301 ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); 1438 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
1302 c->name = Qnil; 1439 c->name = Qnil;
1303 c->device = Qnil; 1440 c->device = Qnil;
1304 c->data = 0; 1441 c->data = 0;
1305 1442
1306 Vthe_null_color_instance = wrap_color_instance (c); 1443 Vthe_null_color_instance = obj;
1444 staticpro_nodump (&Vthe_null_color_instance);
1307 } 1445 }
1308 1446
1309 staticpro_nodump (&Vthe_null_font_instance);
1310 { 1447 {
1311 Lisp_Font_Instance *f = 1448 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (font_instance);
1312 ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); 1449 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
1313 f->name = Qnil; 1450 f->name = Qnil;
1314 f->truename = Qnil; 1451 f->truename = Qnil;
1315 f->device = Qnil; 1452 f->device = Qnil;
1316 f->data = 0; 1453 f->data = 0;
1317 1454
1318 f->ascent = f->height = 0; 1455 f->ascent = f->height = 0;
1319 f->descent = 0; 1456 f->descent = 0;
1320 f->width = 0; 1457 f->width = 0;
1321 f->proportional_p = 0; 1458 f->proportional_p = 0;
1322 1459
1323 Vthe_null_font_instance = wrap_font_instance (f); 1460 Vthe_null_font_instance = obj;
1461 staticpro_nodump (&Vthe_null_font_instance);
1324 } 1462 }
1325 } 1463 }
1326 1464
1327 void 1465 void
1328 vars_of_fontcolor (void) 1466 vars_of_fontcolor (void)