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