X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fobjects.c;h=69fcab67a5e6a39147acfb8ba21973887ba6ebf6;hb=a71e0987b7080176e0046b0b0ed72a9a70e2571d;hp=41617186f9ac03e8feb206e893fb070eae96907a;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git.1 diff --git a/src/objects.c b/src/objects.c index 4161718..69fcab6 100644 --- a/src/objects.c +++ b/src/objects.c @@ -60,7 +60,7 @@ static Lisp_Object mark_color_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); - ((markobj) (c->name)); + markobj (c->name); if (!NILP (c->device)) /* Vthe_null_color_instance */ MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj)); @@ -100,18 +100,16 @@ finalize_color_instance (void *header, int for_disksave) } static int -color_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth) +color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (o1); - struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (o2); - struct device *d1 = DEVICEP (c1->device) ? XDEVICE (c1->device) : 0; - struct device *d2 = DEVICEP (c2->device) ? XDEVICE (c2->device) : 0; - - if (d1 != d2) - return 0; - if (!d1 || !HAS_DEVMETH_P (d1, color_instance_equal)) - return EQ (o1, o2); - return DEVMETH (d1, color_instance_equal, (c1, c2, depth)); + struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); + struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); + + return (c1 == c2) || + ((EQ (c1->device, c2->device)) && + DEVICEP (c1->device) && + HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) && + DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); } static unsigned long @@ -129,7 +127,7 @@ color_instance_hash (Lisp_Object obj, int depth) DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, mark_color_instance, print_color_instance, finalize_color_instance, color_instance_equal, - color_instance_hash, + color_instance_hash, 0, struct Lisp_Color_Instance); DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* @@ -158,7 +156,7 @@ is deallocated as well. CHECK_STRING (name); XSETDEVICE (device, decode_device (device)); - c = alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); + c = alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance); c->name = name; c->device = device; c->data = 0; @@ -243,7 +241,7 @@ mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); - ((markobj) (f->name)); + markobj (f->name); if (!NILP (f->device)) /* Vthe_null_font_instance */ MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj)); @@ -261,8 +259,9 @@ print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) print_internal (f->name, printcharfun, 1); write_c_string (" on ", printcharfun); print_internal (f->device, printcharfun, 0); - MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, - (f, printcharfun, escapeflag)); + if (!NILP (f->device)) + MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, + (f, printcharfun, escapeflag)); sprintf (buf, " 0x%x>", f->header.uid); write_c_string (buf, printcharfun); } @@ -284,11 +283,11 @@ finalize_font_instance (void *header, int for_disksave) this means the `equal' could cause XListFonts to be run the first time. */ static int -font_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth) +font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { /* #### should this be moved into a device method? */ - return internal_equal (font_instance_truename_internal (o1, ERROR_ME_NOT), - font_instance_truename_internal (o2, ERROR_ME_NOT), + return internal_equal (font_instance_truename_internal (obj1, ERROR_ME_NOT), + font_instance_truename_internal (obj2, ERROR_ME_NOT), depth + 1); } @@ -302,7 +301,7 @@ font_instance_hash (Lisp_Object obj, int depth) DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, mark_font_instance, print_font_instance, finalize_font_instance, font_instance_equal, - font_instance_hash, struct Lisp_Font_Instance); + font_instance_hash, 0, struct Lisp_Font_Instance); DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* Return a new `font-instance' object named NAME. @@ -330,7 +329,7 @@ these objects are GCed, the underlying X data is deallocated as well. XSETDEVICE (device, decode_device (device)); - f = alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); + f = alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance); f->name = name; f->device = device; @@ -419,8 +418,16 @@ font_instance_truename_internal (Lisp_Object font_instance, Error_behavior errb) { struct Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); - struct device *d = XDEVICE (f->device); - return DEVMETH_OR_GIVEN (d, font_instance_truename, (f, errb), f->name); + + if (NILP (f->device)) + { + maybe_signal_simple_error ("Couldn't determine font truename", + font_instance, Qfont, errb); + return Qnil; + } + + return DEVMETH_OR_GIVEN (XDEVICE (f->device), + font_instance_truename, (f, errb), f->name); } DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* @@ -445,6 +452,9 @@ Return the properties (an alist or nil) of FONT-INSTANCE. CHECK_FONT_INSTANCE (font_instance); f = XFONT_INSTANCE (font_instance); + if (NILP (f->device)) + return Qnil; + return MAYBE_LISP_DEVMETH (XDEVICE (f->device), font_instance_properties, (f)); } @@ -483,8 +493,8 @@ color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); - ((markobj) (COLOR_SPECIFIER_FACE (color))); - ((markobj) (COLOR_SPECIFIER_FACE_PROPERTY (color))); + markobj (COLOR_SPECIFIER_FACE (color)); + markobj (COLOR_SPECIFIER_FACE_PROPERTY (color)); } /* No equal or hash methods; ignore the face the color is based off @@ -499,7 +509,6 @@ color_instantiate (Lisp_Object specifier, Lisp_Object matchspec, so we can freely error. */ Lisp_Object device = DFW_DEVICE (domain); struct device *d = XDEVICE (device); - Lisp_Object instance; if (COLOR_INSTANCEP (instantiator)) { @@ -516,7 +525,8 @@ color_instantiate (Lisp_Object specifier, Lisp_Object matchspec, if (STRINGP (instantiator)) { /* First, look to see if we can retrieve a cached value. */ - instance = Fgethash (instantiator, d->color_instance_cache, Qunbound); + Lisp_Object instance = + Fgethash (instantiator, d->color_instance_cache, Qunbound); /* Otherwise, make a new one. */ if (UNBOUNDP (instance)) { @@ -661,8 +671,8 @@ font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); - ((markobj) (FONT_SPECIFIER_FACE (font))); - ((markobj) (FONT_SPECIFIER_FACE_PROPERTY (font))); + markobj (FONT_SPECIFIER_FACE (font)); + markobj (FONT_SPECIFIER_FACE_PROPERTY (font)); } /* No equal or hash methods; ignore the face the font is based off @@ -736,17 +746,17 @@ font_instantiate (Lisp_Object specifier, Lisp_Object matchspec, iterate over all possible fonts, and a regexp match on each one. So we cache the results. */ Lisp_Object matching_font = Qunbound; - Lisp_Object hashtab = Fgethash (matchspec, d->charset_font_cache, + Lisp_Object hash_table = Fgethash (matchspec, d->charset_font_cache, Qunbound); - if (UNBOUNDP (hashtab)) + if (UNBOUNDP (hash_table)) { /* need to make a sub hash table. */ - hashtab = make_lisp_hashtable (20, HASHTABLE_KEY_WEAK, - HASHTABLE_EQUAL); - Fputhash (matchspec, hashtab, d->charset_font_cache); + hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, + HASH_TABLE_EQUAL); + Fputhash (matchspec, hash_table, d->charset_font_cache); } else - matching_font = Fgethash (instantiator, hashtab, Qunbound); + matching_font = Fgethash (instantiator, hash_table, Qunbound); if (UNBOUNDP (matching_font)) { @@ -755,7 +765,7 @@ font_instantiate (Lisp_Object specifier, Lisp_Object matchspec, DEVMETH_OR_GIVEN (d, find_charset_font, (device, instantiator, matchspec), instantiator); - Fputhash (instantiator, matching_font, hashtab); + Fputhash (instantiator, matching_font, hash_table); } if (NILP (matching_font)) return Qunbound; @@ -868,8 +878,8 @@ face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); - ((markobj) (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean))); - ((markobj) (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean))); + markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); + markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); } /* No equal or hash methods; ignore the face the face-boolean is based off @@ -1065,7 +1075,7 @@ vars_of_objects (void) staticpro (&Vthe_null_color_instance); { struct Lisp_Color_Instance *c = - alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); + alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance); c->name = Qnil; c->device = Qnil; c->data = 0; @@ -1076,7 +1086,7 @@ vars_of_objects (void) staticpro (&Vthe_null_font_instance); { struct Lisp_Font_Instance *f = - alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); + alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance); f->name = Qnil; f->device = Qnil; f->data = 0;