Mercurial > hg > xemacs-beta

comparison src/objects.c @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 131b0175ea99
children 3d6bfa290dbd
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
40 /* Authors: Ben Wing, Chuck Thompson */ 40 /* Authors: Ben Wing, Chuck Thompson */
41 41
42 void 42 void
43 finalose (void *ptr) 43 finalose (void *ptr)
44 { 44 {
45 Lisp_Object obj; 45 Lisp_Object obj;
46 XSETOBJ (obj, Lisp_Record, ptr); 46 XSETOBJ (obj, Lisp_Record, ptr);
47 47
48 signal_simple_error 48 signal_simple_error
49 ("Can't dump an emacs containing window system objects", obj); 49 ("Can't dump an emacs containing window system objects", obj);
50 } 50 }
72 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 72 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
73 ((markobj) (c->name)); 73 ((markobj) (c->name));
74 if (!NILP (c->device)) /* Vthe_null_color_instance */ 74 if (!NILP (c->device)) /* Vthe_null_color_instance */
75 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj)); 75 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj));
76 76
77 return (c->device); 77 return c->device;
78 } 78 }
79 79
80 static void 80 static void
81 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, 81 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
82 int escapeflag) 82 int escapeflag)
179 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* 179 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
180 Return non-nil if OBJECT is a color instance. 180 Return non-nil if OBJECT is a color instance.
181 */ 181 */
182 (object)) 182 (object))
183 { 183 {
184 return (COLOR_INSTANCEP (object) ? Qt : Qnil); 184 return COLOR_INSTANCEP (object) ? Qt : Qnil;
185 } 185 }
186 186
187 DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /* 187 DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /*
188 Return the name used to allocate COLOR-INSTANCE. 188 Return the name used to allocate COLOR-INSTANCE.
189 */ 189 */
190 (color_instance)) 190 (color_instance))
191 { 191 {
192 CHECK_COLOR_INSTANCE (color_instance); 192 CHECK_COLOR_INSTANCE (color_instance);
193 return (XCOLOR_INSTANCE (color_instance)->name); 193 return XCOLOR_INSTANCE (color_instance)->name;
194 } 194 }
195 195
196 DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /* 196 DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /*
197 Return a three element list containing the red, green, and blue 197 Return a three element list containing the red, green, and blue
198 color components of COLOR-INSTANCE, or nil if unknown. 198 color components of COLOR-INSTANCE, or nil if unknown.
296 */ 296 */
297 static int 297 static int
298 font_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth) 298 font_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth)
299 { 299 {
300 /* #### should this be moved into a device method? */ 300 /* #### should this be moved into a device method? */
301 return (internal_equal (font_instance_truename_internal (o1, ERROR_ME_NOT), 301 return internal_equal (font_instance_truename_internal (o1, ERROR_ME_NOT),
302 font_instance_truename_internal (o2, ERROR_ME_NOT), 302 font_instance_truename_internal (o2, ERROR_ME_NOT),
303 depth + 1)); 303 depth + 1);
304 } 304 }
305 305
306 static unsigned long 306 static unsigned long
307 font_instance_hash (Lisp_Object obj, int depth) 307 font_instance_hash (Lisp_Object obj, int depth)
308 { 308 {
346 /* Stick some default values here ... */ 346 /* Stick some default values here ... */
347 f->ascent = f->height = 1; 347 f->ascent = f->height = 1;
348 f->descent = 0; 348 f->descent = 0;
349 f->width = 1; 349 f->width = 1;
350 f->proportional_p = 0; 350 f->proportional_p = 0;
351 351
352 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance, 352 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance,
353 (f, name, device, errb)); 353 (f, name, device, errb));
354 354
355 if (!retval) 355 if (!retval)
356 return Qnil; 356 return Qnil;
362 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* 362 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
363 Return non-nil if OBJECT is a font instance. 363 Return non-nil if OBJECT is a font instance.
364 */ 364 */
365 (object)) 365 (object))
366 { 366 {
367 return (FONT_INSTANCEP (object) ? Qt : Qnil); 367 return FONT_INSTANCEP (object) ? Qt : Qnil;
368 } 368 }
369 369
370 DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /* 370 DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /*
371 Return the name used to allocate FONT-INSTANCE. 371 Return the name used to allocate FONT-INSTANCE.
372 */ 372 */
373 (font_instance)) 373 (font_instance))
374 { 374 {
375 CHECK_FONT_INSTANCE (font_instance); 375 CHECK_FONT_INSTANCE (font_instance);
376 return (XFONT_INSTANCE (font_instance)->name); 376 return XFONT_INSTANCE (font_instance)->name;
377 } 377 }
378 378
379 DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /* 379 DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /*
380 Return the ascent in pixels of FONT-INSTANCE. 380 Return the ascent in pixels of FONT-INSTANCE.
381 The returned value is the maximum ascent for all characters in the font, 381 The returned value is the maximum ascent for all characters in the font,
416 This means that different characters in the font have different widths. 416 This means that different characters in the font have different widths.
417 */ 417 */
418 (font_instance)) 418 (font_instance))
419 { 419 {
420 CHECK_FONT_INSTANCE (font_instance); 420 CHECK_FONT_INSTANCE (font_instance);
421 return (XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil); 421 return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil;
422 } 422 }
423 423
424 static Lisp_Object 424 static Lisp_Object
425 font_instance_truename_internal (Lisp_Object font_instance, 425 font_instance_truename_internal (Lisp_Object font_instance,
426 Error_behavior errb) 426 Error_behavior errb)
530 /* make sure we cache the failures, too. */ 530 /* make sure we cache the failures, too. */
531 instance = Fmake_color_instance (instantiator, device, Qt); 531 instance = Fmake_color_instance (instantiator, device, Qt);
532 Fputhash (instantiator, instance, d->color_instance_cache); 532 Fputhash (instantiator, instance, d->color_instance_cache);
533 } 533 }
534 534
535 return (NILP (instance) ? Qunbound : instance); 535 return NILP (instance) ? Qunbound : instance;
536 } 536 }
537 else if (VECTORP (instantiator)) 537 else if (VECTORP (instantiator))
538 { 538 {
539 switch (XVECTOR (instantiator)->size) 539 switch (XVECTOR_LENGTH (instantiator))
540 { 540 {
541 case 0: 541 case 0:
542 if (DEVICE_TTY_P (d)) 542 if (DEVICE_TTY_P (d))
543 return Vthe_null_color_instance; 543 return Vthe_null_color_instance;
544 else 544 else
548 case 1: 548 case 1:
549 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)))) 549 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier))))
550 signal_simple_error ("Color specifier not attached to a face", 550 signal_simple_error ("Color specifier not attached to a face",
551 instantiator); 551 instantiator);
552 return (FACE_PROPERTY_INSTANCE_1 552 return (FACE_PROPERTY_INSTANCE_1
553 (Fget_face (vector_data (XVECTOR (instantiator))[0]), 553 (Fget_face (XVECTOR_DATA (instantiator)[0]),
554 COLOR_SPECIFIER_FACE_PROPERTY 554 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)),
555 (XCOLOR_SPECIFIER (specifier)), domain, 555 domain, ERROR_ME, 0, depth));
556 ERROR_ME, 0, depth));
557 556
558 case 2: 557 case 2:
559 return (FACE_PROPERTY_INSTANCE_1 558 return (FACE_PROPERTY_INSTANCE_1
560 (Fget_face (vector_data (XVECTOR (instantiator))[0]), 559 (Fget_face (XVECTOR_DATA (instantiator)[0]),
561 vector_data (XVECTOR (instantiator))[1], domain, 560 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth));
562 ERROR_ME, 0, depth));
563 561
564 default: 562 default:
565 abort (); 563 abort ();
566 } 564 }
567 } 565 }
584 { 582 {
585 if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator)) 583 if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator))
586 return; 584 return;
587 if (VECTORP (instantiator)) 585 if (VECTORP (instantiator))
588 { 586 {
589 if (XVECTOR (instantiator)->size > 2) 587 if (XVECTOR_LENGTH (instantiator) > 2)
590 signal_simple_error ("Inheritance vector must be of size 0 - 2", 588 signal_simple_error ("Inheritance vector must be of size 0 - 2",
591 instantiator); 589 instantiator);
592 else if (XVECTOR (instantiator)->size > 0) 590 else if (XVECTOR_LENGTH (instantiator) > 0)
593 { 591 {
594 Lisp_Object face = vector_data (XVECTOR (instantiator))[0]; 592 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
595 593
596 Fget_face (face); 594 Fget_face (face);
597 if (XVECTOR (instantiator)->size == 2) 595 if (XVECTOR_LENGTH (instantiator) == 2)
598 { 596 {
599 Lisp_Object field = vector_data (XVECTOR (instantiator))[1]; 597 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
600 if (!EQ (field, Qforeground) && !EQ (field, Qbackground)) 598 if (!EQ (field, Qforeground) && !EQ (field, Qbackground))
601 signal_simple_error 599 signal_simple_error
602 ("Inheritance field must be `foreground' or `background'", 600 ("Inheritance field must be `foreground' or `background'",
603 field); 601 field);
604 } 602 }
644 property that this color specifier is used for; if this specifier is 642 property that this color specifier is used for; if this specifier is
645 not part of a face, the instantiator would not be valid) 643 not part of a face, the instantiator would not be valid)
646 */ 644 */
647 (object)) 645 (object))
648 { 646 {
649 return (COLOR_SPECIFIERP (object) ? Qt : Qnil); 647 return COLOR_SPECIFIERP (object) ? Qt : Qnil;
650 } 648 }
651 649
652 650
653 /**************************************************************************** 651 /****************************************************************************
654 Font Object 652 Font Object
729 return instantiator; 727 return instantiator;
730 #endif 728 #endif
731 } 729 }
732 instantiator = Ffont_instance_name (instantiator); 730 instantiator = Ffont_instance_name (instantiator);
733 } 731 }
734 732
735 if (STRINGP (instantiator)) 733 if (STRINGP (instantiator))
736 { 734 {
737 #ifdef MULE 735 #ifdef MULE
738 if (!UNBOUNDP (matchspec)) 736 if (!UNBOUNDP (matchspec))
739 { 737 {
780 /* make sure we cache the failures, too. */ 778 /* make sure we cache the failures, too. */
781 instance = Fmake_font_instance (instantiator, device, Qt); 779 instance = Fmake_font_instance (instantiator, device, Qt);
782 Fputhash (instantiator, instance, d->font_instance_cache); 780 Fputhash (instantiator, instance, d->font_instance_cache);
783 } 781 }
784 782
785 return (NILP (instance) ? Qunbound : instance); 783 return NILP (instance) ? Qunbound : instance;
786 } 784 }
787 else if (VECTORP (instantiator)) 785 else if (VECTORP (instantiator))
788 { 786 {
789 assert (XVECTOR (instantiator)->size == 1); 787 assert (XVECTOR_LENGTH (instantiator) == 1);
790 return (face_property_matching_instance 788 return (face_property_matching_instance
791 (Fget_face (vector_data (XVECTOR (instantiator))[0]), Qfont, 789 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
792 matchspec, domain, ERROR_ME, 0, depth)); 790 matchspec, domain, ERROR_ME, 0, depth));
793 } 791 }
794 else if (NILP (instantiator)) 792 else if (NILP (instantiator))
795 return Qunbound; 793 return Qunbound;
796 else 794 else
804 { 802 {
805 if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator)) 803 if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator))
806 return; 804 return;
807 if (VECTORP (instantiator)) 805 if (VECTORP (instantiator))
808 { 806 {
809 if (vector_length (XVECTOR (instantiator)) != 1) 807 if (XVECTOR_LENGTH (instantiator) != 1)
810 { 808 {
811 signal_simple_error 809 signal_simple_error
812 ("Vector length must be one for font inheritance", instantiator); 810 ("Vector length must be one for font inheritance", instantiator);
813 } 811 }
814 Fget_face (vector_data (XVECTOR (instantiator))[0]); 812 Fget_face (XVECTOR_DATA (instantiator)[0]);
815 } 813 }
816 else 814 else
817 signal_simple_error ("Must be string, vector, or font-instance", 815 signal_simple_error ("Must be string, vector, or font-instance",
818 instantiator); 816 instantiator);
819 } 817 }
851 at all, thus using the \"natural\" font of the terminal's text) 849 at all, thus using the \"natural\" font of the terminal's text)
852 -- a vector of one element (a face to inherit from) 850 -- a vector of one element (a face to inherit from)
853 */ 851 */
854 (object)) 852 (object))
855 { 853 {
856 return (FONT_SPECIFIERP (object) ? Qt : Qnil); 854 return FONT_SPECIFIERP (object) ? Qt : Qnil;
857 } 855 }
858 856
859 857
860 /***************************************************************************** 858 /*****************************************************************************
861 Face Boolean Object 859 Face Boolean Object
895 return instantiator; 893 return instantiator;
896 else if (VECTORP (instantiator)) 894 else if (VECTORP (instantiator))
897 { 895 {
898 Lisp_Object retval; 896 Lisp_Object retval;
899 Lisp_Object prop; 897 Lisp_Object prop;
900 898 int instantiator_len = XVECTOR_LENGTH (instantiator);
901 assert (XVECTOR (instantiator)->size >= 1 && 899
902 XVECTOR (instantiator)->size <= 3); 900 assert (instantiator_len >= 1 && instantiator_len <= 3);
903 if (XVECTOR (instantiator)->size > 1) 901 if (instantiator_len > 1)
904 prop = vector_data (XVECTOR (instantiator))[1]; 902 prop = XVECTOR_DATA (instantiator)[1];
905 else 903 else
906 { 904 {
907 if (NILP (FACE_BOOLEAN_SPECIFIER_FACE 905 if (NILP (FACE_BOOLEAN_SPECIFIER_FACE
908 (XFACE_BOOLEAN_SPECIFIER (specifier)))) 906 (XFACE_BOOLEAN_SPECIFIER (specifier))))
909 signal_simple_error 907 signal_simple_error
911 prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY 909 prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY
912 (XFACE_BOOLEAN_SPECIFIER (specifier)); 910 (XFACE_BOOLEAN_SPECIFIER (specifier));
913 } 911 }
914 912
915 retval = (FACE_PROPERTY_INSTANCE_1 913 retval = (FACE_PROPERTY_INSTANCE_1
916 (Fget_face (vector_data (XVECTOR (instantiator))[0]), 914 (Fget_face (XVECTOR_DATA (instantiator)[0]),
917 prop, domain, ERROR_ME, 0, depth)); 915 prop, domain, ERROR_ME, 0, depth));
918 916
919 if (XVECTOR (instantiator)->size == 3 && 917 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2]))
920 !NILP (vector_data (XVECTOR (instantiator))[2])) 918 retval = NILP (retval) ? Qt : Qnil;
921 retval = (NILP (retval) ? Qt : Qnil);
922 919
923 return retval; 920 return retval;
924 } 921 }
925 else 922 else
926 abort (); /* Eh? */ 923 abort (); /* Eh? */
932 face_boolean_validate (Lisp_Object instantiator) 929 face_boolean_validate (Lisp_Object instantiator)
933 { 930 {
934 if (NILP (instantiator) || EQ (instantiator, Qt)) 931 if (NILP (instantiator) || EQ (instantiator, Qt))
935 return; 932 return;
936 else if (VECTORP (instantiator) && 933 else if (VECTORP (instantiator) &&
937 (XVECTOR (instantiator)->size >= 1 && 934 (XVECTOR_LENGTH (instantiator) >= 1 &&
938 XVECTOR (instantiator)->size <= 3)) 935 XVECTOR_LENGTH (instantiator) <= 3))
939 { 936 {
940 Lisp_Object face = vector_data (XVECTOR (instantiator))[0]; 937 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
941 938
942 Fget_face (face); 939 Fget_face (face);
943 940
944 if (XVECTOR (instantiator)->size > 1) 941 if (XVECTOR_LENGTH (instantiator) > 1)
945 { 942 {
946 Lisp_Object field = vector_data (XVECTOR (instantiator))[1]; 943 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
947 if (!EQ (field, Qunderline) 944 if (!EQ (field, Qunderline)
948 && !EQ (field, Qstrikethru) 945 && !EQ (field, Qstrikethru)
949 && !EQ (field, Qhighlight) 946 && !EQ (field, Qhighlight)
950 && !EQ (field, Qdim) 947 && !EQ (field, Qdim)
951 && !EQ (field, Qblinking) 948 && !EQ (field, Qblinking)
996 the instantiator would not be valid), and optionally a value which, 993 the instantiator would not be valid), and optionally a value which,
997 if non-nil, means to invert the sense of the inherited property. 994 if non-nil, means to invert the sense of the inherited property.
998 */ 995 */
999 (object)) 996 (object))
1000 { 997 {
1001 return (FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil); 998 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
1002 } 999 }
1003 1000
1004 1001
1005 /************************************************************************/ 1002 /************************************************************************/
1006 /* initialization */ 1003 /* initialization */
1082 c->device = Qnil; 1079 c->device = Qnil;
1083 c->data = 0; 1080 c->data = 0;
1084 1081
1085 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c); 1082 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c);
1086 } 1083 }
1087 1084
1088 staticpro (&Vthe_null_font_instance); 1085 staticpro (&Vthe_null_font_instance);
1089 { 1086 {
1090 struct Lisp_Font_Instance *f; 1087 struct Lisp_Font_Instance *f;
1091 1088
1092 f = alloc_lcrecord (sizeof (struct Lisp_Font_Instance), 1089 f = alloc_lcrecord (sizeof (struct Lisp_Font_Instance),
1097 1094
1098 f->ascent = f->height = 0; 1095 f->ascent = f->height = 0;
1099 f->descent = 0; 1096 f->descent = 0;
1100 f->width = 0; 1097 f->width = 0;
1101 f->proportional_p = 0; 1098 f->proportional_p = 0;
1102 1099
1103 XSETFONT_INSTANCE (Vthe_null_font_instance, f); 1100 XSETFONT_INSTANCE (Vthe_null_font_instance, f);
1104 } 1101 }
1105 } 1102 }