From 14af846df5c01a8d5e6edc35e2ba6fa2e3011b56 Mon Sep 17 00:00:00 2001 From: lecoanet Date: Mon, 5 Jun 2000 12:03:13 +0000 Subject: Passage en Tcl_Objs et compilation conditionnelle de GPC --- Bezier.c | 42 +- Makefile.in | 16 +- debian/changelog | 12 + debian/copyright | 21 + generic/Arc.c | 64 +- generic/Curve.c | 84 +- generic/Draw.c | 4 +- generic/Group.c | 10 +- generic/Icon.c | 10 +- generic/Item.c | 831 ++++------ generic/Item.h | 25 +- generic/Map.c | 10 +- generic/Rectangle.c | 54 +- generic/Reticle.c | 10 +- generic/Tabular.c | 16 +- generic/Text.c | 38 +- generic/Track.c | 15 +- generic/Types.h | 13 - generic/Window.c | 10 +- generic/tkZinc.c | 4395 ++++++++++++++++++++++++++------------------------- generic/tkZinc.h | 20 +- patchlvl.h | 4 +- 22 files changed, 2804 insertions(+), 2900 deletions(-) diff --git a/Bezier.c b/Bezier.c index 5ad1230..0de6af5 100644 --- a/Bezier.c +++ b/Bezier.c @@ -173,18 +173,15 @@ BzTileChange(ClientData client_data, ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; BezierItem bz = (BezierItem) item; - Arg *elems; - int i, result, num_elems; + Tcl_Obj **elems; + int i, num_elems; ZnPoint p; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif bz->dev_points = NULL; bz->gradient = NULL; @@ -200,43 +197,28 @@ Init(Item item, Tcl_AppendResult(wi->interp, " bezier coords expected", NULL); return ZN_ERROR; } - result = Lang_SplitList(wi->interp, (*args)[0], &num_elems, &elems, &freeProc); - if ((result == ZN_ERROR) || ((num_elems%2) != 0)) { + if ((Tcl_ListObjGetElements(wi->interp, (*args)[0], &num_elems, &elems) == ZN_ERROR) || + ((num_elems % 2) != 0)) { bz_error: -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_elems, elems); - } -#endif Tcl_AppendResult(wi->interp, " malformed bezier coords", NULL); return ZN_ERROR; } bz->points = ZnListNew(num_elems/2, sizeof(ZnPoint)); for (i = 0; i < num_elems; i += 2) { - if (Tcl_GetDouble(wi->interp, elems[i], &p.x) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, elems[i], &p.x) == ZN_ERROR) { bz_error2: -#ifndef PTK - Tcl_Free((char *) elems); -#endif ZnListFree(bz->points); bz->points = NULL; goto bz_error; } - if (Tcl_GetDouble(wi->interp, elems[i+1], &p.y) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, elems[i+1], &p.y) == ZN_ERROR) { goto bz_error2; } ZnListAdd(bz->points, &p, ZnListTail); } (*args)++; (*argc)--; -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_elems, elems); - } -#endif CLEAR(bz->flags, FILLED_BIT); bz->first_end = NULL; @@ -399,7 +381,7 @@ SetRenderFlags(BezierItem bz) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { WidgetInfo *wi = item->wi; @@ -454,7 +436,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; @@ -624,7 +606,7 @@ ToArea(Item item, WidgetInfo *wi = item->wi; ZnPoint *points; ZnPoint end_points[LINE_END_POINTS]; - int num_points, result, result2; + int num_points, result=-1, result2; int lw = bz->line_width; if (bz->dev_points == NULL) { diff --git a/Makefile.in b/Makefile.in index 39cc52c..c6dc6be 100644 --- a/Makefile.in +++ b/Makefile.in @@ -70,9 +70,9 @@ PTKLIB = @INSTALLARCHLIB@/Tk/pTk SITEPERL = @SITEPERL@ PTKCFLAGS = -DPTK -I$(PTKLIB) # -# If the polygon clipper is used -GPC = libgpc.so -#GPC = +# Define this to use the polygon clipper. +GPC=libgpc.so +#GPC= # # Recognized compilation time flags are : @@ -83,7 +83,11 @@ GPC = libgpc.so # SHAPE include code for reshaping windows. # GPC include code for composing polygons. # -DFLAGS = -DOM -DSHAPE -DGPC +ifeq ($(strip$(GPC)),) +DFLAGS = -DOM -DSHAPE +else +DFLAGS = -DOM -DSHAPE -DGPC +endif #DFLAGS = -DTCL_MEM_DEBUG # @@ -187,7 +191,11 @@ doc/refman.html: doc/refman.ps: doc/refman.tex (cd doc; latex refman.tex; latex refman.tex; dvips -o refman.ps refman.dvi) +ifeq ($(strip($GPC)),) install: installtk installptk installom installgpc +else +install: installtk installptk installom +endif installom: libom.so $(INSTALL_DATA) libom.so $(libdir) diff --git a/debian/changelog b/debian/changelog index ec08421..862190c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,15 @@ +zinc-tk (3.1.16) unstable; urgency=low + + * Passage en Tcl_Objs. + + * La compilation de GPC est optionnelle et la + commande contour n'est oérationnelle que si + GPC est inclu. + + * Ajout du copyright de GPC dans le fichier copyright. + + -- Patrick Lecoanet Mon, 5 Jun 2000 13:56:59 +0200 + zinc-tk (3.1.15) unstable; urgency=low * Ajout de l'item Window diff --git a/debian/copyright b/debian/copyright index 6475b30..c441be1 100644 --- a/debian/copyright +++ b/debian/copyright @@ -19,3 +19,24 @@ Copyright: License along with this code; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +GPC is under the following copyright: + +Copyright: (C) 1997-1999, Advanced Interfaces Group, + University of Manchester. + + This software is free for non-commercial use. It may be copied, + modified, and redistributed provided that this copyright notice + is preserved on all copies. The intellectual property rights of + the algorithms used reside with the University of Manchester + Advanced Interfaces Group. + + You may not use this software, in whole or in part, in support + of any commercial product without the express consent of the + author. + + There is no warranty or other guarantee of fitness of this + software for any purpose. It is provided solely "as is". + +If this doesn't match your intended use, you can cut off GPC from Zinc +by undefining the GPC variable in the Makefile. diff --git a/generic/Arc.c b/generic/Arc.c index 917eb0a..797f671 100644 --- a/generic/Arc.c +++ b/generic/Arc.c @@ -179,17 +179,14 @@ ArcTileChange(ClientData client_data, ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; ArcItem arc = (ArcItem) item; - Arg *elems; - int result, num_elems; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif + Tcl_Obj **elems; + int num_elems; /* Init attributes */ SET(item->flags, VISIBLE_BIT); @@ -217,42 +214,17 @@ Init(Item item, Tcl_AppendResult(wi->interp, " arc coords expected", NULL); return ZN_ERROR; } - result = Lang_SplitList(wi->interp, (*args)[0], &num_elems, &elems, &freeProc); - if ((result == ZN_ERROR) || (num_elems != 4)) { - arc_error: -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_elems, elems); - } -#endif + if ((Tcl_ListObjGetElements(wi->interp, (*args)[0], &num_elems, &elems) == ZN_ERROR) || + (num_elems != 4) || + (Tcl_GetDoubleFromObj(wi->interp, elems[0], &arc->coords[0].x) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, elems[1], &arc->coords[0].y) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, elems[2], &arc->coords[1].x) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, elems[3], &arc->coords[1].y) == ZN_ERROR)) { Tcl_AppendResult(wi->interp, " malformed arc coords", NULL); return ZN_ERROR; - } - if (Tcl_GetDouble(wi->interp, elems[0], &arc->coords[0].x) == ZN_ERROR) { - arc_error2: -#ifndef PTK - Tcl_Free((char *) elems); -#endif - goto arc_error; - }; - if (Tcl_GetDouble(wi->interp, elems[1], &arc->coords[0].y) == ZN_ERROR) { - goto arc_error2; - }; - if (Tcl_GetDouble(wi->interp, elems[2], &arc->coords[1].x) == ZN_ERROR) { - goto arc_error2; - }; - if (Tcl_GetDouble(wi->interp, elems[3], &arc->coords[1].y) == ZN_ERROR) { - goto arc_error2; }; (*args)++; (*argc)--; -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_elems, elems); - } -#endif arc->fill_color = ZnGetColorGradient(wi->interp, wi->win, ZnNameOfColor(wi->fore_color)); @@ -383,7 +355,7 @@ SetRenderFlags(ArcItem arc) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { WidgetInfo *wi = item->wi; @@ -431,7 +403,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; @@ -721,7 +693,7 @@ ToArea(Item item, ZnPoint pts[20]; /* Should be at least LINE_END_POINTS large */ ZnPoint center, tang; ZnBBox t_area; - int num_points, result, result2; + int num_points, result=-1, result2; ZnReal lw = arc->line_width; ZnReal rx, ry, angle, tmp; ZnBool inside, new_inside; @@ -999,10 +971,10 @@ Draw(Item item) WidgetInfo *wi = item->wi; ArcItem arc = (ArcItem) item; XGCValues values; - int width, height; - ZnPoint *p; - XPoint *xp; - int num_points, i; + int width=0, height=0; + ZnPoint *p=NULL; + XPoint *xp=NULL; + int num_points=0, i; if (ISSET(arc->flags, USING_POLY_BIT) && (ISSET(arc->flags, FILLED_BIT) || (arc->line_width))) { diff --git a/generic/Curve.c b/generic/Curve.c index 5ada355..54af677 100644 --- a/generic/Curve.c +++ b/generic/Curve.c @@ -34,7 +34,9 @@ #include "WidgetInfo.h" #include "Image.h" #include "Color.h" +#ifdef GPC #include "gpc/gpc.h" +#endif #include #include @@ -92,7 +94,9 @@ typedef struct _CurveItemStruct { ZnImage tile; ZnPoly dev_shape; ZnColorGradient gradient; +#ifdef GPC gpc_tristrip tristrip; +#endif } CurveItemStruct, *CurveItem; static ZnAttrConfig cv_attrs[] = { @@ -188,22 +192,21 @@ CvTileChange(ClientData client_data, ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; CurveItem cv = (CurveItem) item; - Arg *elems; - int i, result, num_elems; + Tcl_Obj **elems; + int i, num_elems; ZnPoint *p, *points; double dbl; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif POLY_INIT(&cv->dev_shape); +#ifdef GPC cv->tristrip.num_strips = 0; +#endif cv->gradient = NULL; /* Init attributes */ @@ -220,14 +223,9 @@ Init(Item item, Tcl_AppendResult(wi->interp, " curve coords expected", NULL); return ZN_ERROR; } - result = Lang_SplitList(wi->interp, (*args)[0], &num_elems, &elems, &freeProc); - if ((result == ZN_ERROR) || ((num_elems%2) != 0)) { + if ((Tcl_ListObjGetElements(wi->interp, (*args)[0], &num_elems, &elems) == ZN_ERROR) || + ((num_elems % 2) != 0)) { cv_error: -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_elems, elems); - } -#endif Tcl_AppendResult(wi->interp, " malformed curve coords", NULL); return ZN_ERROR; } @@ -239,16 +237,13 @@ Init(Item item, p = points = (ZnPoint *) ZnMalloc(num_elems/2 * sizeof(ZnPoint)); POLY_CONTOUR1(&cv->shape, points, num_elems/2); for (i = 0; i < num_elems; i += 2, p++) { - if (Tcl_GetDouble(wi->interp, elems[i], &dbl) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, elems[i], &dbl) == ZN_ERROR) { cv_error2: -#ifndef PTK - Tcl_Free((char *) elems); -#endif POLY_FREE(&cv->shape); goto cv_error; } p->x = dbl; - if (Tcl_GetDouble(wi->interp, elems[i+1], &dbl) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, elems[i+1], &dbl) == ZN_ERROR) { goto cv_error2; } p->y = dbl; @@ -256,13 +251,6 @@ Init(Item item, } (*args)++; (*argc)--; -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_elems, elems); - } -#endif CLEAR(cv->flags, FILLED_BIT); cv->first_end = NULL; @@ -416,6 +404,11 @@ Destroy(Item item) if (cv->grad_geom) { GradientGeomDelete(cv->grad_geom); } +#ifdef GPC + if (cv->tristrip.num_strips) { + gpc_free_tristrip(&cv->tristrip); + } +#endif } @@ -468,7 +461,7 @@ SetRenderFlags(CurveItem cv) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { WidgetInfo *wi = item->wi; @@ -523,7 +516,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; @@ -579,6 +572,7 @@ TestCCW(ZnPoint *points, * Create a reduced polygon from an unknown one by * adding/clipping all the shapes/holes in turn. */ +#ifdef GPC static void ReduceContours(ZnPoly *poly_in, ZnPoly *poly_out) @@ -597,6 +591,7 @@ ReduceContours(ZnPoly *poly_in, POLY_SET(poly_out, &rpoly); } } +#endif /* @@ -633,9 +628,11 @@ ComputeCoordinates(Item item, SET(cv->flags, REDUCED_BIT); } else if (ISCLEAR(cv->flags, REDUCED_BIT)) { +#ifdef GPC ZnPoly poly; ReduceContours(&cv->shape, &poly); POLY_SET(&cv->shape, &poly); +#endif SET(cv->flags, REDUCED_BIT); } @@ -644,9 +641,11 @@ ComputeCoordinates(Item item, return; } +#ifdef GPC if (cv->tristrip.num_strips) { gpc_free_tristrip(&cv->tristrip); } +#endif /* * Allocate space for devices coordinates, the holes array is _NOT_ @@ -822,7 +821,7 @@ ToArea(Item item, ZnBBox bbox; ZnPoint *points; ZnPoint end_points[LINE_END_POINTS]; - int i, num_points, result, result2; + int i, num_points, result=-1, result2; int width, height; ZnBool first_done = False; @@ -964,10 +963,10 @@ Draw(Item item) WidgetInfo *wi = item->wi; CurveItem cv = (CurveItem) item; XGCValues values; - int i, j, num_points, num2; + int i, j, num_points=0, num2; unsigned int gc_mask; - ZnPoint *points; - XPoint *xpoints = NULL; + ZnPoint *points=NULL; + XPoint *xpoints=NULL; if ((cv->dev_shape.num_contours == 0) || (ISCLEAR(cv->flags, FILLED_OK) && @@ -1008,6 +1007,7 @@ Draw(Item item) } XChangeGC(wi->dpy, wi->gc, gc_mask, &values); +#ifdef GPC if (cv->tristrip.num_strips == 0) { gpc_polygon_to_tristrip((gpc_polygon *) &cv->dev_shape, &cv->tristrip); } @@ -1025,6 +1025,18 @@ Draw(Item item) &xpoints[j], 3, Convex, CoordModeOrigin); } } +#else + num_points = cv->dev_shape.contours[0].num_points; + points = cv->dev_shape.contours[0].points; + ZnListAssertSize(wi->work_xpts, num_points); + xpoints = (XPoint *) ZnListArray(wi->work_xpts); + for (i = 0; i < num_points; i++) { + xpoints[i].x = REAL_TO_INT(points[i].x); + xpoints[i].y = REAL_TO_INT(points[i].y); + } + XFillPolygon(wi->dpy, wi->draw_buffer, wi->gc, + xpoints, num_points, Complex, CoordModeOrigin); +#endif } } @@ -1531,6 +1543,7 @@ Coords(Item item, * ********************************************************************************** */ +#ifdef GPC static void Contour(Item item, int cmd, @@ -1549,6 +1562,7 @@ Contour(Item item, cv->shape.contours[0].num_points);*/ ITEM.Invalidate(item, ZN_COORDS_FLAG); } +#endif /* @@ -1579,7 +1593,11 @@ static ItemClassStruct CURVE_ITEM_CLASS = { NULL, /* Cursor */ NULL, /* Index */ NULL, /* Selection */ +#ifdef GPC Contour, +#else + NULL, +#endif ComputeCoordinates, ToArea, Draw, diff --git a/generic/Draw.c b/generic/Draw.c index fcfbdae..b8f315e 100644 --- a/generic/Draw.c +++ b/generic/Draw.c @@ -459,8 +459,8 @@ DoPolygonRelief(ZnPoint *p, int what_to_do, ...) { - int i, j, processed_points, *result; - ZnPoint *p1, *p11, *p2; + int i, j, processed_points, *result=NULL; + ZnPoint *p1, *p11=NULL, *p2; ZnPoint pp1, pp2, new_pp1, new_pp2; ZnPoint perp, c, shift1, shift2; ZnPoint bevel_points[4]; diff --git a/generic/Group.c b/generic/Group.c index c794d7d..8a99a0d 100644 --- a/generic/Group.c +++ b/generic/Group.c @@ -84,9 +84,9 @@ static ZnAttrConfig group_attrs[] = { ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { GroupItem group = (GroupItem) item; @@ -350,7 +350,7 @@ SetXShape(Item grp) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { GroupItem group = (GroupItem) item; @@ -391,7 +391,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Icon.c b/generic/Icon.c index 140143c..2497846 100644 --- a/generic/Icon.c +++ b/generic/Icon.c @@ -133,9 +133,9 @@ IconImageChange(ClientData client_data, ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; IconItem icon = (IconItem) item; @@ -226,7 +226,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { IconItem icon = (IconItem) item; @@ -290,7 +290,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Item.c b/generic/Item.c index f268880..5d9ac86 100644 --- a/generic/Item.c +++ b/generic/Item.c @@ -172,8 +172,11 @@ static char *attribute_type_strings[] = { "mapinfo", "image", "leaderanchors", - "JoinStyle", - "CapStyle" + "joinstyle", + "capstyle", + "gradientgeometry", + "gradientcolor", + "window" }; @@ -187,11 +190,11 @@ static char *attribute_type_strings[] = { static void Damage(WidgetInfo *wi, ZnBBox *damage); static void Invalidate(Item item, int reason); static int ConfigureField(FieldSet field_set, unsigned int field, - int argc, ZnAttrList argv, int *flags); + int argc, Tcl_Obj *CONST argv[], int *flags); static int QueryField(FieldSet field_set, unsigned int field, - int argc, ZnAttrList argv); -static Arg AttributeToString(WidgetInfo *wi, char *record, ZnAttrConfig *desc, - char *buffer, Tcl_FreeProc **free_proc); + int argc, Tcl_Obj *CONST argv[]); +static Tcl_Obj *AttributeToObj(WidgetInfo *wi, char *record, + ZnAttrConfig *desc, char *buffer); static void FieldImageChange(ClientData client_data, int x, int y, int width, int height, int image_width, int image_height); static void FieldTileChange(ClientData client_data, int x, int y, int width, @@ -228,23 +231,17 @@ InitAttrDesc(ZnAttrConfig *attr_desc) ********************************************************************************** */ static int -AttributesInfo(Item item, - int field, /* 0< means the item itself. */ - int argc, - Arg *args) +AttributesInfo(Item item, + int field, /* 0< means the item itself. */ + int argc, + Tcl_Obj *CONST args[]) { WidgetInfo *wi = item->wi; char *record; ZnAttrConfig *desc; Tk_Uid attr_uid = NULL; -#ifndef PTK - Arg entries[5]; -#else - Arg *entries; -#endif - Arg result; + Tcl_Obj *l, *entries[5]; char buffer[256]; - Tcl_FreeProc *free_proc; if (field < 0) { record = (char *) item; @@ -267,12 +264,12 @@ AttributesInfo(Item item, } if (argc == 1) { - attr_uid = Tk_GetUid(LangString(args[0])); + attr_uid = Tk_GetUid(Tcl_GetString(args[0])); while (True) { if (desc->type == ZN_CONFIG_END) { Tcl_AppendResult(wi->interp, "unknown attribute \"", - LangString(args[0]), "\"", NULL); + Tcl_GetString(args[0]), "\"", NULL); return ZN_ERROR; } else if (attr_uid == desc->uid) { @@ -282,49 +279,35 @@ AttributesInfo(Item item, desc++; } } + entries[0] = NewStringObj(desc->name); + entries[1] = NewStringObj(attribute_type_strings[desc->type]); + entries[2] = NewBooleanObj(desc->read_only ? 1 : 0); + entries[3] = NewStringObj(""); + entries[4] = AttributeToObj(wi, record, desc, buffer); #ifdef PTK - entries = LangAllocVec(5); - LangSetInt(&entries[2], desc->read_only ? 1 : 0); + l = Tcl_Merge(5, entries); + Tcl_SetObjResult(wi->interp, l); #else - entries[2] = desc->read_only ? "1" : "0"; -#endif - LangSetString(&entries[0], desc->name); - LangSetString(&entries[1], attribute_type_strings[desc->type]); - LangSetString(&entries[3], ""); - LangSetArg(&entries[4], AttributeToString(wi, record, desc, buffer, &free_proc)); - result = Tcl_Merge(5, entries); -#ifndef PTK - if (free_proc == TCL_DYNAMIC) { - ZnFree(entries[4]); - } - Tcl_SetResult(wi->interp, result, TCL_DYNAMIC); -#else - LangFreeVec(5, entries); - Tcl_ArgResult(wi->interp, result); + Tcl_SetObjResult(wi->interp, Tcl_NewListObj(5, entries)); #endif } else { +#ifdef PTK + Tcl_Obj *o; +#endif + l = Tcl_GetObjResult(wi->interp); while (desc->type != ZN_CONFIG_END) { + entries[0] = NewStringObj(desc->name); + entries[1] = NewStringObj(attribute_type_strings[desc->type]); + entries[2] = NewBooleanObj(desc->read_only ? 1 : 0); + entries[3] = NewStringObj(""); + entries[4] = AttributeToObj(wi, record, desc, buffer); #ifdef PTK - entries = LangAllocVec(5); - LangSetInt(&entries[2], desc->read_only ? 1 : 0); + o = NULL; + LangSetArg(&o, Tcl_Merge(5, entries)); + Tcl_ListObjAppendElement(wi->interp, l, o); #else - entries[2] = desc->read_only ? "1" : "0"; -#endif - LangSetString(&entries[0], desc->name); - LangSetString(&entries[1], attribute_type_strings[desc->type]); - LangSetString(&entries[3], ""); - LangSetArg(&entries[4], AttributeToString(wi, record, desc, buffer, &free_proc)); - result = Tcl_Merge(5, entries); -#ifndef PTK - if (free_proc == TCL_DYNAMIC) { - ZnFree(entries[4]); - } - Tcl_AppendElement(wi->interp, result); - ZnFree(result); -#else - LangFreeVec(5, entries); - Tcl_AppendArg(wi->interp, result); + Tcl_ListObjAppendElement(wi->interp, l, Tcl_NewListObj(5, entries)); #endif desc++; } @@ -342,11 +325,11 @@ AttributesInfo(Item item, ********************************************************************************** */ static int -ConfigureAttributes(char *record, - int field, /* 0< means item itself. */ - int argc, - Arg *args, - int *flags) +ConfigureAttributes(char *record, + int field, /* 0< means item itself. */ + int argc, + Tcl_Obj *CONST args[], + int *flags) { WidgetInfo *wi; Item item = NULL; @@ -356,7 +339,7 @@ ConfigureAttributes(char *record, ZnPtr valp; ZnAttrConfig *attr_desc; FieldSet field_set = NULL; - + char *str; if (field < 0) { item = (Item) record; @@ -376,20 +359,20 @@ ConfigureAttributes(char *record, } for (i = 0; i < argc; i += 2) { - attr_uid = Tk_GetUid(LangString(args[i])); + attr_uid = Tk_GetUid(Tcl_GetString(args[i])); desc = attr_desc; while (True) { if (desc->type == ZN_CONFIG_END) { /*printf("ERROR: record <0x%X>\n", record);*/ Tcl_AppendResult(wi->interp, "unknown attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } else if (attr_uid == desc->uid) { if (desc->read_only) { Tcl_AppendResult(wi->interp, "attribute \"", - LangString(args[i]), "\" can only be read", NULL); + Tcl_GetString(args[i]), "\" can only be read", NULL); return ZN_ERROR; } valp = record + desc->offset; @@ -398,7 +381,7 @@ ConfigureAttributes(char *record, case ZN_CONFIG_COLOR: { XColor *color; - Tk_Uid new_name = Tk_GetUid(LangString(args[i+1])); + Tk_Uid new_name = Tk_GetUid(Tcl_GetString(args[i+1])); char *name = NULL; if (*((XColor **) valp)) { name = ZnNameOfColor(*((XColor **) valp)); @@ -407,7 +390,7 @@ ConfigureAttributes(char *record, color = ZnGetColor(wi->interp, wi->win, new_name); if (!color) { Tcl_AppendResult(wi->interp, " color expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (*((XColor **) valp)) { @@ -421,7 +404,7 @@ ConfigureAttributes(char *record, case ZN_CONFIG_GRADIENT_COLOR: { ZnColorGradient cg; - Tk_Uid new_name = Tk_GetUid(LangString(args[i+1])); + Tk_Uid new_name = Tk_GetUid(Tcl_GetString(args[i+1])); char *name = NULL; if (*((ZnColorGradient *) valp)) { name = ZnNameOfColorGradient(*((ZnColorGradient *) valp)); @@ -431,7 +414,7 @@ ConfigureAttributes(char *record, if (!cg) { Tcl_AppendResult(wi->interp, " color gradient expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (*((ZnColorGradient *) valp)) { @@ -445,9 +428,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_BOOL: { int b; - if (Tcl_GetBoolean(wi->interp, args[i+1], &b) != ZN_OK) { + if (Tcl_GetBooleanFromObj(wi->interp, args[i+1], &b) != ZN_OK) { Tcl_AppendResult(wi->interp, " boolean expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (b ^ (ISSET(*((char *) valp), desc->bool_bit) != 0)) { @@ -463,12 +446,13 @@ ConfigureAttributes(char *record, if (*((Pixmap *) valp) != ZnUnspecifiedPattern) { name = Tk_NameOfBitmap(wi->dpy, *((Pixmap *) valp)); } - if (strcmp(name, LangString(args[i+1])) != 0) { - if (strlen(LangString(args[i+1])) != 0) { - pattern = Tk_GetBitmap(wi->interp, wi->win, Tk_GetUid(LangString(args[i+1]))); + str = Tcl_GetString(args[i+1]); + if (strcmp(name, str) != 0) { + if (strlen(str) != 0) { + pattern = Tk_GetBitmap(wi->interp, wi->win, Tk_GetUid(str)); if (pattern == None) { Tcl_AppendResult(wi->interp, " pattern expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } } @@ -482,62 +466,40 @@ ConfigureAttributes(char *record, } case ZN_CONFIG_PATTERNS: { - ZnList new_pat_list = NULL; - Pixmap *pats; - int num_pats, result, j; - Arg *elems; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif + ZnList new_pat_list = NULL; + Pixmap *pats; + int num_pats, j, k; + Tcl_Obj **elems; - if (strlen(LangString(args[i+1])) != 0) { - result = Lang_SplitList(wi->interp, args[i+1], &num_pats, &elems, &freeProc); - if (result == ZN_ERROR) { - Tcl_AppendResult(wi->interp, - " pattern list expected for attribute \"", - LangString(args[i]), "\"", NULL); -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_pats, elems); - } -#endif - return ZN_ERROR; - } - if (num_pats) { - new_pat_list = ZnListNew(num_pats, sizeof(Pixmap)); - ZnListAssertSize(new_pat_list, num_pats); - pats = (Pixmap *) ZnListArray(new_pat_list); - for (j = 0; j < num_pats; j++) { - if (strlen(LangString(elems[j])) != 0) { - pats[j] = Tk_GetBitmap(wi->interp, wi->win, - Tk_GetUid(LangString(elems[j]))); - if (pats[j] == None) { - Tcl_AppendResult(wi->interp, - " unknown pattern \"", LangString(elems[j]), - "\" in pattern list", NULL); - ZnListFree(new_pat_list); -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_pats, elems); - } -#endif - return ZN_ERROR; + if (Tcl_ListObjGetElements(wi->interp, args[i+1], + &num_pats, &elems) == ZN_ERROR) { + Tcl_AppendResult(wi->interp, + " pattern list expected for attribute \"", + Tcl_GetString(args[i]), "\"", NULL); + return ZN_ERROR; + } + if (num_pats) { + new_pat_list = ZnListNew(num_pats, sizeof(Pixmap)); + ZnListAssertSize(new_pat_list, num_pats); + pats = (Pixmap *) ZnListArray(new_pat_list); + for (j = 0; j < num_pats; j++) { + str = Tcl_GetString(elems[j]); + if (strlen(str) != 0) { + pats[j] = Tk_GetBitmap(wi->interp, wi->win, Tk_GetUid(str)); + if (pats[j] == None) { + Tcl_AppendResult(wi->interp, " unknown pattern \"", str, + "\" in pattern list", NULL); + for (k = 0; k < j; k++) { + Tk_FreeBitmap(wi->dpy, pats[k]); } - } - else { - pats[j] = ZnUnspecifiedPattern; + ZnListFree(new_pat_list); + return ZN_ERROR; } } + else { + pats[j] = ZnUnspecifiedPattern; + } } -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_pats, elems); - } -#endif } if (*((ZnList *) valp)) { num_pats = ZnListSize(*((ZnList *) valp)); @@ -561,42 +523,25 @@ ConfigureAttributes(char *record, } case ZN_CONFIG_TAGS: { - int num_tags, result, j; - Arg *elems; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif + int num_tags, j; + Tcl_Obj **elems; - if (strlen(LangString(args[i+1])) != 0) { - result = Lang_SplitList(wi->interp, args[i+1], &num_tags, &elems, &freeProc); - if (result == ZN_ERROR) { - Tcl_AppendResult(wi->interp, - " tag list expected for attribute \"", - LangString(args[i]), "\"", NULL); -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_tags, elems); - } -#endif - return ZN_ERROR; - } - if (*((ZnList *) valp)) { - ITEM.FreeTags(item); - *flags |= desc->flags; - } - if (num_tags) { - for (j = 0; j < num_tags; j++) { - ITEM.AddTag(item, Tk_GetUid(LangString(elems[j]))); - } - *flags |= desc->flags; - } -#ifndef PTK - Tcl_Free((char *)elems); -#else - if (freeProc) { - (*freeProc)(num_tags, elems); + if (Tcl_ListObjGetElements(wi->interp, args[i+1], + &num_tags, &elems) == ZN_ERROR) { + Tcl_AppendResult(wi->interp, + " tag list expected for attribute \"", + Tcl_GetString(args[i]), "\"", NULL); + return ZN_ERROR; + } + if (*((ZnList *) valp)) { + ITEM.FreeTags(item); + *flags |= desc->flags; + } + if (num_tags) { + for (j = 0; j < num_tags; j++) { + ITEM.AddTag(item, Tk_GetUid(Tcl_GetString(elems[j]))); } -#endif + *flags |= desc->flags; } break; } @@ -605,10 +550,11 @@ ConfigureAttributes(char *record, case ZN_CONFIG_IMAGE: { char *text = ""; - if (strcmp(LangString(args[i+1]), *((char **) valp)) != 0) { - if (strlen(LangString(args[i+1])) != 0) { - text = (char *) ZnMalloc(strlen(LangString(args[i+1]))+1); - strcpy(text, LangString(args[i+1])); + str = Tcl_GetString(args[i+1]); + if (strcmp(str, *((char **) valp)) != 0) { + if (strlen(str) != 0) { + text = (char *) ZnMalloc(strlen(str)+1); + strcpy(text, str); } if (strlen(*((char **) valp)) != 0) { ZnFree(*((char **) valp)); @@ -625,11 +571,12 @@ ConfigureAttributes(char *record, if (*((Tk_Font *) valp)) { name = Tk_NameOfFont(*((Tk_Font *) valp)); } - if (strcmp(name, LangString(args[i+1])) != 0) { - font = Tk_GetFont(wi->interp, wi->win, LangString(args[i+1])); + str = Tcl_GetString(args[i+1]); + if (strcmp(name, str) != 0) { + font = Tk_GetFont(wi->interp, wi->win, str); if (!font) { Tcl_AppendResult(wi->interp, " font expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (*((Tk_Font *) valp)) { @@ -642,65 +589,48 @@ ConfigureAttributes(char *record, } case ZN_CONFIG_BORDER: { - Border border = NO_BORDER; - int j, len, largc, result; - Arg *largv; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif + Border border = NO_BORDER; + int j, len, largc; + Tcl_Obj **largv; - result = Lang_SplitList(wi->interp, args[i+1], &largc, &largv, &freeProc); - if (result == ZN_ERROR) { + if (Tcl_ListObjGetElements(wi->interp, args[i+1], + &largc, &largv) == ZN_ERROR) { border_error: Tcl_AppendResult(wi->interp, " border expected for attribute \"", - LangString(args[i]), "\"", NULL); -#ifdef PTK - if (largv != NULL && freeProc) { - (*freeProc)(largc, largv); - } -#endif + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } - len = strlen(LangString(args[i+1])); for (j = 0; j < largc; j++) { - if (strncasecmp(LangString(largv[j]), LEFT_SPEC, len) == 0) { + str = Tcl_GetString(largv[j]); + len = strlen(str); + if (strncasecmp(str, LEFT_SPEC, len) == 0) { border |= LEFT_BORDER; } - else if (strncasecmp(LangString(largv[j]), RIGHT_SPEC, len) == 0) { + else if (strncasecmp(str, RIGHT_SPEC, len) == 0) { border |= RIGHT_BORDER; } - else if (strncasecmp(LangString(largv[j]), TOP_SPEC, len) == 0) { + else if (strncasecmp(str, TOP_SPEC, len) == 0) { border |= TOP_BORDER; } - else if (strncasecmp(LangString(largv[j]), BOTTOM_SPEC, len) == 0) { + else if (strncasecmp(str, BOTTOM_SPEC, len) == 0) { border |= BOTTOM_BORDER; } - else if (strncasecmp(LangString(largv[j]), CONTOUR_SPEC, len) == 0) { + else if (strncasecmp(str, CONTOUR_SPEC, len) == 0) { border |= CONTOUR_BORDER; } - else if (strncasecmp(LangString(largv[j]), OBLIQUE_SPEC, len) == 0) { + else if (strncasecmp(str, OBLIQUE_SPEC, len) == 0) { border |= OBLIQUE; } - else if (strncasecmp(LangString(largv[j]), COUNTER_OBLIQUE_SPEC, len) == 0) { + else if (strncasecmp(str, COUNTER_OBLIQUE_SPEC, len) == 0) { border |= COUNTER_OBLIQUE; } - else if (strncasecmp(LangString(largv[j]), NO_BORDER_SPEC, len) == 0) { + else if (strncasecmp(str, NO_BORDER_SPEC, len) == 0) { border |= NO_BORDER; } else { -#ifndef PTK - Tcl_Free((char *) largv); -#endif goto border_error; } } -#ifndef PTK - Tcl_Free((char *) largv); -#else - if (largv != NULL && freeProc) { - (*freeProc)(largc, largv); - } -#endif if (border != *((Border *) valp)) { *((Border *) valp) = border; *flags |= desc->flags; @@ -711,31 +641,32 @@ ConfigureAttributes(char *record, { LineShape line_shape; int len; - len = strlen(LangString(args[i+1])); - if (strncasecmp(LangString(args[i+1]), STRAIGHT_SPEC, len) == 0) { + str = Tcl_GetString(args[i+1]); + len = strlen(str); + if (strncasecmp(str, STRAIGHT_SPEC, len) == 0) { line_shape = LINE_STRAIGHT; } - else if (strncasecmp(LangString(args[i+1]), RIGHT_LIGHTNING_SPEC, len) == 0) { + else if (strncasecmp(str, RIGHT_LIGHTNING_SPEC, len) == 0) { line_shape = LINE_RIGHT_LIGHTNING; } - else if (strncasecmp(LangString(args[i+1]), LEFT_LIGHTNING_SPEC, len) == 0) { + else if (strncasecmp(str, LEFT_LIGHTNING_SPEC, len) == 0) { line_shape = LINE_LEFT_LIGHTNING; } - else if (strncasecmp(LangString(args[i+1]), RIGHT_CORNER_SPEC, len) == 0) { + else if (strncasecmp(str, RIGHT_CORNER_SPEC, len) == 0) { line_shape = LINE_LEFT_CORNER; } - else if (strncasecmp(LangString(args[i+1]), LEFT_CORNER_SPEC, len) == 0) { + else if (strncasecmp(str, LEFT_CORNER_SPEC, len) == 0) { line_shape = LINE_LEFT_CORNER; } - else if (strncasecmp(LangString(args[i+1]), DOUBLE_RIGHT_CORNER_SPEC, len) == 0) { + else if (strncasecmp(str, DOUBLE_RIGHT_CORNER_SPEC, len) == 0) { line_shape = LINE_DOUBLE_LEFT_CORNER; } - else if (strncasecmp(LangString(args[i+1]), DOUBLE_LEFT_CORNER_SPEC, len) == 0) { + else if (strncasecmp(str, DOUBLE_LEFT_CORNER_SPEC, len) == 0) { line_shape = LINE_DOUBLE_LEFT_CORNER; } else { Tcl_AppendResult(wi->interp, " line shape expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (line_shape != *((LineShape *) valp)) { @@ -748,18 +679,19 @@ ConfigureAttributes(char *record, { LineStyle line_style; int len; - len = strlen(LangString(args[i+1])); - if (strncasecmp(LangString(args[i+1]), SIMPLE_SPEC, len) == 0) + str = Tcl_GetString(args[i+1]); + len = strlen(str); + if (strncasecmp(str, SIMPLE_SPEC, len) == 0) line_style = LINE_SIMPLE; - else if (strncasecmp(LangString(args[i+1]), DASHED_SPEC, len) == 0) + else if (strncasecmp(str, DASHED_SPEC, len) == 0) line_style = LINE_DASHED; - else if (strncasecmp(LangString(args[i+1]), MIXED_SPEC, len) == 0) + else if (strncasecmp(str, MIXED_SPEC, len) == 0) line_style = LINE_MIXED; - else if (strncasecmp(LangString(args[i+1]), DOTTED_SPEC, len) == 0) + else if (strncasecmp(str, DOTTED_SPEC, len) == 0) line_style = LINE_DOTTED; else { Tcl_AppendResult(wi->interp, " line style expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (line_style != *((LineStyle *) valp)) { @@ -771,9 +703,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_LINE_END: { ZnLineEnd line_end = NULL; - char *ptr = LangString(args[i+1]); - if (strlen(ptr) != 0) { - line_end = LineEndCreate(wi->interp, LangString(args[i+1])); + str = Tcl_GetString(args[i+1]); + if (strlen(str) != 0) { + line_end = LineEndCreate(wi->interp, str); if (line_end == NULL) { return ZN_ERROR; } @@ -794,9 +726,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_GRADIENT_GEOM: { ZnGradientGeom gg = NULL; - char *ptr = LangString(args[i+1]); - if (strlen(ptr) != 0) { - gg = GradientGeomCreate(wi->interp, LangString(args[i+1])); + str = Tcl_GetString(args[i+1]); + if (strlen(str) != 0) { + gg = GradientGeomCreate(wi->interp, str); if (gg == NULL) { return ZN_ERROR; } @@ -817,9 +749,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_RELIEF: { int relief; - if (Tk_GetRelief(wi->interp, LangString(args[i+1]), &relief) == ZN_ERROR) { + if (Tk_GetRelief(wi->interp, Tcl_GetString(args[i+1]), &relief) == ZN_ERROR) { Tcl_AppendResult(wi->interp, " relief expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (relief != *((ReliefStyle *) valp)) { @@ -832,9 +764,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_JOIN_STYLE: { int join; - if (Tk_GetJoinStyle(wi->interp, LangString(args[i+1]), &join) == ZN_ERROR) { + if (Tk_GetJoinStyle(wi->interp, Tcl_GetString(args[i+1]), &join) == ZN_ERROR) { Tcl_AppendResult(wi->interp, " join expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (join != *((int *) valp)) { @@ -846,9 +778,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_CAP_STYLE: { int cap; - if (Tk_GetCapStyle(wi->interp, LangString(args[i+1]), &cap) == ZN_ERROR) { + if (Tk_GetCapStyle(wi->interp, Tcl_GetString(args[i+1]), &cap) == ZN_ERROR) { Tcl_AppendResult(wi->interp, " cap expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (cap != *((int *) valp)) { @@ -859,39 +791,22 @@ ConfigureAttributes(char *record, } case ZN_CONFIG_POINT: { - ZnPoint point; - int largc, result; - Arg *largv; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif - - result = Lang_SplitList(wi->interp, args[i+1], &largc, &largv, &freeProc); - if (result == ZN_ERROR || largc != 2) { + ZnPoint point; + int largc; + Tcl_Obj **largv; + + if ((Tcl_ListObjGetElements(wi->interp, args[i+1], + &largc, &largv) == ZN_ERROR) || + (largc != 2)) { point_error: -#ifdef PTK - if (largv != NULL && freeProc) { - (*freeProc)(largc, largv); - } -#endif Tcl_AppendResult(wi->interp, " position expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } - if ((Tcl_GetDouble(wi->interp, largv[0], &point.x) == ZN_ERROR) || - (Tcl_GetDouble(wi->interp, largv[1], &point.y) == ZN_ERROR)) { -#ifndef PTK - Tcl_Free((char *)largv); -#endif + if ((Tcl_GetDoubleFromObj(wi->interp, largv[0], &point.x) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, largv[1], &point.y) == ZN_ERROR)) { goto point_error; } -#ifndef PTK - Tcl_Free((char *)largv); -#else - if (largv != NULL && freeProc) { - (*freeProc)(largc, largv); - } -#endif if ((point.x != ((ZnPoint *) valp)->x) || (point.y != ((ZnPoint *) valp)->y)) { *((ZnPoint *) valp) = point; @@ -901,41 +816,24 @@ ConfigureAttributes(char *record, } case ZN_CONFIG_RECT: { - ZnRect rect; - int largc, result; - Arg *largv; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif + ZnRect rect; + int largc; + Tcl_Obj **largv; - result = Lang_SplitList(wi->interp, args[i+1], &largc, &largv, &freeProc); - if (result == ZN_ERROR || largc != 4) { + if ((Tcl_ListObjGetElements(wi->interp, args[i+1], + &largc, &largv) == ZN_ERROR) || + largc != 4) { rect_error: -#ifdef PTK - if (largv != NULL && freeProc) { - (*freeProc)(largc, largv); - } -#endif Tcl_AppendResult(wi->interp, " rectangle expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } - if ((Tcl_GetDouble(wi->interp, largv[0], &rect.x) == ZN_ERROR) || - (Tcl_GetDouble(wi->interp, largv[1], &rect.y) == ZN_ERROR) || - (Tcl_GetDouble(wi->interp, largv[2], &rect.w) == ZN_ERROR) || - (Tcl_GetDouble(wi->interp, largv[3], &rect.h) == ZN_ERROR)) { -#ifndef PTK - Tcl_Free((char *)largv); -#endif + if ((Tcl_GetDoubleFromObj(wi->interp, largv[0], &rect.x) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, largv[1], &rect.y) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, largv[2], &rect.w) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, largv[3], &rect.h) == ZN_ERROR)) { goto rect_error; } -#ifndef PTK - Tcl_Free((char *)largv); -#else - if (largv != NULL && freeProc) { - (*freeProc)(largc, largv); - } -#endif if ((rect.x != ((ZnRect *) valp)->x) && (rect.y != ((ZnRect *) valp)->y) && (rect.w != ((ZnRect *) valp)->w) && @@ -948,9 +846,10 @@ ConfigureAttributes(char *record, case ZN_CONFIG_DIM: { int size; - if (Tk_GetPixels(wi->interp, wi->win, LangString(args[i+1]), &size) == ZN_ERROR) { + if (Tk_GetPixels(wi->interp, wi->win, + Tcl_GetString(args[i+1]), &size) == ZN_ERROR) { Tcl_AppendResult(wi->interp, " dimension expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (size != *((int *) valp)) { @@ -962,12 +861,12 @@ ConfigureAttributes(char *record, case ZN_CONFIG_PRI: { int pri; - if (Tcl_GetInt(wi->interp, args[i+1], &pri) == ZN_ERROR) { + if (Tcl_GetIntFromObj(wi->interp, args[i+1], &pri) == ZN_ERROR) { return ZN_ERROR; } if (pri < 0) { Tcl_AppendResult(wi->interp, " priority must be a positive integer \"", - LangString(args[i+1]), "\"", NULL); + Tcl_GetString(args[i+1]), "\"", NULL); return ZN_ERROR; } if (pri != *((int *) valp)) { @@ -986,11 +885,11 @@ ConfigureAttributes(char *record, { Item item2; int num; - if (strlen(LangString(args[i+1])) == 0) { + if (strlen(Tcl_GetString(args[i+1])) == 0) { item2 = ZN_NO_ITEM; } else { - num = ZnItemsWithTagOrId(wi, LangString(args[i+1]), &item2, NULL); + num = ZnItemsWithTagOrId(wi, args[i+1], &item2, NULL); if (num == 0) { return ZN_ERROR; } @@ -1004,11 +903,12 @@ ConfigureAttributes(char *record, case ZN_CONFIG_WINDOW: { ZnWindow win, ancestor, parent; - if (strlen(LangString(args[i+1])) == 0) { + str = Tcl_GetString(args[i+1]); + if (strlen(str) == 0) { win = NULL; } else { - win = Tk_NameToWindow(wi->interp, args[i+1], wi->win); + win = Tk_NameToWindow(wi->interp, str, wi->win); if (win == NULL) { return ZN_ERROR; } @@ -1053,20 +953,20 @@ ConfigureAttributes(char *record, case ZN_CONFIG_ANGLE: { int integer; - if (Tcl_GetInt(wi->interp, args[i+1], &integer) == ZN_ERROR) { + if (Tcl_GetIntFromObj(wi->interp, args[i+1], &integer) == ZN_ERROR) { return ZN_ERROR; } if (desc->type == ZN_CONFIG_ANGLE) { if ((integer < 0) || (integer > 360)) { Tcl_AppendResult(wi->interp, " angle must be between 0 and 360 \"", - LangString(args[i+1]), "\"", NULL); + Tcl_GetString(args[i+1]), "\"", NULL); return ZN_ERROR; } } else if (desc->type == ZN_CONFIG_UINT) { if (integer < 0) { Tcl_AppendResult(wi->interp, " positive integer expected for \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } } @@ -1079,9 +979,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_JUSTIFY: { Tk_Justify justify; - if (Tk_GetJustify(wi->interp, LangString(args[i+1]), &justify) == ZN_ERROR) { + if (Tk_GetJustify(wi->interp, Tcl_GetString(args[i+1]), &justify) == ZN_ERROR) { Tcl_AppendResult(wi->interp, " justify expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (justify != *((ZnJustify *) valp)) { @@ -1093,9 +993,9 @@ ConfigureAttributes(char *record, case ZN_CONFIG_ANCHOR: { Tk_Anchor anchor; - if (Tk_GetAnchor(wi->interp, LangString(args[i+1]), &anchor) == ZN_ERROR) { + if (Tk_GetAnchor(wi->interp, Tcl_GetString(args[i+1]), &anchor) == ZN_ERROR) { Tcl_AppendResult(wi->interp, " anchor expected for attribute \"", - LangString(args[i]), "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } if (anchor != *((ZnAnchor *) valp)) { @@ -1107,13 +1007,13 @@ ConfigureAttributes(char *record, case ZN_CONFIG_LABEL_FORMAT: { ZnLabelFormat frmt = NULL; - char *ptr = LangString(args[i+1]); - - while (*ptr && (*ptr == ' ')) { - ptr++; + + str = Tcl_GetString(args[i+1]); + while (*str && (*str == ' ')) { + str++; } - if (strlen(ptr) != 0) { - frmt = LabelFormatCreate(wi->interp, ptr, + if (strlen(str) != 0) { + frmt = LabelFormatCreate(wi->interp, str, item->class->GetFieldSet(item)->num_fields); if (frmt == NULL) { return ZN_ERROR; @@ -1138,13 +1038,15 @@ ConfigureAttributes(char *record, { AutoAlign aa; int j; - if (strcmp(LangString(args[i+1]), "-") == 0) { + + str = Tcl_GetString(args[i+1]); + if (strcmp(str, "-") == 0) { aa.automatic = False; } - else if (strlen(LangString(args[i+1])) == 3) { + else if (strlen(str) == 3) { aa.automatic = True; for (j = 0; j < 3; j++) { - switch(LangString(args[i+1])[j]) { + switch(str[j]) { case 'l': case 'L': aa.align[j] = ZnJustifyLeft; @@ -1159,14 +1061,16 @@ ConfigureAttributes(char *record, break; default: Tcl_AppendResult(wi->interp, "invalid auto justify specifcation \"", - LangString(args[i+1]), "\" should be - or a triple of lcr", NULL); + Tcl_GetString(args[i+1]), + "\" should be - or a triple of lcr", NULL); return ZN_ERROR; } } } else { Tcl_AppendResult(wi->interp, "invalid auto alignment specification \"", - LangString(args[i+1]), "\" should be - or a triple of lcr", NULL); + Tcl_GetString(args[i+1]), + "\" should be - or a triple of lcr", NULL); return ZN_ERROR; } if ((aa.automatic != ((AutoAlign *) valp)->automatic) || @@ -1199,25 +1103,25 @@ ConfigureAttributes(char *record, LeaderAnchors lanch = NULL; int anchors[4]; int index, num_tok, anchor_index=0; - char *ptr = LangString(args[i+1]); - while (*ptr && (*ptr == ' ')) { - ptr++; + str = Tcl_GetString(args[i+1]); + while (*str && (*str == ' ')) { + str++; } - while (!*ptr && (anchor_index < 4)) { - switch (*ptr) { + while (!*str && (anchor_index < 4)) { + switch (*str) { case '|': - num_tok = sscanf(ptr, "|%d%n", &anchors[anchor_index], &index); + num_tok = sscanf(str, "|%d%n", &anchors[anchor_index], &index); if (num_tok != 1) { la_error: Tcl_AppendResult(wi->interp, " incorrect leader anchors \"", - LangString(args[i+1]), "\"", NULL); + Tcl_GetString(args[i+1]), "\"", NULL); return ZN_ERROR; } anchors[anchor_index+1] = -1; break; case '%': - num_tok = sscanf(ptr, "%%%dx%d%n", &anchors[anchor_index], + num_tok = sscanf(str, "%%%dx%d%n", &anchors[anchor_index], &anchors[anchor_index+1], &index); if (num_tok != 2) { goto la_error; @@ -1237,7 +1141,7 @@ ConfigureAttributes(char *record, break; } anchor_index += 2; - ptr += index; + str += index; } /* * If empty, pick the default (center of the bounding box). @@ -1283,148 +1187,124 @@ ConfigureAttributes(char *record, /* ********************************************************************************** * - * AttributeToString -- + * AttributeToObj -- * - * Returns the string representation of the attribute pointed + * Returns the obj representation of the attribute pointed * by 'valp'. The attribute type is given by 'type'. The function * never fail. The buffer parameter should be able to * contain 256 characters at least. * ********************************************************************************** */ -static Arg -AttributeToString(WidgetInfo *wi, - char *record, - ZnAttrConfig *desc, - char *buffer, - Tcl_FreeProc **free_proc) +static Tcl_Obj * +AttributeToObj(WidgetInfo *wi, + char *record, + ZnAttrConfig *desc, + char *buffer) { -#ifndef PTK -#define NUM_ELEMS 10 - Arg elems[NUM_ELEMS]; + Tcl_Obj *result = NULL; + char *valp = record + desc->offset; + char *str = ""; + Tcl_Obj *o, *objs[4]; + int i; +#ifdef PTK + Tcl_Obj **tmp=NULL; #endif - Arg *el_ptr; - Arg result = NULL; - char *valp = record + desc->offset; - - *free_proc = TCL_STATIC; switch (desc->type) { case ZN_CONFIG_COLOR: - LangSetString(&result, ""); if (*((XColor **) valp)) { - LangSetString(&result, ZnNameOfColor(*((XColor **) valp))); + result = NewStringObj(ZnNameOfColor(*((XColor **) valp))); } break; case ZN_CONFIG_BOOL: -#ifndef PTK - result = ISSET(*((char *) valp), desc->bool_bit) ? "1" : "0"; -#else - LangSetInt(&result, ISSET(*((char *) valp), desc->bool_bit) ? 1 : 0); -#endif + result = NewBooleanObj(ISSET(*((char *) valp), desc->bool_bit)?1:0); break; case ZN_CONFIG_PATTERN: - LangSetString(&result, ""); if (*((Pixmap *) valp)) { - LangSetString(&result, Tk_NameOfBitmap(wi->dpy, *((Pixmap *) valp))); + result = NewStringObj(Tk_NameOfBitmap(wi->dpy, *((Pixmap *) valp))); } break; case ZN_CONFIG_PATTERNS: { - int num_pats, i; - Pixmap *pats; + int num_pats=0; + Pixmap *pats; +#ifndef PTK + result = Tcl_NewListObj(0, NULL); +#endif if (*((ZnList *) valp)) { pats = (Pixmap *) ZnListArray(*((ZnList *) valp)); num_pats = ZnListSize(*((ZnList *) valp)); -#ifndef PTK - if (num_pats > NUM_ELEMS) { - el_ptr = (char **) ZnMalloc(num_pats*sizeof(char *)); - } - else { - el_ptr = elems; - } -#else - el_ptr = LangAllocVec(num_pats); +#ifdef PTK + tmp = (Tcl_Obj **) ZnMalloc(num_pats * sizeof(Tcl_Obj *)); #endif for (i = 0; i < num_pats; i++) { if (pats[i] != ZnUnspecifiedPattern) { - LangSetString(&el_ptr[i], Tk_NameOfBitmap(wi->dpy, pats[i])); + o = NewStringObj(Tk_NameOfBitmap(wi->dpy, pats[i])); } else { - LangSetString(&el_ptr[i], ""); + o = NewStringObj(""); } - } - result = Tcl_Merge(num_pats, el_ptr); - *free_proc = TCL_DYNAMIC; -#ifndef PTK - if (el_ptr != elems) { - ZnFree(el_ptr); - } +#ifdef PTK + tmp[i] = o; #else - LangFreeVec(num_pats, el_ptr); + Tcl_ListObjAppendElement(wi->interp, result, o); #endif + } } - else { - LangSetString(&result, ""); - } +#ifdef PTK + result = Tcl_Merge(num_pats, tmp); + ZnFree(tmp); +#endif break; } case ZN_CONFIG_TAGS: { - int num_tags, i; + int num_tags=0; Tk_Uid *tags; - + +#ifndef PTK + result = Tcl_NewListObj(0, NULL); +#endif if (*((ZnList *) valp)) { tags = (Tk_Uid *) ZnListArray(*((ZnList *) valp)); num_tags = ZnListSize(*((ZnList *) valp)); -#ifndef PTK - if (num_tags > NUM_ELEMS) { - el_ptr = (char **) ZnMalloc(num_tags*sizeof(char *)); - } - else { - el_ptr = elems; - } -#else - el_ptr = LangAllocVec(num_tags); +#ifdef PTK + tmp = (Tcl_Obj **) ZnMalloc(num_tags * sizeof(Tcl_Obj *)); #endif for (i = 0; i < num_tags; i++) { - LangSetString(&el_ptr[i], tags[i]); - } - result = Tcl_Merge(num_tags, el_ptr); - *free_proc = TCL_DYNAMIC; -#ifndef PTK - if (el_ptr != elems) { - ZnFree(el_ptr); - } +#ifdef PTK + tmp[i] = NewStringObj(tags[i]); #else - LangFreeVec(num_tags, el_ptr); + Tcl_ListObjAppendElement(wi->interp, result, + NewStringObj(tags[i])); #endif + } } - else { - LangSetString(&result, ""); - } +#ifdef PTK + result = Tcl_Merge(num_tags, tmp); + ZnFree(tmp); +#endif break; } case ZN_CONFIG_TEXT: case ZN_CONFIG_MAP_INFO: case ZN_CONFIG_IMAGE: - LangSetString(&result, *((char **) valp)); + result = NewStringObj(*((char **) valp)); break; case ZN_CONFIG_FONT: - LangSetString(&result, ""); if (*((Tk_Font *) valp)) { - LangSetString(&result, Tk_NameOfFont(*((Tk_Font *) valp))); + result = NewStringObj(Tk_NameOfFont(*((Tk_Font *) valp))); } break; case ZN_CONFIG_BORDER: { Border border = *((Border *) valp); if (border == NO_BORDER) { - LangSetString(&result, NO_BORDER_SPEC); + result = NewStringObj(NO_BORDER_SPEC); break; } - *free_proc = TCL_VOLATILE; buffer[0] = 0; if ((border & CONTOUR_BORDER) == CONTOUR_BORDER) { strcat(buffer, CONTOUR_SPEC); @@ -1464,7 +1344,7 @@ AttributeToString(WidgetInfo *wi, } strcat(buffer, COUNTER_OBLIQUE_SPEC); } - LangSetString(&result, buffer); + result = NewStringObj(buffer); } break; case ZN_CONFIG_LINE_SHAPE: @@ -1472,27 +1352,28 @@ AttributeToString(WidgetInfo *wi, LineShape line_shape = *((LineShape *) valp); switch (line_shape) { case LINE_STRAIGHT: - LangSetString(&result, STRAIGHT_SPEC); + str = STRAIGHT_SPEC; break; case LINE_RIGHT_LIGHTNING: - LangSetString(&result, RIGHT_LIGHTNING_SPEC); + str = RIGHT_LIGHTNING_SPEC; break; case LINE_LEFT_LIGHTNING: - LangSetString(&result, LEFT_LIGHTNING_SPEC); + str = LEFT_LIGHTNING_SPEC; break; case LINE_RIGHT_CORNER: - LangSetString(&result, RIGHT_CORNER_SPEC); + str = RIGHT_CORNER_SPEC; break; case LINE_LEFT_CORNER: - LangSetString(&result, LEFT_CORNER_SPEC); + str = LEFT_CORNER_SPEC; break; case LINE_DOUBLE_RIGHT_CORNER: - LangSetString(&result, DOUBLE_RIGHT_CORNER_SPEC); + str = DOUBLE_RIGHT_CORNER_SPEC; break; case LINE_DOUBLE_LEFT_CORNER: - LangSetString(&result, DOUBLE_LEFT_CORNER_SPEC); + str = DOUBLE_LEFT_CORNER_SPEC; break; } + result = NewStringObj(str); break; } case ZN_CONFIG_LINE_STYLE: @@ -1500,29 +1381,27 @@ AttributeToString(WidgetInfo *wi, LineStyle line_style = *((LineStyle *) valp); switch (line_style) { case LINE_SIMPLE: - LangSetString(&result, SIMPLE_SPEC); + str = SIMPLE_SPEC; break; case LINE_DASHED: - LangSetString(&result, DASHED_SPEC); + str = DASHED_SPEC; break; case LINE_MIXED: - LangSetString(&result, MIXED_SPEC); + str = MIXED_SPEC; break; case LINE_DOTTED: - LangSetString(&result, DOTTED_SPEC); + str = DOTTED_SPEC; break; } + result = NewStringObj(str); break; } case ZN_CONFIG_LINE_END: { ZnLineEnd line_end = *((ZnLineEnd *) valp); - if (!line_end) { - LangSetString(&result, ""); - } - else { - LangSetString(&result, LineEndGetString(line_end)); + if (line_end) { + result = NewStringObj(LineEndGetString(line_end)); } break; } @@ -1530,74 +1409,52 @@ AttributeToString(WidgetInfo *wi, { ZnGradientGeom gg = *((ZnGradientGeom *) valp); - if (!gg) { - LangSetString(&result, ""); - } - else { - LangSetString(&result, GradientGeomGetString(gg)); + if (gg) { + result = NewStringObj(GradientGeomGetString(gg)); } break; } case ZN_CONFIG_RELIEF: - LangSetString(&result , Tk_NameOfRelief(*((ReliefStyle *) valp))); + result = NewStringObj(Tk_NameOfRelief(*((ReliefStyle *) valp))); break; case ZN_CONFIG_JOIN_STYLE: - LangSetString(&result , Tk_NameOfJoinStyle(*((int *) valp))); + result = NewStringObj(Tk_NameOfJoinStyle(*((int *) valp))); break; case ZN_CONFIG_CAP_STYLE: - LangSetString(&result , Tk_NameOfCapStyle(*((int *) valp))); + result = NewStringObj(Tk_NameOfCapStyle(*((int *) valp))); break; case ZN_CONFIG_POINT: { -#ifndef PTK - *free_proc = TCL_VOLATILE; - sprintf(buffer, "%g %g", ((ZnPoint *) valp)->x, ((ZnPoint *) valp)->y); - result = buffer; + objs[0] = NewDoubleObj(((ZnPoint *) valp)->x); + objs[1] = NewDoubleObj(((ZnPoint *) valp)->y); +#ifdef PTK + result = Tcl_Merge(2, objs); #else - Arg *list = LangAllocVec(2); - LangSetInt(&list[0], ((ZnPoint *) valp)->x); - LangSetInt(&list[1], ((ZnPoint *) valp)->y); - result = Tcl_Merge(2, list); - LangFreeVec(2, list); + result = Tcl_NewListObj(2, objs); #endif break; } case ZN_CONFIG_RECT: { -#ifndef PTK - *free_proc = TCL_VOLATILE; - sprintf(buffer, "%g %g %g %g", - ((ZnRect *) valp)->x, ((ZnRect *) valp)->y, - ((ZnRect *) valp)->w, ((ZnRect *) valp)->h); - result = buffer; + objs[0] = NewDoubleObj(((ZnRect *) valp)->x); + objs[1] = NewDoubleObj(((ZnRect *) valp)->y); + objs[2] = NewDoubleObj(((ZnRect *) valp)->w); + objs[3] = NewDoubleObj(((ZnRect *) valp)->h); +#ifdef PTK + result = Tcl_Merge(4, objs); #else - Arg *list = LangAllocVec(4); - LangSetInt(&list[0], ((ZnRect *) valp)->x); - LangSetInt(&list[1], ((ZnRect *) valp)->x); - LangSetInt(&list[2], ((ZnRect *) valp)->w); - LangSetInt(&list[3], ((ZnRect *) valp)->h); - result = Tcl_Merge(4, list); - LangFreeVec(4, list); + result = Tcl_NewListObj(4, objs); #endif break; } case ZN_CONFIG_ITEM: - if (*((Item *) valp) == ZN_NO_ITEM) { - LangSetString(&result, ""); - } - else { - *free_proc = TCL_VOLATILE; - sprintf(buffer, "%d", (*((Item *) valp))->id); - LangSetString(&result, buffer); + if (*((Item *) valp) != ZN_NO_ITEM) { + result = NewLongObj((*((Item *) valp))->id); } break; case ZN_CONFIG_WINDOW: - if (*((ZnWindow *) valp) == NULL) { - LangSetString(&result, ""); - } - else { - *free_proc = TCL_VOLATILE; - LangSetString(&result, Tk_PathName(*((ZnWindow *) valp))); + if (*((ZnWindow *) valp) != NULL) { + result = NewStringObj(Tk_PathName(*((ZnWindow *) valp))); } break; case ZN_CONFIG_INT: @@ -1605,28 +1462,20 @@ AttributeToString(WidgetInfo *wi, case ZN_CONFIG_DIM: case ZN_CONFIG_PRI: case ZN_CONFIG_ANGLE: - *free_proc = TCL_VOLATILE; - sprintf(buffer, "%d", *((int *) valp)); - LangSetString(&result, buffer); + result = Tcl_NewIntObj(*((int *) valp)); break; case ZN_CONFIG_JUSTIFY: - { - Tk_Justify justify = *((ZnJustify *) valp); - LangSetString(&result, Tk_NameOfJustify(justify)); - break; - } + result = NewStringObj(Tk_NameOfJustify(*((ZnJustify *) valp))); + break; case ZN_CONFIG_ANCHOR: - LangSetString(&result, Tk_NameOfAnchor(*((Tk_Anchor *) valp))); + result = NewStringObj(Tk_NameOfAnchor(*((Tk_Anchor *) valp))); break; case ZN_CONFIG_LABEL_FORMAT: { ZnLabelFormat frmt = *((ZnLabelFormat *) valp); - if (!frmt) { - LangSetString(&result, ""); - } - else { - LangSetString(&result, LabelFormatGetString(frmt)); + if (frmt) { + result = NewStringObj(LabelFormatGetString(frmt)); } break; } @@ -1635,11 +1484,11 @@ AttributeToString(WidgetInfo *wi, AutoAlign *aa = (AutoAlign *) valp; int i; if (aa->automatic == False) { - LangSetString(&result, "-"); + result = NewStringObj("-"); } else { - *free_proc = TCL_VOLATILE; buffer[0] = 0; + str = buffer; for (i = 0; i < 3; i++) { switch (aa->align[i]) { case ZnJustifyLeft: @@ -1653,10 +1502,10 @@ AttributeToString(WidgetInfo *wi, break; } } - LangSetString(&result, buffer); + result = NewStringObj(buffer); } } - break; + break; case ZN_CONFIG_LEADER_ANCHORS: { @@ -1677,10 +1526,13 @@ AttributeToString(WidgetInfo *wi, else { count = sprintf(ptr, "%%%dx%d", lanch->right_x, lanch->right_y); } - LangSetString(&result, buffer); + result = NewStringObj(buffer); } } + if (result == NULL) { + result = NewStringObj(""); + } return result; } @@ -1695,13 +1547,12 @@ AttributeToString(WidgetInfo *wi, static int QueryAttribute(char *record, int field, /* 0< means item itself. */ - Arg attr_name) + Tcl_Obj *attr_name) { WidgetInfo *wi; Item item; - Tk_Uid attr_uid = Tk_GetUid(LangString(attr_name)); - Arg result = NULL; - Tcl_FreeProc *free_proc; + Tk_Uid attr_uid = Tk_GetUid(Tcl_GetString(attr_name)); + Tcl_Obj *result = NULL; char buffer[256]; ZnAttrConfig *desc; @@ -1723,17 +1574,12 @@ QueryAttribute(char *record, while (True) { if (desc->type == ZN_CONFIG_END) { - Tcl_AppendResult(wi->interp, "unknown attribute \"", - attr_uid, "\"", NULL); + Tcl_AppendResult(wi->interp, "unknown attribute \"", attr_uid, "\"", NULL); return ZN_ERROR; } else if (attr_uid == desc->uid) { - result = AttributeToString(wi, record, desc, buffer, &free_proc); -#ifndef PTK - Tcl_SetResult(wi->interp, result, free_proc); -#else - Tcl_ArgResult(wi->interp, result); -#endif + result = AttributeToObj(wi, record, desc, buffer); + Tcl_SetObjResult(wi->interp, result); break; } else { @@ -2960,7 +2806,7 @@ static Item CreateItem(WidgetInfo *wi, ItemClass item_class, int *argc, - Arg **args) + Tcl_Obj *CONST *args[]) { Item item; @@ -3057,7 +2903,7 @@ static int ConfigureItem(Item item, int field, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], ZnBool init) { WidgetInfo *wi = item->wi; @@ -3109,10 +2955,10 @@ ConfigureItem(Item item, ********************************************************************************** */ static int -QueryItem(Item item, - int field, - int argc, - ZnAttrList argv) +QueryItem(Item item, + int field, + int argc, + Tcl_Obj *CONST argv[]) { if (field < 0) { return item->class->Query(item, argc, argv); @@ -3987,7 +3833,7 @@ static int ConfigureField(FieldSet field_set, unsigned int field, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { int i; @@ -4094,7 +3940,7 @@ static int QueryField(FieldSet field_set, unsigned int field, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { Field field_ptr; @@ -4279,7 +4125,8 @@ DrawFields(FieldSet field_set) clip_text_bbox.orig.y != text_bbox.orig.y || clip_text_bbox.corner.x != text_bbox.corner.x || clip_text_bbox.corner.y != text_bbox.corner.y || - clip_pm_bbox.orig.x != pm_bbox.orig.x || clip_pm_bbox.orig.y != pm_bbox.orig.y || + clip_pm_bbox.orig.x != pm_bbox.orig.x || + clip_pm_bbox.orig.y != pm_bbox.orig.y || clip_pm_bbox.corner.x != pm_bbox.corner.x || clip_pm_bbox.corner.y != pm_bbox.corner.y) { /* we must clip. */ diff --git a/generic/Item.h b/generic/Item.h index 0db8b35..966e88b 100644 --- a/generic/Item.h +++ b/generic/Item.h @@ -142,10 +142,10 @@ typedef struct _FieldSetStruct { /* * Item class record -- */ -typedef int (*ItemInitMethod)(Item item, int *argc, Arg **args); -typedef int (*ItemConfigureMethod)(Item item, int argc, ZnAttrList args, +typedef int (*ItemInitMethod)(Item item, int *argc, Tcl_Obj *CONST *args[]); +typedef int (*ItemConfigureMethod)(Item item, int argc, Tcl_Obj *CONST args[], int *flags); -typedef int (*ItemQueryMethod)(Item item, int argc, ZnAttrList args); +typedef int (*ItemQueryMethod)(Item item, int argc, Tcl_Obj *CONST args[]); typedef void (*ItemCloneMethod)(Item item); typedef void (*ItemDestroyMethod)(Item item); typedef void (*ItemDrawMethod)(Item item); @@ -167,8 +167,9 @@ typedef int (*ItemCoordsMethod)(Item item, int contour, int index, int cmd, typedef void (*ItemInsertCharsMethod)(Item item, int index, char *chars); typedef void (*ItemDeleteCharsMethod)(Item item, int first, int last); typedef void (*ItemCursorMethod)(Item item, int index); -typedef int (*ItemIndexMethod)(Item item, char *index_str, int *index); -typedef int (*ItemSelectionMethod)(Item item, int offset, char *chars, int max_chars); +typedef int (*ItemIndexMethod)(Item item, Tcl_Obj *index_spec, int *index); +typedef int (*ItemSelectionMethod)(Item item, int offset, char *chars, + int max_chars); typedef void (*ItemPostScriptMethod)(Item item, PostScriptInfo ps_info); typedef struct _ItemClassStruct { @@ -214,9 +215,10 @@ typedef struct _ItemClassStruct { extern struct _ITEM { Item (*CloneItem)(Item model); void (*DestroyItem)(Item item); - int (*ConfigureItem)(Item item, int field, int argc, ZnAttrList args, ZnBool init); - int (*QueryItem)(Item item, int field, int argc, ZnAttrList args); - int (*AttributesInfo)(Item item, int field, int argc, Arg *args); + int (*ConfigureItem)(Item item, int field, int argc, Tcl_Obj *CONST args[], + ZnBool init); + int (*QueryItem)(Item item, int field, int argc, Tcl_Obj *CONST args[]); + int (*AttributesInfo)(Item item, int field, int argc, Tcl_Obj *CONST args[]); void (*SetFieldsAutoAlign)(Item item, int alignment); void (*InsertItem)(Item item, Item group, Item mark_item, ZnBool before); void (*UpdateItemPriority)(Item item, Item mark_item, ZnBool before); @@ -249,15 +251,16 @@ extern struct _ITEM { extern struct _ITEM_P { void (*GlobalModuleInit)(); Item (*CreateItem)(struct _WidgetInfo *wi, ItemClass item_class, - int *argc, Arg **args); + int *argc, Tcl_Obj *CONST *args[]); void (*AddItemClass)(ItemClass class); ItemClass (*LookupItemClass)(char *class_name); ZnList (*ItemClassList)(); void (*Damage)(struct _WidgetInfo *wi, ZnBBox *damage); void (*Repair)(struct _WidgetInfo *wi); void (*Update)(struct _WidgetInfo *wi); - int (*ConfigureAttributes)(char *record, int field, int argc, Arg *args, int *flags); - int (*QueryAttribute)(char *record, int field, Arg attr_name); + int (*ConfigureAttributes)(char *record, int field, int argc, + Tcl_Obj *CONST args[], int *flags); + int (*QueryAttribute)(char *record, int field, Tcl_Obj *attr_name); void (*InitFields)(FieldSet field_set); void (*CloneFields)(FieldSet field_set); void (*FreeFields)(FieldSet field_set); diff --git a/generic/Map.c b/generic/Map.c index 66587ea..edd29f5 100644 --- a/generic/Map.c +++ b/generic/Map.c @@ -195,9 +195,9 @@ FreeLists(MapItem map) ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { MapItem map = (MapItem) item; WidgetInfo *wi = item->wi; @@ -370,7 +370,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { WidgetInfo *wi = item->wi; @@ -419,7 +419,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Rectangle.c b/generic/Rectangle.c index c85dc98..f31b96f 100644 --- a/generic/Rectangle.c +++ b/generic/Rectangle.c @@ -155,17 +155,14 @@ RectTileChange(ClientData client_data, ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; RectangleItem rect = (RectangleItem) item; - Arg *elems; - int result, num_elems; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif + Tcl_Obj **elems; + int num_elems; rect->gradient = NULL; @@ -180,42 +177,17 @@ Init(Item item, Tcl_AppendResult(wi->interp, " rectangle coords expected", NULL); return ZN_ERROR; } - result = Lang_SplitList(wi->interp, (*args)[0], &num_elems, &elems, &freeProc); - if ((result == ZN_ERROR) || (num_elems != 4)) { - rect_error: -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_elems, elems); - } -#endif + if ((Tcl_ListObjGetElements(wi->interp, (*args)[0], &num_elems, &elems) == ZN_ERROR) || + (num_elems != 4) || + (Tcl_GetDoubleFromObj(wi->interp, elems[0], &rect->coords[0].x) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, elems[1], &rect->coords[0].y) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, elems[2], &rect->coords[1].x) == ZN_ERROR) || + (Tcl_GetDoubleFromObj(wi->interp, elems[3], &rect->coords[1].y) == ZN_ERROR)) { Tcl_AppendResult(wi->interp, " malformed rectangle coords", NULL); return ZN_ERROR; - } - if (Tcl_GetDouble(wi->interp, elems[0], &rect->coords[0].x) == ZN_ERROR) { - rect_error2: -#ifndef PTK - Tcl_Free((char *) elems); -#endif - goto rect_error; - }; - if (Tcl_GetDouble(wi->interp, elems[1], &rect->coords[0].y) == ZN_ERROR) { - goto rect_error2; - }; - if (Tcl_GetDouble(wi->interp, elems[2], &rect->coords[1].x) == ZN_ERROR) { - goto rect_error2; - }; - if (Tcl_GetDouble(wi->interp, elems[3], &rect->coords[1].y) == ZN_ERROR) { - goto rect_error2; }; (*args)++; (*argc)--; -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_elems, elems); - } -#endif CLEAR(rect->flags, FILLED_BIT); rect->relief = RELIEF_FLAT; @@ -321,7 +293,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { WidgetInfo *wi = item->wi; @@ -376,7 +348,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Reticle.c b/generic/Reticle.c index 6777182..8a52792 100644 --- a/generic/Reticle.c +++ b/generic/Reticle.c @@ -123,9 +123,9 @@ static ZnAttrConfig reticle_attrs[] = { ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { ReticleItem reticle = (ReticleItem) item; WidgetInfo *wi = item->wi; @@ -201,7 +201,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { if (ITEM_P.ConfigureAttributes((char *)item, -1, argc, argv, flags) == ZN_ERROR) { @@ -222,7 +222,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Tabular.c b/generic/Tabular.c index 2c91706..00bd019 100644 --- a/generic/Tabular.c +++ b/generic/Tabular.c @@ -31,6 +31,7 @@ #include "WidgetInfo.h" #include "Item.h" #include "Geo.h" +#include "tkZinc.h" static const char rcsid[] = "$Id$"; @@ -102,9 +103,9 @@ static ZnAttrConfig tabular_attrs[] = { ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; TabularItem tab = (TabularItem) item; @@ -127,8 +128,9 @@ Init(Item item, /* * Then try to see if some fields are needed. */ - if ((*argc > 0) && (LangString((*args)[0])[0] != '-') && - (Tcl_GetInt(wi->interp, (args[0])[0], &field_set->num_fields) != ZN_ERROR)) { + if ((*argc > 0) && (Tcl_GetString((*args)[0])[0] != '-') && + (Tcl_GetIntFromObj(wi->interp, (*args)[0], + &field_set->num_fields) != ZN_ERROR)) { *args += 1; *argc -= 1; ITEM_P.InitFields(field_set); @@ -182,7 +184,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { Item old_connected; @@ -220,7 +222,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Text.c b/generic/Text.c index 61e5020..0b6ac69 100644 --- a/generic/Text.c +++ b/generic/Text.c @@ -45,6 +45,7 @@ #include "Draw.h" #include "Types.h" #include "WidgetInfo.h" +#include "tkZinc.h" static const char rcsid[] = "$Imagine: Text.c,v 1.13 1997/05/15 11:35:46 lecoanet Exp $"; @@ -164,9 +165,9 @@ static ZnAttrConfig text_attrs[] = { ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WidgetInfo *wi = item->wi; TextItem text = (TextItem) item; @@ -281,7 +282,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { Item old_connected; @@ -319,7 +320,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; @@ -577,9 +578,9 @@ Draw(Item item) int font_height; int num_lines, i, line_index, char_index; TextLineInfo lines, lines_ptr; - int underline_thickness, underline_pos, overstrike_pos; - int sel_first_line = -1, sel_last_line = -1, cursor_line = -1; - int sel_start_offset, sel_stop_offset, cursor_offset; + int underline_thickness, underline_pos=0, overstrike_pos=0; + int sel_first_line=-1, sel_last_line=-1, cursor_line=-1; + int sel_start_offset=0, sel_stop_offset=0, cursor_offset=0; lines = (TextLineInfo) ZnListArray(text->text_info); num_lines = ZnListSize(text->text_info); @@ -981,7 +982,7 @@ PointToChar(Item item, static int Index(Item item, - char *index_str, + Tcl_Obj *index_spec, int *index) { TextItem text = (TextItem) item; @@ -991,16 +992,17 @@ Index(Item item, double tmp; char *end, *p; - c = index_str[0]; - length = strlen(index_str); + p = Tcl_GetString(index_spec); + c = p[0]; + length = strlen(p); - if ((c == 'e') && (strncmp(index_str, "end", length) == 0)) { + if ((c == 'e') && (strncmp(p, "end", length) == 0)) { *index = text->num_chars; } - else if ((c == 'i') && (strncmp(index_str, "insert", length) == 0)) { + else if ((c == 'i') && (strncmp(p, "insert", length) == 0)) { *index = text->insert_index; } - else if ((c == 's') && (strncmp(index_str, "sel.first", length) == 0) && + else if ((c == 's') && (strncmp(p, "sel.first", length) == 0) && (length >= 5)) { if (wi->text_info.sel_item != item) { Tcl_AppendResult(wi->interp, "selection isn't in item", (char *) NULL); @@ -1008,7 +1010,7 @@ Index(Item item, } *index = wi->text_info.sel_first; } - else if ((c == 's') && (strncmp(index_str, "sel.last", length) == 0) && + else if ((c == 's') && (strncmp(p, "sel.last", length) == 0) && (length >= 5)) { if (wi->text_info.sel_item != item) { Tcl_AppendResult(wi->interp, "selection isn't in item", (char *) NULL); @@ -1017,7 +1019,7 @@ Index(Item item, *index = wi->text_info.sel_last; } else if (c == '@') { - p = index_str+1; + p++; tmp = strtod(p, &end); if ((end == p) || (*end != ',')) { goto badIndex; @@ -1034,7 +1036,7 @@ Index(Item item, *index = PointToChar(item, x-wi->inset, y-wi->inset); } - else if (Tcl_GetInt(wi->interp, index_str, index) == TCL_OK) { + else if (Tcl_GetIntFromObj(wi->interp, index_spec, index) == TCL_OK) { if (*index < 0){ *index = 0; } @@ -1044,7 +1046,7 @@ Index(Item item, } else { badIndex: - Tcl_AppendResult(wi->interp, "bad index \"", index_str, "\"", (char *) NULL); + Tcl_AppendResult(wi->interp, "bad index \"", p, "\"", (char *) NULL); return TCL_ERROR; } diff --git a/generic/Track.c b/generic/Track.c index 45a13ef..586b5b9 100644 --- a/generic/Track.c +++ b/generic/Track.c @@ -33,6 +33,7 @@ #include "Item.h" #include "Types.h" #include "WidgetInfo.h" +#include "tkZinc.h" static const char rcsid[] = "$Id$"; @@ -307,9 +308,9 @@ static ZnAttrConfig wp_attrs[] = { ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { TrackItem track = (TrackItem) item; FieldSet field_set = &track->field_set; @@ -368,8 +369,8 @@ Init(Item item, /* * Then try to see if some fields are needed. */ - if ((*argc > 0) && (LangString((*args)[0])[0] != '-') && - (Tcl_GetInt(wi->interp, (args[0])[0], &field_set->num_fields) != ZN_ERROR)) { + if ((*argc > 0) && (Tcl_GetString((*args)[0])[0] != '-') && + (Tcl_GetIntFromObj(wi->interp, (*args)[0], &field_set->num_fields) != ZN_ERROR)) { *args += 1; *argc -= 1; ITEM_P.InitFields(field_set); @@ -533,7 +534,7 @@ AddToHistory(TrackItem track, static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { TrackItem track = (TrackItem) item; @@ -609,7 +610,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/Types.h b/generic/Types.h index ff2187d..d6e3b42 100644 --- a/generic/Types.h +++ b/generic/Types.h @@ -44,18 +44,6 @@ extern "C" { #endif -#ifndef PTK -#define Arg char * -#define LangFreeProc void -#define LangString(p) (p) -#define LangCopyArg(p) (p) -#define LangStringArg(p) (p) -#define LangSetString(a,b) (*(a)=(b)) -#define LangSetArg(a,b) (*(a)=(b)) -#define Lang_SplitList(a,b,c,d,e) (Tcl_SplitList(a,b,c,d)) -#endif - - typedef void *ZnItemClassId; typedef void *ZnItemId; @@ -68,7 +56,6 @@ typedef Tk_Font ZnFont; typedef Tk_Window ZnWindow; typedef void *ZnPtr; typedef Tk_Image ZnImage; -typedef Arg *ZnAttrList; typedef struct { ZnPos x, y; diff --git a/generic/Window.c b/generic/Window.c index 9cc8e7f..cbe37cd 100644 --- a/generic/Window.c +++ b/generic/Window.c @@ -175,9 +175,9 @@ static Tk_GeomMgr wind_geom_type = { ********************************************************************************** */ static int -Init(Item item, - int *argc, - Arg **args) +Init(Item item, + int *argc, + Tcl_Obj *CONST *args[]) { WindowItem wind = (WindowItem) item; @@ -255,7 +255,7 @@ Destroy(Item item) static int Configure(Item item, int argc, - ZnAttrList argv, + Tcl_Obj *CONST argv[], int *flags) { WindowItem wind = (WindowItem) item; @@ -319,7 +319,7 @@ Configure(Item item, static int Query(Item item, int argc, - ZnAttrList argv) + Tcl_Obj *CONST argv[]) { if (ITEM_P.QueryAttribute((char *) item, -1, argv[0]) == ZN_ERROR) { return ZN_ERROR; diff --git a/generic/tkZinc.c b/generic/tkZinc.c index 9909b4b..452e80a 100644 --- a/generic/tkZinc.c +++ b/generic/tkZinc.c @@ -50,7 +50,9 @@ static const char compile_id[]="$Compile: " __FILE__ " " __DATE__ " " __TIME__ " #include "Track.h" #include "Transfo.h" #include "Image.h" +#ifdef GPC #include "gpc/gpc.h" +#endif #include #include @@ -232,16 +234,66 @@ static void Bind _ANSI_ARGS_((ClientData client_data, XEvent *eventPtr)); static int FetchSelection _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); static void SelectTo _ANSI_ARGS_((Item item, int index)); -static int WidgetCmd _ANSI_ARGS_((ClientData client_data, - Tcl_Interp *, int argc, Arg *args)); +static int WidgetObjCmd _ANSI_ARGS_((ClientData client_data, + Tcl_Interp *, int argc, Tcl_Obj *CONST args[])); static int Configure _ANSI_ARGS_((Tcl_Interp *interp, WidgetInfo *wi, - int argc, Arg *args, int flags)); + int argc, Tcl_Obj *CONST args[], int flags)); static void Redisplay _ANSI_ARGS_((ClientData client_data)); static void Destroy _ANSI_ARGS_((char *mem_ptr)); static void InitZinc _ANSI_ARGS_((Tcl_Interp *interp)); static void Focus _ANSI_ARGS_((WidgetInfo *wi, ZnBool got_focus)); +#ifdef PTK +Tcl_Obj * +NewLongObj(long val) +{ + Tcl_Obj *obj = Tcl_NewIntObj(0); + Tcl_SetLongObj(obj, val); + return obj; +} +#endif + +#ifdef PTK +Tcl_Obj * +NewBooleanObj(ZnBool val) +{ + Tcl_Obj *obj = Tcl_NewIntObj(0); + Tcl_SetBooleanObj(obj, val); + return obj; +} +#endif + +#ifdef PTK +Tcl_Obj * +NewDoubleObj(ZnReal val) +{ + Tcl_Obj *obj = Tcl_NewIntObj(0); + Tcl_SetDoubleObj(obj, val); + return obj; +} +#endif + +Tcl_Obj * +NewStringObj(char *str) { + return Tcl_NewStringObj(str, strlen(str)); +} + +void +SetStringObj(Tcl_Obj *o, + char *str) { + return Tcl_SetStringObj(o, str, strlen(str)); +} + +#if 1 +char * +Tcl_GetString(Tcl_Obj *obj) +{ + return Tcl_GetStringFromObj(obj, NULL); +} +#endif + + /* *---------------------------------------------------------------------- * @@ -296,7 +348,7 @@ ZnNeedRedisplay(WidgetInfo *wi) /* *---------------------------------------------------------------------- * - * ZincCmd -- + * ZincObjCmd -- * * This procedure is invoked to process the "zinc" Tcl * command. It creates a new "zinc" widget. @@ -305,18 +357,18 @@ ZnNeedRedisplay(WidgetInfo *wi) */ int -ZincCmd(ClientData client_data, /* Main window associated with - * interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - Arg *args) /* Argument strings. */ +ZincObjCmd(ClientData client_data, /* Main window associated with + * interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + Tcl_Obj *CONST args[]) /* Argument strings. */ { Tk_Window top_w = (Tk_Window) client_data; WidgetInfo *wi; Tk_Window tkwin; unsigned int num; int major_op, first_err, first_evt; - + if (!inited) { InitZinc(interp); } @@ -326,12 +378,11 @@ ZincCmd(ClientData client_data, /* Main window associated with return TCL_OK; } if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - LangString(args[0]), " pathName ?options?\"", NULL); + Tcl_WrongNumArgs(interp, 1, args, "pathName ?options?"); return ZN_ERROR; } - tkwin = Tk_CreateWindowFromPath(interp, top_w, LangString(args[1]), NULL); + tkwin = Tk_CreateWindowFromPath(interp, top_w, Tcl_GetString(args[1]), NULL); if (tkwin == NULL) { return ZN_ERROR; } @@ -358,13 +409,14 @@ ZincCmd(ClientData client_data, /* Main window associated with wi->reshape = wi->full_reshape = True; wi->real_top = None; -#ifndef PTK - wi->cmd = Tcl_CreateCommand(interp, Tk_PathName(tkwin), WidgetCmd, +#ifdef PTK + wi->cmd = Lang_CreateWidget(interp, tkwin, (Tcl_CmdProc *) WidgetObjCmd, (ClientData) wi, CmdDeleted); -#else - wi->cmd = Lang_CreateWidget(interp,tkwin, WidgetCmd, (ClientData) wi, CmdDeleted); -#endif +#else + wi->cmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin), WidgetObjCmd, + (ClientData) wi, CmdDeleted); +#endif wi->binding_table = 0; wi->realized = False; wi->update_pending = 0; @@ -479,12 +531,12 @@ ZincCmd(ClientData client_data, /* Main window associated with wi->width, wi->height, DefaultDepthOfScreen(wi->screen)); -#ifndef PTK - Tcl_SetResult(interp, Tk_PathName(tkwin), TCL_STATIC); +#ifdef PTK + Tcl_SetObjResult(interp, LangWidgetArg(interp, tkwin)); #else - Tcl_ArgResult(interp, LangWidgetArg(interp, tkwin)); + Tcl_SetObjResult(interp, NewStringObj(Tk_PathName(tkwin))); #endif - + return TCL_OK; } @@ -549,13 +601,14 @@ EncodeItemPart(Item item, */ static Item ZnSearchWithTagOrId(WidgetInfo *wi, - char *tag, + Tcl_Obj *tag, /* NULL is the same as 'all' */ Item group, TagSearch *tag_search) { Tk_Uid uid, *tags; - int id, i, num_tags; - char *end; + long id; + char *str = NULL; + int i, num_tags; Tcl_HashEntry *entry; Item item = ZN_NO_ITEM; @@ -566,26 +619,35 @@ ZnSearchWithTagOrId(WidgetInfo *wi, tag_search->over = False; tag_search->item_stack = ZnListNew(16, sizeof(Item)); tag_search->group = (GroupItem) group; - + /* * Try to consider the tag as an item id. */ - if (isdigit(*tag)) { - id = strtoul(tag, &end, 0); - if (*end == 0) { - entry = Tcl_FindHashEntry(wi->id_table, (char *) id); - if (entry != NULL) { - item = (Item) Tcl_GetHashValue(entry); + if (tag) { + str = Tcl_GetString(tag); + if (isdigit(str[0])) { + if (Tcl_GetLongFromObj(wi->interp, tag, &id) == ZN_OK) { + entry = Tcl_FindHashEntry(wi->id_table, (char *) id); + if (entry != NULL) { + item = (Item) Tcl_GetHashValue(entry); + } + Tcl_ResetResult(wi->interp); + tag_search->over = True; + return item; } - tag_search->over = True; - return item; } } - - /* + + /* * Now look for a tag. */ - tag_search->tag = uid = Tk_GetUid(tag); + if (!tag) { + tag_search->tag = uid = all_uid; + } + else { + tag_search->tag = uid = Tk_GetUid(str); + } + if (uid == all_uid) { tag_search->current = tag_search->group->head; tag_search->previous = ZN_NO_ITEM; @@ -799,24 +861,24 @@ ZnDoneWithSearch(TagSearch *tag_search) */ int ZnItemsWithTagOrId(WidgetInfo *wi, - char *tag_or_id, + Tcl_Obj *tag_or_id, Item *item, Item **item_list) { unsigned long id; - char *end; Tcl_HashEntry *entry; Tk_Uid tag_uid; ZnList items; int num_items; - - if (isdigit(*tag_or_id)) { - id = strtoul(tag_or_id, &end, 0); - if (*end == 0) { + char *str; + + str = Tcl_GetString(tag_or_id); + if (isdigit(str[0])) { + if (Tcl_GetLongFromObj(wi->interp, tag_or_id, &id) == ZN_OK) { + Tcl_ResetResult(wi->interp); entry = Tcl_FindHashEntry(wi->id_table, (char *) id); if (entry == NULL) { - Tcl_AppendResult(wi->interp, - "item \"", tag_or_id, "\" doesn't exist", NULL); + Tcl_AppendResult(wi->interp, "item \"", str, "\" doesn't exist", NULL); return 0; } *item = (Item) Tcl_GetHashValue(entry); @@ -830,7 +892,7 @@ ZnItemsWithTagOrId(WidgetInfo *wi, /* * It is a tag, try to find it and return the whole list. */ - tag_uid = Tk_GetUid(tag_or_id); + tag_uid = Tk_GetUid(str); /* * If it is 'all' then build a list of all the items @@ -849,7 +911,7 @@ ZnItemsWithTagOrId(WidgetInfo *wi, else { wi->work_item_list = ZnListNew(128, sizeof(Item)); } - for (current = ZnSearchWithTagOrId(wi, all_uid, wi->top_group, &ts); + for (current = ZnSearchWithTagOrId(wi, NULL, wi->top_group, &ts); current != NULL; current = ZnNextWithTagOrId(&ts)) { ZnListAdd(wi->work_item_list, ¤t, ZnListTail); } @@ -881,8 +943,7 @@ ZnItemsWithTagOrId(WidgetInfo *wi, return num_items; } else { - Tcl_AppendResult(wi->interp, - "unknown tag \"", tag_or_id, "\"", NULL); + Tcl_AppendResult(wi->interp, "unknown tag \"", tag_uid, "\"", NULL); return 0; } } @@ -907,12 +968,11 @@ DoItem(Tcl_Interp *interp, Tk_Uid tag_uid) { if (tag_uid == NULL) { - char msg[INTEGER_SPACE]; - sprintf(msg, "%d", item->id); - Tcl_AppendElement(interp, msg); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + NewLongObj(item->id)); if (part != ZN_NO_PART) { - sprintf(msg, "%d", part); - Tcl_AppendElement(interp, msg); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(part)); } } else { @@ -960,9 +1020,8 @@ IsHeirOf(Item item, *---------------------------------------------------------------------- */ static int -FindArea(Tcl_Interp *interp, - WidgetInfo *wi, - Arg *args, +FindArea(WidgetInfo *wi, + Tcl_Obj *CONST args[], Tk_Uid tag_uid, Item group, int enclosed) @@ -970,16 +1029,16 @@ FindArea(Tcl_Interp *interp, ZnPos pos; ZnBBox area; - if (Tcl_GetDouble(interp, args[0], &area.orig.x) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, args[0], &area.orig.x) == ZN_ERROR) { return ZN_ERROR; } - if (Tcl_GetDouble(interp, args[1], &area.orig.y) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, args[1], &area.orig.y) == ZN_ERROR) { return ZN_ERROR; } - if (Tcl_GetDouble(interp, args[2], &area.corner.x) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, args[2], &area.corner.x) == ZN_ERROR) { return ZN_ERROR; } - if (Tcl_GetDouble(interp, args[3], &area.corner.y) == ZN_ERROR) { + if (Tcl_GetDoubleFromObj(wi->interp, args[3], &area.corner.y) == ZN_ERROR) { return ZN_ERROR; } if (area.corner.x < area.orig.x) { @@ -1024,291 +1083,296 @@ FindArea(Tcl_Interp *interp, *---------------------------------------------------------------------- */ static int -FindItems(Tcl_Interp *interp, - WidgetInfo *wi, +FindItems(WidgetInfo *wi, int argc, - Arg *args, - char *new_tag, /* NULL to search or tag string to add tag. */ - char *cmd_name, /* To report errors */ - char *option) /* Also to report errors meaningfully */ + Tcl_Obj *CONST args[], + Tcl_Obj *tag, /* NULL to search or tag to add tag. */ + int first) /* First arg to process in args */ { Tk_Uid tag_uid = NULL; TagSearch ts; - char c; - int length, num_items; + int index, num_items; Item item, group = wi->top_group; + static char *search_cmd_strings[] = { + "above", "all", "atpoint", "atpriority", "below", "enclosed", + "overlapping", "withtag", "withtype", NULL + }; + enum search_cmds { + ZN_S_ABOVE, ZN_S_ALL, ZN_S_ATPOINT, ZN_S_ATPRIORITY, ZN_S_BELOW, + ZN_S_ENCLOSED, ZN_S_OVERLAPPING, ZN_S_WITHTAG, ZN_S_WITHTYPE + }; - if (new_tag != NULL) { - tag_uid = Tk_GetUid(new_tag); + if (Tcl_GetIndexFromObj(wi->interp, args[first], search_cmd_strings, + "search command", 0, &index) != ZN_OK) { + return ZN_ERROR; } - c = LangString(args[0])[0]; - length = strlen(LangString(args[0])); - - /* - * above - */ - if ((c == 'a') && (strncmp(LangString(args[0]), "above", length) == 0)) { - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " above tagOrId ?inGroup?", NULL); - return ZN_ERROR; - } - if (argc == 3) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[2]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { - return ZN_ERROR; - } - } - item = ZnSearchWithTagOrId(wi, LangString(args[1]), group, &ts); - if ((item != ZN_NO_ITEM) && (item->previous != ZN_NO_ITEM)) { - DoItem(interp, item->previous, ZN_NO_PART, tag_uid); - } + if (tag) { + tag_uid = Tk_GetUid(Tcl_GetString(tag)); } - /* - * all - */ - else if ((c == 'a') && (strncmp(LangString(args[0]), "all", length) == 0)) { - if ((argc != 1) && (argc != 2)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " all ?inGroup?", NULL); - return ZN_ERROR; - } - if (argc == 2) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[1]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { - return ZN_ERROR; - } - } - + switch((enum search_cmds) index) { /* - * Go through the item list and collect all item ids. They - * are sorted from most visible to least visible. + * above */ - for (item = ZnSearchWithTagOrId(wi, all_uid, group, &ts); - item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { - DoItem(interp, item, ZN_NO_PART, tag_uid); - } - } - - /* - * atpoint - */ - else if ((c == 'a') && (strncmp(LangString(args[0]), "atpoint", length) == 0)) { - int halo = 1; - ZnPoint p; - int part = ZN_NO_PART; - Item start_item = ZN_NO_ITEM; - - if ((argc < 3) || (argc > 5)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " atpoint x y ?halo? ?start?", NULL); - return ZN_ERROR; - } - if (Tcl_GetDouble(interp, args[1], &p.x) == ZN_ERROR) { - return ZN_ERROR; - } - if (Tcl_GetDouble(interp, args[2], &p.y) == ZN_ERROR) { - return ZN_ERROR; - } - p.x -= wi->inset; - p.y -= wi->inset; - if (argc > 3) { - if (Tcl_GetInt(interp, args[3], &halo) == ZN_ERROR) { + case ZN_S_ABOVE: + { + if ((argc != first+2) && (argc != first+3)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "tagOrId ?inGroup?"); return ZN_ERROR; } - if (halo < 0) { - halo = 0; + if (argc == first+3) { + num_items = ZnItemsWithTagOrId(wi, args[first+2], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } } - } - if (argc > 4) { - start_item = ZnSearchWithTagOrId(wi, LangString(args[4]), group, &ts); - if (start_item != ZN_NO_ITEM) { - start_item = start_item->next; + item = ZnSearchWithTagOrId(wi, args[first+1], group, &ts); + if ((item != ZN_NO_ITEM) && (item->previous != ZN_NO_ITEM)) { + DoItem(wi->interp, item->previous, ZN_NO_PART, tag_uid); } } + break; /* - * We always start the search at the top group to use the - * transform and clip machinery of the group item. The items - * are not required to cache the device coords, etc. So we need - * to setup the correct context before calling the Pick method - * for each item. + * all */ - wi->top_group->class->Pick(wi->top_group, &p, start_item, halo, &item, &part); - - if (item != ZN_NO_ITEM) { - DoItem(interp, item, part, tag_uid); - /*printf("first %d %d\n", item->id, part);*/ - return TCL_OK; - } - } - - /* - * atpriority - */ - else if ((c == 'a') && (strncmp(LangString(args[0]), "atpriority", length) == 0)) { - int pri; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " atpriority pri ?inGroup?", NULL); - return ZN_ERROR; - } - if (Tcl_GetInt(interp, args[1], &pri) == ZN_ERROR) { - return ZN_ERROR; - } - if (argc == 3) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[2]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { + case ZN_S_ALL: + { + if ((argc != first+1) && (argc != first+2)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "?inGroup?"); return ZN_ERROR; } + if (argc == first+2) { + num_items = ZnItemsWithTagOrId(wi, args[first+1], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } + } + + /* + * Go through the item list and collect all item ids. They + * are sorted from most visible to least visible. + */ + for (item = ZnSearchWithTagOrId(wi, NULL, group, &ts); + item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { + DoItem(wi->interp, item, ZN_NO_PART, tag_uid); + } } - + break; /* - * Go through the item table and collect all items with - * the given priority. + * atpoint */ - for (item = ZnSearchWithTagOrId(wi, all_uid, group, &ts); - item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { - if (item->priority == pri) { - DoItem(interp, item, ZN_NO_PART, tag_uid); + case ZN_S_ATPOINT: + { + int halo = 1; + ZnPoint p; + int part = ZN_NO_PART; + Item start_item = ZN_NO_ITEM; + + if ((argc < first+3) || (argc > first+5)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "x y ?halo? ?start?"); + return ZN_ERROR; + } + if (Tcl_GetDoubleFromObj(wi->interp, args[first+1], &p.x) == ZN_ERROR) { + return ZN_ERROR; + } + if (Tcl_GetDoubleFromObj(wi->interp, args[first+2], &p.y) == ZN_ERROR) { + return ZN_ERROR; + } + p.x -= wi->inset; + p.y -= wi->inset; + if (argc > first+3) { + if (Tcl_GetIntFromObj(wi->interp, args[first+3], &halo) == ZN_ERROR) { + return ZN_ERROR; + } + if (halo < 0) { + halo = 0; + } + } + if (argc > first+4) { + start_item = ZnSearchWithTagOrId(wi, args[first+4], group, &ts); + if (start_item != ZN_NO_ITEM) { + start_item = start_item->next; + } + } + /* + * We always start the search at the top group to use the + * transform and clip machinery of the group item. The items + * are not required to cache the device coords, etc. So we need + * to setup the correct context before calling the Pick method + * for each item. + */ + wi->top_group->class->Pick(wi->top_group, &p, start_item, halo, + &item, &part); + + if (item != ZN_NO_ITEM) { + DoItem(wi->interp, item, part, tag_uid); + /*printf("first %d %d\n", item->id, part);*/ + return TCL_OK; + } } - } - } - - /* - * below - */ - else if ((c == 'b') && (strncmp(LangString(args[0]), "below", length) == 0)) { - Item next; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " below tagOrId $inGroup?", NULL); - return ZN_ERROR; - } - if (argc == 3) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[2]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { + break; + /* + * atpriority + */ + case ZN_S_ATPRIORITY: + { + int pri; + + if ((argc != first+2) && (argc != first+3)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "pri ?inGroup?"); return ZN_ERROR; } - } - item = ZN_NO_ITEM; - for (next = ZnSearchWithTagOrId(wi, LangString(args[1]), group, &ts); - next != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { - item = next; - } - if ((item != ZN_NO_ITEM) && (item->next != ZN_NO_ITEM)) { - DoItem(interp, item->next, ZN_NO_PART, tag_uid); - } - } - - /* - * enclosed - */ - else if ((c == 'e') && (strncmp(LangString(args[0]), "enclosed", length) == 0)) { - if ((argc != 5) && (argc != 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " enclosed x1 y1 x2 y2 ?inGroup?", NULL); - return ZN_ERROR; - } - if (argc == 6) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[5]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { + if (Tcl_GetIntFromObj(wi->interp, args[first+1], &pri) == ZN_ERROR) { return ZN_ERROR; } + if (argc == first+3) { + num_items = ZnItemsWithTagOrId(wi, args[first+2], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } + } + + /* + * Go through the item table and collect all items with + * the given priority. + */ + for (item = ZnSearchWithTagOrId(wi, NULL, group, &ts); + item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { + if (item->priority == pri) { + DoItem(wi->interp, item, ZN_NO_PART, tag_uid); + } + } } - return FindArea(interp, wi, args+1, tag_uid, group, True); - } - - /* - * overlapping - */ - else if ((c == 'o') && (strncmp(LangString(args[0]), "overlapping", length) == 0)) { - if ((argc != 5) && (argc != 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " overlapping x1 y1 x2 y2 ?inGroup?", NULL); - return ZN_ERROR; - } - if (argc == 6) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[5]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { + break; + /* + * below + */ + case ZN_S_BELOW: + { + Item next; + + if ((argc != first+2) && (argc != first+3)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "tagOrId $inGroup?"); return ZN_ERROR; } + if (argc == first+3) { + num_items = ZnItemsWithTagOrId(wi, args[first+2], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } + } + item = ZN_NO_ITEM; + for (next = ZnSearchWithTagOrId(wi, args[first+1], group, &ts); + next != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { + item = next; + } + if ((item != ZN_NO_ITEM) && (item->next != ZN_NO_ITEM)) { + DoItem(wi->interp, item->next, ZN_NO_PART, tag_uid); + } } - return FindArea(interp, wi, args+1, tag_uid, group, False); - } - - /* - * withtag - */ - else if ((c == 'w') && (strncmp(LangString(args[0]), "withtag", length) == 0)) { - Item *items; - int i; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " withtag tagOrId ?inGroup?", NULL); - return ZN_ERROR; - } - if (argc == 3) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[2]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { + break; + /* + * enclosed + */ + case ZN_S_ENCLOSED: + { + if ((argc != first+5) && (argc != first+6)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "x1 y1 x2 y2 ?inGroup?"); return ZN_ERROR; } - } - num_items = ZnItemsWithTagOrId(wi, LangString(args[1]), &item, &items); - if (num_items == 0) { - Tcl_SetResult(interp, "", TCL_STATIC); - } - for (i = 0; i < num_items; i++) { - if (IsHeirOf(items[i], group)) { - DoItem(interp, items[i], ZN_NO_PART, tag_uid); + if (argc == first+6) { + num_items = ZnItemsWithTagOrId(wi, args[first+5], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } } + return FindArea(wi, args+first+1, tag_uid, group, True); } - } - - /* - * withtype - */ - else if ((c == 'w') && (strncmp(LangString(args[0]), "withtype", length) == 0)) { - ItemClass cls; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - cmd_name, option, " withtype itemType ?inGroup?", NULL); - return ZN_ERROR; - } - cls = (ItemClass) ITEM_P.LookupItemClass(LangString(args[1])); - if (!cls) { - Tcl_AppendResult(interp, "unknown item type \"", - LangString(args[1]), "\"", NULL); - return ZN_ERROR; + break; + /* + * overlapping + */ + case ZN_S_OVERLAPPING: + { + if ((argc != first+5) && (argc != first+6)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "x1 y1 x2 y2 ?inGroup?"); + return ZN_ERROR; + } + if (argc == first+6) { + num_items = ZnItemsWithTagOrId(wi, args[first+5], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } + } + return FindArea(wi, args+first+1, tag_uid, group, False); } - if (argc == 3) { - num_items = ZnItemsWithTagOrId(wi, LangString(args[2]), &group, NULL); - if ((num_items == 0) || (group->class != ZnGroup)) { + break; + /* + * withtag + */ + case ZN_S_WITHTAG: + { + Item *items; + int i; + + if ((argc != first+2) && (argc != first+3)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "tagOrId ?inGroup?"); return ZN_ERROR; } + if (argc == first+3) { + num_items = ZnItemsWithTagOrId(wi, args[first+2], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } + } + num_items = ZnItemsWithTagOrId(wi, args[first+1], &item, &items); + if (num_items == 0) { + Tcl_SetObjResult(wi->interp, NewStringObj("")); + } + for (i = 0; i < num_items; i++) { + if (IsHeirOf(items[i], group)) { + DoItem(wi->interp, items[i], ZN_NO_PART, tag_uid); + } + } } - + break; /* - * Go through the item table and collect all items with - * the given item type. + * withtype */ - for (item = ZnSearchWithTagOrId(wi, all_uid, group, &ts); - item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { - if (item->class == cls) { - DoItem(interp, item, ZN_NO_PART, tag_uid); + case ZN_S_WITHTYPE: + { + ItemClass cls; + + if ((argc != first+2) && (argc != first+3)) { + Tcl_WrongNumArgs(wi->interp, first+1, args, "itemType ?inGroup?"); + return ZN_ERROR; + } + cls = (ItemClass) ITEM_P.LookupItemClass(Tcl_GetString(args[first+1])); + if (!cls) { + Tcl_AppendResult(wi->interp, "unknown item type \"", + Tcl_GetString(args[first+1]), "\"", NULL); + return ZN_ERROR; + } + if (argc == first+3) { + num_items = ZnItemsWithTagOrId(wi, args[first+2], &group, NULL); + if ((num_items == 0) || (group->class != ZnGroup)) { + return ZN_ERROR; + } + } + + /* + * Go through the item table and collect all items with + * the given item type. + */ + for (item = ZnSearchWithTagOrId(wi, NULL, group, &ts); + item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&ts)) { + if (item->class == cls) { + DoItem(wi->interp, item, ZN_NO_PART, tag_uid); + } } } - } - else { - Tcl_AppendResult(interp, "bad search command \"", LangString(args[0]), - "\": must be above, all, atpoint, atpriority, below, " - "enclosed, overlapping, withtag or withtype", NULL); - return ZN_ERROR; + break; } return TCL_OK; @@ -1324,52 +1388,33 @@ FindItems(Tcl_Interp *interp, */ int ParseCoordList(WidgetInfo *wi, - Arg arg, + Tcl_Obj *arg, ZnPoint **pts, int *num_pts) { - Arg *elems; + Tcl_Obj **elems; int i, result, num_elems; ZnPoint *p; -#ifdef PTK - LangFreeProc *freeProc = NULL; -#endif - - result = Lang_SplitList(wi->interp, arg, &num_elems, &elems, &freeProc); + + result = Tcl_ListObjGetElements(wi->interp, arg, &num_elems, &elems); if ((result == ZN_ERROR) || ((num_elems%2) != 0)) { coord_error: -#ifdef PTK - if (elems != NULL && freeProc) { - (*freeProc)(num_elems, elems); - } -#endif Tcl_AppendResult(wi->interp, " malformed coord list", NULL); return ZN_ERROR; } - + *num_pts = num_elems/2; ZnListAssertSize(wi->work_pts, *num_pts); *pts = p = (ZnPoint *) ZnListArray(wi->work_pts); for (i = 0; i < num_elems; i += 2, p++) { - if (Tcl_GetDouble(wi->interp, elems[i], &p->x) == ZN_ERROR) { - coord_error2: -#ifndef PTK - Tcl_Free((char *) elems); -#endif + if (Tcl_GetDoubleFromObj(wi->interp, elems[i], &p->x) == ZN_ERROR) { goto coord_error; } - if (Tcl_GetDouble(wi->interp, elems[i+1], &p->y) == ZN_ERROR) { - goto coord_error2; + if (Tcl_GetDoubleFromObj(wi->interp, elems[i+1], &p->y) == ZN_ERROR) { + goto coord_error; } } -#ifndef PTK - Tcl_Free((char *) elems); -#else - if (freeProc) { - (*freeProc)(num_elems, elems); - } -#endif - + return ZN_OK; } @@ -1381,22 +1426,29 @@ ParseCoordList(WidgetInfo *wi, * *---------------------------------------------------------------------- */ +#ifdef GPC static int Contour(WidgetInfo *wi, int argc, - Arg *args) + Tcl_Obj *CONST args[]) { ZnPoint *points; ZnPoint p[4], xp[4]; Item item, shape; int cmd, num_points, num, i; - ZnBool simple; + ZnBool simple=False; ZnPoly poly; - char c; + int index; ZnTransfo t, inv; ZnContour *contours; + static char *op_strings[] = { + "diff", "inter", "union", "xor", NULL + }; + int ops[] = { + GPC_DIFF, GPC_INT, GPC_UNION, GPC_XOR + }; - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); if (num == 0) { return ZN_ERROR; } @@ -1406,27 +1458,13 @@ Contour(WidgetInfo *wi, return ZN_ERROR; } - c = LangString(args[3])[0]; - if ((c == 'd') && (strcmp(LangString(args[3]), "diff") == 0)) { - cmd = GPC_DIFF; - } - else if ((c == 'i') && (strcmp(LangString(args[3]), "inter") == 0)) { - cmd = GPC_INT; - } - else if ((c == 'u') && (strcmp(LangString(args[3]), "union") == 0)) { - cmd = GPC_UNION; - } - else if ((c == 'x') && (strcmp(LangString(args[3]), "xor") == 0)) { - cmd = GPC_XOR; - } - else { - Tcl_AppendResult(wi->interp, "unknown contour operation: \"", - LangString(args[3]), - "\" should be diff/inter/union/xor", NULL); + if (Tcl_GetIndexFromObj(wi->interp, args[3], op_strings, + "polygon operator", 0, &index) != ZN_OK) { return ZN_ERROR; } + cmd = ops[index]; - num = ZnItemsWithTagOrId(wi, LangString(args[4]), &shape, NULL); + num = ZnItemsWithTagOrId(wi, args[4], &shape, NULL); if (num == 0) { Tcl_ResetResult(wi->interp); if (ParseCoordList(wi, args[4], &points, &num_points) == ZN_ERROR) { @@ -1496,6 +1534,7 @@ Contour(WidgetInfo *wi, return ZN_OK; } +#endif /* @@ -1508,32 +1547,36 @@ Contour(WidgetInfo *wi, static int Coords(WidgetInfo *wi, int argc, - Arg *args) + Tcl_Obj *CONST args[]) { ZnPoint *points; Item item; int num_points, num = 0, i; int cmd = COORDS_READ; long index, contour = 0; - char *end, c; - char msg[INTEGER_SPACE]; + char *str; + Tcl_Obj *l; - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); if (num == 0) { return ZN_ERROR; } num_points = 0; + /* printf(" coords: argc=%d, item %d class: %s\n", + argc, item->id, item->class->name);*/ if (argc == 3) { /* Get all coords of default contour (0). */ - if (item->class->Coords(item, 0, 0, COORDS_READ_ALL, &points, &num_points) == ZN_ERROR) { + if (item->class->Coords(item, 0, 0, COORDS_READ_ALL, + &points, &num_points) == ZN_ERROR) { return ZN_ERROR; } coords_read: + /*printf(" coords: read %d points, first is %g@%g\n", + num_points, points->x, points->y);*/ + l = Tcl_GetObjResult(wi->interp); for (i = 0; i < num_points; i++, points++) { - sprintf(msg, "%g", points->x); - Tcl_AppendElement(wi->interp, msg); - sprintf(msg, "%g", points->y); - Tcl_AppendElement(wi->interp, msg); + Tcl_ListObjAppendElement(wi->interp, l, NewDoubleObj(points->x)); + Tcl_ListObjAppendElement(wi->interp, l, NewDoubleObj(points->y)); } return ZN_OK; } @@ -1542,41 +1585,41 @@ Coords(WidgetInfo *wi, * See if it is an ADD or REMOVE op. */ i = 3; - c = LangString(args[i])[0]; - if ((c == 'a') && (strcmp(LangString(args[i]), "add") == 0)) { + str = Tcl_GetString(args[3]); + if ((str[0] == 'a') && (strcmp(str, "add") == 0)) { if ((argc < 5) || (argc > 7)) { - Tcl_AppendResult(wi->interp, "wrong # args: should be \"", LangString(args[0]), - "\" coords tagOrId add ?contour? ?index? coordList", NULL); + Tcl_WrongNumArgs(wi->interp, 1, args, + "coords tagOrId add ?contour? ?index? coordList"); return ZN_ERROR; } cmd = COORDS_ADD; i++; } - else if ((c == 'r') && (strcmp(LangString(args[i]), "remove") == 0)) { + else if ((str[0] == 'r') && (strcmp(str, "remove") == 0)) { if ((argc != 5) && (argc != 6)) { - Tcl_AppendResult(wi->interp, "wrong # args: should be \"", LangString(args[0]), - "\" coords tagOrId remove ?contour? index", NULL); + Tcl_WrongNumArgs(wi->interp, 1, args, + "coords tagOrId remove ?contour? index"); return ZN_ERROR; } cmd = COORDS_REMOVE; i++; } - + /* * Try to see if the next param is a vertex index, * a contour index or a coord list. */ - contour = index = strtol(LangString(args[i]), &end, 10); - if (*end != '\0') { + /*printf(" coords: arg %d is %s\n", i, Tcl_GetString(args[i]));*/ + if (Tcl_GetLongFromObj(wi->interp, args[i], &index) != ZN_OK) { if (((argc == 5) && (cmd != COORDS_ADD) && (cmd != COORDS_REMOVE)) || (argc == 6) || (argc == 7)) { Tcl_AppendResult(wi->interp, " incorrect contour index \"", - args[i], "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } else if ((argc == 5) && (cmd != COORDS_ADD)) { Tcl_AppendResult(wi->interp, " incorrect coord index \"", - args[i], "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } else if (ParseCoordList(wi, args[i], &points, &num_points) == ZN_ERROR) { @@ -1598,6 +1641,7 @@ Coords(WidgetInfo *wi, } return ZN_OK; } + contour = index; if (argc == 4) { /* Get all coords of contour. */ if (item->class->Coords(item, contour, 0, COORDS_READ_ALL, @@ -1619,11 +1663,11 @@ Coords(WidgetInfo *wi, * Try to see if the next param is a vertex index or a coord list. */ i++; - index = strtol(LangString(args[i]), &end, 10); - if (*end != '\0') { + /*printf(" coords: arg %d is %s\n", i, Tcl_GetString(args[i]));*/ + if (Tcl_GetLongFromObj(wi->interp, args[i], &index) != ZN_OK) { if ((argc == 7) || ((argc == 6) && (cmd != COORDS_ADD))) { Tcl_AppendResult(wi->interp, " incorrect coord index \"", - args[i], "\"", NULL); + Tcl_GetString(args[i]), "\"", NULL); return ZN_ERROR; } else if (ParseCoordList(wi, args[i], &points, &num_points) == ZN_ERROR) { @@ -1670,7 +1714,8 @@ Coords(WidgetInfo *wi, num_points = 1; cmd = COORDS_REPLACE; } - if (item->class->Coords(item, contour, index, cmd, &points, &num_points) == ZN_ERROR) { + if (item->class->Coords(item, contour, index, cmd, + &points, &num_points) == ZN_ERROR) { return ZN_ERROR; } @@ -1681,7 +1726,7 @@ Coords(WidgetInfo *wi, /* *---------------------------------------------------------------------- * - * WidgetCmd -- + * WidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a widget managed by this module. @@ -1696,68 +1741,103 @@ Coords(WidgetInfo *wi, *---------------------------------------------------------------------- */ static int -WidgetCmd(ClientData client_data, /* Information about the widget. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - Arg *args) /* Argument strings. */ +WidgetObjCmd(ClientData client_data, /* Information about the widget. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + Tcl_Obj *CONST args[]) /* Argument strings. */ { WidgetInfo *wi = (WidgetInfo *) client_data; - char c; - int result; - int length; + int result, cmd_index, index; Item item, *items; ZnList item_list; int num = 0, i, j; - char msg[INTEGER_SPACE]; - char *end, *end2; + char *end, *end2, *str; ZnTransfo *t = NULL; + Tcl_Obj *l, *lobjs[4]; + static char *sub_cmd_strings[] = { + "add", "addtag", "anchorxy", "bbox", "becomes", "bind", + "cget", "chggroup", "clone", "configure", "contour", + "coords", "currentpart", "cursor", "dchars", "dtag", + "find", "fit", "focus", "gettags", "group", + "hasanchors", "hasfields", "hasparts", "hastag", + "index", "insert", "itemcget", "itemconfigure", + "lower", "monitor", "postscript", "raise", "remove", + "rotate", "scale", "select", "smooth", "tapply", + "tdelete", "transform", "translate", "treset", + "trestore", "tsave", "type", NULL + }; + enum sub_cmds { + ZN_W_ADD, ZN_W_ADDTAG, ZN_W_ANCHORXY, ZN_W_BBOX, ZN_W_BECOMES, ZN_W_BIND, + ZN_W_CGET, ZN_W_CHGGROUP, ZN_W_CLONE, ZN_W_CONFIGURE, ZN_W_CONTOUR, + ZN_W_COORDS, ZN_W_CURRENTPART, ZN_W_CURSOR, ZN_W_DCHARS, ZN_W_DTAG, + ZN_W_FIND, ZN_W_FIT, ZN_W_FOCUS, ZN_W_GETTAGS, ZN_W_GROUP, + ZN_W_HASANCHORS, ZN_W_HASFIELDS, ZN_W_HASPARTS, ZN_W_HASTAG, + ZN_W_INDEX, ZN_W_INSERT, ZN_W_ITEMCGET, ZN_W_ITEMCONFIGURE, + ZN_W_LOWER, ZN_W_MONITOR, ZN_W_POSTSCRIPT, ZN_W_RAISE, ZN_W_REMOVE, + ZN_W_ROTATE, ZN_W_SCALE, ZN_W_SELECT, ZN_W_SMOOTH, ZN_W_TAPPLY, + ZN_W_TDELETE, ZN_W_TRANSFORM, ZN_W_TRANSLATE, ZN_W_TRESET, + ZN_W_TRESTORE, ZN_W_TSAVE, ZN_W_TYPE + }; + static char *sel_cmd_strings[] = { + "adjust", "clear", "from", "item", "to", NULL + }; + enum sel_cmds { + ZN_SEL_ADJUST, ZN_SEL_CLEAR, ZN_SEL_FROM, ZN_SEL_ITEM, ZN_SEL_TO + }; + if (argc < 2) { - Tcl_AppendResult(interp, "wrong # of args: \"", - LangString(args[0]), " subcommand ?args?.\"", NULL); + Tcl_WrongNumArgs(interp, 1, args, "subcommand ?args?"); return ZN_ERROR; } Tcl_Preserve((ClientData) wi); - c = LangString(args[1])[0]; - length = strlen(LangString(args[1])); - result = TCL_OK; + if (Tcl_GetIndexFromObj(interp, args[1], sub_cmd_strings, + "subcommand", 0, &cmd_index) != ZN_OK) { + goto error; + } + result = ZN_OK; - /* - * add - */ - if ((c == 'a') && (strcmp(LangString(args[1]), "add") == 0)) { - Item group; - - if (argc == 2) { /* create subcommand alone, return the list of known - * object types. */ - ItemClass *classes = ZnListArray(ITEM_P.ItemClassList()); - - num = ZnListSize(ITEM_P.ItemClassList()); - for (i = 0; i < num; i++) { - Tcl_AppendElement(interp, classes[i]->name); - } - goto done; - } - if ((argc < 4) || (LangString(args[2])[0] == '-')) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" add type group ?args?", NULL); - goto error; - } + printf("executing command \"%s\", argc=%d\n", Tcl_GetString(args[1]), argc); + switch((enum sub_cmds) cmd_index) { + /* + * add + */ + case ZN_W_ADD: { + Item group; ItemClass cls; - cls = ITEM_P.LookupItemClass(LangString(args[2])); + if (argc == 2) { /* create subcommand alone, return the list of known + * object types. */ + ItemClass *classes = ZnListArray(ITEM_P.ItemClassList()); + + num = ZnListSize(ITEM_P.ItemClassList()); + l = Tcl_GetObjResult(interp); + for (i = 0; i < num; i++) { + Tcl_ListObjAppendElement(interp, l, NewStringObj(classes[i]->name)); + } + goto done; + } + if ((argc < 4)) { + add_err: + Tcl_WrongNumArgs(interp, 1, args, "add type group ?args?"); + goto error; + } + str = Tcl_GetString(args[2]); + if (str[0] == '-') { + goto add_err; + } + cls = ITEM_P.LookupItemClass(str); if (!cls) { - Tcl_AppendResult(interp, "unknown item type \"", LangString(args[2]), - "\"", NULL); + Tcl_AppendResult(interp, "unknown item type \"", str, "\"", NULL); goto error; } - num = ZnItemsWithTagOrId(wi, LangString(args[3]), &group, NULL); + num = ZnItemsWithTagOrId(wi, args[3], &group, NULL); if (!num || (group->class != ZnGroup)) { Tcl_AppendResult(interp, ", group item expected, got \"", - LangString(args[3]), "\"", NULL); + Tcl_GetString(args[3]), "\"", NULL); goto error; } @@ -1771,1480 +1851,1428 @@ WidgetCmd(ClientData client_data, /* Information about the widget. */ if (ITEM.ConfigureItem(item, -1, argc, args, True) == ZN_ERROR) { goto error; } - sprintf(msg, "%d", item->id); - Tcl_SetResult(interp, msg, TCL_VOLATILE); - } - } - - /* - * addtag - */ - else if ((c == 'a') && (strcmp(LangString(args[1]), "addtag") == 0)) { - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" addtag tag searchCommand ?arg arg ...?", NULL); - goto error; - } - result = FindItems(interp, wi, argc-3, args+3, LangString(args[2]), - LangString(args[0]), " addtag tag"); - } - - /* - * anchorxy - */ - else if ((c == 'a') && (strcmp(LangString(args[1]), "anchorxy") == 0)) { - Tk_Anchor anchor; - ZnPoint p; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" anchorxy tagOrId anchor", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if ((num == 0) || !item->class->has_anchors) { - Tcl_AppendResult(interp, "unkown item or doesn't support anchors \"", - LangString(args[2]), NULL); - goto error; - } - if (Tk_GetAnchor(interp, LangString(args[3]), &anchor)) { - goto error; + Tcl_SetObjResult(interp, NewLongObj(item->id)); } + break; /* - * If something has changed in the geometry we need to - * update or the anchor location will be erroneous. + * addtag */ - ITEM_P.Update(wi); - item->class->GetAnchor(item, anchor, &p); - sprintf(msg, "%g", p.x); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%g", p.y); - Tcl_AppendElement(interp, msg); - } - - /* - * becomes - */ - else if ((c == 'b') && (strncmp(LangString(args[1]), "becomes", length) == 0)) { - Tcl_AppendResult(interp, "Command not yet implemented", NULL); - goto error; - } - - /* - * bbox - */ - else if ((c == 'b') && (strncmp(LangString(args[1]), "bbox", length) == 0)) { - ZnBBox bbox; - int i; - ZnBool found = False; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" bbox tagOrId ?tagOrId ...?", NULL); - goto error; - } - argc -= 2; - args += 2; - - ITEM_P.Update(wi); - ResetBBox(&bbox); - for (i = 0; i < argc; i++) { - num = ZnItemsWithTagOrId(wi, LangString(args[i]), &item, &items); - found |= (num != 0); - for (j = 0; j < num; j++) { - AddBBoxToBBox(&bbox, &items[j]->item_bounding_box); + case ZN_W_ADDTAG: + { + if (argc < 4) { + Tcl_WrongNumArgs(interp, 1, args, "addtag tag searchCommand ?arg arg ...?"); + goto error; } + result = FindItems(wi, argc, args, args[2], 3); } - if (found && !IsEmptyBBox(&bbox)) { - sprintf(msg, "%g", bbox.orig.x+wi->inset); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%g", bbox.orig.y+wi->inset); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%g", bbox.corner.x+wi->inset); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%g", bbox.corner.y+wi->inset); - Tcl_AppendElement(interp, msg); - } - } - - /* - * bind - */ - else if ((c == 'b') && (strncmp(LangString(args[1]), "bind", length) == 0)) { - ClientData elem = 0; - int part = ZN_NO_PART; - - if ((argc < 3) || (argc > 5)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" bind tagOrId ?sequence? ?command?", NULL); - goto error; - } + break; /* - * Test if (a) an itemid or (b) an itemid:part or (c) a tag is provided. + * anchorxy */ - if (isdigit(LangString(args[2])[0])) { - Tcl_HashEntry *entry; - int id; + case ZN_W_ANCHORXY: + { + Tk_Anchor anchor; + ZnPoint p; - id = strtoul(LangString(args[2]), &end, 0); - if (*end == ':') { - part = strtoul(end+1, &end2, 0); - if (*end2 != 0) { - goto bind_a_tag; - } - } - else if (*end != 0) { - goto bind_a_tag; - } - entry = Tcl_FindHashEntry(wi->id_table, (char *) id); - if (entry == NULL) { - Tcl_AppendResult(interp, - "item \"", id, "\" doesn't exist", NULL); + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "anchorxy tagOrId anchor"); goto error; } - item = elem = Tcl_GetHashValue(entry); - if (!elem) { + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if ((num == 0) || !item->class->has_anchors) { + Tcl_AppendResult(interp, "unknown item or doesn't support anchors \"", + Tcl_GetString(args[2]), NULL); goto error; } - if (*end == ':') { - elem = EncodeItemPart((Item) elem, part); + if (Tk_GetAnchor(interp, Tcl_GetString(args[3]), &anchor)) { + goto error; } - /*printf("adding element 0x%X to the binding table of item 0x%X\n", elem, item);*/ - } - else { - bind_a_tag: - elem = (ClientData) Tk_GetUid(LangString(args[2])); + /* + * If something has changed in the geometry we need to + * update or the anchor location will be erroneous. + */ + ITEM_P.Update(wi); + item->class->GetAnchor(item, anchor, &p); + l = Tcl_GetObjResult(wi->interp); + Tcl_ListObjAppendElement(wi->interp, l, NewDoubleObj(p.x)); + Tcl_ListObjAppendElement(wi->interp, l, NewDoubleObj(p.y)); } - + break; /* - * Make a binding table if the widget doesn't already have one. - */ - if (wi->binding_table == NULL) { - wi->binding_table = Tk_CreateBindingTable(interp); + * becomes + */ + case ZN_W_BECOMES: + { + Tcl_AppendResult(interp, "Command not yet implemented", NULL); + goto error; } - - if (argc == 5) { - int append = 0; - unsigned long mask; + break; + /* + * bbox + */ + case ZN_W_BBOX: + { + ZnBBox bbox; + int i; + ZnBool found = False; - if (LangString(args[4])[0] == 0) { - result = Tk_DeleteBinding(interp, wi->binding_table, elem, LangString(args[3])); - goto done; - } - if (LangString(args[4])[0] == '+') { - args[4] = LangStringArg(LangString(args[4])+1); - append = 1; - } - mask = Tk_CreateBinding(interp, wi->binding_table, - elem, LangString(args[3]), args[4], append); - if (mask == 0) { + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "bbox tagOrId ?tagOrId ...?"); goto error; } - if (mask & (unsigned) ~(ButtonMotionMask | Button1MotionMask | - Button2MotionMask | Button3MotionMask | - Button4MotionMask | Button5MotionMask | - ButtonPressMask | ButtonReleaseMask | - EnterWindowMask | LeaveWindowMask | - KeyPressMask | KeyReleaseMask | - PointerMotionMask)) { - Tk_DeleteBinding(interp, wi->binding_table, elem, LangString(args[3])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, and enter/leave ", - "events may be used", NULL); - goto error; + argc -= 2; + args += 2; + + ITEM_P.Update(wi); + ResetBBox(&bbox); + for (i = 0; i < argc; i++) { + num = ZnItemsWithTagOrId(wi, args[i], &item, &items); + found |= (num != 0); + for (j = 0; j < num; j++) { + AddBBoxToBBox(&bbox, &items[j]->item_bounding_box); + } + } + if (found && !IsEmptyBBox(&bbox)) { + lobjs[0] = NewDoubleObj(bbox.orig.x+wi->inset); + lobjs[1] = NewDoubleObj(bbox.orig.y+wi->inset); + lobjs[2] = NewDoubleObj(bbox.corner.x+wi->inset); + lobjs[3] = NewDoubleObj(bbox.corner.y+wi->inset); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, lobjs)); } } - else if (argc == 4) { - Arg command; + break; + /* + * bind + */ + case ZN_W_BIND: + { + ClientData elem = 0; + int part = ZN_NO_PART; - command = Tk_GetBinding(interp, wi->binding_table, elem, LangString(args[3])); - if (command == NULL) { + if ((argc < 3) || (argc > 5)) { + Tcl_WrongNumArgs(interp, 1, args, "bind tagOrId ?sequence? ?command?"); goto error; } -#ifndef PTK - Tcl_SetResult(interp, command, TCL_STATIC); + /* + * Test if (a) an itemid or (b) an itemid:part or (c) a tag is provided. + */ + str = Tcl_GetString(args[2]); + if (isdigit(str[0])) { + Tcl_HashEntry *entry; + int id; + + id = strtoul(str, &end, 0); + if (*end == ':') { + part = strtoul(end+1, &end2, 0); + if (*end2 != 0) { + goto bind_a_tag; + } + } + else if (*end != 0) { + goto bind_a_tag; + } + entry = Tcl_FindHashEntry(wi->id_table, (char *) id); + if (entry == NULL) { + Tcl_AppendResult(interp, "item \"", str, "\" doesn't exist", NULL); + goto error; + } + item = elem = Tcl_GetHashValue(entry); + if (!elem) { + goto error; + } + if (*end == ':') { + elem = EncodeItemPart((Item) elem, part); + } + /*printf("adding element 0x%X to the binding table of item 0x%X\n", elem, item);*/ + } + else { + bind_a_tag: + elem = (ClientData) Tk_GetUid(str); + } + + /* + * Make a binding table if the widget doesn't already have one. + */ + if (wi->binding_table == NULL) { + wi->binding_table = Tk_CreateBindingTable(interp); + } + + if (argc == 5) { + int append = 0; + unsigned long mask; + + str = Tcl_GetString(args[4]); + if (str[0] == 0) { + result = Tk_DeleteBinding(interp, wi->binding_table, elem, + Tcl_GetString(args[3])); + goto done; + } + if (str[0] == '+') { + str++; + append = 1; + } +#ifdef PTK + mask = Tk_CreateBinding(interp, wi->binding_table, + elem, Tcl_GetString(args[3]), args[4], append); #else - Tcl_ArgResult(interp, command); + mask = Tk_CreateBinding(interp, wi->binding_table, + elem, Tcl_GetString(args[3]), str, append); #endif - } - else { - Tk_GetAllBindings(interp, wi->binding_table, elem); - } - } - - /* - * cget - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "cget", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" cget option", NULL); - goto error; - } - result = Tk_ConfigureValue(interp, wi->win, config_specs, - (char *) wi, LangString(args[2]), 0); - } - - /* - * chggroup - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "chggroup", length) == 0)) { - Item grp; - int adjust=0; - ZnTransfo inv, t, t2, *this_one; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" chggroup tagOrIg group ?adjustTransform?", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[3]), &grp, NULL); - if (num == 0) { - goto error; - } - if (argc == 5) { - if (Tcl_GetBoolean(interp, args[4], &adjust) != ZN_OK) { - goto error; + if (mask == 0) { + goto error; + } + if (mask & (unsigned) ~(ButtonMotionMask | Button1MotionMask | + Button2MotionMask | Button3MotionMask | + Button4MotionMask | Button5MotionMask | + ButtonPressMask | ButtonReleaseMask | + EnterWindowMask | LeaveWindowMask | + KeyPressMask | KeyReleaseMask | + PointerMotionMask)) { + Tk_DeleteBinding(interp, wi->binding_table, elem, Tcl_GetString(args[3])); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "requested illegal events; ", + "only key, button, motion, and enter/leave ", + "events may be used", NULL); + goto error; + } } - } - if ((item->parent == grp) || (item->parent == ZN_NO_ITEM)) { - goto done; - } - if (adjust) { - ITEM.GetItemTransform(grp, &t); - ZnTransfoInvert(&t, &inv); - ITEM.GetItemTransform(item->parent, &t); - ZnTransfoCompose(&t2, &t, &inv); - this_one = &t2; - if (item->transfo) { - ZnTransfoCompose(&t, item->transfo, &t2); - this_one = &t; + else if (argc == 4) { +#ifdef PTK + Tcl_Obj *command; +#else + char *command; +#endif + command = Tk_GetBinding(interp, wi->binding_table, elem, Tcl_GetString(args[3])); + if (command == NULL) { + goto error; + } +#ifdef PTK + Tcl_SetObjResult(interp, command); + Tcl_DecrRefCount(command); +#else + Tcl_SetObjResult(interp, NewStringObj(command)); +#endif + } + else { + Tk_GetAllBindings(interp, wi->binding_table, elem); } } - ITEM.RemoveItem(item); - ITEM.InsertItem(item, grp, ZN_NO_ITEM, True); - ITEM.Invalidate(item, ZN_COORDS_FLAG); - if (adjust) { - ITEM.SetTransfo(item, this_one); - } - } - - /* - * clone - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "clone", length) == 0)) { - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" clone tagOrId ?option value ...?", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - if (num == 0) { - goto error; - } - argc -= 3; - args += 3; - for (i = 0; i < num; i++) { - item = ITEM.CloneItem(items[i]); - ITEM.InsertItem(item, items[i]->parent, ZN_NO_ITEM, True); - if (ITEM.ConfigureItem(item, -1, argc, args, False) == ZN_ERROR) { + break; + /* + * cget + */ + case ZN_W_CGET: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "cget option"); goto error; } - sprintf(msg, "%d", item->id); - Tcl_AppendElement(interp, msg); - } - } - - /* - * configure - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "configure", length) == 0)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, wi->win, config_specs, - (char *) wi, (char *) NULL, 0); - } - else if (argc == 3) { - result = Tk_ConfigureInfo(interp, wi->win, config_specs, - (char *) wi, LangString(args[2]), 0); - } - else { - result = Configure(interp, wi, argc-2, args+2, TK_CONFIG_ARGV_ONLY); - } - } - - /* - * contour - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "contour", length) == 0)) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" contour tagOrId diff/inter/union/xor coordListOrTagOrId", - NULL); - goto error; - } - if (Contour(wi, argc, args) == ZN_ERROR) { - goto error; - } - } - - /* - * coords - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "coords", length) == 0)) { - if ((argc < 3) || (argc > 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" coords tagOrId ?add/remove? ?contour? ?index? ?coordList?", - NULL); - goto error; - } - if (Coords(wi, argc, args) == ZN_ERROR) { - goto error; - } - } - - /* - * currentpart - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "currentpart", length) == 0)) { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" currentpart", NULL); - goto error; - } - sprintf(msg, "%d", wi->current_part); - Tcl_AppendResult(interp, msg, NULL); - } - - /* - * cursor - */ - else if ((c == 'c') && (strncmp(LangString(args[1]), "cursor", length) == 0)) { - int index; - if (argc != 4) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" cursor tagOrId index", NULL); - goto error; + result = Tk_ConfigureValue(interp, wi->win, config_specs, + (char *) wi, Tcl_GetString(args[2]), 0); } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - for (i = 0; i < num; i++) { - if ((items[i]->class->Cursor == NULL) || - (items[i]->class->Index == NULL)) { - continue; + break; + /* + * chggroup + */ + case ZN_W_CHGGROUP: + { + Item grp; + int adjust=0; + ZnTransfo inv, t, t2, *this_one=NULL; + + if ((argc != 4) && (argc != 5)) { + Tcl_WrongNumArgs(interp, 1, args, "chggroup tagOrIg group ?adjustTransform?"); + goto error; } - result = (*items[i]->class->Index)(items[i], LangString(args[3]), &index); - if (result != ZN_OK) { + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { goto error; } - - (*items[i]->class->Cursor)(items[i], index); - if ((items[i] == wi->text_info.focus_item) && wi->text_info.cursor_on) { - ITEM.Invalidate(items[i], ZN_COORDS_FLAG); + num = ZnItemsWithTagOrId(wi, args[3], &grp, NULL); + if (num == 0) { + goto error; + } + if (argc == 5) { + if (Tcl_GetBooleanFromObj(interp, args[4], &adjust) != ZN_OK) { + goto error; + } + } + if ((item->parent == grp) || (item->parent == ZN_NO_ITEM)) { + goto done; + } + if (adjust) { + ITEM.GetItemTransform(grp, &t); + ZnTransfoInvert(&t, &inv); + ITEM.GetItemTransform(item->parent, &t); + ZnTransfoCompose(&t2, &t, &inv); + this_one = &t2; + if (item->transfo) { + ZnTransfoCompose(&t, item->transfo, &t2); + this_one = &t; + } + } + ITEM.RemoveItem(item); + ITEM.InsertItem(item, grp, ZN_NO_ITEM, True); + ITEM.Invalidate(item, ZN_COORDS_FLAG); + if (adjust) { + ITEM.SetTransfo(item, this_one); } } - } - - /* - * dchars - */ - else if ((c == 'd') && (strncmp(LangString(args[1]), "dchars", length) == 0)) { - int first, last; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" dchars tagOrId first ?last?", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - for (i = 0; i < num; i++) { - if ((items[i]->class->Index == NULL) || - (items[i]->class->DeleteChars == NULL)) { - continue; + break; + /* + * clone + */ + case ZN_W_CLONE: + { + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "clone tagOrId ?option value ...?"); + goto error; } - result = (*items[i]->class->Index)(items[i], LangString(args[3]), &first); - if (result != ZN_OK) { + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + if (num == 0) { goto error; } - if (argc == 5) { - result = (*items[i]->class->Index)(items[i], LangString(args[4]), &last); - if (result != ZN_OK) { + argc -= 3; + args += 3; + l = Tcl_GetObjResult(interp); + for (i = 0; i < num; i++) { + item = ITEM.CloneItem(items[i]); + ITEM.InsertItem(item, items[i]->parent, ZN_NO_ITEM, True); + if (ITEM.ConfigureItem(item, -1, argc, args, False) == ZN_ERROR) { goto error; } + Tcl_ListObjAppendElement(interp, l, NewLongObj(item->id)); + } + } + break; + /* + * configure + */ + case ZN_W_CONFIGURE: + { + if (argc == 2) { + result = Tk_ConfigureInfo(interp, wi->win, config_specs, + (char *) wi, (char *) NULL, 0); + } + else if (argc == 3) { + result = Tk_ConfigureInfo(interp, wi->win, config_specs, + (char *) wi, Tcl_GetString(args[2]), 0); } else { - last = first; + result = Configure(interp, wi, argc-2, args+2, TK_CONFIG_ARGV_ONLY); } - (*items[i]->class->DeleteChars)(items[i], first, last); - } - } - - /* - * dtag - */ - else if ((c == 'd') && (strncmp(LangString(args[1]), "dtag", length) == 0)) { - Tk_Uid tag; - Tcl_HashEntry *entry; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" dtag tagOrId ?tagToDelete?", NULL); - goto error; - } - if (argc == 4) { - tag = Tk_GetUid(LangString(args[3])); - } else { - tag = Tk_GetUid(LangString(args[2])); - } - entry = Tcl_FindHashEntry(wi->tag_table, tag); - item_list = (ZnList) Tcl_GetHashValue(entry); - items = (Item *) ZnListArray(item_list); - for (i = ZnListSize(item_list)-1; i >= 0; i++) { - ITEM.RemoveTag(items[i], (char *) tag); } + break; /* - * The RemoveTag method *must* remove the tag table - * entry when it gets empty. Otherwise a tag probe - * we bring back an empty item list and this would - * not be reported as an error by ZnItemsWithTagOrId. + * contour */ - } - - /* - * find - */ - else if ((c == 'f') && (strncmp(LangString(args[1]), "find", length) == 0)) { - if (argc < 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" find searchCommand ?arg arg ...?", NULL); - goto error; - } - result = FindItems(interp, wi, argc-2, args+2, NULL, LangString(args[0]), " find"); - } - - /* - * fit - */ - else if ((c == 'f') && (strncmp(LangString(args[1]), "fit", length) == 0)) { - ZnPoint *points; - int num_points; - ZnReal error; - ZnList to_points; - - if (argc != 4) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" fit coordList error", NULL); - goto error; - } - if (ParseCoordList(wi, args[2], &points, &num_points) == ZN_ERROR) { - return ZN_ERROR; - } - if (Tcl_GetDouble(interp, args[3], &error) == ZN_ERROR) { - goto error; - } - to_points = ZnListNew(32, sizeof(ZnPoint)); - FitBezier(points, num_points, error, to_points); - points = (ZnPoint *) ZnListArray(to_points); - num_points = ZnListSize(to_points); - for (i = 0; i < num_points; i++, points++) { - sprintf(msg, "%g", points->x); - Tcl_AppendElement(wi->interp, msg); - sprintf(msg, "%g", points->y); - Tcl_AppendElement(wi->interp, msg); - } - ZnListFree(to_points); - } - - /* - * focus - */ - else if ((c == 'f') && (strncmp(LangString(args[1]), "focus", length) == 0)) { - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" focus ?tagOrId?", NULL); - goto error; - } - item = wi->text_info.focus_item; - if (argc == 2) { - if (item != ZN_NO_ITEM) { - sprintf(msg, "%d", item->id); - Tcl_SetResult(wi->interp, msg, TCL_VOLATILE); + case ZN_W_CONTOUR: + { +#ifdef GPC + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, + "contour tagOrId operator coordListOrTagOrId"); + goto error; } - goto done; - } - if ((item != ZN_NO_ITEM) && (wi->text_info.got_focus)) { - ITEM.Invalidate(item, ZN_COORDS_FLAG); - } - if (LangString(args[2])[0] == 0) { - wi->text_info.focus_item = ZN_NO_ITEM; - goto done; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - item = ZN_NO_ITEM; - for (i = 0; i < num; i++) { - if (items[i]->class->Cursor != NULL) { - break; + if (Contour(wi, argc, args) == ZN_ERROR) { + goto error; } - } - if (num == 0) { - goto done; - } - wi->text_info.focus_item = items[i]; - if (wi->text_info.got_focus) { - ITEM.Invalidate(wi->text_info.focus_item, ZN_COORDS_FLAG); - } - } - - /* - * gettags - */ - else if ((c == 'g') && (strncmp(LangString(args[1]), "gettags", length) == 0)) { - Tk_Uid *tags; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" gettags tagOrId", NULL); + break; +#else + Tcl_AppendResult(interp, "Command \"", Tcl_GetString(args[1]), + "\" not available (compile Zinc with GPC).", + NULL); goto error; +#endif } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; + /* + * coords + */ + case ZN_W_COORDS: + { + if ((argc < 3) || (argc > 6)) { + Tcl_WrongNumArgs(interp, 1, args, + "coords tagOrId ?add/remove? ?contour? ?index? ?coordList?"); + goto error; + } + if (Coords(wi, argc, args) == ZN_ERROR) { + goto error; + } } - if (!item->tags || !ZnListSize(item->tags)) { - goto done; + break; + /* + * currentpart + */ + case ZN_W_CURRENTPART: + { + if (argc != 2) { + Tcl_WrongNumArgs(interp, 1, args, "currentpart"); + goto error; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(wi->current_part)); } - else { - num = ZnListSize(item->tags); - tags = (Tk_Uid *) ZnListArray(item->tags); + break; + /* + * cursor + */ + case ZN_W_CURSOR: + { + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "cursor tagOrId index"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); for (i = 0; i < num; i++) { - Tcl_AppendElement(interp, tags[i]); + if ((items[i]->class->Cursor == NULL) || + (items[i]->class->Index == NULL)) { + continue; + } + result = (*items[i]->class->Index)(items[i], args[3], &index); + if (result != ZN_OK) { + goto error; + } + + (*items[i]->class->Cursor)(items[i], index); + if ((items[i] == wi->text_info.focus_item) && wi->text_info.cursor_on) { + ITEM.Invalidate(items[i], ZN_COORDS_FLAG); + } } } - } - - /* - * group - */ - else if ((c == 'g') && (strncmp(LangString(args[1]), "group", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" group tagOrId", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; - } - if (item->parent != ZN_NO_ITEM) { - sprintf(msg, "%d", item->parent->id); + break; + /* + * dchars + */ + case ZN_W_DCHARS: + { + int first, last; + + if ((argc != 4) && (argc != 5)) { + Tcl_WrongNumArgs(interp, 1, args, "dchars tagOrId first ?last?"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + for (i = 0; i < num; i++) { + if ((items[i]->class->Index == NULL) || + (items[i]->class->DeleteChars == NULL)) { + continue; + } + result = (*items[i]->class->Index)(items[i], args[3], &first); + if (result != ZN_OK) { + goto error; + } + if (argc == 5) { + result = (*items[i]->class->Index)(items[i], args[4], &last); + if (result != ZN_OK) { + goto error; + } + } + else { + last = first; + } + (*items[i]->class->DeleteChars)(items[i], first, last); + } } - else { + break; + /* + * dtag + */ + case ZN_W_DTAG: + { + Tk_Uid tag; + Tcl_HashEntry *entry; + + if ((argc != 3) && (argc != 4)) { + Tcl_WrongNumArgs(interp, 1, args, "dtag tagOrId ?tagToDelete?"); + goto error; + } + if (argc == 4) { + tag = Tk_GetUid(Tcl_GetString(args[3])); + } + else { + tag = Tk_GetUid(Tcl_GetString(args[2])); + } + entry = Tcl_FindHashEntry(wi->tag_table, tag); + item_list = (ZnList) Tcl_GetHashValue(entry); + items = (Item *) ZnListArray(item_list); + for (i = ZnListSize(item_list)-1; i >= 0; i++) { + ITEM.RemoveTag(items[i], (char *) tag); + } /* - * Top group is its own parent. + * The RemoveTag method *must* remove the tag table + * entry when it gets empty. Otherwise a tag probe + * we bring back an empty item list and this would + * not be reported as an error by ZnItemsWithTagOrId. */ - sprintf(msg, "%d", item->id); } - Tcl_SetResult(interp, msg, TCL_VOLATILE); - } - - /* - * hasanchors - */ - else if ((c == 'h') && (strncmp(LangString(args[1]), "hasanchors", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" hasanchors tagOrId", NULL); - goto error; + break; + /* + * find + */ + case ZN_W_FIND: + { + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "find searchCommand ?arg arg ...?"); + goto error; + } + result = FindItems(wi, argc, args, NULL, 2); } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; + break; + /* + * fit + */ + case ZN_W_FIT: + { + ZnPoint *points; + int num_points; + ZnReal error; + ZnList to_points; + + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "fit coordList error"); + goto error; + } + if (ParseCoordList(wi, args[2], &points, &num_points) == ZN_ERROR) { + return ZN_ERROR; + } + if (Tcl_GetDoubleFromObj(interp, args[3], &error) == ZN_ERROR) { + goto error; + } + to_points = ZnListNew(32, sizeof(ZnPoint)); + FitBezier(points, num_points, error, to_points); + points = (ZnPoint *) ZnListArray(to_points); + num_points = ZnListSize(to_points); + l = Tcl_GetObjResult(interp); + for (i = 0; i < num_points; i++, points++) { + Tcl_ListObjAppendElement(interp, l, NewDoubleObj(points->x)); + Tcl_ListObjAppendElement(interp, l, NewDoubleObj(points->y)); + } + ZnListFree(to_points); } - Tcl_SetResult(interp, item->class->has_anchors ? "1" : "0", TCL_STATIC); - } - - /* - * hasfields - */ - else if ((c == 'h') && (strncmp(LangString(args[1]), "hasfields", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" hasfields tagOrId", NULL); - goto error; + break; + /* + * focus + */ + case ZN_W_FOCUS: + { + if ((argc != 2) && (argc != 3)) { + Tcl_WrongNumArgs(interp, 1, args, "focus ?tagOrId?"); + goto error; + } + item = wi->text_info.focus_item; + if (argc == 2) { + if (item != ZN_NO_ITEM) { + Tcl_SetObjResult(interp, NewLongObj(item->id)); + } + goto done; + } + if ((item != ZN_NO_ITEM) && (wi->text_info.got_focus)) { + ITEM.Invalidate(item, ZN_COORDS_FLAG); + } + if (Tcl_GetString(args[2])[0] == 0) { + wi->text_info.focus_item = ZN_NO_ITEM; + goto done; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + item = ZN_NO_ITEM; + for (i = 0; i < num; i++) { + if (items[i]->class->Cursor != NULL) { + break; + } + } + if (num == 0) { + goto done; + } + wi->text_info.focus_item = items[i]; + if (wi->text_info.got_focus) { + ITEM.Invalidate(wi->text_info.focus_item, ZN_COORDS_FLAG); + } } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; + break; + /* + * gettags + */ + case ZN_W_GETTAGS: + { + Tk_Uid *tags; + + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "gettags tagOrId"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + if (!item->tags || !ZnListSize(item->tags)) { + goto done; + } + else { + num = ZnListSize(item->tags); + tags = (Tk_Uid *) ZnListArray(item->tags); + l = Tcl_GetObjResult(interp); + for (i = 0; i < num; i++) { + Tcl_ListObjAppendElement(interp, l, NewStringObj(tags[i])); + } + } } - Tcl_SetResult(interp, item->class->has_fields ? "1" : "0", TCL_STATIC); - } - - /* - * hasparts - */ - else if ((c == 'h') && (strncmp(LangString(args[1]), "hasparts", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" hasparts tagOrId", NULL); - goto error; + break; + /* + * group + */ + case ZN_W_GROUP: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "group tagOrId"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + if (item->parent != ZN_NO_ITEM) { + Tcl_SetObjResult(interp, NewLongObj(item->parent->id)); + } + else { + /* + * Top group is its own parent. + */ + Tcl_SetObjResult(interp, NewLongObj(item->id)); + } } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; + break; + /* + * hasanchors + */ + case ZN_W_HASANCHORS: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "hasanchors tagOrId"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + Tcl_SetObjResult(interp, NewBooleanObj(item->class->has_anchors?1:0)); } - Tcl_SetResult(interp, item->class->has_parts ? "1" : "0", TCL_STATIC); - } - - /* - * hastag - */ - else if ((c == 'h') && (strncmp(LangString(args[1]), "hastag", length) == 0)) { - Tk_Uid tag_uid; - Tk_Uid *tags; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" hastag tagOrId tag", NULL); - goto error; + break; + /* + * hasfields + */ + case ZN_W_HASFIELDS: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "hasfields tagOrId"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + Tcl_SetObjResult(interp, NewBooleanObj(item->class->has_fields?1:0)); } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; + break; + /* + * hasparts + */ + case ZN_W_HASPARTS: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "hasparts tagOrId"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + Tcl_SetObjResult(interp, NewBooleanObj(item->class->has_parts?1:0)); } - if (!item->tags || !ZnListSize(item->tags)) { - Tcl_AppendResult(interp, "0", NULL); + break; + /* + * hastag + */ + case ZN_W_HASTAG: + { + Tk_Uid tag_uid; + Tk_Uid *tags; + + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "hastag tagOrId tag"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + if (!item->tags || !ZnListSize(item->tags)) { + Tcl_SetObjResult(interp, NewBooleanObj(0)); + } + else { + num = ZnListSize(item->tags); + tag_uid = Tk_GetUid(Tcl_GetString(args[3])); + tags = (Tk_Uid *) ZnListArray(item->tags); + for (i = 0; i < num; i++) { + if (tags[i] == tag_uid) { + Tcl_SetObjResult(interp, NewBooleanObj(1)); + goto done; + } + } + Tcl_SetObjResult(interp, NewBooleanObj(0)); + } } - else { - num = ZnListSize(item->tags); - tag_uid = Tk_GetUid(LangString(args[3])); - tags = (Tk_Uid *) ZnListArray(item->tags); + break; + /* + * index + */ + case ZN_W_INDEX: + { + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "index tagOrId string"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); for (i = 0; i < num; i++) { - if (tags[i] == tag_uid) { - Tcl_SetResult(interp, "1", TCL_STATIC); + if (items[i]->class->Index != NULL) { + result = (*items[i]->class->Index)(items[i], args[3], &index); + if (result != ZN_OK) { + goto error; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); goto done; } } - Tcl_SetResult(interp, "0", TCL_STATIC); - } - } - - /* - * index - */ - else if ((c == 'i') && (strncmp(LangString(args[1]), "index", length) == 0)) { - int index; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" index tagOrId string", NULL); + Tcl_AppendResult(interp, "can't find an indexable item \"", + Tcl_GetString(args[2]), "\"", NULL); goto error; } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - for (i = 0; i < num; i++) { - if (items[i]->class->Index != NULL) { - result = (*items[i]->class->Index)(items[i], LangString(args[3]), &index); + break; + /* + * insert + */ + case ZN_W_INSERT: + { + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "insert tagOrId before string"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + for (i = 0; i < num; i++) { + if ((items[i]->class->Index == NULL) || + (items[i]->class->InsertChars == NULL)) { + continue; + } + result = (*items[i]->class->Index)(items[i], args[3], &index); if (result != ZN_OK) { goto error; } - sprintf(msg, "%d", index); - Tcl_SetResult(interp, msg, TCL_VOLATILE); + (*items[i]->class->InsertChars)(items[i], index, Tcl_GetString(args[4])); + } + } + break; + /* + * itemcget + */ + case ZN_W_ITEMCGET: + { + int field = -1; + + if (argc < 4) { + itemcget_syntax: + Tcl_WrongNumArgs(interp, 1, args, "itemcget tagOrId ?field? option"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + if (argc == 5) { + if (Tcl_GetIntFromObj(interp, args[3], &field) != ZN_OK) { + Tcl_AppendResult(interp, "invalid field index \"", Tcl_GetString(args[3]), + "\", should be a positive integer", NULL); + goto error; + } + argc--; + args++; + } + if (argc != 4) { + goto itemcget_syntax; + } + if (ITEM.QueryItem(item, field, 1, &args[3]) != ZN_OK) { + goto error; + } + } + break; + /* + * itemconfigure + */ + case ZN_W_ITEMCONFIGURE: + { + int field = -1; + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, + "itemconfigure tagOrId ?field? option value ?option value? ..."); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + if (num == 0) { + goto error; + } + if ((argc > 3) && (Tcl_GetString(args[3])[0] != '-')) { + if (Tcl_GetIntFromObj(interp, args[3], &field) != ZN_OK) { + Tcl_AppendResult(interp, "invalid field index \"", + Tcl_GetString(args[3]), + "\", should be a positive integer", NULL); + goto error; + } + argc--; + args++; + } + argc -= 3; + args += 3; + if (argc < 2) { + if (ITEM.AttributesInfo(item, field, argc, args) == ZN_ERROR) { + goto error; + } goto done; } - } - Tcl_AppendResult(interp, "can't find an indexable item \"", - LangString(args[2]), "\"", NULL); - goto error; - } - - /* - * insert - */ - else if ((c == 'i') && (strncmp(LangString(args[1]), "insert", length) == 0)) { - int index; - - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" insert tagOrId before string", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - for (i = 0; i < num; i++) { - if ((items[i]->class->Index == NULL) || - (items[i]->class->InsertChars == NULL)) { - continue; + for (i = 0; i < num; i++) { + result = ITEM.ConfigureItem(items[i], field, argc, args, False); } - result = (*items[i]->class->Index)(items[i], LangString(args[3]), &index); - if (result != ZN_OK) { + /* + * Don't report errors when configuring many items/fields. All + * options are not supported by all item types. + */ + if ((num == 1) && (result == ZN_ERROR)) { goto error; } - (*items[i]->class->InsertChars)(items[i], index, LangString(args[4])); - } - } - - /* - * itemcget - */ - else if ((c == 'i') && (strncmp(LangString(args[1]), "itemcget", length) == 0)) { - int field = -1; -#ifndef PTK - char *largv[1]; -#else - Arg *largv = LangAllocVec(1); -#endif - if (argc < 4) { - itemcget_syntax: - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" itemcget tagOrId ?field? option", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; } - if (LangString(args[3])[0] != '-') { - char *end; - if (argc != 5) { - goto itemcget_syntax; + break; + /* + * lower + */ + case ZN_W_LOWER: + { + Item mark = ZN_NO_ITEM; + TagSearch search; + + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "lower tagOrId ?belowThis?"); + goto error; } - field = strtoul(LangString(args[3]), &end, 0); - if (*end == 0) { - argc--; - args++; + if (argc == 4) { + for (item = ZnSearchWithTagOrId(wi, args[3], wi->top_group, &search); + item != ZN_NO_ITEM; + item = ZnNextWithTagOrId(&search)) { + mark = item; + } + if (mark == ZN_NO_ITEM) { + Tcl_AppendResult(interp, "unknown tag or item \"", + Tcl_GetString(args[3]), "\"", NULL); + goto error; + } } - else { - Tcl_AppendResult(interp, "invalid field index \"", LangString(args[3]), - "\", should be a positive integer", NULL); + item = ZnSearchWithTagOrId(wi, args[2], wi->top_group, &search); + if (item == ZN_NO_ITEM) { + Tcl_AppendResult(interp, "unknown tag or item \"", + Tcl_GetString(args[2]), "\"", NULL); goto error; } - } - if (argc != 4) { - goto itemcget_syntax; - } - largv[0] = LangCopyArg(args[3]); - if (ITEM.QueryItem(item, field, 1, largv) != ZN_OK) { -#ifdef PTK - LangFreeVec(1, largv); -#endif - goto error; - } -#ifdef PTK - LangFreeVec(1, largv); -#endif - } - - /* - * itemconfigure - */ - else if ((c == 'i') && (strncmp(LangString(args[1]), "itemconfigure", length) == 0)) { - int field = -1; - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" itemconfigure tagOrId ?field? option value ?option value? ...", - NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - if (num == 0) { - goto error; - } - if ((argc > 3) && (LangString(args[3])[0] != '-')) { - char *end; - field = strtoul(LangString(args[3]), &end, 0); - if (*end == 0) { - argc--; - args++; + if (mark == ZN_NO_ITEM) { + mark = ((GroupItem) item->parent)->tail; } - else { - Tcl_AppendResult(interp, "invalid field index \"", LangString(args[3]), - "\", should be a positive integer", NULL); - goto error; + for (; item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&search)) { + if (item != mark) { + ITEM.UpdateItemPriority(item, mark, False); + mark = item; + } } } - argc -= 3; - args += 3; - if (argc < 2) { - if (ITEM.AttributesInfo(item, field, argc, args) == ZN_ERROR) { + break; + /* + * monitor + */ + case ZN_W_MONITOR: + { + ZnBool on_off; + + if ((argc != 2) && (argc != 3)) { + Tcl_WrongNumArgs(interp, 1, args, "monitor ?onOff?"); goto error; } - goto done; - } - for (i = 0; i < num; i++) { - result = ITEM.ConfigureItem(items[i], field, argc, args, False); + if (argc == 3) { + if (Tcl_GetBooleanFromObj(interp, args[2], &on_off) != ZN_OK) { + goto error; + } + wi->monitoring = on_off; + if (on_off == True) { + wi->num_updates = 0; + wi->last_time = wi->total_time = 0; + } + } + if ((argc == 2) || (on_off == False)) { + lobjs[0] = Tcl_NewIntObj(wi->num_updates); + lobjs[1] = Tcl_NewIntObj(wi->last_time); + lobjs[2] = Tcl_NewIntObj(wi->total_time); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, lobjs)); + } } + break; /* - * Don't report errors when configuring many items/fields. All - * options are not supported by all item types. + * postscript */ - if ((num == 1) && (result == ZN_ERROR)) { - goto error; - } - } - - /* - * lower - */ - else if ((c == 'l') && (strncmp(LangString(args[1]), "lower", length) == 0)) { - Item mark = ZN_NO_ITEM; - TagSearch search; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" lower tagOrId ?belowThis?", NULL); + case ZN_W_POSTSCRIPT: + { + Tcl_AppendResult(interp, "Command not yet implemented", NULL); goto error; } - if (argc == 4) { - for (item = ZnSearchWithTagOrId(wi, LangString(args[3]), wi->top_group, &search); - item != ZN_NO_ITEM; - item = ZnNextWithTagOrId(&search)) { - mark = item; + break; + /* + * raise + */ + case ZN_W_RAISE: + { + Item mark = ZN_NO_ITEM; + TagSearch search; + + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "raise tagOrId ?aboveThis?"); + goto error; } - if (mark == ZN_NO_ITEM) { - Tcl_AppendResult(interp, "unkown tag or item \"", - LangString(args[3]), "\"", NULL); + if (argc == 4) { + /* + * Find the topmost item with the tag. + */ + mark = ZnSearchWithTagOrId(wi, args[3], wi->top_group, &search); + if (mark == ZN_NO_ITEM) { + Tcl_AppendResult(interp, "unknown tag or item \"", + Tcl_GetString(args[3]), "\"", NULL); + goto error; + } + ZnDoneWithSearch(&search); + } + item = ZnSearchWithTagOrId(wi, args[2], wi->top_group, &search); + if (item == ZN_NO_ITEM) { + Tcl_AppendResult(interp, "unknown tag or item \"", + Tcl_GetString(args[2]), "\"", NULL); goto error; } - } - item = ZnSearchWithTagOrId(wi, LangString(args[2]), wi->top_group, &search); - if (item == ZN_NO_ITEM) { - Tcl_AppendResult(interp, "unkown tag or item \"", - LangString(args[2]), "\"", NULL); - goto error; - } - if (mark == ZN_NO_ITEM) { - mark = ((GroupItem) item->parent)->tail; - } - for (; item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&search)) { - if (item != mark) { - ITEM.UpdateItemPriority(item, mark, False); - mark = item; + if (mark == ZN_NO_ITEM) { + mark = ((GroupItem) item->parent)->head; + } + for (; item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&search)) { + if (item != mark) { + ITEM.UpdateItemPriority(item, mark, True); + } } } - } - - /* - * monitor - */ - else if ((c == 'm') && (strncmp(LangString(args[1]), "monitor", length) == 0)) { - ZnBool on_off; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" monitor ?onOff?", NULL); - goto error; - } - if (argc == 3) { - if (Tcl_GetBoolean(interp, args[2], &on_off) != ZN_OK) { + break; + /* + * remove + */ + case ZN_W_REMOVE: + { + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "remove tagOrId ?tagOrId ...?"); goto error; } - wi->monitoring = on_off; - if (on_off == True) { - wi->num_updates = 0; - wi->last_time = wi->total_time = 0; + argc -= 2; + args += 2; + for (j = 0; j < argc; j++) { + num = ZnItemsWithTagOrId(wi, args[j], &item, &items); + if (num == 0) { + goto error; + } + for (i = num-1; i >= 0; i--) { + if (items[i] == wi->top_group) { + continue; + } + if (wi->binding_table != NULL) { + /* + * BUG: we can't actually destroy all the item's bindings + * if there are field bindings registered. + */ + Tk_DeleteAllBindings(wi->binding_table, (ClientData) items[i]); + } + ITEM.DestroyItem(items[i]); + } } } - if ((argc == 2) || (on_off == False)) { - sprintf(msg, "%d", wi->num_updates); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", wi->last_time); - Tcl_AppendElement(interp, msg); - /* sprintf(msg, "%d", wi->num_updates!=0?wi->total_time/wi->num_updates:0);*/ - sprintf(msg, "%d", wi->total_time); - Tcl_AppendElement(interp, msg); - } - } - - /* - * postscript - */ - else if ((c == 'p') && (strncmp(LangString(args[1]), "postscript", length) == 0)) { - Tcl_AppendResult(interp, "Command not yet implemented", NULL); - goto error; - } - - /* - * raise - */ - else if ((c == 'r') && (strncmp(LangString(args[1]), "raise", length) == 0)) { - Item mark = ZN_NO_ITEM; - TagSearch search; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" raise tagOrId ?aboveThis?", NULL); - goto error; - } - if (argc == 4) { - /* - * Find the topmost item with the tag. - */ - mark = ZnSearchWithTagOrId(wi, LangString(args[3]), wi->top_group, &search); - if (mark == ZN_NO_ITEM) { - Tcl_AppendResult(interp, "unkown tag or item \"", - LangString(args[3]), "\"", NULL); + break; + /* + * rotate + */ + case ZN_W_ROTATE: + { + ZnReal angle; + ZnPoint p; + + if ((argc != 4) && (argc != 6)) { + Tcl_WrongNumArgs(interp, 1, args, "rotate tagOrId angle ?centerX centerY?"); goto error; } - ZnDoneWithSearch(&search); - } - item = ZnSearchWithTagOrId(wi, LangString(args[2]), wi->top_group, &search); - if (item == ZN_NO_ITEM) { - Tcl_AppendResult(interp, "unkown tag or item \"", - LangString(args[2]), "\"", NULL); - goto error; - } - if (mark == ZN_NO_ITEM) { - mark = ((GroupItem) item->parent)->head; - } - for (; item != ZN_NO_ITEM; item = ZnNextWithTagOrId(&search)) { - if (item != mark) { - ITEM.UpdateItemPriority(item, mark, True); + + if (argc == 6) { + if (Tcl_GetDoubleFromObj(interp, args[4], &p.x) == ZN_ERROR) { + goto error; + } + if (Tcl_GetDoubleFromObj(interp, args[5], &p.y) == ZN_ERROR) { + goto error; + } } - } - } - - /* - * remove - */ - else if ((c == 'r') && (strncmp(LangString(args[1]), "remove", length) == 0)) { - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" remove tagOrId ?tagOrId ...?", NULL); - goto error; - } - argc -= 2; - args += 2; - for (j = 0; j < argc; j++) { - num = ZnItemsWithTagOrId(wi, LangString(args[j]), &item, &items); + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); if (num == 0) { + Tcl_HashEntry *e; + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[2])); + if (e == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, + "\"", Tcl_GetString(args[2]), "\" must be either a tag or ", + "an id or a transform name", (char *) NULL); + goto error; + } + t = (ZnTransfo *) Tcl_GetHashValue(e); + } + + if (Tcl_GetDoubleFromObj(interp, args[3], &angle) == ZN_ERROR) { goto error; } - for (i = num-1; i >= 0; i--) { - if (items[i] == wi->top_group) { - continue; + if (t) { + if (argc == 6) { + ZnTranslate(t, -p.x, -p.y); + } + ZnRotateRad(t, angle); + if (argc == 6) { + ZnTranslate(t, p.x, p.y); } - if (wi->binding_table != NULL) { - /* - * BUG: we can't actually destroy all the item's bindings - * if there are field bindings registered. - */ - Tk_DeleteAllBindings(wi->binding_table, (ClientData) items[i]); + } + if (num != 0) { + for (i = 0; i < num; i++) { + ITEM.RotateItem(items[i], angle, (argc == 6) ? &p : NULL); } - ITEM.DestroyItem(items[i]); } } - } - - /* - * rotate - */ - else if ((c == 'r') && (strncmp(LangString(args[1]), "rotate", length) == 0)) { - ZnReal angle; - ZnPoint p; - - if ((argc != 4) && (argc != 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" rotate tagOrId angle ?centerX centerY?", (char *) NULL); - goto error; + break; + /* + * scale + */ + case ZN_W_SCALE: + { + ZnPoint scale; + + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "scale tagOrId xFactor yFactor"); + goto error; + } + if (argc == 5) { + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + if (num == 0) { + Tcl_HashEntry *e; + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[2])); + if (e == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "\"", Tcl_GetString(args[2]), + "\" must be either a tag or ", + "an id or a transform name", (char *) NULL); + goto error; + } + t = (ZnTransfo *) Tcl_GetHashValue(e); + } + } + if (Tcl_GetDoubleFromObj(interp, args[argc-2], &scale.x) == ZN_ERROR) { + goto error; + } + if (Tcl_GetDoubleFromObj(interp, args[argc-1], &scale.y) == ZN_ERROR) { + goto error; + } + if (t) { + ZnScale(t, scale.x, scale.y); + } + if (num != 0) { + for (i = 0; i < num; i++) { + ITEM.ScaleItem(items[i], scale.x, scale.y); + } + } } - - if (argc == 6) { - if (Tcl_GetDouble(interp, args[4], &p.x) == ZN_ERROR) { + break; + /* + * select + */ + case ZN_W_SELECT: + { + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "select option ?tagOrId? ?arg?"); goto error; } - if (Tcl_GetDouble(interp, args[5], &p.y) == ZN_ERROR) { + if (argc >= 4) { + num = ZnItemsWithTagOrId(wi, args[3], &item, &items); + if (num == 0) { + goto done; + } + item = ZN_NO_ITEM; + for (i = 0; i < num; i++) { + if ((items[i]->class->Index != NULL) && + (items[i]->class->Selection != NULL)) { + item = items[i]; + break; + } + } + if (item == ZN_NO_ITEM) { + Tcl_AppendResult(interp, "can't find an indexable item \"", + Tcl_GetString(args[3]), "\"", NULL); + goto error; + } + } + if (argc == 5) { + result = item->class->Index(item, args[4], &index); + if (result != ZN_OK) { + goto error; + } + } + if (Tcl_GetIndexFromObj(interp, args[2], sel_cmd_strings, + "selection option", 0, &cmd_index) != ZN_OK) { goto error; } + switch ((enum sel_cmds) cmd_index) { + case ZN_SEL_ADJUST: + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "select adjust tagOrId index"); + goto error; + } + if (wi->text_info.sel_item == item) { + if (index < (wi->text_info.sel_first + wi->text_info.sel_last)/2) { + wi->text_info.sel_anchor = wi->text_info.sel_last+1; + } + else { + wi->text_info.sel_anchor = wi->text_info.sel_first; + } + } + SelectTo(item, index); + break; + case ZN_SEL_CLEAR: + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "select clear"); + goto error; + } + if (wi->text_info.sel_item != ZN_NO_ITEM) { + ITEM.Invalidate(wi->text_info.sel_item, ZN_DRAW_FLAG); + wi->text_info.sel_item = ZN_NO_ITEM; + } + break; + case ZN_SEL_FROM: + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "select from tagOrId index"); + goto error; + } + wi->text_info.anchor_item = item; + wi->text_info.sel_anchor = index; + break; + case ZN_SEL_ITEM: + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "select item"); + goto error; + } + if (wi->text_info.sel_item != ZN_NO_ITEM) { + Tcl_SetObjResult(interp, NewLongObj(wi->text_info.sel_item->id)); + } + break; + case ZN_SEL_TO: + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "select to tagOrId index"); + goto error; + } + SelectTo(item, index); + break; + } } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - if (num == 0) { - Tcl_HashEntry *e; - e = Tcl_FindHashEntry(wi->t_table, LangString(args[2])); - if (e == NULL) { - Tcl_FreeResult(interp); - Tcl_AppendResult(interp, - "\"", LangString(args[2]), "\" must be either a tag or ", - "an id or a transform name", (char *) NULL); + break; + /* + * smooth + */ + case ZN_W_SMOOTH: + { + ZnPoint *points; + int num_points; + ZnList to_points; + + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "smooth coordList"); goto error; } - t = (ZnTransfo *) Tcl_GetHashValue(e); + if (ParseCoordList(wi, args[2], &points, &num_points) == ZN_ERROR) { + return ZN_ERROR; + } + to_points = ZnListNew(32, sizeof(ZnPoint)); + SmoothPathWithBezier(points, num_points, to_points); + points = (ZnPoint *) ZnListArray(to_points); + num_points = ZnListSize(to_points); + l = Tcl_GetObjResult(interp); + for (i = 0; i < num_points; i++, points++) { + Tcl_ListObjAppendElement(interp, l, NewDoubleObj(points->x)); + Tcl_ListObjAppendElement(interp, l, NewDoubleObj(points->y)); + } + ZnListFree(to_points); } - - if (Tcl_GetDouble(interp, args[3], &angle) == ZN_ERROR) { + break; + /* + * tapply + */ + case ZN_W_TAPPLY: + { + Tcl_AppendResult(interp, "Command not yet implemented", NULL); goto error; } - if (t) { - if (argc == 6) { - ZnTranslate(t, -p.x, -p.y); + break; + /* + * tdelete + */ + case ZN_W_TDELETE: + { + Tcl_HashEntry *e; + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "tdelete tName"); + goto error; } - ZnRotateRad(t, angle); - if (argc == 6) { - ZnTranslate(t, p.x, p.y); + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[2])); + if (e == NULL) { + Tcl_AppendResult(interp, "\"", Tcl_GetString(args[2]), + "\" must be a transform name", (char *) NULL); + goto error; } + t = (ZnTransfo *) Tcl_GetHashValue(e); + ZnTransfoFree(t); + Tcl_DeleteHashEntry(e); } - if (num != 0) { - for (i = 0; i < num; i++) { - ITEM.RotateItem(items[i], angle, (argc == 6) ? &p : NULL); + break; + /* + * transform + */ + case ZN_W_TRANSFORM: + { + int num_points; + ZnPoint *p, xp; + ZnTransfo t, t2, inv, *this_one; + Item from, to; + + if ((argc != 4) && (argc != 5)) { + Tcl_WrongNumArgs(interp, 1, args, "transform ?tagOrIdFrom? tagOrIdTo coordlist"); + goto error; + } + + if (argc == 5) { + num = ZnItemsWithTagOrId(wi, args[2], &from, &items); + if (num == 0) { + goto error; + } } - } - } - - /* - * scale - */ - else if ((c == 's') && (strncmp(LangString(args[1]), "scale", length) == 0)) { - ZnPoint scale; - - if (argc != 5) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" scale tagOrId xFactor yFactor", (char *) NULL); - goto error; - } - if (argc == 5) { - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); + num = ZnItemsWithTagOrId(wi, args[argc-2], &to, &items); if (num == 0) { Tcl_HashEntry *e; - e = Tcl_FindHashEntry(wi->t_table, LangString(args[2])); + /* + * Try to find a named transform. + */ + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[argc-2])); if (e == NULL) { - Tcl_FreeResult(interp); - Tcl_AppendResult(interp, "\"", LangString(args[2]), + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "\"", Tcl_GetString(args[argc-2]), "\" must be either a tag or ", "an id or a transform name", (char *) NULL); goto error; } - t = (ZnTransfo *) Tcl_GetHashValue(e); - } - } - if (Tcl_GetDouble(interp, args[argc-2], &scale.x) == ZN_ERROR) { - goto error; - } - if (Tcl_GetDouble(interp, args[argc-1], &scale.y) == ZN_ERROR) { - goto error; - } - if (t) { - ZnScale(t, scale.x, scale.y); - } - if (num != 0) { - for (i = 0; i < num; i++) { - ITEM.ScaleItem(items[i], scale.x, scale.y); + inv = *((ZnTransfo *) Tcl_GetHashValue(e)); } - } - } - - /* - * select - */ - else if ((c == 's') && (strncmp(LangString(args[1]), "select", length) == 0)) { - int index; - - if (argc < 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" select option ?tagOrId? ?arg?", NULL); - goto error; - } - if (argc >= 4) { - num = ZnItemsWithTagOrId(wi, LangString(args[3]), &item, &items); - if (num == 0) { - goto done; + else { + ITEM.GetItemTransform(to, &t); + ZnTransfoInvert(&t, &inv); } - item = ZN_NO_ITEM; - for (i = 0; i < num; i++) { - if ((items[i]->class->Index != NULL) && - (items[i]->class->Selection != NULL)) { - item = items[i]; - break; - } + this_one = &inv; + if (argc == 5) { + ITEM.GetItemTransform(from, &t); + ZnTransfoCompose(&t2, &t, &inv); + this_one = &t2; } - if (item == ZN_NO_ITEM) { - Tcl_AppendResult(interp, "can't find an indexable item \"", - LangString(args[3]), "\"", NULL); + /*ZnPrintTransfo(&t); + ZnPrintTransfo(&inv);*/ + + if (ParseCoordList(wi, args[argc-1], &p, &num_points) == ZN_ERROR) { + Tcl_AppendResult(interp, " invalid coord list \"", + Tcl_GetString(args[argc-1]), "\"", NULL); goto error; } - } - if (argc == 5) { - result = item->class->Index(item, LangString(args[4]), &index); - if (result != ZN_OK) { - goto error; + l = Tcl_GetObjResult(interp); + for (i = 0; i < num_points; i++, p++) { + /* + * Need to adjust for the border. + */ + if (argc != 5) { + p->x -= wi->inset; + p->y -= wi->inset; + } + ZnTransformPoint(this_one, p, &xp); + /*printf("p->x=%g, p->y=%g, xp.x=%g, xp.y=%g\n", p->x, p->y, xp.x, xp.y);*/ + Tcl_ListObjAppendElement(interp, l, NewDoubleObj(xp.x)); + Tcl_ListObjAppendElement(interp, l, NewDoubleObj(xp.y)); } } - c = LangString(args[2])[0]; - length = strlen(LangString(args[2])); - if ((c == 'a') && (strncmp(LangString(args[2]), "adjust", length) == 0)) { + break; + /* + * translate + */ + case ZN_W_TRANSLATE: + { + ZnPoint trans; + if (argc != 5) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" select adjust tagOrId index", NULL); + Tcl_WrongNumArgs(interp, 1, args, "translate tagOrId xAmount yAmount"); goto error; } - if (wi->text_info.sel_item == item) { - if (index < (wi->text_info.sel_first + wi->text_info.sel_last)/2) { - wi->text_info.sel_anchor = wi->text_info.sel_last+1; - } - else { - wi->text_info.sel_anchor = wi->text_info.sel_first; + num = 0; + if (argc == 5) { + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + if (num == 0) { + Tcl_HashEntry *e; + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[2])); + if (e == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "\"", Tcl_GetString(args[2]), + "\" must be either a tag or ", + "an id or a transform name", (char *) NULL); + goto error; + } + t = (ZnTransfo *) Tcl_GetHashValue(e); } } - SelectTo(item, index); - } - else if ((c == 'c') && (strncmp(LangString(args[2]), "clear", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" select clear", NULL); + if (Tcl_GetDoubleFromObj(interp, args[argc-2], &trans.x) == ZN_ERROR) { goto error; } - if (wi->text_info.sel_item != ZN_NO_ITEM) { - ITEM.Invalidate(wi->text_info.sel_item, ZN_DRAW_FLAG); - wi->text_info.sel_item = ZN_NO_ITEM; - } - } - else if ((c == 'f') && (strncmp(LangString(args[2]), "from", length) == 0)) { - if (argc != 5) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" select from tagOrId index", NULL); + if (Tcl_GetDoubleFromObj(interp, args[argc-1], &trans.y) == ZN_ERROR) { goto error; } - wi->text_info.anchor_item = item; - wi->text_info.sel_anchor = index; + if (t) { + ZnTranslate(t, trans.x, trans.y); + } + if (num != 0) { + for (i = 0; i < num; i++) { + ITEM.TranslateItem(items[i], trans.x, trans.y); + } + } } - else if ((c == 'i') && (strncmp(LangString(args[2]), "item", length) == 0)) { + break; + /* + * treset + */ + case ZN_W_TRESET: + { if (argc != 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" select item", NULL); + Tcl_WrongNumArgs(interp, 1, args, "treset tagOrId"); goto error; } - if (wi->text_info.sel_item != ZN_NO_ITEM) { - sprintf(msg, "%d", wi->text_info.sel_item->id); - Tcl_SetResult(interp, msg, TCL_VOLATILE); + if (argc == 3) { + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); + if (num == 0) { + Tcl_HashEntry *e; + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[2])); + if (e == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "\"", Tcl_GetString(args[2]), + "\" must be either a tag or ", + "an id or a transform name", (char *) NULL); + goto error; + } + t = (ZnTransfo *) Tcl_GetHashValue(e); + } + } + if (t) { + ZnTransfoSetIdentity(t); } - } - else if ((c == 't') && (strncmp(LangString(args[2]), "to", length) == 0)) { - if (argc != 5) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" select to tagOrId index", NULL); - goto error; + if (num != 0) { + for (i = 0; i < num; i++) { + ITEM.ResetTransfo(items[i]); + } } - SelectTo(item, index); - } - } - - /* - * smooth - */ - else if ((c == 's') && (strncmp(LangString(args[1]), "smooth", length) == 0)) { - ZnPoint *points; - int num_points; - ZnList to_points; - - if (argc != 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" smooth coordList", NULL); - goto error; - } - if (ParseCoordList(wi, args[2], &points, &num_points) == ZN_ERROR) { - return ZN_ERROR; - } - to_points = ZnListNew(32, sizeof(ZnPoint)); - SmoothPathWithBezier(points, num_points, to_points); - points = (ZnPoint *) ZnListArray(to_points); - num_points = ZnListSize(to_points); - for (i = 0; i < num_points; i++, points++) { - sprintf(msg, "%g", points->x); - Tcl_AppendElement(wi->interp, msg); - sprintf(msg, "%g", points->y); - Tcl_AppendElement(wi->interp, msg); - } - ZnListFree(to_points); - } - - /* - * tapply - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "tapply", length) == 0)) { - Tcl_AppendResult(interp, "Command not yet implemented", NULL); - goto error; - } - - /* - * tdelete - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "tdelete", length) == 0)) { - Tcl_HashEntry *e; - if (argc != 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" tdelete tName", NULL); - goto error; - } - e = Tcl_FindHashEntry(wi->t_table, LangString(args[2])); - if (e == NULL) { - Tcl_AppendResult(interp, "\"", LangString(args[2]), - "\" must be a transform name", (char *) NULL); - goto error; - } - t = (ZnTransfo *) Tcl_GetHashValue(e); - ZnTransfoFree(t); - Tcl_DeleteHashEntry(e); - } - - /* - * transform - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "transform", length) == 0)) { - int num_points; - ZnPoint *p, xp; - ZnTransfo t, t2, inv, *this_one; - Item from, to; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" transform ?tagOrIdFrom? tagOrIdTo coordlist", NULL); - goto error; } - - if (argc == 5) { - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &from, &items); - if (num == 0) { + break; + /* + * trestore + */ + case ZN_W_TRESTORE: + { + Tcl_HashEntry *e; + + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "trestore tagOrId tName"); goto error; } - } - num = ZnItemsWithTagOrId(wi, LangString(args[argc-2]), &to, &items); - if (num == 0) { - Tcl_HashEntry *e; - /* - * Try to find a named transform. - */ - e = Tcl_FindHashEntry(wi->t_table, LangString(args[argc-2])); + e = Tcl_FindHashEntry(wi->t_table, Tcl_GetString(args[argc-1])); if (e == NULL) { - Tcl_FreeResult(interp); - Tcl_AppendResult(interp, "\"", LangString(args[argc-2]), - "\" must be either a tag or ", - "an id or a transform name", (char *) NULL); + Tcl_AppendResult(interp, "\"", Tcl_GetString(args[argc-1]), + "\" must be a transform name", (char *) NULL); goto error; } - inv = *((ZnTransfo *) Tcl_GetHashValue(e)); - } - else { - ITEM.GetItemTransform(to, &t); - ZnTransfoInvert(&t, &inv); - } - this_one = &inv; - if (argc == 5) { - ITEM.GetItemTransform(from, &t); - ZnTransfoCompose(&t2, &t, &inv); - this_one = &t2; - } - /*ZnPrintTransfo(&t); - ZnPrintTransfo(&inv);*/ - - if (ParseCoordList(wi, args[argc-1], &p, &num_points) == ZN_ERROR) { - Tcl_AppendResult(interp, - " invalid coord list \"", args[argc-1], "\"", NULL); - goto error; - } - for (i = 0; i < num_points; i++, p++) { - /* - * Need to adjust for the border. - */ - if (argc != 5) { - p->x -= wi->inset; - p->y -= wi->inset; - } - ZnTransformPoint(this_one, p, &xp); - /*printf("p->x=%g, p->y=%g, xp.x=%g, xp.y=%g\n", p->x, p->y, xp.x, xp.y);*/ - sprintf(msg, "%g", xp.x); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%g", xp.y); - Tcl_AppendElement(interp, msg); - } - } - - /* - * translate - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "translate", length) == 0)) { - ZnPoint trans; - - if (argc != 5) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" translate tagOrId xAmount yAmount", NULL); - goto error; - } - num = 0; - if (argc == 5) { - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); + t = (ZnTransfo *) Tcl_GetHashValue(e); + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); if (num == 0) { - Tcl_HashEntry *e; - e = Tcl_FindHashEntry(wi->t_table, LangString(args[2])); - if (e == NULL) { - Tcl_FreeResult(interp); - Tcl_AppendResult(interp, "\"", LangString(args[2]), - "\" must be either a tag or ", - "an id or a transform name", (char *) NULL); - goto error; - } - t = (ZnTransfo *) Tcl_GetHashValue(e); + goto error; } - } - if (Tcl_GetDouble(interp, args[argc-2], &trans.x) == ZN_ERROR) { - goto error; - } - if (Tcl_GetDouble(interp, args[argc-1], &trans.y) == ZN_ERROR) { - goto error; - } - if (t) { - ZnTranslate(t, trans.x, trans.y); - } - if (num != 0) { for (i = 0; i < num; i++) { - ITEM.TranslateItem(items[i], trans.x, trans.y); + ITEM.SetTransfo(items[i], t); } } - } - - /* - * treset - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "treset", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" treset tagOrId", NULL); - goto error; - } - if (argc == 3) { - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); + break; + /* + * tsave + */ + case ZN_W_TSAVE: + { + Tcl_HashEntry *e; + int new, invert=0; + ZnTransfo *inv; + + if ((argc != 4) && (argc != 5)) { + Tcl_WrongNumArgs(interp, 1, args, "tsave tagOrId tName ?invert?"); + goto error; + } + num = ZnItemsWithTagOrId(wi, args[2], &item, &items); if (num == 0) { - Tcl_HashEntry *e; - e = Tcl_FindHashEntry(wi->t_table, LangString(args[2])); - if (e == NULL) { - Tcl_FreeResult(interp); - Tcl_AppendResult(interp, - "\"", LangString(args[2]), "\" must be either a tag or ", - "an id or a transform name", (char *) NULL); + goto error; + } + if (argc == 5) { + if (Tcl_GetBooleanFromObj(interp, args[4], &invert) != ZN_OK) { goto error; } - t = (ZnTransfo *) Tcl_GetHashValue(e); } - } - if (t) { - ZnTransfoSetIdentity(t); - } - if (num != 0) { - for (i = 0; i < num; i++) { - ITEM.ResetTransfo(items[i]); + t = item->transfo; + e = Tcl_CreateHashEntry(wi->t_table, Tcl_GetString(args[argc-1]), &new); + if (!new) { + ZnTransfoFree((ZnTransfo *) Tcl_GetHashValue(e)); } + if (invert) { + inv = ZnTransfoNew(); + ZnTransfoInvert(t, inv); + } + else { + inv = ZnTransfoDuplicate(t); + } + Tcl_SetHashValue(e, inv); } - } - - /* - * trestore - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "trestore", length) == 0)) { - Tcl_HashEntry *e; - - if (argc != 4) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" trestore tagOrId tName", NULL); - goto error; - } - e = Tcl_FindHashEntry(wi->t_table, LangString(args[argc-1])); - if (e == NULL) { - Tcl_AppendResult(interp, "\"", LangString(args[argc-1]), - "\" must be a transform name", (char *) NULL); - goto error; - } - t = (ZnTransfo *) Tcl_GetHashValue(e); - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - if (num == 0) { - goto error; - } - for (i = 0; i < num; i++) { - ITEM.SetTransfo(items[i], t); - } - } - - /* - * tsave - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "tsave", length) == 0)) { - Tcl_HashEntry *e; - int new, invert=0; - ZnTransfo *inv; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, - "wrong # args: should be \"", LangString(args[0]), - "\" tsave tagOrId tName ?invert?", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, &items); - if (num == 0) { - goto error; - } - if (argc == 5) { - if (Tcl_GetBoolean(interp, args[4], &invert) != ZN_OK) { + break; + /* + * type + */ + case ZN_W_TYPE: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "type tagOrId"); goto error; } + num = ZnItemsWithTagOrId(wi, args[2], &item, NULL); + if (num == 0) { + goto error; + } + Tcl_SetObjResult(interp, NewStringObj(item->class->name)); } - t = item->transfo; - e = Tcl_CreateHashEntry(wi->t_table, LangString(args[argc-1]), &new); - if (!new) { - ZnTransfoFree((ZnTransfo *) Tcl_GetHashValue(e)); - } - if (invert) { - inv = ZnTransfoNew(); - ZnTransfoInvert(t, inv); - } - else { - inv = ZnTransfoDuplicate(t); - } - Tcl_SetHashValue(e, inv); + break; } - /* - * type - */ - else if ((c == 't') && (strncmp(LangString(args[1]), "type", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" type tagOrId", NULL); - goto error; - } - num = ZnItemsWithTagOrId(wi, LangString(args[2]), &item, NULL); - if (num == 0) { - goto error; - } - Tcl_SetResult(interp, item->class->name, TCL_STATIC); - } - - else { - Tcl_AppendResult(interp, "invalid command \"", LangString(args[1]), - "\": must be " - "add, addtag, anchorxy, bbox, becomes, bind, cget, " - "chggroup, clone, configure, contour, coords, currentpart, " - "cursor, chars, dtag, find, fit, focus, gettags, group, " - "hasanchors, hasfields, hasparts, hastag, index, insert, " - "itemcget, itemconfigure, lower, monitor, postscript, raise, " - "remove, rotate, scale, select, smooth, tapply, tdelete, " - "transform, translate, treset, trestore, tsave, type", NULL); - goto error; - } done: if (wi->work_item_list) { ZnListFree(wi->work_item_list); @@ -3252,7 +3280,7 @@ WidgetCmd(ClientData client_data, /* Information about the widget. */ } Tcl_Release((ClientData) wi); return result; - + error: if (wi->work_item_list) { ZnListFree(wi->work_item_list); @@ -3312,18 +3340,22 @@ TileChange(ClientData client_data, *---------------------------------------------------------------------- */ static int -Configure(Tcl_Interp *interp, /* Used for error reporting. */ - WidgetInfo *wi, /* Information about widget. */ - int argc, /* Number of valid entries in args. */ - Arg *args, /* Arguments. */ - int flags) /* Flags to pass to Tk_ConfigureWidget. */ +Configure(Tcl_Interp *interp,/* Used for error reporting. */ + WidgetInfo *wi, /* Information about widget. */ + int argc, /* Number of valid entries in args. */ + Tcl_Obj *CONST args[], /* Arguments. */ + int flags) /* Flags to pass to Tk_ConfigureWidget. */ { #define CONFIG_PROBE(offset) (ISSET(config_specs[offset].specFlags, \ TK_CONFIG_OPTION_SPECIFIED)) ZnBBox bbox; - if (Tk_ConfigureWidget(interp, wi->win, config_specs, - argc, args, (char *) wi, flags) != TCL_OK) { + if (Tk_ConfigureWidget(interp, wi->win, config_specs, argc, +#ifdef PTK + (Tcl_Obj **) args, (char *) wi, flags) != TCL_OK) { +#else + (char **) args, (char *) wi, flags|TK_CONFIG_OBJS) != TCL_OK) { +#endif return ZN_ERROR; } @@ -3654,11 +3686,7 @@ Event(ClientData client_data, /* Information about widget. */ if (wi->win != NULL) { wi->win = NULL; wi->realized = False; -#ifndef PTK - Tcl_DeleteCommand(wi->interp, Tcl_GetCommandName(wi->interp, wi->cmd)); -#else - Lang_DeleteWidget(wi->interp, wi->cmd); -#endif + Tcl_DeleteCommandFromToken(wi->interp, wi->cmd); } if (wi->update_pending) { Tcl_CancelIdleCall(Redisplay, (ClientData) wi); @@ -4867,443 +4895,468 @@ MapInfoTextStyleFromString(Tcl_Interp *interp, } int -MapInfoCmd(ClientData client_data, - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - Arg *args) +MapInfoObjCmd(ClientData client_data, + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + Tcl_Obj *CONST args[]) { - char c, c2; - int length, result; + int index, index2, result; MapInfoMaster *master; - char msg[INTEGER_SPACE*7]; + Tcl_Obj *lobjs[7]; + static char *sub_cmd_strings[] = { + "add", "count", "create", "delete", "duplicate", + "get", "remove", "replace", "scale", "translate", NULL + }; + static char *e_type_strings[] = { + "arc", "line", "symbol", "text", NULL + }; + enum sub_cmds { + ZN_MI_ADD, ZN_MI_COUNT, ZN_MI_CREATE, ZN_MI_DELETE, ZN_MI_DUPLICATE, + ZN_MI_GET, ZN_MI_REMOVE, ZN_MI_REPLACE, ZN_MI_SCALE, ZN_MI_TRANSLATE + }; + enum e_types { + ZN_E_ARC, ZN_E_LINE, ZN_E_SYMBOL, ZN_E_TEXT + }; if (!inited) { InitZinc(interp); } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # of args: \"", - LangString(args[0]), " subcommand ?args?.\"", NULL); + if (argc < 3) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo/name subCmd ?args?"); return ZN_ERROR; } - c = LangString(args[2])[0]; - length = strlen(LangString(args[2])); - result = TCL_OK; - - /* - * create - */ - if ((c == 'c') && (strncmp(LangString(args[2]), "create", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - " name create\"", NULL); - return ZN_ERROR; - } - if (ZnCreateMapInfo(interp, LangString(args[1]), NULL) == ZN_ERROR) { - return ZN_ERROR; - } - } - - /* - * delete - */ - else if ((c == 'd') && (strncmp(LangString(args[2]), "delete", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo delete", NULL); - return ZN_ERROR; - } - if (ZnDeleteMapInfo(interp, LangString(args[1])) == ZN_ERROR) { - return ZN_ERROR; - } - } - - /* - * duplicate - */ - else if ((c == 'd') && (strncmp(LangString(args[2]), "duplicate", length) == 0)) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo duplicate name", NULL); - return ZN_ERROR; - } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; - } - if (ZnDuplicateMapInfo(interp, LangString(args[3]), master->map_info) == ZN_ERROR) { - return ZN_ERROR; - } + if (Tcl_GetIndexFromObj(interp, args[2], sub_cmd_strings, + "subCmd", 0, &index) != ZN_OK) { + return ZN_ERROR; } + result = TCL_OK; - /* - * add/replace - */ - else if (((c == 'a') && (strncmp(LangString(args[2]), "add", length) == 0)) || - ((c == 'r') && (strncmp(LangString(args[2]), "replace", length) == 0))) { - MapInfoLineStyle line_style; - MapInfoTextStyle text_style; - char *imsg = (c == 'a') ? "" : " index"; - int i, index, num_param=4; - int coords[6]; - - if (c != 'a') { - num_param++; - } - if (argc < num_param) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo ", LangString(args[2]), " type", imsg, - " ?args?", NULL); - return ZN_ERROR; + switch((enum sub_cmds) index) { + /* + * create + */ + case ZN_MI_CREATE: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "name create"); + return ZN_ERROR; + } + if (ZnCreateMapInfo(interp, Tcl_GetString(args[1]), NULL) == ZN_ERROR) { + return ZN_ERROR; + } } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; + break; + /* + * delete + */ + case ZN_MI_DELETE: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo delete"); + return ZN_ERROR; + } + if (ZnDeleteMapInfo(interp, Tcl_GetString(args[1])) == ZN_ERROR) { + return ZN_ERROR; + } } - if (c != 'a') { - if (Tcl_GetInt(interp, args[4], &index) == ZN_ERROR) { + break; + /* + * duplicate + */ + case ZN_MI_DUPLICATE: + { + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo duplicate name"); return ZN_ERROR; } - if (index < 0) { - index = 0; + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { + return ZN_ERROR; + } + if (ZnDuplicateMapInfo(interp, Tcl_GetString(args[3]), + master->map_info) == ZN_ERROR) { + return ZN_ERROR; } } - c2 = LangString(args[3])[0]; - length = strlen(LangString(args[3])); - if ((c2 == 'l') && (strncmp(LangString(args[3]), "line", length) == 0)) { - if (argc != (num_param+6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo ", LangString(args[2]), " line", imsg, - " style width x1 y1 x2 y2", NULL); + break; + /* + * add/replace + */ + case ZN_MI_ADD: + case ZN_MI_REPLACE: + { + MapInfoLineStyle line_style; + MapInfoTextStyle text_style; + int i, index; + int coords[6]; + ZnBool add_cmd = (enum sub_cmds) index == ZN_MI_ADD; + int num_param = add_cmd ? 4 : 5; + + if (argc < num_param) { + Tcl_WrongNumArgs(interp, 3, args, + add_cmd ? "elementType ?args?" : "elementType index ?args?"); return ZN_ERROR; } - if (MapInfoLineStyleFromString(interp, LangString(args[num_param]), - &line_style) == ZN_ERROR) { + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { return ZN_ERROR; } - for (i = 0; i < 5; i++) { - if (Tcl_GetInt(interp, args[num_param+i+1], &coords[i]) == ZN_ERROR) { + if (!add_cmd) { + if (Tcl_GetIntFromObj(interp, args[4], &index) == ZN_ERROR) { return ZN_ERROR; } + if (index < 0) { + index = 0; + } } - if (coords[0] < 0) { - coords[0] = 0; - } - if (c == 'a') { - MapInfoAddLine(master->map_info, ZnListTail, NULL, line_style, - coords[0], coords[1], coords[2], coords[3], coords[4]); + if (Tcl_GetIndexFromObj(interp, args[0], e_type_strings, + "elementType", 0, &index2) != ZN_OK) { + return ZN_ERROR; } - else { - MapInfoReplaceLine(master->map_info, index, NULL, line_style, + switch ((enum e_types) index2) { + case ZN_E_LINE: + { + if (argc != (num_param+6)) { + Tcl_WrongNumArgs(interp, 4, args, + add_cmd ? "style width x1 y1 x2 y2" : "index style width x1 y1 x2 y2"); + return ZN_ERROR; + } + if (MapInfoLineStyleFromString(interp, Tcl_GetString(args[num_param]), + &line_style) == ZN_ERROR) { + return ZN_ERROR; + } + for (i = 0; i < 5; i++) { + if (Tcl_GetIntFromObj(interp, args[num_param+i+1], &coords[i]) == ZN_ERROR) { + return ZN_ERROR; + } + } + if (coords[0] < 0) { + coords[0] = 0; + } + if (add_cmd) { + MapInfoAddLine(master->map_info, ZnListTail, NULL, line_style, coords[0], coords[1], coords[2], coords[3], coords[4]); + } + else { + MapInfoReplaceLine(master->map_info, index, NULL, line_style, + coords[0], coords[1], coords[2], coords[3], coords[4]); + } + } + break; + case ZN_E_SYMBOL: + { + if (argc != (num_param+3)) { + Tcl_WrongNumArgs(interp, 4, args, + add_cmd ? "x y intVal" : "index x y intVal"); + return ZN_ERROR; + } + for (i = 0; i < 3; i++) { + if (Tcl_GetIntFromObj(interp, args[num_param+i], &coords[i]) == ZN_ERROR) { + return ZN_ERROR; + } + } + if (coords[2] < 0) { + coords[2] = 0; + } + if (add_cmd) { + MapInfoAddSymbol(master->map_info, ZnListTail, NULL, coords[0], + coords[1], coords[2]); + } + else { + MapInfoReplaceSymbol(master->map_info, index, NULL, coords[0], + coords[1], coords[2]); + } + } + case ZN_E_TEXT: + { + if (argc != (num_param+5)) { + Tcl_WrongNumArgs(interp, 4, args, + add_cmd ? "textStyle lineStyle x y string" : "index textStyle lineStyle x y string"); + return ZN_ERROR; + } + if (MapInfoTextStyleFromString(interp, Tcl_GetString(args[num_param]), + &text_style) == ZN_ERROR) { + return ZN_ERROR; + } + if (MapInfoLineStyleFromString(interp, Tcl_GetString(args[num_param+1]), + &line_style) == ZN_ERROR) { + return ZN_ERROR; + } + for (i = 0; i < 2; i++) { + if (Tcl_GetIntFromObj(interp, args[num_param+i+2], &coords[i]) == ZN_ERROR) { + return ZN_ERROR; + } + } + if (add_cmd) { + MapInfoAddText(master->map_info, ZnListTail, NULL, text_style, + line_style, coords[0], coords[1], + Tcl_GetString(args[num_param+4])); + } + else { + /*printf("replace text ts %d ls %d %d %d %s\n", text_style, + line_style, coords[0], coords[1], Tcl_GetString(args[num_param+4]));*/ + MapInfoReplaceText(master->map_info, index, NULL, text_style, + line_style, coords[0], coords[1], + Tcl_GetString(args[num_param+4])); + } + } + break; + case ZN_E_ARC: + { + if (argc != (num_param+7)) { + Tcl_WrongNumArgs(interp, 4, args, + add_cmd ? "style width cx cy radius start extent" : "index style width cx cy radius start extent"); + return ZN_ERROR; + } + if (MapInfoLineStyleFromString(interp, Tcl_GetString(args[num_param]), + &line_style) == ZN_ERROR) { + return ZN_ERROR; + } + for (i = 0; i < 6; i++) { + if (Tcl_GetIntFromObj(interp, args[num_param+i+1], &coords[i]) == ZN_ERROR) { + return ZN_ERROR; + } + } + if (coords[0] < 0) { + coords[0] = 0; + } + if (add_cmd) { + MapInfoAddArc(master->map_info, ZnListTail, NULL, line_style, + coords[0], coords[1], coords[2], coords[3], coords[4], + coords[5]); + } + else { + MapInfoReplaceArc(master->map_info, index, NULL, line_style, coords[0], + coords[1], coords[2], coords[3], coords[4], coords[5]); + } + } + break; } + UpdateMapInfoClients(master); } - else if ((c2 == 's') && (strncmp(LangString(args[3]), "symbol", length) == 0)) { - if (argc != (num_param+3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo ", LangString(args[2]), " symbol", imsg, - " x y intVal", NULL); + break; + /* + * count + */ + case ZN_MI_COUNT: + { + int count = 0; + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo count type"); return ZN_ERROR; } - for (i = 0; i < 3; i++) { - if (Tcl_GetInt(interp, args[num_param+i], &coords[i]) == ZN_ERROR) { - return ZN_ERROR; - } - } - if (coords[2] < 0) { - coords[2] = 0; + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { + return ZN_ERROR; } - if (c == 'a') { - MapInfoAddSymbol(master->map_info, ZnListTail, NULL, coords[0], - coords[1], coords[2]); + args += 3; + argc -= 3; + if (Tcl_GetIndexFromObj(interp, args[0], e_type_strings, + "elementType", 0, &index2) != ZN_OK) { + return ZN_ERROR; } - else { - MapInfoReplaceSymbol(master->map_info, index, NULL, coords[0], - coords[1], coords[2]); + switch ((enum e_types) index2) { + case ZN_E_LINE: + count = MapInfoNumLines(master->map_info); + break; + case ZN_E_SYMBOL: + count = MapInfoNumSymbols(master->map_info); + break; + case ZN_E_TEXT: + count = MapInfoNumTexts(master->map_info); + break; + case ZN_E_ARC: + count = MapInfoNumArcs(master->map_info); + break; } + Tcl_SetObjResult(interp, Tcl_NewIntObj(count)); } - else if ((c2 == 't') && (strncmp(LangString(args[3]), "text", length) == 0)) { - if (argc != (num_param+5)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo ", LangString(args[2]), " text", imsg, - " textStyle lineStyle x y string", NULL); + break; + /* + * get + */ + case ZN_MI_GET: + { + int index; + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo get type index"); return ZN_ERROR; } - if (MapInfoTextStyleFromString(interp, LangString(args[num_param]), - &text_style) == ZN_ERROR) { + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { return ZN_ERROR; } - if (MapInfoLineStyleFromString(interp, LangString(args[num_param+1]), - &line_style) == ZN_ERROR) { + if (Tcl_GetIntFromObj(interp, args[4], &index) == ZN_ERROR) { return ZN_ERROR; } - for (i = 0; i < 2; i++) { - if (Tcl_GetInt(interp, args[num_param+i+2], &coords[i]) == ZN_ERROR) { - return ZN_ERROR; - } + if (index < 0) { + index = 0; } - if (c == 'a') { - MapInfoAddText(master->map_info, ZnListTail, NULL, text_style, - line_style, coords[0], coords[1], LangString(args[num_param+4])); + args += 3; + argc -= 3; + if (Tcl_GetIndexFromObj(interp, args[0], e_type_strings, + "elementType", 0, &index2) != ZN_OK) { + return ZN_ERROR; } - else { - /*printf("replace text ts %d ls %d %d %d %s\n", text_style, - line_style, coords[0], coords[1], LangString(args[num_param+4]));*/ - MapInfoReplaceText(master->map_info, index, NULL, text_style, - line_style, coords[0], coords[1], LangString(args[num_param+4])); + switch ((enum e_types) index2) { + case ZN_E_LINE: + { + MapInfoLineStyle line_style; + int line_width; + int x_from, y_from, x_to, y_to; + MapInfoGetLine(master->map_info, index, NULL, &line_style, + &line_width, &x_from, &y_from, &x_to, &y_to); + lobjs[0] = NewStringObj(MapInfoLineStyleToString(line_style)); + lobjs[1] = Tcl_NewIntObj(line_width); + lobjs[2] = Tcl_NewIntObj(x_from); + lobjs[3] = Tcl_NewIntObj(y_from); + lobjs[4] = Tcl_NewIntObj(x_to); + lobjs[5] = Tcl_NewIntObj(y_to); + Tcl_SetObjResult(interp, Tcl_NewListObj(6, lobjs)); + } + break; + case ZN_E_SYMBOL: + { + int x, y; + char symbol; + MapInfoGetSymbol(master->map_info, index, NULL, &x, &y, &symbol); + lobjs[0] = Tcl_NewIntObj(x); + lobjs[1] = Tcl_NewIntObj(y); + lobjs[2] = Tcl_NewIntObj(symbol); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, lobjs)); + } + break; + case ZN_E_TEXT: + { + int x, y; + char *text; + MapInfoTextStyle text_style; + MapInfoLineStyle line_style; + MapInfoGetText(master->map_info, index, NULL, &text_style, &line_style, + &x, &y, &text); + lobjs[0] = Tcl_NewIntObj(x); + lobjs[1] = Tcl_NewIntObj(y); + lobjs[2] = NewStringObj(MapInfoTextStyleToString(text_style)); + lobjs[3] = NewStringObj(MapInfoLineStyleToString(line_style)); + lobjs[4] = NewStringObj(text); + Tcl_SetObjResult(interp, Tcl_NewListObj(5, lobjs)); + } + break; + case ZN_E_ARC: + { + MapInfoLineStyle line_style; + int line_width; + int center_x, center_y, start, extent; + unsigned int radius; + MapInfoGetArc(master->map_info, index, NULL, &line_style, &line_width, + ¢er_x, ¢er_y, &radius, &start, &extent); + lobjs[0] = NewStringObj(MapInfoLineStyleToString(line_style)); + lobjs[1] = Tcl_NewIntObj(line_width); + lobjs[2] = Tcl_NewIntObj(center_x); + lobjs[3] = Tcl_NewIntObj(center_y); + lobjs[4] = Tcl_NewIntObj(radius); + lobjs[5] = Tcl_NewIntObj(start); + lobjs[6] = Tcl_NewIntObj(extent); + Tcl_SetObjResult(interp, Tcl_NewListObj(7, lobjs)); + } + break; } } - else if ((c2 == 'a') && (strncmp(LangString(args[3]), "arc", length) == 0)) { - if (argc != (num_param+7)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo ", LangString(args[2]), " arc", imsg, - " style width cx cy radius start extent", NULL); + break; + /* + * remove + */ + case ZN_MI_REMOVE: + { + int index; + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo remove type index"); return ZN_ERROR; } - if (MapInfoLineStyleFromString(interp, LangString(args[num_param]), - &line_style) == ZN_ERROR) { + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { return ZN_ERROR; } - for (i = 0; i < 6; i++) { - if (Tcl_GetInt(interp, args[num_param+i+1], &coords[i]) == ZN_ERROR) { - return ZN_ERROR; - } + if (Tcl_GetIntFromObj(interp, args[4], &index) == ZN_ERROR) { + return ZN_ERROR; } - if (coords[0] < 0) { - coords[0] = 0; + if (index < 0) { + index = 0; } - if (c == 'a') { - MapInfoAddArc(master->map_info, ZnListTail, NULL, line_style, - coords[0], coords[1], coords[2], coords[3], coords[4], - coords[5]); + args += 3; + argc -= 3; + if (Tcl_GetIndexFromObj(interp, args[0], e_type_strings, + "elementType", 0, &index2) != ZN_OK) { + return ZN_ERROR; } - else { - MapInfoReplaceArc(master->map_info, index, NULL, line_style, coords[0], - coords[1], coords[2], coords[3], coords[4], coords[5]); + switch ((enum e_types) index2) { + case ZN_E_LINE: + MapInfoRemoveLine(master->map_info, index); + break; + case ZN_E_SYMBOL: + MapInfoRemoveSymbol(master->map_info, index); + break; + case ZN_E_TEXT: + MapInfoRemoveText(master->map_info, index); + break; + case ZN_E_ARC: + MapInfoRemoveArc(master->map_info, index); + break; } + UpdateMapInfoClients(master); } - UpdateMapInfoClients(master); - } - - /* - * count - */ - else if ((c == 'c') && (strncmp(LangString(args[2]), "count", length) == 0)) { - int count = 0; - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo count type", NULL); - return ZN_ERROR; - } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; - } - args += 3; - argc -= 3; - c2 = LangString(args[0])[0]; - length = strlen(LangString(args[0])); - if ((c2 == 'l') && (strncmp(LangString(args[0]), "line", length) == 0)) { - count = MapInfoNumLines(master->map_info); - } - else if ((c2 == 's') && (strncmp(LangString(args[0]), "symbol", length) == 0)) { - count = MapInfoNumSymbols(master->map_info); - } - else if ((c2 == 't') && (strncmp(LangString(args[0]), "text", length) == 0)) { - count = MapInfoNumTexts(master->map_info); - } - else if ((c2 == 'a') && (strncmp(LangString(args[0]), "arc", length) == 0)) { - count = MapInfoNumArcs(master->map_info); - } - sprintf(msg, "%d", count); - Tcl_SetResult(interp, msg, TCL_VOLATILE); - } - - /* - * get - */ - else if ((c == 'g') && (strncmp(LangString(args[2]), "get", length) == 0)) { - int index; - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo get type index", NULL); - return ZN_ERROR; - } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; - } - if (Tcl_GetInt(interp, args[4], &index) == ZN_ERROR) { - return ZN_ERROR; - } - if (index < 0) { - index = 0; - } - args += 3; - argc -= 3; - c2 = LangString(args[0])[0]; - length = strlen(LangString(args[0])); - if ((c2 == 'l') && (strncmp(LangString(args[0]), "line", length) == 0)) { - MapInfoLineStyle line_style; - int line_width; - int x_from, y_from, x_to, y_to; - MapInfoGetLine(master->map_info, index, NULL, &line_style, - &line_width, &x_from, &y_from, &x_to, &y_to); - Tcl_AppendElement(interp, MapInfoLineStyleToString(line_style)); - sprintf(msg, "%d", line_width); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", x_from); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", y_from); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", x_to); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", y_to); - Tcl_AppendElement(interp, msg); - } - else if ((c2 == 's') && (strncmp(LangString(args[0]), "symbol", length) == 0)) { - int x, y; - char symbol; - MapInfoGetSymbol(master->map_info, index, NULL, &x, &y, &symbol); - sprintf(msg, "%d", x); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", y); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", symbol); - Tcl_AppendElement(interp, msg); - } - else if ((c2 == 't') && (strncmp(LangString(args[0]), "text", length) == 0)) { - int x, y; - char *text; - MapInfoTextStyle text_style; - MapInfoLineStyle line_style; - MapInfoGetText(master->map_info, index, NULL, &text_style, &line_style, - &x, &y, &text); - sprintf(msg, "%d", x); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", y); - Tcl_AppendElement(interp, msg); - Tcl_AppendElement(interp, MapInfoTextStyleToString(text_style)); - Tcl_AppendElement(interp, MapInfoLineStyleToString(line_style)); - Tcl_AppendElement(interp, text); - } - else if ((c2 == 'a') && (strncmp(LangString(args[0]), "arc", length) == 0)) { - MapInfoLineStyle line_style; - int line_width; - int center_x, center_y, start, extent; - unsigned int radius; - MapInfoGetArc(master->map_info, index, NULL, &line_style, &line_width, - ¢er_x, ¢er_y, &radius, &start, &extent); - Tcl_AppendElement(interp, MapInfoLineStyleToString(line_style)); - sprintf(msg, "%d", line_width); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", center_x); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", center_y); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", radius); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", start); - Tcl_AppendElement(interp, msg); - sprintf(msg, "%d", extent); - Tcl_AppendElement(interp, msg); - } - } - - /* - * remove - */ - else if ((c == 'r') && (strncmp(LangString(args[2]), "remove", length) == 0)) { - int index; - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo remove type index", NULL); - return ZN_ERROR; - } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; - } - if (Tcl_GetInt(interp, args[4], &index) == ZN_ERROR) { - return ZN_ERROR; - } - if (index < 0) { - index = 0; - } - args += 3; - argc -= 3; - c2 = LangString(args[0])[0]; - length = strlen(LangString(args[0])); - if ((c2 == 'l') && (strncmp(LangString(args[0]), "line", length) == 0)) { - MapInfoRemoveLine(master->map_info, index); - } - else if ((c2 == 's') && (strncmp(LangString(args[0]), "symbol", length) == 0)) { - MapInfoRemoveSymbol(master->map_info, index); - } - else if ((c2 == 't') && (strncmp(LangString(args[0]), "text", length) == 0)) { - MapInfoRemoveText(master->map_info, index); - } - else if ((c2 == 'a') && (strncmp(LangString(args[0]), "arc", length) == 0)) { - MapInfoRemoveArc(master->map_info, index); - } - UpdateMapInfoClients(master); - } - - /* - * scale - */ - else if ((c == 's') && (strncmp(LangString(args[2]), "scale", length) == 0)) { - double factor; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo scale factor", NULL); - return ZN_ERROR; - } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; + break; + /* + * scale + */ + case ZN_MI_SCALE: + { + double factor; + + if (argc != 4) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo scale factor"); + return ZN_ERROR; + } + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { + return ZN_ERROR; + } + if (Tcl_GetDoubleFromObj(interp, args[3], &factor) == ZN_ERROR) { + return ZN_ERROR; + } + MapInfoScale(master->map_info, factor); + UpdateMapInfoClients(master); } - if (Tcl_GetDouble(interp, args[3], &factor) == ZN_ERROR) { - return ZN_ERROR; + break; + /* + * translate + */ + case ZN_MI_TRANSLATE: + { + int x, y; + + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "mapInfo translate xAmount yAmount"); + return ZN_ERROR; + } + master = LookupMapInfoMaster(interp, Tcl_GetString(args[1])); + if (master == NULL) { + return ZN_ERROR; + } + if (Tcl_GetIntFromObj(interp, args[3], &x) == ZN_ERROR) { + return ZN_ERROR; + } + if (Tcl_GetIntFromObj(interp, args[4], &y) == ZN_ERROR) { + return ZN_ERROR; + } + MapInfoTranslate(master->map_info, x, y); + UpdateMapInfoClients(master); } - MapInfoScale(master->map_info, factor); - UpdateMapInfoClients(master); + break; } - /* - * translate - */ - else if ((c == 't') && (strncmp(LangString(args[2]), "translate", length) == 0)) { - int x, y; - - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" mapInfo translate xAmount yAmount", NULL); - return ZN_ERROR; - } - master = LookupMapInfoMaster(interp, LangString(args[1])); - if (master == NULL) { - return ZN_ERROR; - } - if (Tcl_GetInt(interp, args[3], &x) == ZN_ERROR) { - return ZN_ERROR; - } - if (Tcl_GetInt(interp, args[4], &y) == ZN_ERROR) { - return ZN_ERROR; - } - MapInfoTranslate(master->map_info, x, y); - UpdateMapInfoClients(master); - } - - else { - Tcl_AppendResult(interp, "invalid command \"", LangString(args[2]), - "\": must be create, delete, duplicate, add, count, " - "get, replace, remove, scale, translate", NULL); - return ZN_ERROR; - } - return TCL_OK; } @@ -5311,87 +5364,97 @@ MapInfoCmd(ClientData client_data, /* *---------------------------------------------------------------------- * - * VideomapCmd -- + * VideomapObjCmd -- * * *---------------------------------------------------------------------- */ int -VideomapCmd(ClientData client_data, - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - Arg *args) +VideomapObjCmd(ClientData client_data, + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + Tcl_Obj *CONST args[]) { ZnList ids; - char c; - int length; + int index; int *id_array, id_num, i; - char num_str[INTEGER_SPACE]; - + Tcl_Obj *l; + static char *sub_cmd_strings[] = { + "ids", "load", NULL + }; + enum sub_cmds { + ZN_V_IDS, ZN_V_LOAD + }; + if (!inited) { InitZinc(interp); } if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - LangString(args[0]), " filename\"", NULL); + Tcl_WrongNumArgs(interp, 1, args, "?subCmd? filename $args?"); return ZN_ERROR; } - c = LangString(args[1])[0]; - length = strlen(LangString(args[1])); - - /* - * ids - */ - if ((c == 'i') && (strncmp(LangString(args[1]), "ids", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - " ids filename\"", NULL); - return ZN_ERROR; - } - ids = MapInfoVideomapIds(LangString(args[2])); - if (ids == NULL) { - Tcl_AppendResult(interp, "unable to look at videomap file \"", - LangString(args[2]), "\"", NULL); - return ZN_ERROR; - } - id_array = (int *) ZnListArray(ids); - id_num = ZnListSize(ids); - for (i = 0; i < id_num; i++) { - sprintf(num_str, "%d", id_array[i]); - Tcl_AppendElement(interp, num_str); - } - ZnListFree(ids); + if (Tcl_GetIndexFromObj(interp, args[1], sub_cmd_strings, + "subCmd", 0, &index) != ZN_OK) { + return ZN_ERROR; } - /* - * load - */ - else if ((c == 'l') && (strncmp(LangString(args[1]), "load", length) == 0)) { - MapInfoId map_info; - int index; - - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", LangString(args[0]), - "\" load filename index mapInfo", NULL); - return ZN_ERROR; - } - if (Tcl_GetInt(interp, args[3], &index) == ZN_ERROR) { - return ZN_ERROR; - } - if (index < 0) { - index = 0; - } - if (ZnCreateMapInfo(interp, LangString(args[4]), &map_info) == ZN_ERROR) { - return ZN_ERROR; + switch((enum sub_cmds) index) { + /* + * ids + */ + case ZN_V_IDS: + { + if (argc != 3) { + Tcl_WrongNumArgs(interp, 1, args,"ids filename"); + return ZN_ERROR; + } + ids = MapInfoVideomapIds(Tcl_GetString(args[2])); + if (ids == NULL) { + Tcl_AppendResult(interp, "unable to look at videomap file \"", + Tcl_GetString(args[2]), "\"", NULL); + return ZN_ERROR; + } + id_array = (int *) ZnListArray(ids); + id_num = ZnListSize(ids); + l = Tcl_GetObjResult(interp); + for (i = 0; i < id_num; i++) { + Tcl_ListObjAppendElement(interp, l, Tcl_NewIntObj(id_array[i])); + } + ZnListFree(ids); } - if (MapInfoGetVideomap(map_info, LangString(args[2]), index) == ZN_ERROR) { - Tcl_AppendResult(interp, "unable to load videomap file \"", LangString(args[2]), ":", - LangString(args[3]), "\"", NULL); - return ZN_ERROR; + break; + /* + * load + */ + case ZN_V_LOAD: + { + MapInfoId map_info; + int index; + + if (argc != 5) { + Tcl_WrongNumArgs(interp, 1, args, "load filename index mapInfo"); + return ZN_ERROR; + } + if (Tcl_GetIntFromObj(interp, args[3], &index) == ZN_ERROR) { + return ZN_ERROR; + } + if (index < 0) { + index = 0; + } + if (ZnCreateMapInfo(interp, Tcl_GetString(args[4]), &map_info) == ZN_ERROR) { + return ZN_ERROR; + } + if (MapInfoGetVideomap(map_info, Tcl_GetString(args[2]), index) == ZN_ERROR) { + Tcl_AppendResult(interp, "unable to load videomap file \"", + Tcl_GetString(args[2]), ":", + Tcl_GetString(args[3]), "\"", NULL); + return ZN_ERROR; + } + ZnUpdateMapInfoClients(map_info); } - ZnUpdateMapInfoClients(map_info); + break; } return TCL_OK; @@ -5474,12 +5537,12 @@ Tkzinc_Init(Tcl_Interp *interp) /* Used for error reporting. */ return ZN_ERROR; } - Tcl_CreateCommand(interp, "zinc", ZincCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "mapinfo", MapInfoCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "videomap", VideomapCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "zinc", ZincObjCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "mapinfo", MapInfoObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "videomap", VideomapObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } diff --git a/generic/tkZinc.h b/generic/tkZinc.h index 6aee547..5bc84e1 100644 --- a/generic/tkZinc.h +++ b/generic/tkZinc.h @@ -35,10 +35,24 @@ #include "List.h" #include "MapInfo.h" - -int ZnItemsWithTagOrId(WidgetInfo *wi, char *tag_or_id, Item *item, +#ifdef PTK +Tcl_Obj *NewLongObj(long val); +Tcl_Obj *NewBooleanObj(ZnBool val); +Tcl_Obj *NewDoubleObj(ZnReal val); +#else +# define NewLongObj Tcl_NewLongObj +# define NewBooleanObj Tcl_NewBooleanObj +# define NewDoubleObj Tcl_NewDoubleObj +#endif +Tcl_Obj *NewStringObj(char *val); +void SetStringObj(Tcl_Obj *o, char *val); +#if 1 +char *Tcl_GetString(Tcl_Obj *obj); +#endif + +int ZnItemsWithTagOrId(WidgetInfo *wi, Tcl_Obj *tag_or_id, Item *item, Item **item_list); -int ParseCoordList(WidgetInfo *wi, Arg arg, ZnPoint **pts, +int ParseCoordList(WidgetInfo *wi, Tcl_Obj *arg, ZnPoint **pts, int *num_pts); void DoItem(Tcl_Interp *interp, Item item, int part, Tk_Uid tag_uid); void ZnNeedRedisplay(WidgetInfo *wi); diff --git a/patchlvl.h b/patchlvl.h index 1904655..e4c79ee 100644 --- a/patchlvl.h +++ b/patchlvl.h @@ -11,6 +11,6 @@ #ifndef ZINCVERSION #define ZINCVER 3 #define ZINCREV 1 -#define ZINCPLVL 15 -#define ZINCVERSION "zinc-version-3115" +#define ZINCPLVL 16 +#define ZINCVERSION "zinc-version-3116" #endif -- cgit v1.1