/* * t4vertexrep.cpp -- * * This file contains the implementation of the class T4Vertex * which is defined in .../include/t4graphrep.h. * * Authors: Jacob Levy and Jean-Claude Wippler. * jyl@best.com jcw@equi4.com * * Copyright (c) 2000-2003, JYL Software Inc. * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE, EVEN IF * JYL SOFTWARE INC. IS MADE AWARE OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "t4graphrep.h" /* * These functions implement the T4Vertex GenObject extension data type: */ static void T4VertexCleanup(Tcl_Interp *interp, void *data, struct GO_Extension *extPtr); static int T4VertexInvoke(Tcl_Interp *interp, char *name, void *data, int objc, Tcl_Obj *CONST objv[], struct GO_Extension *extPtr); /* * The T4Vertex GenObject extension data structure itself: */ static struct GO_Extension vertexExtension = { (char *) "T4Vertex", 9, T4VertexCleanup, T4VertexInvoke, NULL, NULL }; /* * This pointer gives global access to the T4Vertex GenObject extension: */ struct GO_Extension *vertexExt = &vertexExtension; /* * The cleanup implementation: */ static void T4VertexCleanup(Tcl_Interp *interp, void *data, struct GO_Extension *extPtr) { T4Vertex *vp = (T4Vertex *) data; vp->CleanupInternal(interp); delete vp; } /* * The various sub-commands for "t4graph::vertex": */ static CONST84 char *subCommands[] = { (char *) "kind", (char *) "get", (char *) "set", (char *) "setnode", (char *) "rank", (char *) "detach", (char *) "dispose", (char *) "isvalid", (char *) "isdetached", (char *) "type", (char *) "name", (char *) "rename", (char *) "node", (char *) "root", (char *) "storage", (char *) "move", (char *) "next", (char *) "prev", (char *) "call", (char *) "id", (char *) "userdata", (char *) NULL }; typedef enum FSubCommands { FKind = 0, FGet, FSet, FSetNode, FRank, FDetach, FDispose, FIsValid, FIsDetached, FType, FName, FRename, FNode, FRoot, FStorage, FMove, FNext, FPrev, FCall, FId, FUserData } FSubCommands; /* * T4VertexInvoke -- * * This procedure is invoked when a T4Vertex object is used as a command. * * Results: * A standard Tcl result. The interpreter result may contain various * results depending on the sub-command selected. * * Side effects: * Whatever the selected sub-command does. */ static int T4VertexInvoke(Tcl_Interp *interp, char *name, void *data, int objc, Tcl_Obj *CONST objv[], GO_Extension *extPtr) { T4Vertex *fp; FSubCommands index; char buffer[512]; /* * There must be at least two arguments. */ if (objc < 2) { sprintf(buffer, "%s cmd ?arg ...?", name); Tcl_WrongNumArgs(interp, 0, NULL, buffer); return TCL_ERROR; } /* * The client data is the T4Vertex for this instance. */ fp = (T4Vertex *) data; /* * Figure out what operation was requested. There is no default -- * the caller must specify an operation. */ if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **) subCommands, (char *) "cmd", 0, (int *) &index) != TCL_OK) { return TCL_ERROR; } /* * Check that the vertex is valid. Only return an error if the vertex * is invalid and the operation requested is not "isvalid". */ if ((fp == NULL) || ((index != FIsValid) && !fp->IsValid())) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), fp->GetName(), ": invalid vertex", NULL); return TCL_ERROR; } objc -= 2; objv += 2; /* * Invoke the requested operation: */ switch (index) { case FKind: Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) "vertex", -1); return TCL_OK; case FGet: return fp->Get(interp, objc, objv); case FSet: return fp->Set(interp, objc, objv); case FSetNode: return fp->SetNode(interp, objc, objv); case FRank: return fp->Rank(interp, objc, objv); case FDetach: return fp->Detach(interp, objc, objv); case FDispose: return fp->Dispose(interp, objc, objv); case FIsValid: return fp->IsValid(interp, objc, objv); case FIsDetached: return fp->IsDetached(interp, objc, objv); case FType: return fp->Type(interp, objc, objv); case FName: return fp->Name(interp, objc, objv); case FRename: return fp->Rename(interp, objc, objv); case FNode: return fp->Node(interp, objc, objv); case FRoot: return fp->Root(interp, objc, objv); case FStorage: Tcl_SetStringObj(Tcl_GetObjResult(interp), fp->GetStorage()->GetName(), -1); return TCL_OK; case FMove: return fp->Move(interp, objc, objv); case FNext: return fp->Next(interp, objc, objv); case FPrev: return fp->Prev(interp, objc, objv); case FCall: return fp->Call(interp, objc+1, objv-1); case FId: return fp->Id(interp, objc, objv); case FUserData: return fp->UserData(interp, objc, objv); default: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "T4VertexInvoke: unreachable code!", (char *) NULL); return TCL_ERROR; } } /* * The various (optional) type selector values for the T4Vertex::Set * operation. */ static char *typeSelectors[] = { (char *) "-int", (char *) "-double", (char *) "-string", (char *) "-node", (char *) "-binary", NULL }; typedef enum TSelector { TSInteger = 0, TSDouble, TSString, TSNode, TSBinary } TSelector; /* * Constructor: */ T4Vertex::T4Vertex(e4_Vertex ff, T4Storage *ss) { f = ff; s = ss; } /* * Destructor: */ T4Vertex::~T4Vertex() { Tcl_Obj *sobj = GetTclObject(); f = invalidVertex; s = NULL; } /* * Cleanup done before destructor: */ void T4Vertex::CleanupInternal(Tcl_Interp *interp) { e4_VertexUniqueID vuid; if (!f.IsValid() || !f.GetUniqueID(vuid) || (s == NULL)) { return; } s->RemoveVertex(interp, vuid); } /* * ExternalizeVertex -- * * This procedure gives the caller access to the underlying * e4_Vertex object. * * Results: * None. * * Side effects: * The caller can now manipulate the underlying e4_Vertex * object directly. */ void T4Vertex::ExternalizeVertex(e4_Vertex &ff) { ff = f; } /* **************************************************************************** * * The following methods implement Tcl sub-commands on a T4Vertex * object. * **************************************************************************** */ /* * Get -- * * Return the value of this vertex as a Tcl object. * * Results: * A standard Tcl result. Upon success, the interpreter result * contains (an object representing) the value of this vertex. * * Side effects: * May export more T4Graph objects (a T4Node) to Tcl. */ int T4Vertex::Get(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { T4Node *np; int ii; double ff; const void *bytes; int nbytes; const char *ss; e4_Node nn; e4_NodeUniqueID nuid; Tcl_Obj *res; /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex get"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * If there is a cached value, use that as the result. */ res = s->GetVertexStoredObject(interp, f); if (res != NULL) { Tcl_SetObjResult(interp, res); return TCL_OK; } /* * Depending on the vertex type, get the value using different * access methods. */ switch (f.Type()) { case E4_VTBINARY: if (!f.Get(bytes, nbytes)) { Tcl_AppendResult(interp, "cannot retrieve value of vertex ", GetName(), NULL); return TCL_ERROR; } Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) bytes, nbytes); return TCL_OK; case E4_VTINT: if (!f.Get(ii)) { Tcl_AppendResult(interp, "cannot retrieve value of vertex ", GetName(), NULL); return TCL_ERROR; } Tcl_SetIntObj(Tcl_GetObjResult(interp), ii); break; case E4_VTDOUBLE: if (!f.Get(ff)) { Tcl_AppendResult(interp, "cannot retrieve value of vertex ", GetName(), NULL); return TCL_ERROR; } Tcl_SetDoubleObj(Tcl_GetObjResult(interp), (double) ff); break; case E4_VTSTRING: if (!f.Get(ss)) { Tcl_AppendResult(interp, "cannot retrieve value of vertex ", GetName(), NULL); return TCL_ERROR; } Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) ss, -1); break; case E4_VTNODE: if (!f.Get(nn)) { Tcl_AppendResult(interp, "cannot retrieve value of vertex ", GetName(), NULL); return TCL_ERROR; } (void) nn.GetUniqueID(nuid); np = s->GetNodeById(interp, nuid); if (np == NULL) { np = new T4Node(nn, s); s->StoreNode(interp, np, nuid); } /* * Ensure this node's internal representation has a Tcl_Obj * * associated with it, and set the interpreter result to that. */ res = np->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(nodeExt, np, interp); np->SetTclObject(res); } Tcl_SetObjResult(interp, res); break; default: Tcl_AppendResult(interp, "t4graph::vertex storage get -- ", " unreachable code!", NULL); return TCL_ERROR; } /* * Cache the Tcl object representing this value. */ s->SetVertexStoredObject(interp, f, Tcl_GetObjResult(interp)); return TCL_OK; } /* * SetAs -- * * Sets the value of this vertex to the supplied value converted * to the requested type. * * Results: * A standard Tcl result. * * Side effects: * May set the value of this vertex. T4Graph objects that were * previously accessible through this vertex may become invalid. */ int T4Vertex::SetAs(Tcl_Interp *interp, Tcl_Obj *val, int rt) { TSelector reqtype = (TSelector) rt; int i; double d; char *sv; int len; T4Node *np; e4_Node nn; bool cachevalue = true; switch (reqtype) { case TSInteger: if (Tcl_GetIntFromObj(interp, val, &i) == TCL_ERROR) { return TCL_ERROR; } if (!f.Set(i)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } break; case TSDouble: if (Tcl_GetDoubleFromObj(interp, val, &d) == TCL_ERROR) { return TCL_ERROR; } if (!f.Set(d)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } break; case TSString: sv = Tcl_GetString(val); if (!f.Set(sv)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } break; case TSNode: np = (T4Node *) GO_GetInternalRep(val, nodeExt); if (np == NULL) { Tcl_AppendResult(interp, "could not retrieve node named ", Tcl_GetString(val), NULL); return TCL_ERROR; } np->ExternalizeNode(nn); if (!nn.IsValid()) { Tcl_AppendResult(interp, "node name ", Tcl_GetString(val), " is invalid", NULL); return TCL_ERROR; } if (!f.Set(nn)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } /* * Cannot cache nodes as this would prevent their vertices * from becoming detached if the cache is the only reference. */ cachevalue = false; break; case TSBinary: sv = Tcl_GetStringFromObj(val, &len); if (!f.Set((void *) sv, len)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } break; default: Tcl_ResetResult(interp); Tcl_AppendResult(interp, "invalid requested type for assignment to ", "vertex ", GetName(), NULL); return TCL_ERROR; } /* * Cache the new value for this vertex. */ if (cachevalue) { s->SetVertexStoredObject(interp, f, val); } Tcl_ResetResult(interp); return TCL_OK; } /* * Set -- * * Sets the value of this vertex to the value supplied as argument. * * Results: * A standard Tcl result. * * Side effects: * May set the value of this vertex. T4Graph objects that were * previously accessible through this vertex may become invalid. */ int T4Vertex::Set(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int i; double d; T4Node *np; e4_Node nn; TSelector index; bool cachevalue = true; /* * Expecting one argument. */ if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex set newval ?typesel?"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * If a specific value type is requested, handle it specially by * attempting to convert the supplied value to the requested type * before assigning it to the vertex. */ if (objc == 2) { if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **) typeSelectors, (char *) "typeselector", 0, (int *) &index) != TCL_OK) { return TCL_ERROR; } return SetAs(interp, objv[0], (int) index); } /* * See if it's a node -- if so, use that as the value. */ np = (T4Node *) GO_GetInternalRep(objv[0], nodeExt); if (np != NULL) { np->ExternalizeNode(nn); if (nn.IsValid()) { if (!f.Set(nn)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } /* * Cannot cache nodes as this would prevent their vertices from * becoming detached if the cache held the only reference. */ Tcl_ResetResult(interp); return TCL_OK; } } /* * See if we can get an integer. */ if (Tcl_GetIntFromObj(interp, objv[0], &i) == TCL_OK) { if (!f.Set(i)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } s->SetVertexStoredObject(interp, f, objv[0]); Tcl_ResetResult(interp); return TCL_OK; } /* * Try to get a double value out of the given object. */ if (Tcl_GetDoubleFromObj(interp, objv[0], &d) == TCL_OK) { if (!f.Set(d)) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } s->SetVertexStoredObject(interp, f, objv[0]); Tcl_ResetResult(interp); return TCL_OK; } /* * Last resort - set the value as a string. */ if (!f.Set(Tcl_GetString(objv[0]))) { Tcl_AppendResult(interp, "could not set value of vertex ", GetName(), NULL); return TCL_ERROR; } s->SetVertexStoredObject(interp, f, objv[0]); Tcl_ResetResult(interp); return TCL_OK; } /* * SetNode -- * * Set the value of this vertex to a new node. Also export the * new node to Tcl. * * Results: * A standard Tcl result. If successful, the interpreter result * contains the name by which the new node is known in Tcl. * * Side effects: * May create a new node. May export a new T4Node object to Tcl. * T4Graph objects that were previously accessible through this * vertex may become invalid. */ int T4Vertex::SetNode(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_Node n; e4_NodeUniqueID nuid; T4Node *np; Tcl_Obj *res; /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex setnode"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Attempt to set the vertex to a new node. */ if (!f.SetNode(n)) { Tcl_AppendResult(interp, "could not set vertex ", GetName(), " to a new node", NULL); return TCL_ERROR; } /* * Create the new T4Node object and export it to Tcl. */ (void) n.GetUniqueID(nuid); np = new T4Node(n, s); s->StoreNode(interp, np, nuid); res = np->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(nodeExt, np, interp); np->SetTclObject(res); } Tcl_SetObjResult(interp, res); return TCL_OK; } /* * Rank -- * * Return the rank of this vertex in its containing node. * * Results: * A standard Tcl result. Upon success, the interpreter * result contains an integer, the rank of this vertex in * its containing node. * * Side effects: * None. */ int T4Vertex::Rank(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex rank"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Set the interpreter result to contain the rank. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), f.Rank()); return TCL_OK; } /* * Detach -- * * Detach this vertex from its containing node. * * Results: * A standard Tcl result. * * Side effects: * The node that used to contain this vertex no longer contains it. */ int T4Vertex::Detach(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex detach"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Attempt to detach this vertex. */ if (!f.Detach()) { Tcl_AppendResult(interp, "could not detach vertex ", GetName(), NULL); return TCL_ERROR; } /* * Do not leave remnant results in the interpreter. */ Tcl_ResetResult(interp); /* * Clear the stored information for this vertex, because since it is * now detached it no longer has a containing node and it cannot be * used as stored procedure. */ s->ClearVertexStoredState(interp, f); return TCL_OK; } /* * Dispose -- * * Disposes of the Tcl command for this vertex. * * Results: * A standard Tcl result. This is a noop that is supported for * a few more releases, after which it'll be removed. * * Side effects: * None. */ int T4Vertex::Dispose(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Returns success. */ return TCL_OK; } /* * IsValid -- * * Return a boolean indicating whether this vertex is valid. * * Results: * A standard Tcl result. Upon success, the interpreter result * contains a boolean value indicating whether this vertex is valid. * * Side effects: * None. */ int T4Vertex::IsValid(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex isvalid"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0); } else { Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1); } return TCL_OK; } /* * IsDetached -- * * Return a boolean indicating whether this vertex is detached. * * Results: * A standard Tcl result. Upon success, the interpreter result * contains a boolean value indicating whether this vertex is detached. * * Side effects: * None. */ int T4Vertex::IsDetached(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex isdetached"); return TCL_ERROR; } /* * Check that the vertex is detached. */ if (f.IsDetached()) { Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1); } else { Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0); } return TCL_OK; } /* * Type -- * * Returns a string representing the type of the value stored * in this vertex. * * Results: * A standard Tcl result. Upon success, the interpreter result * contains a string representing the type of the value stored * in this vertex. * * Side effects: * None. */ int T4Vertex::Type(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int userData = 0; /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex type"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } switch (f.Type()) { case E4_VTUNKNOWN: Tcl_AppendResult(interp, "could not retrieve type of vertex ", GetName(), NULL); return TCL_ERROR; case E4_VTNODE: Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) "node", -1); return TCL_OK; case E4_VTINT: Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) "int", -1); return TCL_OK; case E4_VTDOUBLE: Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) "double", -1); return TCL_OK; case E4_VTSTRING: Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) "string", -1); return TCL_OK; case E4_VTBINARY: Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) "binary", -1); return TCL_OK; default: Tcl_AppendResult(interp, "$vertex type -- unreachable code!", NULL); return TCL_ERROR; } } /* * Name -- * * Returns the name of this vertex in its containing node. * * Results: * A standard Tcl result. Upon success, the interpreter result * contains a string, the name of this vertex in its containing * node. * * Side effects: * None. */ int T4Vertex::Name(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex name"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Set the interpreter result to the name of this vertex. */ Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) f.Name(), -1); return TCL_OK; } /* * Rename -- * * Rename this vertex within its containing node to the value of * the argument. * * Results: * A standard Tcl result. * * Side effects: * The vertex is renamed in the persistent storage. */ int T4Vertex::Rename(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { /* * Expecting one argument. */ if (objc != 1) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex rename newname"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Attempt to rename the vertex. */ if (!f.Rename(Tcl_GetString(objv[0]))) { Tcl_AppendResult(interp, "could not rename vertex ", GetName(), NULL); return TCL_ERROR; } return TCL_OK; } /* * Node -- * * Set the interpreter result to the name assigned to the node * containing this vertex. * * Results: * A standard Tcl result. Upon success, the interpreter result * contains a string, the name assigned to the node containing * this vertex. * * Side effects: * May export a T4Node object to Tcl. */ int T4Vertex::Node(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_Node n; e4_NodeUniqueID nuid; T4Node *np; Tcl_Obj *res; /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex node"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Attempt to retrieve the node containing this vertex. */ if ((!f.GetNode(n)) || (!n.IsValid())) { Tcl_AppendResult(interp, "could not get containing node for vertex ", GetName(), NULL); return TCL_ERROR; } /* * See if we have exported this node to Tcl before. If not, create * a new T4Node and make it ready to be exported. */ (void) n.GetUniqueID(nuid); np = s->GetNodeById(interp, nuid); if (np == NULL) { np = new T4Node(n, s); s->StoreNode(interp, np, nuid); } /* * Ensure there is a Tcl_Obj * associated with this node's internal * representation. */ res = np->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(nodeExt, np, interp); np->SetTclObject(res); } Tcl_SetObjResult(interp, res); return TCL_OK; } /* * Root -- * * Retrieves the root node of the storage containing this vertex. * * Results: * A standard Tcl result. Upon success, the interpreter result contains * a string, the name by which the root node of this storage is known * to Tcl. * * Side effects: * A node may be exported to Tcl. */ int T4Vertex::Root(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_Node rn; e4_NodeUniqueID nuid; T4Node *rnp; Tcl_Obj *res; /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex root"); return TCL_ERROR; } /* * Check that this node is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Retrieve the root node. */ if ((!f.GetRootNode(rn)) || (!rn.IsValid())) { Tcl_AppendResult(interp, "could not retrieve root node from vertex ", GetName(), NULL); return TCL_ERROR; } /* * See if we have exported this node already. If not, then export it. */ (void) rn.GetUniqueID(nuid); rnp = s->GetNodeById(interp, nuid); if (rnp == NULL) { rnp = new T4Node(rn, s); s->StoreNode(interp, rnp, nuid); } res = rnp->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(nodeExt, rnp, interp); rnp->SetTclObject(res); } Tcl_SetObjResult(interp, res); return TCL_OK; } /* * Move -- * * Move a given vertex into the node containing this vertex at the * position determined by the given insertOrder and offset. If * insertOrder is "before" or "at", offset is subtracted from the * rank of this vertex plus one to get the rank at which to insert * the given vertex. If insertOrder is "after", offset is added to * the rank of this vertex to get the rank at which to insert the * vertex. If insertOrder is "first" or "last", the vertex is inserted * as the first or last vertex in the node containing this vertex; in * these cases offset is ignored. * * Results: * A standard Tcl result. * * Side effects: * The vertex is moved in the persisent storage. */ int T4Vertex::Move(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_Vertex of; T4Vertex *ofp; int offset; e4_InsertOrder io; /* * Expecting three arguments. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex move vertex insertorder offset"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Try to extract the offset: */ if (Tcl_GetIntFromObj(interp, objv[2], &offset) == TCL_ERROR) { return TCL_ERROR; } /* * Try to extract the insertOrder: */ if (T4Graph_ParseInsertOrder(interp, objv[1], &io) == TCL_ERROR) { return TCL_ERROR; } /* * Try to locate the other vertex. */ ofp = (T4Vertex *) GO_GetInternalRep(objv[0], vertexExt); if (ofp == NULL) { /* * The other vertex is not known in Tcl. We cannot move it. */ Tcl_AppendResult(interp, "unknown vertex ", Tcl_GetString(objv[0]), NULL); return TCL_ERROR; } /* * Obtain the e4_Vertex for the vertex to be moved. */ ofp->ExternalizeVertex(of); /* * Attempt the move. */ if (!f.MoveVertex(of, io, offset)) { Tcl_AppendResult(interp, "could not move vertex ", Tcl_GetString(objv[0]), " relative to vertex ", GetName(), NULL); return TCL_ERROR; } return TCL_OK; } /* * Next -- * * Return the next vertex after this one in the node containing * this vertex. * * Results: * A standard Tcl result. Upon success the interpreter result * contains the name by which the next vertex is known in Tcl or * the empty string if this vertex is not followed by any vertices. * * Side effects: * May export a vertex to Tcl. */ int T4Vertex::Next(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_Vertex vv; e4_VertexUniqueID vuid; T4Vertex *nv; int num = 1; Tcl_Obj *res; /* * Expecting zero or one arguments. */ if ((objc != 0) && (objc != 1)) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex next ?num?"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * If there is one argument, it is the number of vertices to go * forward. */ if (objc == 1) { if (Tcl_GetIntFromObj(interp, objv[0], &num) == TCL_ERROR) { return TCL_ERROR; } } /* * Attempt to retrieve the next vertex. */ if ((!f.Next(num, vv)) || (!vv.IsValid())) { Tcl_SetStringObj(Tcl_GetObjResult(interp), "", -1); return TCL_OK; } /* * See if we have exported this vertex to Tcl before. If not, create * a new T4Vertex and make it ready to be exported. */ (void) vv.GetUniqueID(vuid); nv = s->GetVertexById(interp, vuid); if (nv == NULL) { nv = new T4Vertex(vv, s); s->StoreVertex(interp, nv, vuid); } /* * Ensure that this vertex's internal representation has an * associated Tcl_Obj *. */ res = nv->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(vertexExt, nv, interp); nv->SetTclObject(res); } Tcl_SetObjResult(interp, res); return TCL_OK; } /* * Prev -- * * Return the previous vertex after this one in the node containing * this vertex. * * Results: * A standard Tcl result. Upon success the interpreter result * contains the name by which the next vertex is known in Tcl or * the empty string if this vertex is not preceded by any vertices. * * Side effects: * May export a vertex to Tcl. */ int T4Vertex::Prev(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_Vertex vv; e4_VertexUniqueID vuid; T4Vertex *nv; int num = 1; Tcl_Obj *res; /* * Expecting zero or one arguments. */ if ((objc != 0) && (objc != 1)) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex prev ?num?"); return TCL_ERROR; } /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * If there is one argument, it is the number of vertices to go * backwards. */ if (objc == 1) { if (Tcl_GetIntFromObj(interp, objv[0], &num) == TCL_ERROR) { return TCL_ERROR; } } /* * Attempt to retrieve the next vertex. */ if ((!f.Prev(num, vv)) || (!vv.IsValid())) { Tcl_SetStringObj(Tcl_GetObjResult(interp), "", -1); return TCL_OK; } /* * See if we have exported this vertex to Tcl before. If not, create * a new T4Vertex and make it ready to be exported. */ (void) vv.GetUniqueID(vuid); nv = s->GetVertexById(interp, vuid); if (nv == NULL) { nv = new T4Vertex(vv, s); s->StoreVertex(interp, nv, vuid); } /* * Ensure that this vertex's internal representation has an * associated Tcl_Obj *. */ res = nv->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(vertexExt, nv, interp); nv->SetTclObject(res); } Tcl_SetObjResult(interp, res); return TCL_OK; } /* * Call -- * * Call the value of this vertex (which should be a string) as * a Tcl command. * * Results: * A standard Tcl result. * * Side effects: * Whatever the command does. */ int T4Vertex::Call(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int id, len, ret; T4CmdInfo *cmdInfo; T4Node *np; e4_Node n; e4_NodeUniqueID nuid; e4_VertexUniqueID vuid; char *storedprocname; int i; Tcl_Obj *res; Tcl_Obj *stackobjv[32]; Tcl_Obj **nobjv = stackobjv; /* * There are no limits on what arguments may be given. */ /* * Check that the vertex is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "vertex ", GetName(), " is invalid", NULL); return TCL_ERROR; } /* * Make sure that the value of this vertex is a string. If not, we can * not use it as the body of a stored procedure. */ if (f.Type() != E4_VTSTRING) { Tcl_AppendResult(interp, "vertex ", GetName(), " cannot be used as ", "a stored procedure", NULL); return TCL_ERROR; } /* * Check that the vertex can be used as a stored procedure. * We need the T4Node representing the node containing this * vertex so that we can pass its name to the stored procedure * as the value of its "this" argument. * * NOTE: This means that detached vertices cannot be used as * stored procedures. */ if (f.IsDetached() || (!f.GetNode(n)) || (!n.IsValid())) { Tcl_AppendResult(interp, "vertex ", f.Name(), " cannot be used ", "as a stored procedure", NULL); return TCL_ERROR; } /* * See if the stored command procedure is already exported to Tcl. If * not, define the stored command procedure. */ cmdInfo = s->GetVertexStoredCmdInfo(interp, f); if (cmdInfo == NULL) { /* * Ensure the existence of the namespace that contains the * commands for the stored procedures, and compute the name * for the stored procedure. */ (void) f.GetUniqueID(vuid); id = vuid.GetUniqueID(); len = 128 + s->GetNameLen(); storedprocname = Tcl_Alloc(len); sprintf(storedprocname, "namespace eval ::tgraph::%s {}", s->GetName()); (void) Tcl_Eval(interp, storedprocname); Tcl_ResetResult(interp); /* * Create the stored procedure. */ sprintf(storedprocname, "::tgraph::%s::storedproc%d", s->GetName(), id); cmdInfo = T4Graph_DefineStoredProcedure(interp, storedprocname, s, f); if (cmdInfo == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "cannot invoke stored procedure ", f.Name(), NULL); Tcl_Free(storedprocname); return TCL_ERROR; } } /* * Check that the node was already exported to Tcl, and if not, * export it now. */ (void) n.GetUniqueID(nuid); np = s->GetNodeById(interp, nuid); if (np == NULL) { np = new T4Node(n, s); s->StoreNode(interp, np, nuid); } /* * Ensure that the internal representation for the node * containing this vertex an associated Tcl_Obj *. */ res = np->GetTclObject(); if (res == NULL) { res = GO_MakeGenObject(vertexExt, np, interp); np->SetTclObject(res); } if (res == NULL) { return TCL_ERROR; } if (objc > 31) { nobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) * (objc + 1)); } nobjv[0] = res; for (i = 0; i < objc; i++) { nobjv[i+1] = objv[i]; } ret = (cmdInfo->objProc)(cmdInfo->objClientData, interp, objc+1, nobjv); if (nobjv != stackobjv) { Tcl_Free((char *) nobjv); } return ret; } /* * Id -- * * Returns an identifier that is unique among all vertices in * the storage containing this vertex. * * Results: * A standard Tcl result. Upon successful completion, the interpreter * result contains the integer ID. * * Side effects: * None. */ int T4Vertex::Id(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { e4_VertexUniqueID vuid; /* * Expecting zero arguments. */ if (objc != 0) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex id"); return TCL_ERROR; } /* * Check that the vertex object is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "invalid vertex ", GetName(), NULL); return TCL_ERROR; } (void) f.GetUniqueID(vuid); Tcl_SetIntObj(Tcl_GetObjResult(interp), vuid.GetUniqueID()); return TCL_OK; } /* * UserData -- * * Sets or returns the user data associated with this vertex. * * Results: * A standard Tcl result. When retrieving the user data, upon * success, the interpreter result contains an integer representing * the stored user data. * * Side effects: * May modify the user data associated with this vertex in its * storage. */ int T4Vertex::UserData(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int i; /* * Expecting zero or one arguments. */ if ((objc != 0) && (objc != 1)) { Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$vertex userdata ?newvalue?"); return TCL_ERROR; } /* * Check that the vertex object is valid. */ if (!f.IsValid()) { Tcl_AppendResult(interp, "invalid vertex ", GetName(), NULL); return TCL_ERROR; } /* * If one argument is given, it must be an integer (the new value). * Attempt to extract the new value. */ if (objc == 1) { if (Tcl_GetIntFromObj(interp, objv[0], &i) == TCL_ERROR) { return TCL_ERROR; } if (!f.SetUserData(i)) { Tcl_AppendResult(interp, "cannot set user data for vertex ", GetName(), NULL); return TCL_ERROR; } Tcl_ResetResult(interp); return TCL_OK; } /* * No arguments given, so we want to retrieve the value. */ if (!f.GetUserData(i)) { Tcl_AppendResult(interp, "cannot retrieve user data for vertex ", GetName(), NULL); return TCL_ERROR; } /* * Set the interpreter result to the retrieved value. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), i); return TCL_OK; } /* * IsValid -- * * This operation is only intended for use by the invoker function. */ bool T4Vertex::IsValid() const { return f.IsValid(); }