diff options
author | lecoanet | 2005-05-30 15:24:37 +0000 |
---|---|---|
committer | lecoanet | 2005-05-30 15:24:37 +0000 |
commit | a87b141d105347b063df0306b8a5111d355a55a7 (patch) | |
tree | bcea96ca435cfaac3844ec0ed821034a0330608f /generic | |
parent | 53f4f132d1573969b9b6e05ad90421e0fdba7df5 (diff) | |
download | tkzinc-a87b141d105347b063df0306b8a5111d355a55a7.zip tkzinc-a87b141d105347b063df0306b8a5111d355a55a7.tar.gz tkzinc-a87b141d105347b063df0306b8a5111d355a55a7.tar.bz2 tkzinc-a87b141d105347b063df0306b8a5111d355a55a7.tar.xz |
In Perl, when doing an itemcget or itemconfigure on an image, the returned
value is now the image object not its name. This should be far more useful.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/Item.c | 31 |
1 files changed, 21 insertions, 10 deletions
diff --git a/generic/Item.c b/generic/Item.c index 46f2a3d..af2a1b1 100644 --- a/generic/Item.c +++ b/generic/Item.c @@ -119,8 +119,7 @@ Tcl_ObjType ZnAttrObjType = { ********************************************************************************** */ static void Invalidate(ZnItem item, int reason); -static void AttributeToObj(Tcl_Interp *interp, void *record, ZnAttrConfig *desc, - Tcl_Obj *result); +static void AttributeToObj(Tcl_Interp *interp, void *record, ZnAttrConfig *desc); @@ -262,22 +261,24 @@ 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); - entries[4] = Tcl_NewStringObj("", -1); - AttributeToObj(interp, record, desc, entries[4]); + AttributeToObj(interp, record, desc); + entries[4] = Tcl_GetObjResult(interp); Tcl_SetObjResult(interp, Tcl_NewListObj(5, entries)); } else { - l = Tcl_GetObjResult(interp); + l = Tcl_NewObj(); while (desc_table->type != ZN_CONFIG_END) { entries[0] = Tcl_NewStringObj(desc_table->name, -1); 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); - entries[4] = Tcl_NewStringObj("", -1); - AttributeToObj(interp, record, desc_table, entries[4]); + AttributeToObj(interp, record, desc_table); + entries[4] = Tcl_GetObjResult(interp); Tcl_ListObjAppendElement(interp, l, Tcl_NewListObj(5, entries)); + Tcl_ResetResult(interp); desc_table++; } + Tcl_SetObjResult(interp, l); } return TCL_OK; @@ -1058,14 +1059,14 @@ ZnConfigureAttributes(ZnWInfo *wi, static void AttributeToObj(Tcl_Interp *interp, void *record, - ZnAttrConfig *desc, - Tcl_Obj *result) + ZnAttrConfig *desc) { char *valp = ((char *) record) + desc->offset; char *str = ""; Tcl_Obj *o; unsigned int i; char buffer[256]; + Tcl_Obj *result = Tcl_GetObjResult(interp); switch (desc->type) { case ZN_CONFIG_GRADIENT: @@ -1094,6 +1095,16 @@ AttributeToObj(Tcl_Interp *interp, Tcl_SetBooleanObj(result, ISSET(*((unsigned short *) valp), desc->bool_bit)?1:0); return; 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; +#endif + } + break; case ZN_CONFIG_BITMAP: if (*((ZnImage *) valp)) { str = ZnNameOfImage(*((ZnImage *) valp)); @@ -1256,7 +1267,7 @@ ZnQueryAttribute(Tcl_Interp *interp, if (!desc) { return TCL_ERROR; } - AttributeToObj(interp, record, desc, Tcl_GetObjResult(interp)); + AttributeToObj(interp, record, desc); return TCL_OK; } |