comparison src/objects.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
55 ****************************************************************************/ 55 ****************************************************************************/
56 56
57 Lisp_Object Qcolor_instancep; 57 Lisp_Object Qcolor_instancep;
58 58
59 static Lisp_Object 59 static Lisp_Object
60 mark_color_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) 60 mark_color_instance (Lisp_Object obj)
61 { 61 {
62 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 62 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
63 markobj (c->name); 63 mark_object (c->name);
64 if (!NILP (c->device)) /* Vthe_null_color_instance */ 64 if (!NILP (c->device)) /* Vthe_null_color_instance */
65 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj)); 65 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c));
66 66
67 return c->device; 67 return c->device;
68 } 68 }
69 69
70 static void 70 static void
71 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, 71 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
72 int escapeflag) 72 int escapeflag)
73 { 73 {
74 char buf[100]; 74 char buf[100];
75 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 75 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
76 if (print_readably) 76 if (print_readably)
77 error ("printing unreadable object #<color-instance 0x%x>", 77 error ("printing unreadable object #<color-instance 0x%x>",
78 c->header.uid); 78 c->header.uid);
79 write_c_string ("#<color-instance ", printcharfun); 79 write_c_string ("#<color-instance ", printcharfun);
80 print_internal (c->name, printcharfun, 0); 80 print_internal (c->name, printcharfun, 0);
88 } 88 }
89 89
90 static void 90 static void
91 finalize_color_instance (void *header, int for_disksave) 91 finalize_color_instance (void *header, int for_disksave)
92 { 92 {
93 struct Lisp_Color_Instance *c = (struct Lisp_Color_Instance *) header; 93 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
94 94
95 if (!NILP (c->device)) 95 if (!NILP (c->device))
96 { 96 {
97 if (for_disksave) finalose (c); 97 if (for_disksave) finalose (c);
98 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); 98 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
100 } 100 }
101 101
102 static int 102 static int
103 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 103 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
104 { 104 {
105 struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); 105 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
106 struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); 106 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
107 107
108 return (c1 == c2) || 108 return (c1 == c2) ||
109 ((EQ (c1->device, c2->device)) && 109 (EQ (c1->device, c2->device) &&
110 DEVICEP (c1->device) && 110 DEVICEP (c1->device) &&
111 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) && 111 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) &&
112 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); 112 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth)));
113 } 113 }
114 114
115 static unsigned long 115 static unsigned long
116 color_instance_hash (Lisp_Object obj, int depth) 116 color_instance_hash (Lisp_Object obj, int depth)
117 { 117 {
118 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 118 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
119 struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; 119 struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0;
120 120
121 return HASH2 ((unsigned long) d, 121 return HASH2 ((unsigned long) d,
122 !d ? LISP_HASH (obj) 122 !d ? LISP_HASH (obj)
123 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), 123 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth),
125 } 125 }
126 126
127 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, 127 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
128 mark_color_instance, print_color_instance, 128 mark_color_instance, print_color_instance,
129 finalize_color_instance, color_instance_equal, 129 finalize_color_instance, color_instance_equal,
130 color_instance_hash, 130 color_instance_hash, 0,
131 struct Lisp_Color_Instance); 131 Lisp_Color_Instance);
132 132
133 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* 133 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
134 Return a new `color-instance' object named NAME (a string). 134 Return a new `color-instance' object named NAME (a string).
135 135
136 Optional argument DEVICE specifies the device this object applies to 136 Optional argument DEVICE specifies the device this object applies to
147 these objects are GCed, the underlying window-system data (e.g. X object) 147 these objects are GCed, the underlying window-system data (e.g. X object)
148 is deallocated as well. 148 is deallocated as well.
149 */ 149 */
150 (name, device, no_error)) 150 (name, device, no_error))
151 { 151 {
152 struct Lisp_Color_Instance *c; 152 Lisp_Color_Instance *c;
153 Lisp_Object val; 153 Lisp_Object val;
154 int retval; 154 int retval;
155 155
156 CHECK_STRING (name); 156 CHECK_STRING (name);
157 XSETDEVICE (device, decode_device (device)); 157 XSETDEVICE (device, decode_device (device));
158 158
159 c = alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); 159 c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
160 c->name = name; 160 c->name = name;
161 c->device = device; 161 c->device = device;
162 c->data = 0; 162 c->data = 0;
163 163
164 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance, 164 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance,
193 color components of COLOR-INSTANCE, or nil if unknown. 193 color components of COLOR-INSTANCE, or nil if unknown.
194 Component values range from 0 to 65535. 194 Component values range from 0 to 65535.
195 */ 195 */
196 (color_instance)) 196 (color_instance))
197 { 197 {
198 struct Lisp_Color_Instance *c; 198 Lisp_Color_Instance *c;
199 199
200 CHECK_COLOR_INSTANCE (color_instance); 200 CHECK_COLOR_INSTANCE (color_instance);
201 c = XCOLOR_INSTANCE (color_instance); 201 c = XCOLOR_INSTANCE (color_instance);
202 202
203 if (NILP (c->device)) 203 if (NILP (c->device))
235 235
236 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont, 236 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont,
237 Error_behavior errb); 237 Error_behavior errb);
238 238
239 static Lisp_Object 239 static Lisp_Object
240 mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) 240 mark_font_instance (Lisp_Object obj)
241 { 241 {
242 struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 242 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
243 243
244 markobj (f->name); 244 mark_object (f->name);
245 if (!NILP (f->device)) /* Vthe_null_font_instance */ 245 if (!NILP (f->device)) /* Vthe_null_font_instance */
246 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj)); 246 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f));
247 247
248 return f->device; 248 return f->device;
249 } 249 }
250 250
251 static void 251 static void
252 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 252 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
253 { 253 {
254 char buf[200]; 254 char buf[200];
255 struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 255 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
256 if (print_readably) 256 if (print_readably)
257 error ("printing unreadable object #<font-instance 0x%x>", f->header.uid); 257 error ("printing unreadable object #<font-instance 0x%x>", f->header.uid);
258 write_c_string ("#<font-instance ", printcharfun); 258 write_c_string ("#<font-instance ", printcharfun);
259 print_internal (f->name, printcharfun, 1); 259 print_internal (f->name, printcharfun, 1);
260 write_c_string (" on ", printcharfun); 260 write_c_string (" on ", printcharfun);
261 print_internal (f->device, printcharfun, 0); 261 print_internal (f->device, printcharfun, 0);
262 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, 262 if (!NILP (f->device))
263 (f, printcharfun, escapeflag)); 263 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
264 (f, printcharfun, escapeflag));
264 sprintf (buf, " 0x%x>", f->header.uid); 265 sprintf (buf, " 0x%x>", f->header.uid);
265 write_c_string (buf, printcharfun); 266 write_c_string (buf, printcharfun);
266 } 267 }
267 268
268 static void 269 static void
269 finalize_font_instance (void *header, int for_disksave) 270 finalize_font_instance (void *header, int for_disksave)
270 { 271 {
271 struct Lisp_Font_Instance *f = (struct Lisp_Font_Instance *) header; 272 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
272 273
273 if (!NILP (f->device)) 274 if (!NILP (f->device))
274 { 275 {
275 if (for_disksave) finalose (f); 276 if (for_disksave) finalose (f);
276 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); 277 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
298 } 299 }
299 300
300 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, 301 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
301 mark_font_instance, print_font_instance, 302 mark_font_instance, print_font_instance,
302 finalize_font_instance, font_instance_equal, 303 finalize_font_instance, font_instance_equal,
303 font_instance_hash, struct Lisp_Font_Instance); 304 font_instance_hash, 0, Lisp_Font_Instance);
304 305
305 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* 306 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
306 Return a new `font-instance' object named NAME. 307 Return a new `font-instance' object named NAME.
307 DEVICE specifies the device this object applies to and defaults to the 308 DEVICE specifies the device this object applies to and defaults to the
308 selected device. An error is signalled if the font is unknown or cannot 309 selected device. An error is signalled if the font is unknown or cannot
314 you drop all pointers to it and allow it to be garbage collected. When 315 you drop all pointers to it and allow it to be garbage collected. When
315 these objects are GCed, the underlying X data is deallocated as well. 316 these objects are GCed, the underlying X data is deallocated as well.
316 */ 317 */
317 (name, device, no_error)) 318 (name, device, no_error))
318 { 319 {
319 struct Lisp_Font_Instance *f; 320 Lisp_Font_Instance *f;
320 Lisp_Object val; 321 Lisp_Object val;
321 int retval = 0; 322 int retval = 0;
322 Error_behavior errb = decode_error_behavior_flag (no_error); 323 Error_behavior errb = decode_error_behavior_flag (no_error);
323 324
324 if (ERRB_EQ (errb, ERROR_ME)) 325 if (ERRB_EQ (errb, ERROR_ME))
326 else if (!STRINGP (name)) 327 else if (!STRINGP (name))
327 return Qnil; 328 return Qnil;
328 329
329 XSETDEVICE (device, decode_device (device)); 330 XSETDEVICE (device, decode_device (device));
330 331
331 f = alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); 332 f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
332 f->name = name; 333 f->name = name;
333 f->device = device; 334 f->device = device;
334 335
335 f->data = 0; 336 f->data = 0;
336 337
414 415
415 static Lisp_Object 416 static Lisp_Object
416 font_instance_truename_internal (Lisp_Object font_instance, 417 font_instance_truename_internal (Lisp_Object font_instance,
417 Error_behavior errb) 418 Error_behavior errb)
418 { 419 {
419 struct Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); 420 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
420 struct device *d = XDEVICE (f->device); 421
421 return DEVMETH_OR_GIVEN (d, font_instance_truename, (f, errb), f->name); 422 if (NILP (f->device))
423 {
424 maybe_signal_simple_error ("Couldn't determine font truename",
425 font_instance, Qfont, errb);
426 return Qnil;
427 }
428
429 return DEVMETH_OR_GIVEN (XDEVICE (f->device),
430 font_instance_truename, (f, errb), f->name);
422 } 431 }
423 432
424 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* 433 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /*
425 Return the canonical name of FONT-INSTANCE. 434 Return the canonical name of FONT-INSTANCE.
426 Font names are patterns which may match any number of fonts, of which 435 Font names are patterns which may match any number of fonts, of which
436 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* 445 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /*
437 Return the properties (an alist or nil) of FONT-INSTANCE. 446 Return the properties (an alist or nil) of FONT-INSTANCE.
438 */ 447 */
439 (font_instance)) 448 (font_instance))
440 { 449 {
441 struct Lisp_Font_Instance *f; 450 Lisp_Font_Instance *f;
442 451
443 CHECK_FONT_INSTANCE (font_instance); 452 CHECK_FONT_INSTANCE (font_instance);
444 f = XFONT_INSTANCE (font_instance); 453 f = XFONT_INSTANCE (font_instance);
454
455 if (NILP (f->device))
456 return Qnil;
445 457
446 return MAYBE_LISP_DEVMETH (XDEVICE (f->device), 458 return MAYBE_LISP_DEVMETH (XDEVICE (f->device),
447 font_instance_properties, (f)); 459 font_instance_properties, (f));
448 } 460 }
449 461
468 /* Qcolor defined in general.c */ 480 /* Qcolor defined in general.c */
469 481
470 static void 482 static void
471 color_create (Lisp_Object obj) 483 color_create (Lisp_Object obj)
472 { 484 {
473 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 485 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
474 486
475 COLOR_SPECIFIER_FACE (color) = Qnil; 487 COLOR_SPECIFIER_FACE (color) = Qnil;
476 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; 488 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
477 } 489 }
478 490
479 static void 491 static void
480 color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) 492 color_mark (Lisp_Object obj)
481 { 493 {
482 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 494 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
483 495
484 markobj (COLOR_SPECIFIER_FACE (color)); 496 mark_object (COLOR_SPECIFIER_FACE (color));
485 markobj (COLOR_SPECIFIER_FACE_PROPERTY (color)); 497 mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color));
486 } 498 }
487 499
488 /* No equal or hash methods; ignore the face the color is based off 500 /* No equal or hash methods; ignore the face the color is based off
489 of for `equal' */ 501 of for `equal' */
490 502
608 } 620 }
609 621
610 void 622 void
611 set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) 623 set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
612 { 624 {
613 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 625 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
614 626
615 COLOR_SPECIFIER_FACE (color) = face; 627 COLOR_SPECIFIER_FACE (color) = face;
616 COLOR_SPECIFIER_FACE_PROPERTY (color) = property; 628 COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
617 } 629 }
618 630
646 /* Qfont defined in general.c */ 658 /* Qfont defined in general.c */
647 659
648 static void 660 static void
649 font_create (Lisp_Object obj) 661 font_create (Lisp_Object obj)
650 { 662 {
651 struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); 663 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
652 664
653 FONT_SPECIFIER_FACE (font) = Qnil; 665 FONT_SPECIFIER_FACE (font) = Qnil;
654 FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil; 666 FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil;
655 } 667 }
656 668
657 static void 669 static void
658 font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) 670 font_mark (Lisp_Object obj)
659 { 671 {
660 struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); 672 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
661 673
662 markobj (FONT_SPECIFIER_FACE (font)); 674 mark_object (FONT_SPECIFIER_FACE (font));
663 markobj (FONT_SPECIFIER_FACE_PROPERTY (font)); 675 mark_object (FONT_SPECIFIER_FACE_PROPERTY (font));
664 } 676 }
665 677
666 /* No equal or hash methods; ignore the face the font is based off 678 /* No equal or hash methods; ignore the face the font is based off
667 of for `equal' */ 679 of for `equal' */
668 680
669 #ifdef MULE 681 #ifdef MULE
670 682
671 int 683 int
672 font_spec_matches_charset (struct device *d, Lisp_Object charset, 684 font_spec_matches_charset (struct device *d, Lisp_Object charset,
673 CONST Bufbyte *nonreloc, Lisp_Object reloc, 685 const Bufbyte *nonreloc, Lisp_Object reloc,
674 Bytecount offset, Bytecount length) 686 Bytecount offset, Bytecount length)
675 { 687 {
676 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, 688 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
677 (d, charset, nonreloc, reloc, offset, length), 689 (d, charset, nonreloc, reloc, offset, length),
678 1); 690 1);
818 } 830 }
819 831
820 void 832 void
821 set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) 833 set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
822 { 834 {
823 struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); 835 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
824 836
825 FONT_SPECIFIER_FACE (font) = face; 837 FONT_SPECIFIER_FACE (font) = face;
826 FONT_SPECIFIER_FACE_PROPERTY (font) = property; 838 FONT_SPECIFIER_FACE_PROPERTY (font) = property;
827 } 839 }
828 840
853 Lisp_Object Qface_boolean; 865 Lisp_Object Qface_boolean;
854 866
855 static void 867 static void
856 face_boolean_create (Lisp_Object obj) 868 face_boolean_create (Lisp_Object obj)
857 { 869 {
858 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 870 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
859 871
860 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil; 872 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
861 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil; 873 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
862 } 874 }
863 875
864 static void 876 static void
865 face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) 877 face_boolean_mark (Lisp_Object obj)
866 { 878 {
867 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 879 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
868 880
869 markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); 881 mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
870 markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); 882 mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
871 } 883 }
872 884
873 /* No equal or hash methods; ignore the face the face-boolean is based off 885 /* No equal or hash methods; ignore the face the face-boolean is based off
874 of for `equal' */ 886 of for `equal' */
875 887
963 975
964 void 976 void
965 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, 977 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
966 Lisp_Object property) 978 Lisp_Object property)
967 { 979 {
968 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 980 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
969 981
970 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; 982 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
971 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; 983 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
972 } 984 }
973 985
1022 1034
1023 /* Qcolor, Qfont defined in general.c */ 1035 /* Qcolor, Qfont defined in general.c */
1024 defsymbol (&Qface_boolean, "face-boolean"); 1036 defsymbol (&Qface_boolean, "face-boolean");
1025 } 1037 }
1026 1038
1039 static const struct lrecord_description color_specifier_description[] = {
1040 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) },
1041 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) },
1042 { XD_END }
1043 };
1044
1045 static const struct lrecord_description font_specifier_description[] = {
1046 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) },
1047 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) },
1048 { XD_END }
1049 };
1050
1051 static const struct lrecord_description face_boolean_specifier_description[] = {
1052 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) },
1053 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) },
1054 { XD_END }
1055 };
1056
1027 void 1057 void
1028 specifier_type_create_objects (void) 1058 specifier_type_create_objects (void)
1029 { 1059 {
1030 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); 1060 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
1031 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); 1061 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
1056 SPECIFIER_HAS_METHOD (font, validate_matchspec); 1086 SPECIFIER_HAS_METHOD (font, validate_matchspec);
1057 #endif 1087 #endif
1058 } 1088 }
1059 1089
1060 void 1090 void
1061 vars_of_objects (void) 1091 reinit_specifier_type_create_objects (void)
1062 { 1092 {
1063 staticpro (&Vthe_null_color_instance); 1093 REINITIALIZE_SPECIFIER_TYPE (color);
1094 REINITIALIZE_SPECIFIER_TYPE (font);
1095 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
1096 }
1097
1098 void
1099 reinit_vars_of_objects (void)
1100 {
1101 staticpro_nodump (&Vthe_null_color_instance);
1064 { 1102 {
1065 struct Lisp_Color_Instance *c = 1103 Lisp_Color_Instance *c =
1066 alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); 1104 alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
1067 c->name = Qnil; 1105 c->name = Qnil;
1068 c->device = Qnil; 1106 c->device = Qnil;
1069 c->data = 0; 1107 c->data = 0;
1070 1108
1071 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c); 1109 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c);
1072 } 1110 }
1073 1111
1074 staticpro (&Vthe_null_font_instance); 1112 staticpro_nodump (&Vthe_null_font_instance);
1075 { 1113 {
1076 struct Lisp_Font_Instance *f = 1114 Lisp_Font_Instance *f =
1077 alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); 1115 alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
1078 f->name = Qnil; 1116 f->name = Qnil;
1079 f->device = Qnil; 1117 f->device = Qnil;
1080 f->data = 0; 1118 f->data = 0;
1081 1119
1082 f->ascent = f->height = 0; 1120 f->ascent = f->height = 0;
1085 f->proportional_p = 0; 1123 f->proportional_p = 0;
1086 1124
1087 XSETFONT_INSTANCE (Vthe_null_font_instance, f); 1125 XSETFONT_INSTANCE (Vthe_null_font_instance, f);
1088 } 1126 }
1089 } 1127 }
1128
1129 void
1130 vars_of_objects (void)
1131 {
1132 reinit_vars_of_objects ();
1133 }