Mercurial > hg > xemacs-beta

comparison src/objects.c @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents cc15677e0335
children 74fd4e045ea6
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
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, void (*markobj) (Lisp_Object))
61 { 61 {
62 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 62 struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
63 ((markobj) (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, markobj)); 65 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj));
66 66
67 return c->device; 67 return c->device;
68 } 68 }
98 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); 98 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
99 } 99 }
100 } 100 }
101 101
102 static int 102 static int
103 color_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth) 103 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
104 { 104 {
105 struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (o1); 105 struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
106 struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (o2); 106 struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
107 struct device *d1 = DEVICEP (c1->device) ? XDEVICE (c1->device) : 0; 107
108 struct device *d2 = DEVICEP (c2->device) ? XDEVICE (c2->device) : 0; 108 return (c1 == c2) ||
109 109 ((EQ (c1->device, c2->device)) &&
110 if (d1 != d2) 110 DEVICEP (c1->device) &&
111 return 0; 111 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) &&
112 if (!d1 || !HAS_DEVMETH_P (d1, color_instance_equal)) 112 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth)));
113 return EQ (o1, o2);
114 return DEVMETH (d1, color_instance_equal, (c1, c2, depth));
115 } 113 }
116 114
117 static unsigned long 115 static unsigned long
118 color_instance_hash (Lisp_Object obj, int depth) 116 color_instance_hash (Lisp_Object obj, int depth)
119 { 117 {
241 static Lisp_Object 239 static Lisp_Object
242 mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) 240 mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
243 { 241 {
244 struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 242 struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
245 243
246 ((markobj) (f->name)); 244 markobj (f->name);
247 if (!NILP (f->device)) /* Vthe_null_font_instance */ 245 if (!NILP (f->device)) /* Vthe_null_font_instance */
248 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj)); 246 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj));
249 247
250 return f->device; 248 return f->device;
251 } 249 }
282 /* Fonts are equal if they resolve to the same name. 280 /* Fonts are equal if they resolve to the same name.
283 Since we call `font-truename' to do this, and since font-truename is lazy, 281 Since we call `font-truename' to do this, and since font-truename is lazy,
284 this means the `equal' could cause XListFonts to be run the first time. 282 this means the `equal' could cause XListFonts to be run the first time.
285 */ 283 */
286 static int 284 static int
287 font_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth) 285 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
288 { 286 {
289 /* #### should this be moved into a device method? */ 287 /* #### should this be moved into a device method? */
290 return internal_equal (font_instance_truename_internal (o1, ERROR_ME_NOT), 288 return internal_equal (font_instance_truename_internal (obj1, ERROR_ME_NOT),
291 font_instance_truename_internal (o2, ERROR_ME_NOT), 289 font_instance_truename_internal (obj2, ERROR_ME_NOT),
292 depth + 1); 290 depth + 1);
293 } 291 }
294 292
295 static unsigned long 293 static unsigned long
296 font_instance_hash (Lisp_Object obj, int depth) 294 font_instance_hash (Lisp_Object obj, int depth)
481 static void 479 static void
482 color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) 480 color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
483 { 481 {
484 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); 482 struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
485 483
486 ((markobj) (COLOR_SPECIFIER_FACE (color))); 484 markobj (COLOR_SPECIFIER_FACE (color));
487 ((markobj) (COLOR_SPECIFIER_FACE_PROPERTY (color))); 485 markobj (COLOR_SPECIFIER_FACE_PROPERTY (color));
488 } 486 }
489 487
490 /* No equal or hash methods; ignore the face the color is based off 488 /* No equal or hash methods; ignore the face the color is based off
491 of for `equal' */ 489 of for `equal' */
492 490
497 { 495 {
498 /* When called, we're inside of call_with_suspended_errors(), 496 /* When called, we're inside of call_with_suspended_errors(),
499 so we can freely error. */ 497 so we can freely error. */
500 Lisp_Object device = DFW_DEVICE (domain); 498 Lisp_Object device = DFW_DEVICE (domain);
501 struct device *d = XDEVICE (device); 499 struct device *d = XDEVICE (device);
502 Lisp_Object instance;
503 500
504 if (COLOR_INSTANCEP (instantiator)) 501 if (COLOR_INSTANCEP (instantiator))
505 { 502 {
506 /* If we are on the same device then we're done. Otherwise change 503 /* If we are on the same device then we're done. Otherwise change
507 the instantiator to the name used to generate the pixel and let the 504 the instantiator to the name used to generate the pixel and let the
514 } 511 }
515 512
516 if (STRINGP (instantiator)) 513 if (STRINGP (instantiator))
517 { 514 {
518 /* First, look to see if we can retrieve a cached value. */ 515 /* First, look to see if we can retrieve a cached value. */
519 instance = Fgethash (instantiator, d->color_instance_cache, Qunbound); 516 Lisp_Object instance =
517 Fgethash (instantiator, d->color_instance_cache, Qunbound);
520 /* Otherwise, make a new one. */ 518 /* Otherwise, make a new one. */
521 if (UNBOUNDP (instance)) 519 if (UNBOUNDP (instance))
522 { 520 {
523 /* make sure we cache the failures, too. */ 521 /* make sure we cache the failures, too. */
524 instance = Fmake_color_instance (instantiator, device, Qt); 522 instance = Fmake_color_instance (instantiator, device, Qt);
659 static void 657 static void
660 font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) 658 font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
661 { 659 {
662 struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); 660 struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
663 661
664 ((markobj) (FONT_SPECIFIER_FACE (font))); 662 markobj (FONT_SPECIFIER_FACE (font));
665 ((markobj) (FONT_SPECIFIER_FACE_PROPERTY (font))); 663 markobj (FONT_SPECIFIER_FACE_PROPERTY (font));
666 } 664 }
667 665
668 /* No equal or hash methods; ignore the face the font is based off 666 /* No equal or hash methods; ignore the face the font is based off
669 of for `equal' */ 667 of for `equal' */
670 668
734 MATCHSPEC. This is potentially a very slow operation, 732 MATCHSPEC. This is potentially a very slow operation,
735 as it involves doing an XListFonts() or equivalent to 733 as it involves doing an XListFonts() or equivalent to
736 iterate over all possible fonts, and a regexp match 734 iterate over all possible fonts, and a regexp match
737 on each one. So we cache the results. */ 735 on each one. So we cache the results. */
738 Lisp_Object matching_font = Qunbound; 736 Lisp_Object matching_font = Qunbound;
739 Lisp_Object hashtab = Fgethash (matchspec, d->charset_font_cache, 737 Lisp_Object hash_table = Fgethash (matchspec, d->charset_font_cache,
740 Qunbound); 738 Qunbound);
741 if (UNBOUNDP (hashtab)) 739 if (UNBOUNDP (hash_table))
742 { 740 {
743 /* need to make a sub hash table. */ 741 /* need to make a sub hash table. */
744 hashtab = make_lisp_hashtable (20, HASHTABLE_KEY_WEAK, 742 hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK,
745 HASHTABLE_EQUAL); 743 HASH_TABLE_EQUAL);
746 Fputhash (matchspec, hashtab, d->charset_font_cache); 744 Fputhash (matchspec, hash_table, d->charset_font_cache);
747 } 745 }
748 else 746 else
749 matching_font = Fgethash (instantiator, hashtab, Qunbound); 747 matching_font = Fgethash (instantiator, hash_table, Qunbound);
750 748
751 if (UNBOUNDP (matching_font)) 749 if (UNBOUNDP (matching_font))
752 { 750 {
753 /* make sure we cache the failures, too. */ 751 /* make sure we cache the failures, too. */
754 matching_font = 752 matching_font =
755 DEVMETH_OR_GIVEN (d, find_charset_font, 753 DEVMETH_OR_GIVEN (d, find_charset_font,
756 (device, instantiator, matchspec), 754 (device, instantiator, matchspec),
757 instantiator); 755 instantiator);
758 Fputhash (instantiator, matching_font, hashtab); 756 Fputhash (instantiator, matching_font, hash_table);
759 } 757 }
760 if (NILP (matching_font)) 758 if (NILP (matching_font))
761 return Qunbound; 759 return Qunbound;
762 instantiator = matching_font; 760 instantiator = matching_font;
763 } 761 }
866 static void 864 static void
867 face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) 865 face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
868 { 866 {
869 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); 867 struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
870 868
871 ((markobj) (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean))); 869 markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
872 ((markobj) (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean))); 870 markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
873 } 871 }
874 872
875 /* No equal or hash methods; ignore the face the face-boolean is based off 873 /* No equal or hash methods; ignore the face the face-boolean is based off
876 of for `equal' */ 874 of for `equal' */
877 875