Mercurial > hg > xemacs-beta

comparison src/objects.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 501cfd01ee6d
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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) 60 mark_color_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
61 { 61 {
62 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 62 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
63 mark_object (c->name); 63 markobj (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)); 65 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj));
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 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 75 struct 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 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; 93 struct Lisp_Color_Instance *c = (struct 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 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); 105 struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
106 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); 106 struct 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 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 118 struct 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, 0, 130 color_instance_hash,
131 Lisp_Color_Instance); 131 struct 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 Lisp_Color_Instance *c; 152 struct 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 (Lisp_Color_Instance, &lrecord_color_instance); 159 c = alloc_lcrecord_type (struct 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 Lisp_Color_Instance *c; 198 struct 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) 240 mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
241 { 241 {
242 Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 242 struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
243 243
244 mark_object (f->name); 244 markobj (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)); 246 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj));
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 Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 255 struct 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);
267 } 267 }
268 268
269 static void 269 static void
270 finalize_font_instance (void *header, int for_disksave) 270 finalize_font_instance (void *header, int for_disksave)
271 { 271 {
272 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; 272 struct Lisp_Font_Instance *f = (struct Lisp_Font_Instance *) header;
273 273
274 if (!NILP (f->device)) 274 if (!NILP (f->device))
275 { 275 {
276 if (for_disksave) finalose (f); 276 if (for_disksave) finalose (f);
277 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); 277 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
299 } 299 }
300 300
301 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, 301 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
302 mark_font_instance, print_font_instance, 302 mark_font_instance, print_font_instance,
303 finalize_font_instance, font_instance_equal, 303 finalize_font_instance, font_instance_equal,
304 font_instance_hash, 0, Lisp_Font_Instance); 304 font_instance_hash, struct Lisp_Font_Instance);
305 305
306 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* 306 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
307 Return a new `font-instance' object named NAME. 307 Return a new `font-instance' object named NAME.
308 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
309 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
315 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
316 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.
317 */ 317 */
318 (name, device, no_error)) 318 (name, device, no_error))
319 { 319 {
320 Lisp_Font_Instance *f; 320 struct Lisp_Font_Instance *f;
321 Lisp_Object val; 321 Lisp_Object val;
322 int retval = 0; 322 int retval = 0;
323 Error_behavior errb = decode_error_behavior_flag (no_error); 323 Error_behavior errb = decode_error_behavior_flag (no_error);
324 324
325 if (ERRB_EQ (errb, ERROR_ME)) 325 if (ERRB_EQ (errb, ERROR_ME))
327 else if (!STRINGP (name)) 327 else if (!STRINGP (name))
328 return Qnil; 328 return Qnil;
329 329
330 XSETDEVICE (device, decode_device (device)); 330 XSETDEVICE (device, decode_device (device));
331 331
332 f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); 332 f = alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance);
333 f->name = name; 333 f->name = name;
334 f->device = device; 334 f->device = device;
335 335
336 f->data = 0; 336 f->data = 0;
337 337
415 415
416 static Lisp_Object 416 static Lisp_Object
417 font_instance_truename_internal (Lisp_Object font_instance, 417 font_instance_truename_internal (Lisp_Object font_instance,
418 Error_behavior errb) 418 Error_behavior errb)
419 { 419 {
420 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); 420 struct Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
421 421
422 if (NILP (f->device)) 422 if (NILP (f->device))
423 { 423 {
424 maybe_signal_simple_error ("Couldn't determine font truename", 424 maybe_signal_simple_error ("Couldn't determine font truename",
425 font_instance, Qfont, errb); 425 font_instance, Qfont, errb);
426 return Qnil; 426 return Qnil;
427 } 427 }
428 428
429 return DEVMETH_OR_GIVEN (XDEVICE (f->device), 429 return DEVMETH_OR_GIVEN (XDEVICE (f->device),
430 font_instance_truename, (f, errb), f->name); 430 font_instance_truename, (f, errb), f->name);
431 } 431 }
432 432
433 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* 433 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /*
445 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* 445 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /*
446 Return the properties (an alist or nil) of FONT-INSTANCE. 446 Return the properties (an alist or nil) of FONT-INSTANCE.
447 */ 447 */
448 (font_instance)) 448 (font_instance))
449 { 449 {
450 Lisp_Font_Instance *f; 450 struct Lisp_Font_Instance *f;
451 451
452 CHECK_FONT_INSTANCE (font_instance); 452 CHECK_FONT_INSTANCE (font_instance);
453 f = XFONT_INSTANCE (font_instance); 453 f = XFONT_INSTANCE (font_instance);
454 454
455 if (NILP (f->device)) 455 if (NILP (f->device))
480 /* Qcolor defined in general.c */ 480 /* Qcolor defined in general.c */
481 481
482 static void 482 static void
483 color_create (Lisp_Object obj) 483 color_create (Lisp_Object obj)
484 { 484 {
485 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 485 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
486 486
487 COLOR_SPECIFIER_FACE (color) = Qnil; 487 COLOR_SPECIFIER_FACE (color) = Qnil;
488 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; 488 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
489 } 489 }
490 490
491 static void 491 static void
492 color_mark (Lisp_Object obj) 492 color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
493 { 493 {
494 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 494 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
495 495
496 mark_object (COLOR_SPECIFIER_FACE (color)); 496 markobj (COLOR_SPECIFIER_FACE (color));
497 mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color)); 497 markobj (COLOR_SPECIFIER_FACE_PROPERTY (color));
498 } 498 }
499 499
500 /* 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
501 of for `equal' */ 501 of for `equal' */
502 502
505 Lisp_Object domain, Lisp_Object instantiator, 505 Lisp_Object domain, Lisp_Object instantiator,
506 Lisp_Object depth) 506 Lisp_Object depth)
507 { 507 {
508 /* When called, we're inside of call_with_suspended_errors(), 508 /* When called, we're inside of call_with_suspended_errors(),
509 so we can freely error. */ 509 so we can freely error. */
510 Lisp_Object device = DOMAIN_DEVICE (domain); 510 Lisp_Object device = DFW_DEVICE (domain);
511 struct device *d = XDEVICE (device); 511 struct device *d = XDEVICE (device);
512 512
513 if (COLOR_INSTANCEP (instantiator)) 513 if (COLOR_INSTANCEP (instantiator))
514 { 514 {
515 /* If we are on the same device then we're done. Otherwise change 515 /* If we are on the same device then we're done. Otherwise change
620 } 620 }
621 621
622 void 622 void
623 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)
624 { 624 {
625 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 625 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
626 626
627 COLOR_SPECIFIER_FACE (color) = face; 627 COLOR_SPECIFIER_FACE (color) = face;
628 COLOR_SPECIFIER_FACE_PROPERTY (color) = property; 628 COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
629 } 629 }
630 630
631 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /* 631 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /*
632 Return t if OBJECT is a color specifier. 632 Return t if OBJECT is a color specifier.
633 633
634 See `make-color-specifier' for a description of possible color instantiators. 634 Valid instantiators for color specifiers are:
635
636 -- a string naming a color (e.g. under X this might be "lightseagreen2"
637 or "#F534B2")
638 -- a color instance (use that instance directly if the device matches,
639 or use the string that generated it)
640 -- a vector of no elements (only on TTY's; this means to set no color
641 at all, thus using the "natural" color of the terminal's text)
642 -- a vector of one or two elements: a face to inherit from, and
643 optionally a symbol naming which property of that face to inherit,
644 either `foreground' or `background' (if omitted, defaults to the same
645 property that this color specifier is used for; if this specifier is
646 not part of a face, the instantiator would not be valid)
635 */ 647 */
636 (object)) 648 (object))
637 { 649 {
638 return COLOR_SPECIFIERP (object) ? Qt : Qnil; 650 return COLOR_SPECIFIERP (object) ? Qt : Qnil;
639 } 651 }
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 Lisp_Specifier *font = XFONT_SPECIFIER (obj); 663 struct 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) 670 font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
659 { 671 {
660 Lisp_Specifier *font = XFONT_SPECIFIER (obj); 672 struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
661 673
662 mark_object (FONT_SPECIFIER_FACE (font)); 674 markobj (FONT_SPECIFIER_FACE (font));
663 mark_object (FONT_SPECIFIER_FACE_PROPERTY (font)); 675 markobj (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);
692 Lisp_Object domain, Lisp_Object instantiator, 704 Lisp_Object domain, Lisp_Object instantiator,
693 Lisp_Object depth) 705 Lisp_Object depth)
694 { 706 {
695 /* When called, we're inside of call_with_suspended_errors(), 707 /* When called, we're inside of call_with_suspended_errors(),
696 so we can freely error. */ 708 so we can freely error. */
697 Lisp_Object device = DOMAIN_DEVICE (domain); 709 Lisp_Object device = DFW_DEVICE (domain);
698 struct device *d = XDEVICE (device); 710 struct device *d = XDEVICE (device);
699 Lisp_Object instance; 711 Lisp_Object instance;
700 712
701 #ifdef MULE 713 #ifdef MULE
702 if (!UNBOUNDP (matchspec)) 714 if (!UNBOUNDP (matchspec))
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 Lisp_Specifier *font = XFONT_SPECIFIER (obj); 835 struct 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
829 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /* 841 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /*
830 Return non-nil if OBJECT is a font specifier. 842 Return non-nil if OBJECT is a font specifier.
831 843
832 See `make-font-specifier' for a description of possible font instantiators. 844 Valid instantiators for font specifiers are:
845
846 -- a string naming a font (e.g. under X this might be
847 "-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*" for a 14-point
848 upright medium-weight Courier font)
849 -- a font instance (use that instance directly if the device matches,
850 or use the string that generated it)
851 -- a vector of no elements (only on TTY's; this means to set no font
852 at all, thus using the "natural" font of the terminal's text)
853 -- a vector of one element (a face to inherit from)
833 */ 854 */
834 (object)) 855 (object))
835 { 856 {
836 return FONT_SPECIFIERP (object) ? Qt : Qnil; 857 return FONT_SPECIFIERP (object) ? Qt : Qnil;
837 } 858 }
844 Lisp_Object Qface_boolean; 865 Lisp_Object Qface_boolean;
845 866
846 static void 867 static void
847 face_boolean_create (Lisp_Object obj) 868 face_boolean_create (Lisp_Object obj)
848 { 869 {
849 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 870 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
850 871
851 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil; 872 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
852 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil; 873 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
853 } 874 }
854 875
855 static void 876 static void
856 face_boolean_mark (Lisp_Object obj) 877 face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
857 { 878 {
858 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 879 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
859 880
860 mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); 881 markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
861 mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); 882 markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
862 } 883 }
863 884
864 /* 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
865 of for `equal' */ 886 of for `equal' */
866 887
954 975
955 void 976 void
956 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, 977 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
957 Lisp_Object property) 978 Lisp_Object property)
958 { 979 {
959 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 980 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
960 981
961 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; 982 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
962 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; 983 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
963 } 984 }
964 985
965 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /* 986 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /*
966 Return non-nil if OBJECT is a face-boolean specifier. 987 Return non-nil if OBJECT is a face-boolean specifier.
967 988
968 See `make-face-boolean-specifier' for a description of possible 989 Valid instantiators for face-boolean specifiers are
969 face-boolean instantiators. 990
991 -- t or nil
992 -- a vector of two or three elements: a face to inherit from,
993 optionally a symbol naming the property of that face to inherit from
994 (if omitted, defaults to the same property that this face-boolean
995 specifier is used for; if this specifier is not part of a face,
996 the instantiator would not be valid), and optionally a value which,
997 if non-nil, means to invert the sense of the inherited property.
970 */ 998 */
971 (object)) 999 (object))
972 { 1000 {
973 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil; 1001 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
974 } 1002 }
979 /************************************************************************/ 1007 /************************************************************************/
980 1008
981 void 1009 void
982 syms_of_objects (void) 1010 syms_of_objects (void)
983 { 1011 {
984 INIT_LRECORD_IMPLEMENTATION (color_instance);
985 INIT_LRECORD_IMPLEMENTATION (font_instance);
986
987 DEFSUBR (Fcolor_specifier_p); 1012 DEFSUBR (Fcolor_specifier_p);
988 DEFSUBR (Ffont_specifier_p); 1013 DEFSUBR (Ffont_specifier_p);
989 DEFSUBR (Fface_boolean_specifier_p); 1014 DEFSUBR (Fface_boolean_specifier_p);
990 1015
991 defsymbol (&Qcolor_instancep, "color-instance-p"); 1016 defsymbol (&Qcolor_instancep, "color-instance-p");
1009 1034
1010 /* Qcolor, Qfont defined in general.c */ 1035 /* Qcolor, Qfont defined in general.c */
1011 defsymbol (&Qface_boolean, "face-boolean"); 1036 defsymbol (&Qface_boolean, "face-boolean");
1012 } 1037 }
1013 1038
1014 static const struct lrecord_description color_specifier_description[] = {
1015 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) },
1016 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) },
1017 { XD_END }
1018 };
1019
1020 static const struct lrecord_description font_specifier_description[] = {
1021 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) },
1022 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) },
1023 { XD_END }
1024 };
1025
1026 static const struct lrecord_description face_boolean_specifier_description[] = {
1027 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) },
1028 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) },
1029 { XD_END }
1030 };
1031
1032 void 1039 void
1033 specifier_type_create_objects (void) 1040 specifier_type_create_objects (void)
1034 { 1041 {
1035 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); 1042 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
1036 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); 1043 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
1061 SPECIFIER_HAS_METHOD (font, validate_matchspec); 1068 SPECIFIER_HAS_METHOD (font, validate_matchspec);
1062 #endif 1069 #endif
1063 } 1070 }
1064 1071
1065 void 1072 void
1066 reinit_specifier_type_create_objects (void) 1073 vars_of_objects (void)
1067 { 1074 {
1068 REINITIALIZE_SPECIFIER_TYPE (color); 1075 staticpro (&Vthe_null_color_instance);
1069 REINITIALIZE_SPECIFIER_TYPE (font);
1070 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
1071 }
1072
1073 void
1074 reinit_vars_of_objects (void)
1075 {
1076 staticpro_nodump (&Vthe_null_color_instance);
1077 { 1076 {
1078 Lisp_Color_Instance *c = 1077 struct Lisp_Color_Instance *c =
1079 alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); 1078 alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance);
1080 c->name = Qnil; 1079 c->name = Qnil;
1081 c->device = Qnil; 1080 c->device = Qnil;
1082 c->data = 0; 1081 c->data = 0;
1083 1082
1084 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c); 1083 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c);
1085 } 1084 }
1086 1085
1087 staticpro_nodump (&Vthe_null_font_instance); 1086 staticpro (&Vthe_null_font_instance);
1088 { 1087 {
1089 Lisp_Font_Instance *f = 1088 struct Lisp_Font_Instance *f =
1090 alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); 1089 alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance);
1091 f->name = Qnil; 1090 f->name = Qnil;
1092 f->device = Qnil; 1091 f->device = Qnil;
1093 f->data = 0; 1092 f->data = 0;
1094 1093
1095 f->ascent = f->height = 0; 1094 f->ascent = f->height = 0;
1098 f->proportional_p = 0; 1097 f->proportional_p = 0;
1099 1098
1100 XSETFONT_INSTANCE (Vthe_null_font_instance, f); 1099 XSETFONT_INSTANCE (Vthe_null_font_instance, f);
1101 } 1100 }
1102 } 1101 }
1103
1104 void
1105 vars_of_objects (void)
1106 {
1107 reinit_vars_of_objects ();
1108 }