From 34d170b2d9a437ac4e671ba42d7ba110b00b6a38 Mon Sep 17 00:00:00 2001 From: lecoanet Date: Tue, 31 May 2005 09:16:14 +0000 Subject: This patch fixes the previous try to bring a useful value out of an image attribute. --- generic/Item.c | 73 +++++++++++++++++++++++++--------------------------------- 1 file changed, 32 insertions(+), 41 deletions(-) (limited to 'generic/Item.c') diff --git a/generic/Item.c b/generic/Item.c index af2a1b1..8fe85f6 100644 --- a/generic/Item.c +++ b/generic/Item.c @@ -119,7 +119,7 @@ Tcl_ObjType ZnAttrObjType = { ********************************************************************************** */ static void Invalidate(ZnItem item, int reason); -static void AttributeToObj(Tcl_Interp *interp, void *record, ZnAttrConfig *desc); +static Tcl_Obj *AttributeToObj(Tcl_Interp *interp, void *record, ZnAttrConfig *desc); @@ -261,9 +261,9 @@ ZnAttributesInfo(Tcl_Interp *interp, entries[1] = Tcl_NewStringObj(attribute_type_strings[desc->type], -1); entries[2] = Tcl_NewBooleanObj(desc->read_only ? 1 : 0); entries[3] = Tcl_NewStringObj("", -1); - AttributeToObj(interp, record, desc); - entries[4] = Tcl_GetObjResult(interp); - Tcl_SetObjResult(interp, Tcl_NewListObj(5, entries)); + entries[4] = AttributeToObj(interp, record, desc); + l = Tcl_NewListObj(5, entries); + Tcl_SetObjResult(interp, l); } else { l = Tcl_NewObj(); @@ -272,10 +272,8 @@ ZnAttributesInfo(Tcl_Interp *interp, entries[1] = Tcl_NewStringObj(attribute_type_strings[desc_table->type], -1); entries[2] = Tcl_NewBooleanObj(desc_table->read_only ? 1 : 0); entries[3] = Tcl_NewStringObj("", -1); - AttributeToObj(interp, record, desc_table); - entries[4] = Tcl_GetObjResult(interp); + entries[4] = AttributeToObj(interp, record, desc_table); Tcl_ListObjAppendElement(interp, l, Tcl_NewListObj(5, entries)); - Tcl_ResetResult(interp); desc_table++; } Tcl_SetObjResult(interp, l); @@ -1056,17 +1054,16 @@ ZnConfigureAttributes(ZnWInfo *wi, * ********************************************************************************** */ -static void +static Tcl_Obj * AttributeToObj(Tcl_Interp *interp, void *record, ZnAttrConfig *desc) { char *valp = ((char *) record) + desc->offset; char *str = ""; - Tcl_Obj *o; + Tcl_Obj *o, *obj; unsigned int i; char buffer[256]; - Tcl_Obj *result = Tcl_GetObjResult(interp); switch (desc->type) { case ZN_CONFIG_GRADIENT: @@ -1083,25 +1080,24 @@ AttributeToObj(Tcl_Interp *interp, grads = ZnListArray(*((ZnList *) valp)); num_grads = ZnListSize(*((ZnList *) valp)); + obj = Tcl_NewObj(); for (i = 0; i < num_grads; i++) { o = Tcl_NewStringObj(ZnNameOfGradient(grads[i]), -1); - Tcl_ListObjAppendElement(interp, result, o); + Tcl_ListObjAppendElement(interp, obj, o); } - return; + return obj; } } break; case ZN_CONFIG_BOOL: - Tcl_SetBooleanObj(result, ISSET(*((unsigned short *) valp), desc->bool_bit)?1:0); - return; + return Tcl_NewBooleanObj(ISSET(*((unsigned short *) valp), desc->bool_bit)?1:0); case ZN_CONFIG_IMAGE: if (*((ZnImage *) valp)) { str = ZnNameOfImage(*((ZnImage *) valp)); #if PTK // Just return the perl image object, it is far more // useful than the mere string name. - Tcl_SetObjResult(interp, LangObjectObj(interp, str)); - return; + return LangObjectObj(interp, str); #endif } break; @@ -1119,6 +1115,7 @@ AttributeToObj(Tcl_Interp *interp, pats = (ZnImage *) ZnListArray(*((ZnList *) valp)); num_pats = ZnListSize(*((ZnList *) valp)); + obj = Tcl_NewObj(); for (i = 0; i < num_pats; i++) { if (pats[i] != ZnUnspecifiedImage) { o = Tcl_NewStringObj(ZnNameOfImage(pats[i]), -1); @@ -1126,9 +1123,9 @@ AttributeToObj(Tcl_Interp *interp, else { o = Tcl_NewStringObj("", -1); } - Tcl_ListObjAppendElement(interp, result, o); + Tcl_ListObjAppendElement(interp, obj, o); } - return; + return obj; } break; } @@ -1140,11 +1137,12 @@ AttributeToObj(Tcl_Interp *interp, if (*((ZnList *) valp)) { tags = (Tk_Uid *) ZnListArray(*((ZnList *) valp)); num_tags = ZnListSize(*((ZnList *) valp)); + obj = Tcl_NewObj(); for (i = 0; i < num_tags; i++) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(tags[i], -1)); } - return; + return obj; } break; } @@ -1187,13 +1185,13 @@ AttributeToObj(Tcl_Interp *interp, str = (char *) Tk_NameOfCapStyle(*((int *) valp)); break; case ZN_CONFIG_POINT: - Tcl_ListObjAppendElement(interp, result, Tcl_NewDoubleObj(((ZnPoint *) valp)->x)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewDoubleObj(((ZnPoint *) valp)->y)); - return; + obj = Tcl_NewObj(); + Tcl_ListObjAppendElement(interp, obj, Tcl_NewDoubleObj(((ZnPoint *) valp)->x)); + Tcl_ListObjAppendElement(interp, obj, Tcl_NewDoubleObj(((ZnPoint *) valp)->y)); + return obj; case ZN_CONFIG_ITEM: if (*((ZnItem *) valp) != ZN_NO_ITEM) { - Tcl_SetLongObj(result, (int) (*((ZnItem *) valp))->id); - return; + return Tcl_NewLongObj((int) (*((ZnItem *) valp))->id); } break; case ZN_CONFIG_WINDOW: @@ -1202,29 +1200,22 @@ AttributeToObj(Tcl_Interp *interp, } break; case ZN_CONFIG_CHAR: - Tcl_SetIntObj(result, *((char *) valp)); - return; + return Tcl_NewIntObj(*((char *) valp)); case ZN_CONFIG_UCHAR: case ZN_CONFIG_ALPHA: - Tcl_SetIntObj(result, *((unsigned char *) valp)); - return; + return Tcl_NewIntObj(*((unsigned char *) valp)); case ZN_CONFIG_USHORT: case ZN_CONFIG_PRI: - Tcl_SetIntObj(result, *((unsigned short *) valp)); - return; + return Tcl_NewIntObj(*((unsigned short *) valp)); case ZN_CONFIG_SHORT: - Tcl_SetIntObj(result, *((short *) valp)); - return; + return Tcl_NewIntObj(*((short *) valp)); case ZN_CONFIG_UINT: - Tcl_SetIntObj(result, *((unsigned int *) valp)); - return; + return Tcl_NewIntObj(*((unsigned int *) valp)); case ZN_CONFIG_INT: case ZN_CONFIG_ANGLE: - Tcl_SetIntObj(result, *((int *) valp)); - return; + return Tcl_NewIntObj(*((int *) valp)); case ZN_CONFIG_DIM: - Tcl_SetDoubleObj(result, *((ZnDim *) valp)); - return; + return Tcl_NewDoubleObj(*((ZnDim *) valp)); case ZN_CONFIG_ALIGNMENT: str = (char *) Tk_NameOfJustify(*((Tk_Justify *) valp)); break; @@ -1245,7 +1236,7 @@ AttributeToObj(Tcl_Interp *interp, ZnNameOfLeaderAnchors(*((ZnLeaderAnchors *) valp), buffer); break; } - Tcl_SetStringObj(result, str, -1); + return Tcl_NewStringObj(str, -1); } @@ -1267,7 +1258,7 @@ ZnQueryAttribute(Tcl_Interp *interp, if (!desc) { return TCL_ERROR; } - AttributeToObj(interp, record, desc); + Tcl_SetObjResult(interp, AttributeToObj(interp, record, desc)); return TCL_OK; } -- cgit v1.1