This patch fixes the previous try to bring a useful value out of an image attribute.

1 files changed, 32 insertions, 41 deletions

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;
 }