/*
 * t4storagerep.cpp --
 *
 *	This file contains the implementation of the class T4Storage
 *	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 are declared for Tcl script callbacks.
 */

static void
NodeAddCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;
    e4_Node n = (e4_Node) r;

    c->storage->AddNodeCallback(c->interp, n);
}

static void
VertexAddCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;
    e4_Vertex v = (e4_Vertex) r;

    c->storage->AddVertexCallback(c->interp, v);
}

static void
NodeDetCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;
    e4_Node n = (e4_Node) r;

    c->storage->DetNodeCallback(c->interp, n);
}

static void
VertexDetCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;
    e4_Vertex v = (e4_Vertex) r;

    c->storage->DetVertexCallback(c->interp, v);
}

static void
NodeAttCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;
    e4_Node n = (e4_Node) r;

    c->storage->AttNodeCallback(c->interp, n);
}

static void
VertexAttCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;
    e4_Vertex v = (e4_Vertex) r;

    c->storage->AttVertexCallback(c->interp, v);
}

static void
VertexModCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4StoragePerInterp *spp = (T4StoragePerInterp *) clientData;
    e4_Vertex v = (e4_Vertex) r;
    e4_ModVertexEventReason cbr = (e4_ModVertexEventReason) (int) csdata;

    spp->storage->ModVertexCallback(spp, v, cbr);
}

static void
NodeModCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4StoragePerInterp *spp = (T4StoragePerInterp *) clientData;
    e4_Node n = (e4_Node) r;
    e4_ModNodeEventReason cbr = (e4_ModNodeEventReason) (int) csdata;

    spp->storage->ModNodeCallback(spp, n, cbr);
}

static void
StorageChangeCallbackFn(void *clientData, const e4_RefCount &r, void *csdata)
{
    T4CallbackRecord *c = (T4CallbackRecord *) clientData;

    c->storage->ChangeStorageCallback(c->interp);
}

/*
 * Constructor:
 */

T4Storage::T4Storage(e4_Storage ss, char *fn, char *dn)
{
    /*
     * So far this storage is not in any interpreter.
     */

    spip = NULL;

    /*
     * Copy the given e4_Storage object into our cache.
     */

    s = ss;

    /*
     * Save the driver and file names.
     */

    fname = strdup(fn);
    drivername = strdup(dn);
}

/*
 * Destructor:
 */

T4Storage::~T4Storage()
{
    while (spip != NULL) {
	this->InternalClose(spip->interp, false);
    }

    /*
     * Unregister this storage in the global storage registry.
     */

    if (s.IsValid()) {
	T4Graph_UnregisterStorage(s.GetTemporaryUID());
    }

    /*
     * Free the allocated storage:
     */

    s = invalidStorage;

    /*
     * Discard the strings for the driver and file names.
     */

    free(fname);
    free(drivername);
}

/*
 * RemoveAllCallbacks --
 *
 *	Clean up the callback facility.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	All callbacks registered on this storage are cancelled.
 */

void
T4Storage::RemoveAllCallbacks(T4StoragePerInterp *spp)
{
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *o;

    /*
     * Remove the callbacks that are installed for T4Graph maintainence:
     */

    s.DeleteCallback(E4_ECMODNODE, NodeModCallbackFn, (void *) spp);
    s.DeleteCallback(E4_ECMODVERTEX, VertexModCallbackFn, (void *) spp);

    /*
     * Clean up the callback facility.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {

        /*
	 * Discard the script.
	 */

	o = (Tcl_Obj *) Tcl_GetHashValue(ePtr);
	Tcl_DecrRefCount(o);

	/*
	 * Discard the callback record.
	 */

	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	delete r;
    }
    Tcl_DeleteHashTable(spp->callbacks);
    Tcl_Free((char *) spp->callbacks);
    spp->callbacks = NULL;

    /*
     * Discard callback records for each callback kind.
     */

    if (spp->cbaddnode > 0) {
	s.DeleteCallback(E4_ECADDNODE,
			 NodeAddCallbackFn,
			 (void *) spp->cbAddNodeRecord);
	delete spp->cbAddNodeRecord;
	spp->cbAddNodeRecord = NULL;
	spp->cbaddnode = 0;
    }
    if (spp->cbaddvertex > 0) {
	s.DeleteCallback(E4_ECADDVERTEX,
			 VertexAddCallbackFn,
			 (void *) spp->cbAddVertexRecord);
	delete spp->cbAddVertexRecord;
	spp->cbAddVertexRecord = NULL;
	spp->cbaddvertex = 0;
    }
    if (spp->cbdetnode > 0) {
	s.DeleteCallback(E4_ECDETNODE,
			 NodeDetCallbackFn,
			 (void *) spp->cbDetNodeRecord);
	delete spp->cbDetNodeRecord;
	spp->cbDetNodeRecord = NULL;
	spp->cbdetnode = 0;
    }
    if (spp->cbdetvertex > 0) {
	s.DeleteCallback(E4_ECDETVERTEX,
			 VertexDetCallbackFn,
			 (void *) spp->cbDetVertexRecord);
	delete spp->cbDetVertexRecord;
	spp->cbDetVertexRecord = NULL;
	spp->cbdetvertex = 0;
    }
    if (spp->cbattnode > 0) {
	s.DeleteCallback(E4_ECATTNODE,
			 NodeAttCallbackFn,
			 (void *) spp->cbAttNodeRecord);
	delete spp->cbAttNodeRecord;
	spp->cbAttNodeRecord = NULL;
	spp->cbattnode = 0;
    }
    if (spp->cbattvertex > 0) {
	s.DeleteCallback(E4_ECATTVERTEX,
			 VertexAttCallbackFn,
			 (void *) spp->cbAttVertexRecord);
	delete spp->cbAttVertexRecord;
	spp->cbAttVertexRecord = NULL;
	spp->cbattvertex = 0;
    }
    if (spp->cbchgstorage > 0) {
	s.DeleteCallback(E4_ECCHANGESTG,
			 StorageChangeCallbackFn,
			 (void *) spp->cbChgStorageRecord);
	delete spp->cbChgStorageRecord;
	spp->cbChgStorageRecord = NULL;
	spp->cbchgstorage = 0;
    }
}

/*
 * GetNodeById --
 *
 *	Given a hash id, retrieve the associated T4Node object.
 *
 * Results:
 *	The T4Node object if found, NULL otherwise.
 *
 * Side effects:
 *	None.
 */

T4Node *
T4Storage::GetNodeById(Tcl_Interp *interp, e4_NodeUniqueID nuid)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *hPtr;
    int id = nuid.GetUniqueID();

    if (spp == NULL) {
	return NULL;
    }
    hPtr = Tcl_FindHashEntry(spp->exportedNodes, (char *) id);
    if (hPtr == NULL) {
	return NULL;
    }
    return (T4Node *) Tcl_GetHashValue(hPtr);
}

/*
 * GetVertexById --
 *
 *	Given a hash id, retrieve the associated T4Vertex object.
 *
 * Results:
 *	The T4Vertex object if found, NULL otherwise.
 *
 * Side effects:
 *	None.
 */

T4Vertex *
T4Storage::GetVertexById(Tcl_Interp *interp, e4_VertexUniqueID vuid)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *hPtr;
    int id = vuid.GetUniqueID();

    if (spp == NULL) {
	return NULL;
    }
    hPtr = Tcl_FindHashEntry(spp->exportedVertices, (char *) id);
    if (hPtr == NULL) {
	return NULL;
    }
    return (T4Vertex *) Tcl_GetHashValue(hPtr);
}

/*
 * ClearVertexStoredState --
 *
 *	Clear stored state associated with a vertex. This works whether or
 *	not the vertex is exported to Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May release a Tcl_Obj object, and may undefine a procedure.
 */

void
T4Storage::ClearVertexStoredState(Tcl_Interp *interp, e4_Vertex v) const
{
    T4StoragePerInterp *spp =
	((T4Storage *) this)->GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    int id;
    Tcl_HashEntry *ep;
    T4CmdInfo *cmdInfo;
    Tcl_Obj *obj;

    if (spp == NULL) {
	return;
    }
    (void) v.GetUniqueID(vuid);
    id = vuid.GetUniqueID();
    ep = Tcl_FindHashEntry(spp->storedProcs, (char *) id);
    if (ep != NULL) {
	cmdInfo = (T4CmdInfo *) Tcl_GetHashValue(ep);
	Tcl_DeleteCommand(interp, cmdInfo->cmdName);
	Tcl_Free(cmdInfo->cmdName);
	Tcl_Free((char *) cmdInfo);
	Tcl_DeleteHashEntry(ep);
    }
    ep = Tcl_FindHashEntry(spp->storedValues, (char *) id);
    if (ep != NULL) {
	obj = (Tcl_Obj *) Tcl_GetHashValue(ep);
	Tcl_DecrRefCount(obj);
	Tcl_DeleteHashEntry(ep);
    }
}

/*
 * SetVertexStoredObject --
 *
 *	Sets the stored Tcl_Object associated with a vertex. This works whether
 *	or not the vertex is exported to Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May release a Tcl_Obj. After this operation, retrieving the stored
 *	object for this vertex will return the object passed in this call.
 */

void
T4Storage::SetVertexStoredObject(Tcl_Interp *interp, e4_Vertex v,
				 Tcl_Obj *obj) const
{
    T4StoragePerInterp *spp =
	((T4Storage *) this)->GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    int id, isnew;
    Tcl_HashEntry *ep;
    Tcl_Obj *oldobj;

    if (spp == NULL) {
	return;
    }
    (void) v.GetUniqueID(vuid);
    id = vuid.GetUniqueID();
    ep = Tcl_CreateHashEntry(spp->storedValues, (char *) id, &isnew);
    if (!isnew) {
	oldobj = (Tcl_Obj *) Tcl_GetHashValue(ep);
	Tcl_DecrRefCount(oldobj);
    }
    Tcl_IncrRefCount(obj);
    Tcl_SetHashValue(ep, obj);
}

/*
 * SetVertexStoredCmdInfo --
 *
 *	Sets the CmdInfo structure associated with a vertex. This works
 *	whether or not this vertex has been exported to Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the command info, may undefine a previously defined procedure.
 */

void
T4Storage::SetVertexStoredCmdInfo(Tcl_Interp *interp, e4_Vertex v,
				  T4CmdInfo *cmdInfo) const
{
    T4StoragePerInterp *spp =
	((T4Storage *) this)->GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    int id, isnew;
    Tcl_HashEntry *ep;
    T4CmdInfo *oldcmd;

    if (spp == NULL) {
	return;
    }
    (void) v.GetUniqueID(vuid);
    id = vuid.GetUniqueID();
    ep = Tcl_CreateHashEntry(spp->storedProcs, (char *) id, &isnew);
    if (!isnew) {
	oldcmd = (T4CmdInfo *) Tcl_GetHashValue(ep);
	Tcl_DeleteCommand(interp, oldcmd->cmdName);
	Tcl_Free(oldcmd->cmdName);
	Tcl_Free((char *) oldcmd);
    }
    Tcl_SetHashValue(ep, cmdInfo);
}

/*
 * GetVertexStoredObject --
 *
 *	Returns a stored Tcl object that represents the value of a vertex.
 *
 * Results:
 *	A Tcl_Obj * if there's a stored Tcl_Obj for the requested vertex,
 *	or NULL.
 *
 * Side effects:
 *	None.
 */

Tcl_Obj *
T4Storage::GetVertexStoredObject(Tcl_Interp *interp, e4_Vertex v) const
{
    T4StoragePerInterp *spp =
	((T4Storage *) this)->GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    int id;
    Tcl_HashEntry *ep;

    if (spp == NULL) {
	return NULL;
    }
    (void) v.GetUniqueID(vuid);
    id = vuid.GetUniqueID();
    ep = Tcl_FindHashEntry(spp->storedValues, (char *) id);
    if (ep == NULL) {
	return NULL;
    }
    return (Tcl_Obj *) Tcl_GetHashValue(ep);
}

/*
 * GetVertexStoredCmdInfo --
 *
 *	Retrieve a T4CmdInfo * if one is stored for the requested vertex.
 *
 * Results:
 *	A T4CmdInfo * if one is available, or NULL.
 *
 * Side effects:
 *	None.
 */

T4CmdInfo *
T4Storage::GetVertexStoredCmdInfo(Tcl_Interp *interp, e4_Vertex v) const
{
    T4StoragePerInterp *spp =
	((T4Storage *) this)->GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    int id;
    Tcl_HashEntry *ep;

    if (spp == NULL) {
	return NULL;
    }
    (void) v.GetUniqueID(vuid);
    id = vuid.GetUniqueID();
    ep = Tcl_FindHashEntry(spp->storedProcs, (char *) id);
    if (ep == NULL) {
	return NULL;
    }
    return (T4CmdInfo *) Tcl_GetHashValue(ep);
}

/*
 * StoreNode --
 *
 *	Make a new entry in the exported nodes table for the given
 *	T4Node object under the supplied id.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Subsequently the node can be retrieved given the supplied id.
 */

void
T4Storage::StoreNode(Tcl_Interp *interp, T4Node *n, int id)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *hPtr;
    int isnew;

    if (spp == NULL) {
	return;
    }
    hPtr = Tcl_CreateHashEntry(spp->exportedNodes, (char *) id, &isnew);
    if (!isnew) {

	/*
	 * Should panic!
	 */

	fprintf(stderr,
		"TGRAPH: duplicate node storage for %d: 0x%x and 0x%x\n",
		id, n, (int) Tcl_GetHashValue(hPtr));
	return;
    }
    Tcl_SetHashValue(hPtr, n);
}

/*
 * StoreVertex --
 *
 *	Make a new entry in the exported vertices table for the given
 *	T4Vertex object under the supplied id.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Subsequently the vertex can be retrieved given the supplied id.
 */

void
T4Storage::StoreVertex(Tcl_Interp *interp, T4Vertex *f, int id)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *hPtr;
    int isnew;

    if (spp == NULL) {
	return;
    }
    hPtr = Tcl_CreateHashEntry(spp->exportedVertices, (char *) id, &isnew);
    if (!isnew) {

	/*
	 * Should panic!
	 */

	fprintf(stderr, 
		"TGRAPH: duplicate vertex storage for %d: 0x%x and 0x%x\n",
		id, f, (int) Tcl_GetHashValue(hPtr));
	return;
    }
    Tcl_SetHashValue(hPtr, f);
}

/*
 * RemoveNode --
 *
 *	Given an id, removes the entry for the associated node
 *	from the hash table of exported nodes in this storage.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Subsequently the node can no longer be retrieved given the id.
 */

void
T4Storage::RemoveNode(Tcl_Interp *interp, e4_NodeUniqueID nuid)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *hPtr;
    int id = nuid.GetUniqueID();

    if (spp == NULL) {
	return;
    }
    if (spp->exportedNodes == NULL) {
	return;
    }
    hPtr = Tcl_FindHashEntry(spp->exportedNodes, (char *) id);
    if (hPtr == NULL) {
        return;
    }
    Tcl_DeleteHashEntry(hPtr);
}

/*
 * RemoveVertex --
 *
 *	Given an id, removes the entry for the associated vertex
 *	from the hash table of exported vertices in this storage.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Subsequently the vertex can no longer be retrieved given the id.
 */

void
T4Storage::RemoveVertex(Tcl_Interp *interp, e4_VertexUniqueID vuid)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *hPtr;
    int id = vuid.GetUniqueID();

    if (spp == NULL) {
	return;
    }
    if (spp->exportedVertices == NULL) {
	return;
    }
    hPtr = Tcl_FindHashEntry(spp->exportedVertices, (char *) id);
    if (hPtr == NULL) {
        return;
    }
    Tcl_DeleteHashEntry(hPtr);
}

/*
 * ExternalizeStorage --
 *
 *	This procedure gives the caller access to the underlying
 *	e4_Storage object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The caller can now manipulate the underlying e4_Storage
 *	object directly.
 */

void
T4Storage::ExternalizeStorage(e4_Storage &ss)
{
    ss = s;
}

/*
 ****************************************************************************
 *
 * The following methods implement Tcl sub-commands on a T4Storage
 * object.
 *
 ****************************************************************************
 */

/*
 * Close --
 *
 *	Remove the T4Storage object from this interpreter without
 *	Deleteing it. If this is the last reference to the underlying
 *	e4Graph storage object then it will be closed.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The storage is no longer accessible in this interpreter, and
 *	all T4Graph objects that belong in this storage that have been
 *	exported to Tcl become invalid.
 */

int
T4Storage::Close(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage close");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    return InternalClose(interp, true);
}

/*
 * Helper function for closing the storage and cleaning up its state.
 */

int
T4Storage::InternalClose(Tcl_Interp *interp, bool selfdestruct)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashSearch search;
    Tcl_HashEntry *ep;
    Tcl_Obj *obj;
    char buf[128];
    int tid = s.GetTemporaryUID();

    /*
     * If the storage is not available in this interpreter, error out.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage \"", GetName(),
			       "\" is not available in this interpreter",
			       NULL);
	return TCL_ERROR;
    }
	
    /*
     * Splice it out of the list of per-interpreter records.
     */

    if (spip == spp) {
	spip = spp->next;
    }
    if (spp->prev != NULL) {
	spp->prev->next = spp->next;
    }
    if (spp->next != NULL) {
	spp->next->prev = spp->prev;
    }

    /*
     * Clean up all the storage associated with this per-interpreter record.
     */

    Tcl_DeleteHashTable(spp->exportedNodes);
    Tcl_Free((char *) spp->exportedNodes);
    Tcl_DeleteHashTable(spp->exportedVertices);
    Tcl_Free((char *) spp->exportedVertices);
    for (ep = Tcl_FirstHashEntry(spp->storedValues, &search);
	 ep != NULL;
	 ep = Tcl_NextHashEntry(&search)) {
	obj = (Tcl_Obj *) Tcl_GetHashValue(ep);
	Tcl_DecrRefCount(obj);
    }
    Tcl_DeleteHashTable(spp->storedProcs);
    Tcl_Free((char *) spp->storedProcs);
    Tcl_DeleteHashTable(spp->storedValues);
    Tcl_Free((char *) spp->storedValues);

    /*
     * Delete the Tcl command for this storage, and delete this T4Storage
     * object from the hash table for storages that are open in this interp.
     * Also remove all exported objects from this storage in this interp.
     */

    T4Graph_DeleteStorageCommand(interp, this);

    /*
     * Remove the namespace for stored procedures from the interpreter. This
     * will undefine all of them in one step.
     */

    sprintf(buf, "namespace delete ::tgraph::%s", GetName());
    (void) Tcl_Eval(interp, buf);
    Tcl_ResetResult(interp);

    /*
     * Clean up the callback facility.
     */

    RemoveAllCallbacks(spp);

    /*
     * Destroy the per-interpreter record itself.
     */

    delete spp;

    /*
     * If other interpreters still hold a reference to this storage
     * then don't destroy it.
     */

    if ((spip != NULL) || (!selfdestruct)) {
	return TCL_OK;
    }

    /*
     * No more references to this storage remain, so we delete its instance.
     * The destructor closes the storage by explicitly assigning 
     * invalidStorage to the instance variable.
     */

    delete this;

    return TCL_OK;
}

/*
 * Commit --
 *
 *	Commit any changes to this object to persistent storage.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this operation, the state of exported T4Graph objects
 *	exactly reflects the state in the persistent storage.
 */

int
T4Storage::Commit(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage commit");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Attempt to commit.
     */

    if (!s.Commit()) {
	Tcl_AppendResult(interp, "commit on storage ", GetName(), 
			 " failed", NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 * CopyTo --
 *
 *	Copies the contents of this e4Graph storage object to the given
 *	e4Graph storage object.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this operation the other storage contains the same structure
 *	as this storage. All objects belonging to the other storage become
 *	invalid.
 */

int
T4Storage::CopyTo(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int forceCommit = 0;
    Tcl_HashTable *storages;
    Tcl_HashEntry *ePtr;
    T4Storage *otherStorage;
    e4_Storage os;

    /*
     * Expecting one or two arguments.
     */

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage copyto otherstorage ?commit?");
	return TCL_ERROR;
    }

    /*
     * If there are two arguments, attempt to obtain the boolean that
     * says whether we want to commit the other storage after the copy.
     */

    if (objc == 2) {
	if (Tcl_GetBooleanFromObj(interp, objv[1], &forceCommit) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /*
     * Check that the underlying storage is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Attempt to get the storage from the given argument.
     */

    storages = (Tcl_HashTable *) Tcl_GetAssocData(interp, T4_ASSOCKEY, NULL);
    if (storages == NULL) {
	Tcl_AppendResult(interp, "internal error: invalid storage hash",
			 " table", NULL);
	return TCL_ERROR;
    }
    ePtr = Tcl_FindHashEntry(storages, Tcl_GetString(objv[0]));
    if (ePtr == NULL) {
	Tcl_AppendResult(interp, "unknown storage ", Tcl_GetString(objv[0]),
			 NULL);
	return TCL_ERROR;
    }
    otherStorage = (T4Storage *) Tcl_GetHashValue(ePtr);
    if (otherStorage == NULL) {
	Tcl_AppendResult(interp, "unknown storage ", Tcl_GetString(objv[0]),
			 NULL);
	return TCL_ERROR;
    }

    /*
     * Obtain the e4Graph object for the other storage.
     */

    otherStorage->ExternalizeStorage(os);

    /*
     * Check the other storage is valid.
     */

    if (!os.IsValid()) {
	Tcl_AppendResult(interp, "invalid storage ", Tcl_GetString(objv[0]),
			 NULL);
	return TCL_ERROR;
    }

    /*
     * Attempt to copy.
     */

    if (!s.CopyTo(os, (forceCommit == 0) ? false : true)) {
	Tcl_AppendResult(interp, "copy from ", GetName(), " to ",
			 Tcl_GetString(objv[0]), " failed", NULL);
	return TCL_ERROR;
    }

    /*
     * If we get here, success
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}

/*
 * Delete --
 *
 *	Deletes the underlying e4Graph storage object and the T4Graph
 *	storage object.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The persistent storage for the T4Graph object may be Deleteed.
 *	After this operation, the T4Graph object can no longer be accessed
 *	in this interpreter and any T4Graph objects exported to Tcl that
 *	belong in this storage become invalid.
 */

int
T4Storage::Delete(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    e4_Storage hold;

    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage Delete");
	return TCL_ERROR;
    }

    /*
     * Check that the underlying storage is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Hold onto the storage while we're closing this instance's reference.
     */

    hold = s;

    /*
     * Now clean up the in-core state.
     */

    if (InternalClose(interp, true) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * And finally delete the storage through the handle we held onto.
     */

    hold.Delete();

    return TCL_OK;
}

/*
 * DoGC --
 *
 *	Cause a GC to occur in the e4Graph storage attached to this
 *	T4Graph storage object.
 *
 * Results:
 *	A standard Tcl result. Upon success the interpreter result is empty.
 *
 * Side effects:
 *	Causes a garbage collection. Detach callbacks may issue.
 */

int
T4Storage::DoGC(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, "$storage dogc");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    s.DoGC();

    Tcl_ResetResult(interp);
    return TCL_OK;
}

/*
 * NeedsGC --
 *
 *	Returns a boolean value saying whether the e4Graph storage
 *	attached to this TGraph storage object needs GC.
 *
 * Results:
 *	A standard Tcl result. Upon success the interpreter result
 *	contains a boolean saying whether the underlying storage
 *	needs a GC.
 *
 * Side effects:
 *	None.
 */

int
T4Storage::NeedsGC(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, "$storage needsgc");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), s.NeedsGC());

    return TCL_OK;
}

/*
 * Node --
 *
 *	Creates and returns a new detached node within the underlying
 *	storage.
 *
 * Results:
 *	A standard Tcl result. Upon success, the interpreter result contains
 *	the Tcl name of the new node.
 *
 * Side effects:
 *	May create a new node in the storage.
 */

int
T4Storage::Node(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    e4_Node n;
    T4Node *np;
    e4_NodeUniqueID nuid;
    Tcl_Obj *res;

    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, "$storage node");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Attempt to create a new detached node:
     */

    if ((!s.CreateDetachedNode(n)) || (!n.IsValid())) {
	Tcl_AppendResult(interp,
			 "could not create new detached node in storage ",
			 GetName(), NULL);
	return TCL_ERROR;
    }

    /*
     * Export the new detached node to Tcl. It's possible that it has
     * already been exported by a callback. If so, just use the same
     * T4Node.
     */

    (void) n.GetUniqueID(nuid);
    np = GetNodeById(interp, nuid);
    if (np == NULL) {
	np = new T4Node(n, this);
	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;
}

/*
 * Vertex --
 *
 *	Create and return a new detached vertex in this storage.
 *
 * Results:
 *	A standard Tcl result. Upon success, the interpreter result contains
 *	the Tcl name of the new vertex.
 *
 * Side effects:
 *	May create a new vertex in the storage.
 */

int
T4Storage::Vertex(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    e4_Vertex v;
    T4Vertex *vp;
    e4_VertexUniqueID vuid;
    Tcl_Obj *res;

    /*
     * Expecting two or three arguments: name, value and optional
     * type selector.
     */

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage vertex name val ?typesel?");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Attempt to create a new detached vertex. Create it with the
     * default value of (integer) 0.
     */

    if ((!s.CreateDetachedVertex((const char *) Tcl_GetString(objv[0]),
				 0, v)) ||
	(!v.IsValid())) {
	Tcl_AppendResult(interp,
			 "could not create new detached vertex in storage ",
			 GetName(), NULL);
	return TCL_ERROR;
    }

    /*
     * Export the new detached vertex to Tcl. It may already have been exported
     * by a vertex add callback. In that case use the one that's already
     * registeterd.
     */

    (void) v.GetUniqueID(vuid);
    vp = GetVertexById(interp, vuid);
    if (vp == NULL) {
	vp = new T4Vertex(v, this);
	StoreVertex(interp, vp, vuid);
    }
    res = vp->GetTclObject();
    if (res == NULL) {
	res = GO_MakeGenObject(vertexExt, vp, interp);
	vp->SetTclObject(res);
    }

    /*
     * Set the vertex to its real value.
     */

    if (vp->Set(interp, objc-1, objv+1) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Return the name of the new detached vertex.
     */

    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

/*
 * Root --
 *
 *	When called with zero arguments, returns the T4Graph object that
 *	represents the root node.
 *
 *	When called with one argument, the name of a valid node, sets the
 *	root node of that storage to the given node.
 *
 * Results:
 *	A valid Tcl result. When called with zero arguments, upon success
 *	the interpreter result contains the name of the root node (as
 *	exported to Tcl).
 *
 * Side effects:
 *	May change which node is the root node of this storage.
 */

int
T4Storage::Root(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    char *nn;
    e4_Node n;
    T4Node *np;
    e4_NodeUniqueID nuid;
    Tcl_Obj *res;

    /*
     * Expecting zero or one arguments.
     */

    if ((objc != 0) && (objc != 1)) {
	Tcl_WrongNumArgs(interp, 0, NULL, "$storage root ?newroot?");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * If there is one argument, check that it is the name of an exported
     * node.
     */

    if (objc == 1) {

	nn = Tcl_GetString(objv[0]);

	/*
	 * Obtain the node denoted by the supplied Tcl_Obj.
	 */

	np = (T4Node *) GO_GetInternalRep(objv[0], nodeExt);
	if (np == NULL) {
	    Tcl_AppendResult(interp, "invalid node ", nn, NULL);
	    return TCL_ERROR;
	}
	np->ExternalizeNode(n);
	if (!n.IsValid()) {
	    Tcl_AppendResult(interp, "invalid node ", nn, NULL);
	    return TCL_ERROR;
	}

	/*
	 * Attempt to set the root node of this storage to the given node.
	 */

	if (!s.SetRootNode(n)) {
	    Tcl_AppendResult(interp,
			     "could not set root node of storage ", GetName(),
			     " to node ", np->GetName(), NULL);
	    return TCL_ERROR;
	}

	/*
	 * Clear the interpreter result, don't leave turds!
	 */

	Tcl_ResetResult(interp);
	return TCL_OK;
    }

    /*
     * Zero arguments: retrieve the root node and export it to Tcl.
     */

    if ((!s.GetRootNode(n)) || (!n.IsValid())) {
	Tcl_AppendResult(interp,
			 "could not obtain root of storage ", 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 = GetNodeById(interp, nuid);
    if (np == NULL) {
	np = new T4Node(n, this);
	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;
}

/*
 * IsValid --
 *
 *	Returns a boolean value indicating whether the T4Graph storage
 *	object is valid.
 *
 * Results:
 *	A standard Tcl result. Upon success the interpreter result
 *	contains a boolean value indicating whether the storage is
 *	valid.
 *
 * Side effects:
 *	None.
 */

int
T4Storage::IsValid(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage isvalid");
	return TCL_ERROR;
    }

    /*
     * Is this storage valid?
     */

    if (s.IsValid()) {
	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1);
    } else {
	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
    }
    return TCL_OK;
}

/*
 * IsStable --
 *
 *	Returns a boolean value indicating whether the T4Graph storage
 *	object is stable (it needs to be committed).
 *
 * Results:
 *	A standard Tcl result. Upon success the interpreter result
 *	contains a boolean value indicating whether the storage is
 *	stable.
 *
 * Side effects:
 *	None.
 */

int
T4Storage::IsStable(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage isstable");
	return TCL_ERROR;
    }

    /*
     * Is this storage stable?
     */

    if (s.IsStable()) {
	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1);
    } else {
	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
    }
    return TCL_OK;
}

/*
 * MarkUnstable --
 *
 *	Mark the storage as unstable (it needs to be committed).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The storage is marked as unstable (it needs to be committed).
 */

int
T4Storage::MarkUnstable(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage markunstable");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Mark the storage as unstable.
     */

    s.MarkUnstable();

    return TCL_OK;
}

/*
 * Name --
 *
 *	Sets the interpreter result to the name of this storage.
 *
 * Results:
 *	A standard Tcl result. Upon success the interpreter result
 *	contains a string, the name of this storage.
 *
 * Side effects:
 *	None.
 */

int
T4Storage::Name(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting zero arguments.
     */

    if (objc != 0) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage name");
	return TCL_ERROR;
    }

    /*
     * Check that the storage object is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendResult(interp, "storage ", GetName(), " is invalid", NULL);
	return TCL_ERROR;
    }

    /*
     * Return the string name of this storage. If the interpreter is
     * safe, do not tell him the real name of the storage. Instead tell
     * him only the name by which it is known in Tcl.
     */

    if (Tcl_IsSafe(interp)) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), GetName(), -1);
    } else {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) s.GetName(), -1);
    }

    return TCL_OK;
}

/*
 * Foreach --
 *
 *	Iterate over selected elements in this storage, executing an
 *	arbitrary piece of Tcl code for each selected element.
 *
 * Results:
 *	A standard Tcl result. Upon successful completion, the interpreter
 *	result is left empty.
 *
 * Side effects:
 *	Whatever the evaluated Tcl code does. May export new elements of
 *	this storage to Tcl.
 */

static CONST84 char *selectors[] = {
    (char *) "node",
    (char *) "vertex",
    (char *) NULL
};
typedef enum SSelectors {
    SNode = 0,
    SVertex
} SSelectors;

static CONST84 char *choices[] = {
    (char *) "detached",
    (char *) "attached",
    (char *) "both",
    (char *) NULL
};

int
T4Storage::Foreach(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    SSelectors index;

    /*
     * Expecting at least three arguments.
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 0, NULL, 
			 (char *) "$storage foreach sel var ?options? cmd");
	return TCL_ERROR;
    }

    /*
     * Figure out what selector was requested.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0],
			    (CONST84 char **) selectors,
			    (char *) "selector", 0, (int *) &index)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    objc--;
    objv++;

    switch (index) {
    case SNode:
	return VisitNodes(interp, objc, objv);
    case SVertex:
	return VisitVertices(interp, objc, objv);
    }

    /*
     * Not reached, but some compilers insist on this..
     */

    return TCL_ERROR;
}

/*
 * These filters help select nodes and vertices to visit.
 */

static CONST84 char *filters[] = {
    (char *) "-type",
    (char *) "-name",
    (char *) "-class",
    (char *) NULL
};
typedef enum SFilters {
    SType = 0,
    SName,
    SClass,
} SFilters;

/*
 * VisitNodes --
 *
 *	Helper function to visit selected nodes in a storage.
 *
 * Results:
 *	A standard Tcl result. Upon successful completion, the interpreter
 *	result is left empty.
 *
 * Side effects:
 *	Whatever the evaluated Tcl code does. May export new elements of
 *	this storage to Tcl.
 */

int
T4Storage::VisitNodes(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    e4_Node n = invalidNode;
    e4_NodeUniqueID nuid;
    T4Node *np;
    int ret = TCL_OK, retone;
    bool done = false;
    Tcl_Obj *vp1, *vp2;
    Tcl_Obj *res;
    Tcl_Obj *cmd;
    e4_DetachChoice dc;

    /*
     * Expecting two or four arguments, the name of a variable to
     * set to each node as it is visited, and the command to execute.
     * If four arguments are present, the two additional ones are
     * expected to be "-class" and a string from the "choices" array
     * above.
     */

    if ((objc != 2) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage foreach node var ?-class c? cmd");
	return TCL_ERROR;
    }

    /*
     * Get the variable name.
     */

    vp1 = objv[0];
    vp2 = NULL;

    /*
     * Get the command to execute.
     */

    if (objc == 2) {
	cmd = objv[1];
    } else {
	cmd = objv[3];
    }

    /*
     * Select which group of nodes to visit.
     */

    if (objc == 2) {
	dc = E4_DCATTACHED;
    } else {
	char *s = Tcl_GetString(objv[1]);

	if (strncmp(s, "-class", strlen(s)) != 0) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "Incorrect flag \"", s, "\", expected ",
				   "-class", NULL);
	    return TCL_ERROR;
	}

	if (Tcl_GetIndexFromObj(interp, objv[2],
				(CONST84 char **) choices,
				(char *) "class", 0, (int *) &dc)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /*
     * Create the iterator.
     */

    e4_NodeVisitor nv(s, dc);

    /*
     * Iterate over every node in the storage.
     */

    while ((!done) && (nv.CurrentNodeAndAdvance(n))) {

	/*
	 * See if we already exported this node to Tcl.
	 */

	(void) n.GetUniqueID(nuid);
	np = GetNodeById(interp, nuid);
	if (np == NULL) {
	    np = new T4Node(n, this);
	    StoreNode(interp, np, nuid);
	}
	res = np->GetTclObject();
	if (res == NULL) {
	    res = GO_MakeGenObject(nodeExt, np, interp);
	    np->SetTclObject(res);
	}

	/*
	 * Set the iteration variable to the Tcl_Obj * for this node.
	 */

	(void) Tcl_ObjSetVar2(interp, vp1, vp2, res, 0);

	/*
	 * And finally execute the command.
	 */

	retone = Tcl_EvalObjEx(interp, cmd, 0);
	switch (retone) {
	case TCL_OK:
	case TCL_CONTINUE:
	    Tcl_ResetResult(interp);
	    break;
	case TCL_BREAK:
	    Tcl_ResetResult(interp);
	    done = true;
	    break;
	case TCL_ERROR:
	default:
	    done = true;
	    ret = retone;
	    break;
	}
    }
    (void) Tcl_UnsetVar(interp, Tcl_GetString(vp1), 0);
    return ret;
}

/*
 * VisitVertices --
 *
 *	Helper function to visit selected vertices in a storage.
 *
 * Results:
 *	A standard Tcl result. Upon successful completion, the interpreter
 *	result is left empty.
 *
 * Side effects:
 *	Whatever the evaluated Tcl command does. May export new elements
 *	of the storage to Tcl.
 */

static CONST84 char *typenames[] = {
    (char *) "node",
    (char *) "int",
    (char *) "float",
    (char *) "string",
    (char *) "binary",
    (char *) NULL
};

int
T4Storage::VisitVertices(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    e4_Vertex v = invalidVertex;
    e4_VertexUniqueID vuid;
    T4Vertex *vp;
    char *namefilter = NULL;
    SFilters filter;
    e4_VertexType vt = E4_VTUNKNOWN;
    int ret = TCL_OK, retone;
    bool done = false;
    Tcl_Obj *vp1, *vp2;
    Tcl_Obj *res;
    e4_DetachChoice dc = E4_DCATTACHED;

    /*
     * Expecting two, four, six or eight arguments, the name of a variable
     * to set to each vertex as it is visited, an optional type filter
     * (two args), an optional name filter (two args), an optional set of
     * entities (both, detached or attached) (two args), and the command
     * to execute.
     */

    if ((objc != 2) && (objc != 4) && (objc != 6) && (objc != 8)) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *)
	    "$storage foreach vertex v ?-class c? ?-type t? ?-name n? cmd");
	return TCL_ERROR;
    }

    /*
     * Get the iteration variable:
     */

    vp1 = objv[0];
    vp2 = NULL;

    /*
     * Parse the optional specifiers:
     */

    for (objc--, objv++; objc > 1; objc -= 2, objv += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[0],
				(CONST84 char **) filters,
				(char *) "filter", 0, (int *) &filter)
	    != TCL_OK) {
	    return TCL_ERROR;
	}

	switch (filter) {
	case SName:
	    namefilter = Tcl_GetString(objv[1]);
	    break;
	case SType:
	    if (Tcl_GetIndexFromObj(interp, objv[1], 
				    (CONST84 char **) typenames, 
				    (char *) "typename", 0, (int *) &vt) 
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case SClass:
	    if (Tcl_GetIndexFromObj(interp, objv[1],
				    (CONST84 char **) choices,
				    (char *) "class", 0, (int *) &dc)
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }

    /*
     * Create the iterator:
     */

    e4_VertexVisitor vv(s, dc, (const char *) namefilter, vt);

    /*
     * Iterate over the selected vertices.
     */

    while ((!done) && (vv.CurrentVertexAndAdvance(v))) {

	/*
	 * See if we already exported this vertex to Tcl.
	 */

	(void) v.GetUniqueID(vuid);
	vp = GetVertexById(interp, vuid);
	if (vp == NULL) {
	    vp = new T4Vertex(v, this);
	    StoreVertex(interp, vp, vuid);
	}
	res = vp->GetTclObject();
	if (res == NULL) {
	    res = GO_MakeGenObject(vertexExt, vp, interp);
	    vp->SetTclObject(res);
	}
	
	/*
	 * Set the iteration variable.
	 */

	(void) Tcl_ObjSetVar2(interp, vp1, vp2, res, 0);

	/*
	 * And finally execute the command.
	 */

	retone = Tcl_EvalObjEx(interp, objv[0], 0);
	switch (retone) {
	case TCL_OK:
	case TCL_CONTINUE:
	    Tcl_ResetResult(interp);
	    break;
	case TCL_BREAK:
	    Tcl_ResetResult(interp);
	    done = true;
	    break;
	case TCL_ERROR:
	default:
	    done = true;
	    ret = retone;
	    break;
	}
    }

    /*
     * Unset the iteration variable.
     */

    (void) Tcl_UnsetVar(interp, Tcl_GetString(vp1), 0);
    return ret;
}

/*
 * Statistic --
 *
 *	Retrieve a statistic collected while running a TGraph application.
 *
 * Results:
 *	A standard Tcl result. Upon success, the interpreter result contains
 *	the value of the statistic retrieved.
 *
 * Side effects:
 *	None.
 */

static CONST84 char *statspaceselectors[] = {
    (char *) "node",
    (char *) "vertex",
    (char *) "name",
    (char *) "string",
    (char *) "int",
    (char *) "float",
    (char *) "binary",
    NULL
};
static CONST84 char *statkindselectors[] = {
    (char *) "used",
    (char *) "available",
    (char *) "freed",
    (char *) "allocated",
    NULL
};

int
T4Storage::Statistic(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    e4_Space sp;
    e4_SpaceStat st;
    int v;

    /*
     * Expecting exactly two arguments.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage statistic space kind");
	return TCL_ERROR;
    }

    /*
     * Determine which space kind we want a statistic about.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0], 
			    (CONST84 char **) statspaceselectors,
			    (char *) "space", 0, (int *) &sp)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Determine which statistic we want about that space.
     */

    if (Tcl_GetIndexFromObj(interp, objv[1],
			    (CONST84 char **) statkindselectors,
			    (char *) "kind", 0, (int *) &st)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Retrieve the actual statistic.
     */

    if (!s.GetStatistic(sp, st, v)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "cannot retrieve statistic \"",
			       Tcl_GetString(objv[1]), 
			       "\" about space \"",
			       Tcl_GetString(objv[0]),
			       "\" in storage ",
			       GetName(), NULL);
	return TCL_ERROR;
    }

    Tcl_SetIntObj(Tcl_GetObjResult(interp), v);

    return TCL_OK;
}

/*
 * Get --
 *
 *	Get a TGraph entity identified by a given ID and kind string.
 *
 * Result:
 *	A standard Tcl result. Upon success, the interpreter result
 *	contains the name of the Tcl command to use to invoke
 *	operations on the TGraph entity.
 *
 * Side effects:
 *	May define a Tcl command for a newly exported TGraph entity.
 */

static CONST84 char *objectkindselectors[] = {
    (char *) "node",
    (char *) "vertex",
    (char *) "storage",
    NULL
};

int
T4Storage::Get(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int id;
    T4ObjectKindSelector oksel;
    e4_NodeUniqueID nuid;
    e4_VertexUniqueID vuid;
    e4_Node n;
    e4_Vertex v;
    T4Node *tnp;
    T4Vertex *tvp;
    Tcl_Obj *res;

    /*
     * Expecting exactly two arguments, the kind of the object to retrieve
     * and its ID.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, NULL, (char *) "$storage get objkind id");
	return TCL_ERROR;
    }

    /*
     * Determine the kind of object to retrieve.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0],
			    (CONST84 char **) objectkindselectors,
			    (char *) "objkind", 0, (int *) &oksel)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Attempt to get the integer ID of the object to retrieve:
     */

    if (Tcl_GetIntFromObj(interp, objv[1], &id) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check that the storage is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "invalid storage ", GetName(), NULL);
	return TCL_ERROR;
    }

    /*
     * Attempt to retrieve the object requested:
     */
    switch (oksel) {
    case T4_OKSTORAGE:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "can't do \"$storage get storage ..", NULL);
	return TCL_ERROR;

    case T4_OKNODE:
	nuid.SetUniqueID(id, s);

	/*
	 * If the node is already exported to Tcl, return its command name.
	 */

	tnp = GetNodeById(interp, nuid);
	if (tnp != NULL) {
	    res = tnp->GetTclObject();
	    if (res == NULL) {
		res = GO_MakeGenObject(nodeExt, tnp, interp);
		tnp->SetTclObject(res);
	    }
	    Tcl_SetObjResult(interp, res);
	    return TCL_OK;
	}

	/*
	 * Not exported yet. Retrieve the e4_Node for this ID, then export
	 * the corresponding Tcl command.
	 */

	if ((!s.GetNodeFromID(nuid, n)) || (!n.IsValid())) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid node id ",
				   Tcl_GetString(objv[1]),
				   NULL);
	    return TCL_ERROR;
	}

	tnp = new T4Node(n, this);
	StoreNode(interp, tnp, nuid);

	res = tnp->GetTclObject();
	if (res == NULL) {
	    res = GO_MakeGenObject(nodeExt, tnp, interp);
	    tnp->SetTclObject(res);
	}
	Tcl_SetObjResult(interp, res);
	return TCL_OK;

    case T4_OKVERTEX:
	vuid.SetUniqueID(id, s);

	/*
	 * If the vertex is already exported to Tcl, return its command name.
	 */

	tvp = GetVertexById(interp, vuid);
	if (tvp != NULL) {
	    res = tvp->GetTclObject();
	    if (res == NULL) {
		res = GO_MakeGenObject(vertexExt, tvp, interp);
		tvp->SetTclObject(res);
	    }
	    Tcl_SetObjResult(interp, res);
	    return TCL_OK;
	}

	/*
	 * Not yet exported. Retrieve the e4_Vertex for this ID, then export
	 * its Tcl command.
	 */

	if ((!s.GetVertexFromID(vuid, v)) || (!v.IsValid())) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid vertex id ",
				   Tcl_GetString(objv[1]),
				   NULL);
	    return TCL_ERROR;
	}

	tvp = new T4Vertex(v, this);
	StoreVertex(interp, tvp, vuid);

	res = tvp->GetTclObject();
	if (res == NULL) {
	    res = GO_MakeGenObject(vertexExt, tvp, interp);
	    tvp->SetTclObject(res);
	}
	Tcl_SetObjResult(interp, res);
	return TCL_OK;
    }

    /*
     * If we get here there's an internal error, because this code should
     * be unreachable.
     */

    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			   "internal error: \"$storage get\": unreachable",
			   " code", NULL);
    return TCL_ERROR;
}

/*
 * Share --
 *
 *	Share this storage with another interpreter.
 *
 * Results:
 *	A standard Tcl result. Upon success, the interpreter result will
 *	contain the name of the storage in the other interpreter.
 *
 * Side effects:
 *	The other interpreter (a slave of this one) will have access to
 *	the storage.
 */

int
T4Storage::Share(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_Interp *slave;

    /*
     * If the storage is not accessible in this interpreter, error out.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage \"", GetName(),
			       "\" is not available in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    /*
     * Expecting exactly two arguments, the name of the interpreter to
     * share this storage with, and the name of the global variable in
     * that interpreter to store the name of the storage into.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage share interp globalvar");
	return TCL_ERROR;
    }

    /*
     * Find the slave interpreter.
     */

    slave = Tcl_GetSlave(interp, Tcl_GetString(objv[0]));
    if (slave == NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "$storage share",
			       ": could not find interpreter \"",
			       Tcl_GetString(objv[2]),
			       "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Check if the storage is already accessible in the slave. If not, then
     * make it available in the slave.
     */

    spp = GetStoragePerInterp(slave);
    if (spp == NULL) {

	/*
	 * Export it as a command.
	 */

	if (T4Graph_MakeStorageCommand(slave, this) == TCL_ERROR) {
	    return TCL_ERROR;
	}

	/*
	 * Register the storage in the slave.
	 */

	RegisterStoragePerInterp(slave);

	/*
	 * Ensure the slave interpreter is set up to close the storages
	 * that are registered in it when the interpreter is deleted.
	 */

	T4Graph_RegisterInterp(slave);
    }

    /*
     * Now assign the storage name to the designated global variable.
     */

    Tcl_SetVar(slave, Tcl_GetString(objv[1]), GetName(), TCL_GLOBAL_ONLY);

    /*
     * And leave the name of the new storage in this interpreter result.
     */

    Tcl_SetStringObj(Tcl_GetObjResult(interp), GetName(), -1);

    return TCL_OK;
}

/*
 * Callback --
 *
 *	Add or remove a callback for events of interest while running
 *	a TGraph application.
 *
 * Results:
 *	A standard Tcl result. Upon success, when a callback is added,
 *	the interpreter result contains the token to use when cancelling
 *	that callback later. Upon success, when a callback is removed,
 *	the interpreter result is empty.
 *
 * Side effects:
 *	Subsequently, when the specified event happens, a callback may
 *	occur or may stop to occur.
 */

static CONST84 char *callbackeventselectors[] = {
    (char *) "add",
    (char *) "detach",
    (char *) "attach",
    (char *) "modify",
    (char *) "change",
    NULL
};
static CONST84 char *callbackactionselectors[] = {
    (char *) "add",
    (char *) "delete",
    (char *) "get",
    (char *) "set",
    (char *) "kind",
    (char *) "count",
    (char *) "exists",
    NULL
};

int
T4Storage::Callback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4CallbackActionSelector cbas;

    /*
     * Expecting at least two arguments.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback action arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Determine what kind of action (add or delete a callback) is requested.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0],
			    (CONST84 char **) callbackactionselectors,
			    (char *) "action", 0, (int *) &cbas) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (cbas) {
    case T4_CBASADD:
	return CBAddCallback(interp, objc-1, objv+1);
    case T4_CBASDEL:
	return CBDelCallback(interp, objc-1, objv+1);
    case T4_CBASGET:
	return CBGetCallback(interp, objc-1, objv+1);
    case T4_CBASSET:
	return CBSetCallback(interp, objc-1, objv+1);
    case T4_CBASKND:
	return CBKindCallback(interp, objc-1, objv+1);
    case T4_CBASCNT:
	return CBCountCallback(interp, objc-1, objv+1);
    case T4_CBASHAS:
	return CBHasCallback(interp, objc-1, objv+1);
    }

    /*
     * Some compilers (VC++) insist on this...
     */

    return TCL_ERROR;
}

/*
 * Configure --
 *
 *	Configure options for a storage, or retrieve one or all
 *	option settings for a storage.
 *
 * Results:
 *	A standard Tcl result. Upon success, the interpreter result is
 *	empty when options are configured. When behaviors are retrieved,
 *	upon success the interpreter result contains a list of alternating
 *	option names and values.
 *
 * Side effects:
 *	May modify the behavior of this storage according to the options
 *	being configured in the call.
 */

int
T4Storage::Configure(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    /*
     * Expecting either zero, one or an even numbered >= 2 arguments.
     */

    if ((objc != 0) && (objc != 1) && ((objc % 2) != 0)) {
	Tcl_WrongNumArgs(interp, 0, NULL,
		 (char *) "$storage configure ?opt? ?val? ?opt val ..?");
	return TCL_ERROR;
    }

    if (objc == 0) {
	return GetStorageOptions(interp);
    }
    if (objc == 1) {
	return GetStorageOption(interp, objv[0]);
    }
    return SetStorageOptions(interp, objc, objv);
}

/*
 * Helper functions to manage callbacks.
 */

int
T4Storage::CBAddCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    T4CallbackRecord *r, *savedr;
    Tcl_HashEntry *ePtr;
    int isnew;
    T4ObjectKindSelector cbos;
    T4CallbackEventSelector cbes;

    /*
     * Expecting three arguments.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 0, NULL,
		 (char *) "storage callback add objsel eventsel script");
	return TCL_ERROR;
    }

    /*
     * Attempt to parse the object selector.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0],
			    (CONST84 char **) objectkindselectors,
			    (char *) "objsel", 0, (int *) &cbos)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Attempt to parse the event selector.
     */

    if (Tcl_GetIndexFromObj(interp, objv[1], 
			    (CONST84 char **) callbackeventselectors,
			    (char *) "eventsel", 0, (int *) &cbes)
	!= TCL_OK){
	return TCL_ERROR;
    }

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    r = new T4CallbackRecord;
    r->interp = interp;
    r->storage = this;

    switch (cbos) {
    case T4_OKSTORAGE:
	switch (cbes) {
	case T4_CBESCHG:
	    if (spp->cbchgstorage < 0) {
		spp->cbchgstorage = 0;
	    }
	    if (spp->cbchgstorage == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECCHANGESTG;

		spp->cbChgStorageRecord = savedr;

		s.DeclareCallback(E4_ECCHANGESTG,
				  StorageChangeCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbchgstorage++;
	    r->kind = E4_ECCHANGESTG;
	    break;

	case T4_CBESMOD:
	case T4_CBESADD:
	case T4_CBESATT:
	case T4_CBESDET:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid callback operation on storage",
				   NULL);
	    return TCL_ERROR;
	}
	break;

    case T4_OKNODE:
	switch (cbes) {
	case T4_CBESMOD:
	    if (spp->cbmodnode < 0) {
		spp->cbmodnode = 0;
	    }
	    spp->cbmodnode++;
	    r->kind = E4_ECMODNODE;	    
	    break;
	case T4_CBESADD:
	    if (spp->cbaddnode < 0) {
		spp->cbaddnode = 0;
	    }
	    if (spp->cbaddnode == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECADDNODE;
		
		spp->cbAddNodeRecord = savedr;

		s.DeclareCallback(E4_ECADDNODE,
				  NodeAddCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbaddnode++;
	    r->kind = E4_ECADDNODE;
	    break;
	case T4_CBESDET:
	    if (spp->cbdetnode < 0) {
		spp->cbdetnode = 0;
	    }
	    if (spp->cbdetnode == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECDETNODE;

		spp->cbDetNodeRecord = savedr;

		s.DeclareCallback(E4_ECDETNODE,
				  NodeDetCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbdetnode++;
	    r->kind = E4_ECDETNODE;
	    break;
	case T4_CBESATT:
	    if (spp->cbattnode < 0) {
		spp->cbattnode = 0;
	    }
	    if (spp->cbattnode == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECATTNODE;

		spp->cbAttNodeRecord = savedr;

		s.DeclareCallback(E4_ECATTNODE,
				  NodeAttCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbattnode++;
	    r->kind = E4_ECATTNODE;
	    break;
	case T4_CBESCHG:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid callback operation on node",
				   NULL);
	    return TCL_ERROR;
	}
	break;
    case T4_OKVERTEX:
	switch (cbes) {
	case T4_CBESADD:
	    if (spp->cbaddvertex < 0) {
		spp->cbaddvertex = 0;
	    }
	    if (spp->cbaddvertex == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECADDVERTEX;

		spp->cbAddVertexRecord = savedr;

		s.DeclareCallback(E4_ECADDVERTEX,
				  VertexAddCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbaddvertex++;
	    r->kind = E4_ECADDVERTEX;
	    break;
	case T4_CBESDET:
	    if (spp->cbdetvertex < 0) {
		spp->cbdetvertex = 0;
	    }
	    if (spp->cbdetvertex == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECDETVERTEX;

		spp->cbDetVertexRecord = savedr;

		s.DeclareCallback(E4_ECDETVERTEX,
				  VertexDetCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbdetvertex++;
	    r->kind = E4_ECDETVERTEX;
	    break;
	case T4_CBESATT:
	    if (spp->cbattvertex < 0) {
		spp->cbattvertex = 0;
	    }
	    if (spp->cbattvertex == 0) {
		savedr = new T4CallbackRecord;
		savedr->interp = interp;
		savedr->storage = this;
		savedr->kind = E4_ECATTVERTEX;

		spp->cbAttVertexRecord = savedr;

		s.DeclareCallback(E4_ECATTVERTEX,
				  VertexAttCallbackFn,
				  (void *) savedr);
	    }
	    spp->cbattvertex++;
	    r->kind = E4_ECATTVERTEX;
	    break;
	case T4_CBESMOD:
	    if (spp->cbmodvertex < 0) {
		spp->cbmodvertex = 0;
	    }
	    spp->cbmodvertex++;
	    r->kind = E4_ECMODVERTEX;
	    break;
	case T4_CBESCHG:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid callback operation on vertex",
				   NULL);
	    return TCL_ERROR;
	}
	break;
    }

    /*
     * Record the script.
     */

    ePtr = Tcl_CreateHashEntry(spp->callbacks, (char *) r, &isnew);
    Tcl_SetHashValue(ePtr, objv[2]);
    Tcl_IncrRefCount(objv[2]);

    Tcl_SetIntObj(Tcl_GetObjResult(interp), (int) r);
    return TCL_OK;
}

int
T4Storage::CBDelCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *ePtr;
    int i;
    T4CallbackRecord *r;
    Tcl_Obj *o;

    /*
     * Expecting one argument, the callback token.
     */

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback del callbacktoken");
	return TCL_ERROR;
    }

    /*
     * Extract the callback record.
     */

    if (Tcl_GetIntFromObj(interp, objv[0], &i) != TCL_OK) {
	return TCL_ERROR;
    }
    r = (T4CallbackRecord *) i;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    /*
     * Unrecord this script.
     */

    ePtr = E4_FINDHASHENTRY(spp->callbacks, (char *) r);
    if (ePtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "invalid callback token ",
			       Tcl_GetString(objv[0]), NULL);
	return TCL_ERROR;
    }
    o = (Tcl_Obj *) Tcl_GetHashValue(ePtr);
    Tcl_DecrRefCount(o);

    /*
     * Delete the hash entry.
     */

    Tcl_DeleteHashEntry(ePtr);

    /*
     * Now figure out if this was the last recorded Tcl-level callback
     * of this kind. If so, then remove the e4Graph-level callback.
     */

    switch (r->kind) {
    case E4_ECADDNODE:
	spp->cbaddnode--;
	if (spp->cbaddnode <= 0) {
	    s.DeleteCallback(E4_ECADDNODE,
			     NodeAddCallbackFn,
			     (void *) spp->cbAddNodeRecord);
	    delete spp->cbAddNodeRecord;
	    spp->cbAddNodeRecord = NULL;
	}
	break;
    case E4_ECDETNODE:
	spp->cbdetnode--;
	if (spp->cbdetnode <= 0) {
	    s.DeleteCallback(E4_ECDETNODE,
			     NodeDetCallbackFn,
			     (void *) spp->cbDetNodeRecord);
	    delete spp->cbDetNodeRecord;
	    spp->cbDetNodeRecord = NULL;
	}
	break;
    case E4_ECATTNODE:
	spp->cbattnode--;
	if (spp->cbattnode <= 0) {
	    s.DeleteCallback(E4_ECATTNODE,
			     NodeAttCallbackFn,
			     (void *) spp->cbAttNodeRecord);
	    delete spp->cbAttNodeRecord;
	    spp->cbAttNodeRecord = NULL;
	}
	break;
    case E4_ECMODNODE:
	spp->cbmodnode--;
	if (spp->cbmodnode < 0) {
	    spp->cbmodnode = 0;
	}
	break;
    case E4_ECADDVERTEX:
	spp->cbaddvertex--;
	if (spp->cbaddvertex <= 0) {
	    s.DeleteCallback(E4_ECADDVERTEX,
			     VertexAddCallbackFn,
			     (void *) spp->cbAddVertexRecord);
	    delete spp->cbAddVertexRecord;
	    spp->cbAddVertexRecord = NULL;
	}
	break;
    case E4_ECDETVERTEX:
	spp->cbdetvertex--;
	if (spp->cbdetvertex <= 0) {
	    s.DeleteCallback(E4_ECDETVERTEX,
			     VertexDetCallbackFn,
			     (void *) spp->cbDetVertexRecord);
	    delete spp->cbDetVertexRecord;
	    spp->cbDetVertexRecord = NULL;
	}
	break;
    case E4_ECATTVERTEX:
	spp->cbattvertex--;
	if (spp->cbattvertex <= 0) {
	    s.DeleteCallback(E4_ECATTVERTEX,
			     VertexAttCallbackFn,
			     (void *) spp->cbAttVertexRecord);
	    delete spp->cbAttVertexRecord;
	    spp->cbAttVertexRecord = NULL;
	}
	break;
    case E4_ECMODVERTEX:
	spp->cbmodvertex--;
	if (spp->cbmodvertex < 0) {
	    spp->cbmodvertex = 0;
	}
	break;
    case E4_ECCHANGESTG:
	spp->cbchgstorage--;
	if (spp->cbchgstorage <= 0) {
	    s.DeleteCallback(E4_ECCHANGESTG,
			     StorageChangeCallbackFn,
			     (void *) spp->cbChgStorageRecord);
	    delete spp->cbChgStorageRecord;
	    spp->cbChgStorageRecord = NULL;
	}
    }

    /*
     * Finally, delete the callback token.
     */

    delete r;

    return TCL_OK;
}

int
T4Storage::CBGetCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);

    Tcl_HashEntry *ePtr;
    int i;
    T4CallbackRecord *r;
    Tcl_Obj *o;

    /*
     * Expecting one argument, the callback token.
     */

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback get callbacktoken");
	return TCL_ERROR;
    }

    /*
     * Extract the callback record.
     */

    if (Tcl_GetIntFromObj(interp, objv[0], &i) != TCL_OK) {
	return TCL_ERROR;
    }
    r = (T4CallbackRecord *) i;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    /*
     * See if we have such a record.
     */

    ePtr = E4_FINDHASHENTRY(spp->callbacks, (char *) r);
    if (ePtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "invalid callback token ",
			       Tcl_GetString(objv[0]), NULL);
	return TCL_ERROR;
    }
    o = (Tcl_Obj *) Tcl_GetHashValue(ePtr);

    /*
     * Now return the actual script.
     */

    Tcl_SetObjResult(interp, o);

    return TCL_OK;
}

int
T4Storage::CBSetCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *ePtr;
    int i;
    T4CallbackRecord *r;
    Tcl_Obj *o;

    /*
     * Expecting two argument, the callback token and the new script.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback get callbacktoken");
	return TCL_ERROR;
    }

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    /*
     * Extract the callback record.
     */

    if (Tcl_GetIntFromObj(interp, objv[0], &i) != TCL_OK) {
	return TCL_ERROR;
    }
    r = (T4CallbackRecord *) i;

    /*
     * See if we have such a record.
     */

    ePtr = E4_FINDHASHENTRY(spp->callbacks, (char *) r);
    if (ePtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "invalid callback token ",
			       Tcl_GetString(objv[0]), NULL);
	return TCL_ERROR;
    }
    o = (Tcl_Obj *) Tcl_GetHashValue(ePtr);

    /*
     * Discard old script.
     */

    Tcl_DecrRefCount(o);

    /*
     * Install new script.
     */

    E4_SETHASHVALUE(ePtr, objv[1]);
    Tcl_IncrRefCount(objv[1]);
    
    /*
     * Now return the callback token, as we do when it was created.
     */

    Tcl_SetObjResult(interp, objv[0]);
    
    return TCL_OK;
}

int
T4Storage::CBKindCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *ePtr;
    int i;
    T4CallbackRecord *r;
    char buffer[128];

    /*
     * Expecting one argument, the callback token.
     */

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback kind callbacktoken");
	return TCL_ERROR;
    }

    /*
     * Extract the callback record.
     */

    if (Tcl_GetIntFromObj(interp, objv[0], &i) != TCL_OK) {
	return TCL_ERROR;
    }
    r = (T4CallbackRecord *) i;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }
    
    /*
     * See if we have such a record.
     */

    ePtr = E4_FINDHASHENTRY(spp->callbacks, (char *) r);
    if (ePtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "invalid callback token ",
			       Tcl_GetString(objv[0]), NULL);
	return TCL_ERROR;
    }

    switch (r->kind) {
    case E4_ECADDNODE:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "node add", NULL);
	break;
    case E4_ECADDVERTEX:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "vertex add", NULL);
	break;
    case E4_ECDETNODE:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "node detach", NULL);
	break;
    case E4_ECATTNODE:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "node attach", NULL);
	break;
    case E4_ECMODNODE:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "node modify", NULL);
	break;
    case E4_ECDETVERTEX:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "vertex detach", NULL);
	break;
    case E4_ECATTVERTEX:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "vertex attach", NULL);
	break;
    case E4_ECMODVERTEX:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "vertex modify", NULL);
	break;
    case E4_ECCHANGESTG:
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage change", NULL);
	break;
    default:
	/*
	 * User defined event code.
	 */

	sprintf(buffer, "userdefined %d", r->kind);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       buffer, NULL);
	break;
    }

    return TCL_OK;
}

int
T4Storage::CBCountCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    T4ObjectKindSelector cbos;
    T4CallbackEventSelector cbes;

    /*
     * Expecting two arguments, an object selector and an event selector.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback count objsel eventsel");
	return TCL_ERROR;
    }

    /*
     * Attempt to parse the object selector.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0], 
			    (CONST84 char **) objectkindselectors,
			    (char *) "objsel", 0, (int *) &cbos)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Attempt to parse the event selector.
     */

    if (Tcl_GetIndexFromObj(interp, objv[1], 
			    (CONST84 char **) callbackeventselectors,
			    (char *) "eventsel", 0, (int *) &cbes)
	!= TCL_OK){
	return TCL_ERROR;
    }

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    switch (cbos) {
    case T4_OKNODE:
	switch (cbes) {
	case T4_CBESMOD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbmodnode);
	    break;
	case T4_CBESADD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbaddnode);
	    break;
	case T4_CBESDET:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbdetnode);
	    break;
	case T4_CBESATT:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbattnode);
	    break;
	case T4_CBESCHG:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid callback operation on node",
				   NULL);
	    return TCL_ERROR;
	}
	break;
    case T4_OKVERTEX:
	switch (cbes) {
	case T4_CBESMOD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbmodvertex);
	    break;
	case T4_CBESADD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbaddvertex);
	    break;
	case T4_CBESDET:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbdetvertex);
	    break;
	case T4_CBESATT:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbattvertex);
	    break;
	case T4_CBESCHG:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid callback operation on vertex",
				   NULL);
	    return TCL_ERROR;
	}
	break;
    case T4_OKSTORAGE:
	switch (cbes) {
	case T4_CBESMOD:
	case T4_CBESADD:
	case T4_CBESDET:
	case T4_CBESATT:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
				   "invalid callback operation on storage",
				   NULL);
	    return TCL_ERROR;
	case T4_CBESCHG:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), spp->cbchgstorage);
	    break;
	}
	break;
    }

    return TCL_OK;
}

int
T4Storage::CBHasCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    T4ObjectKindSelector cbos;
    T4CallbackEventSelector cbes;

    /*
     * Expecting two arguments, an object selector and an event selector.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, NULL,
			 (char *) "$storage callback exists objsel eventsel");
	return TCL_ERROR;
    }

    /*
     * Attempt to parse the object selector.
     */

    if (Tcl_GetIndexFromObj(interp, objv[0],
			    (CONST84 char **) objectkindselectors,
			    (char *) "objsel", 0, (int *) &cbos)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Attempt to parse the event selector.
     */

    if (Tcl_GetIndexFromObj(interp, objv[1],
			    (CONST84 char **) callbackeventselectors,
			    (char *) "eventsel", 0, (int *) &cbes)
	!= TCL_OK){
	return TCL_ERROR;
    }

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "storage ", GetName(),
			       " is unavailable in this interpreter",
			       NULL);
	return TCL_ERROR;
    }

    switch (cbos) {
    case T4_OKNODE:
	switch (cbes) {
	case T4_CBESMOD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbmodnode > 0) ? 1 : 0);
	    break;
	case T4_CBESADD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbaddnode > 0) ? 1 : 0);
	    break;
	case T4_CBESDET:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbdetnode > 0) ? 1 : 0);
	    break;
	case T4_CBESATT:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbattnode > 0) ? 1 : 0);
	    break;
	case T4_CBESCHG:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	    break;
	}
	break;
    case T4_OKVERTEX:
	switch (cbes) {
	case T4_CBESMOD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbmodvertex > 0) ? 1 : 0);
	    break;
	case T4_CBESADD:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 
			  (spp->cbaddvertex > 0) ? 1 : 0);
	    break;
	case T4_CBESDET:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbdetvertex > 0) ? 1 : 0);
	    break;
	case T4_CBESATT:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbattvertex > 0) ? 1 : 0);
	    break;
	case T4_CBESCHG:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	    break;
	}
	break;
    case T4_OKSTORAGE:
	switch (cbes) {
	case T4_CBESMOD:
	case T4_CBESADD:
	case T4_CBESDET:
	case T4_CBESATT:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	    break;
	case T4_CBESCHG:
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
			  (spp->cbchgstorage > 0) ? 1 : 0);
	    break;
	}
	break;
    }

    return TCL_OK;
}

void
T4Storage::AddNodeCallback(Tcl_Interp *interp, e4_Node n)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    e4_NodeUniqueID nuid;
    T4Node *np;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	return;
    }

    /*
     * Ensure the node is exported to Tcl.
     */

    if (!n.GetUniqueID(nuid)) {
	return;
    }
    np = GetNodeById(interp, nuid);
    if (np == NULL) {
	np = new T4Node(n, this);
	StoreNode(interp, np, nuid);
    }
    res = np->GetTclObject();
    if (res == NULL) {
	res = GO_MakeGenObject(nodeExt, np, interp);
	np->SetTclObject(res);
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for adding nodes.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECADDNODE) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }

    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::DetNodeCallback(Tcl_Interp *interp, e4_Node n)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    e4_NodeUniqueID nuid;
    T4Node *np;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	return;
    }

    /*
     * Ensure the node is exported to Tcl, if not, punt.
     */

    if (!n.GetUniqueID(nuid)) {
	return;
    }
    np = GetNodeById(interp, nuid);
    if (np == NULL) {
	return;
    }
    res = np->GetTclObject();
    if (res == NULL) {
	return;
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for deleting nodes.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECDETNODE) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::AttNodeCallback(Tcl_Interp *interp, e4_Node n)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    e4_NodeUniqueID nuid;
    T4Node *np;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	return;
    }

    /*
     * Ensure the node is exported to Tcl, if not, punt.
     */

    if (!n.GetUniqueID(nuid)) {
	return;
    }
    np = GetNodeById(interp, nuid);
    if (np == NULL) {
	return;
    }
    res = np->GetTclObject();
    if (res == NULL) {
	return;
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for deleting nodes.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECATTNODE) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::AddVertexCallback(Tcl_Interp *interp, e4_Vertex v)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    T4Vertex *vp;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	return;
    }

    /*
     * Ensure the vertex is exported to Tcl.
     */

    if (!v.GetUniqueID(vuid)) {
	return;
    }
    vp = GetVertexById(interp, vuid);
    if (vp == NULL) {
	vp = new T4Vertex(v, this);
	StoreVertex(interp, vp, vuid);
    }
    res = vp->GetTclObject();
    if (res == NULL) {
	res = GO_MakeGenObject(vertexExt, vp, interp);
	vp->SetTclObject(res);
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for adding vertices.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECADDVERTEX) {
	    continue;
	}

	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::DetVertexCallback(Tcl_Interp *interp, e4_Vertex v)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    T4Vertex *vp;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	return;
    }

    /*
     * Ensure the vertex is exported to Tcl, if not, punt.
     */

    if (!v.GetUniqueID(vuid)) {
	return;
    }
    vp = GetVertexById(interp, vuid);
    if (vp == NULL) {
	return;
    }
    res = vp->GetTclObject();
    if (res == NULL) {
	return;
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for deleting vertices.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECDETVERTEX) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::AttVertexCallback(Tcl_Interp *interp, e4_Vertex v)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    e4_VertexUniqueID vuid;
    T4Vertex *vp;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * If the storage is unavailable in this interpreter, punt.
     */

    if (spp == NULL) {
	return;
    }

    /*
     * Ensure the vertex is exported to Tcl, if not, punt.
     */

    if (!v.GetUniqueID(vuid)) {
	return;
    }
    vp = GetVertexById(interp, vuid);
    if (vp == NULL) {
	return;
    }
    res = vp->GetTclObject();
    if (res == NULL) {
	return;
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for deleting vertices.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECATTVERTEX) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

/*
 * Special, always-on callbacks for vertex and node modification. These
 * methods do some bookkeeping before calling any Tcl scripts registered
 * for these callbacks.
 */

void
T4Storage::ModNodeCallback(T4StoragePerInterp *spp,
			   e4_Node n,
			   e4_ModNodeEventReason cbr)
{
    Tcl_Interp *interp = spp->interp;
    e4_NodeUniqueID nuid;
    T4Node *np;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * Ensure the node is exported to Tcl, if not, punt.
     */

    if (!n.GetUniqueID(nuid)) {
	return;
    }
    np = GetNodeById(interp, nuid);
    if (np == NULL) {
	return;
    }
    res = np->GetTclObject();
    if (res == NULL) {
	return;
    }
    Tcl_IncrRefCount(res);

    /*
     * Iterate over all callbacks and invoke the ones for deleting nodes.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECMODNODE) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::ModVertexCallback(T4StoragePerInterp *spp,
			     e4_Vertex v,
			     e4_ModVertexEventReason cbr)
{
    Tcl_Interp *interp = spp->interp;
    e4_VertexUniqueID vuid;
    T4Vertex *vp;
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    /*
     * Ensure the vertex is exported to Tcl. If not, punt.
     */

    if (!v.GetUniqueID(vuid)) {
	return;
    }
    vp = GetVertexById(interp, vuid);
    if (vp == NULL) {
	return;
    }
    res = vp->GetTclObject();
    if (res == NULL) {
	return;
    }
    Tcl_IncrRefCount(res);

    /*
     * If the vertex's value was modified, flush the state
     * associated with this vertex.
     */

    if (cbr == E4_ERMVMODVALUE) {
	spp->storage->ClearVertexStoredState(interp, v);
    }

    /*
     * Iterate over all callbacks and invoke the ones for deleting vertices.
     */

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECMODVERTEX) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}

void
T4Storage::ChangeStorageCallback(Tcl_Interp *interp)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);
    Tcl_HashEntry *ePtr;
    Tcl_HashSearch search;
    T4CallbackRecord *r;
    Tcl_Obj *res;
    Tcl_Obj **objv, **newobjv;
    int objc, i, status;

    res = Tcl_NewObj();
    Tcl_SetStringObj(res, GetName(), -1);
    Tcl_IncrRefCount(res);

    for (ePtr = Tcl_FirstHashEntry(spp->callbacks, &search);
	 ePtr != NULL;
	 ePtr = Tcl_NextHashEntry(&search)) {
	r = (T4CallbackRecord *) Tcl_GetHashKey(spp->callbacks, ePtr);
	if (r->kind != E4_ECCHANGESTG) {
	    continue;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, (Tcl_Obj *) Tcl_GetHashValue(ePtr),
				   &objc, &objv) != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
	newobjv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) *
					 (objc + 1));
	for (i = 0; i < objc; i++) {
	    newobjv[i] = objv[i];
	}
	newobjv[objc] = res;
	status = Tcl_EvalObjv(interp, objc + 1, newobjv, 0);
	(void) Tcl_Free((char *) newobjv);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(res);
	    return;
	}
    }
    Tcl_DecrRefCount(res);
    Tcl_ResetResult(interp);
}
	
/*
 * Return the per-interpreter data structure for this storage for the given
 * interpreter. If not found, return NULL.
 */

T4StoragePerInterp *
T4Storage::GetStoragePerInterp(Tcl_Interp *interp)
{
    T4StoragePerInterp *spp;

    for (spp = spip; spp != NULL; spp = spp->next) {
	if (spp->interp == interp) {
	    return spp;
	}
    }
    return NULL;
}

/*
 * Register the storage in the given interpreter, after ensuring
 * that the interpreter has a proper data association for registering
 * storages.
 */

void
T4Storage::RegisterStoragePerInterp(Tcl_Interp *interp)
{
    T4StoragePerInterp *spp = GetStoragePerInterp(interp);

    /*
     * If the storage is already available in the given interpreter, just
     * return.
     */

    if (spp != NULL) {
	return;
    }

    /*
     * Not available yet, make a new record and link it into the list
     * of per-interpreter records.
     */

    spp = new T4StoragePerInterp;

    /*
     * Store the storage it belongs to.
     */

    spp->storage = this;

    /*
     * Initialize hash table storage for T4Graph objects that
     * were exported to Tcl:
     */

    spp->exportedNodes = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(spp->exportedNodes, TCL_ONE_WORD_KEYS);
    spp->exportedVertices = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(spp->exportedVertices, TCL_ONE_WORD_KEYS);
    spp->storedProcs = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(spp->storedProcs, TCL_ONE_WORD_KEYS);
    spp->storedValues = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(spp->storedValues, TCL_ONE_WORD_KEYS);

    /*
     * Initialize the Tcl callback facility.
     */

    spp->callbacks = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(spp->callbacks, TCL_ONE_WORD_KEYS);

    /*
     * Add per-storage-per-interp internal maintainence callbacks:
     */

    s.DeclareCallback(E4_ECMODNODE, NodeModCallbackFn, (void *) spp);
    s.DeclareCallback(E4_ECMODVERTEX, VertexModCallbackFn, (void *) spp);

    /*
     * Initialize callback counters.
     */

    spp->cbaddnode = 0;
    spp->cbaddvertex = 0;
    spp->cbdetnode = 0;
    spp->cbdetvertex = 0;
    spp->cbattnode = 0;
    spp->cbattvertex = 0;
    spp->cbmodnode = 0;
    spp->cbmodvertex = 0;
    spp->cbchgstorage = 0;

    spp->cbAddNodeRecord = NULL;
    spp->cbAddVertexRecord = NULL;
    spp->cbDetNodeRecord = NULL;
    spp->cbDetVertexRecord = NULL;
    spp->cbAttNodeRecord = NULL;
    spp->cbAttVertexRecord = NULL;
    spp->cbChgStorageRecord = NULL;

    spp->interp = interp;

    /*
     * Link the new record into the chain.
     */

    spp->next = spip;
    spp->prev = NULL;

    if (spip != NULL) {
	spip->prev = spp;
    }
    spip = spp;
}

/*
 * This procedure unregisters this storage in the given interpreter.
 */

void
T4Storage::UnregisterStoragePerInterp(Tcl_Interp *interp)
{
    InternalClose(interp, true);

    Tcl_ResetResult(interp);
}

/*
 * These options are valid for $storage configure and tgraph::open:
 */

static CONST84 char *optionNames[] = {
    (char *) "-rwmode",
    (char *) "-driver",
    (char *) "-commitatclose",
    (char *) "-opengc",
    (char *) "-gcbeforecommit",
    (char *) "-autogc",
    (char *) "-bigprealloc",
    (char *) "-compactatclose",
    NULL
};
typedef enum SOptions {
    SORWMode = 0,
    SODriver = 1,
    SOCommitAtClose = 2,
    SOOpenGC = 3,
    SOGCBeforeCommit = 4,
    SOAutoGC = 5,
    SOBigPrealloc = 6,
    SOCompactAtClose = 7
};

/*
 * Helper method to return all storage options for this storage.
 */

int
T4Storage::GetStorageOptions(Tcl_Interp *interp)
{
    int modes;
    Tcl_Obj *lobj;

    Tcl_ResetResult(interp);

    if (!s.IsValid()) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "$storage configure: invalid storage", NULL);
	return TCL_ERROR;
    }

    lobj = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj("-driver", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewStringObj(s.GetDriver(), -1));
    Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj("-rwmode", -1));
    Tcl_ListObjAppendElement(interp, lobj, Tcl_NewStringObj("rw", -1));

    modes = s.GetState();

    Tcl_ListObjAppendElement(interp, lobj, 
			     Tcl_NewStringObj("-commitatclose", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewIntObj(((modes & E4_COMMITATCLOSE) == 0)
					   ? 0 : 1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewStringObj("-opengc", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewIntObj(((modes & E4_OPENGC) == 0) 
					   ? 0 : 1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewStringObj("-gcbeforecommit", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewIntObj(((modes & E4_GCBEFORECOMMIT) == 0)
					   ? 0 : 1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewStringObj("-autogc", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewIntObj(((modes & E4_AUTOGC) == 0) 
					   ? 0 : 1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewStringObj("-bigprealloc", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewIntObj(((modes & E4_BIGPREALLOC) == 0) 
					   ? 0 : 1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewStringObj("-compactatclose", -1));
    Tcl_ListObjAppendElement(interp, lobj,
			     Tcl_NewIntObj(((modes & E4_COMPACTATCLOSE) == 0) 
					   ? 0 : 1));
    Tcl_SetObjResult(interp, lobj);

    return TCL_OK;
}

/*
 * Helper method to return a specific option value for this storage.
 */

int
T4Storage::GetStorageOption(Tcl_Interp *interp, Tcl_Obj *opt)
{
   SOptions index;
   int modes;

    /*
     * Check if the storage is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "$storage configure: invalid storage",
			       NULL);
	return TCL_ERROR;
    }

    /*
     * See if the requested option is valid.
     */

    if (Tcl_GetIndexFromObj(interp, opt,
			    (CONST84 char **) optionNames,
			    (char *) "option",
			    0, (int *) &index) 
	!= TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Return the relevant option:
     */

    switch (index) {
    case SORWMode:
	Tcl_SetStringObj(Tcl_GetObjResult(interp), "rw", -1);
	break;
    case SODriver:
	Tcl_SetStringObj(Tcl_GetObjResult(interp), 
			 (char *) s.GetDriver(), 
			 -1);
	break;
    case SOCommitAtClose:
	modes = s.GetState();
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 ((modes & E4_COMMITATCLOSE) == 0) 
				? (char *) "0" : (char *) "1",
			 -1);
	break;
    case SOOpenGC:
	modes = s.GetState();
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 ((modes & E4_OPENGC) == 0)
				? (char *) "0" : (char *) "1",
			 -1);
	break;
    case SOGCBeforeCommit:
	modes = s.GetState();
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 ((modes & E4_GCBEFORECOMMIT) == 0)
				? (char *) "0" : (char *) "1",
			 -1);
	break;
    case SOAutoGC:
	modes = s.GetState();
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 ((modes & E4_AUTOGC) == 0)
				? (char *) "0" : (char *) "1",
			 -1);
	break;
    case SOBigPrealloc:
	modes = s.GetState();
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 ((modes & E4_BIGPREALLOC) == 0)
				? (char *) "0" : (char *) "1",
			 -1);
	break;
    case SOCompactAtClose:
	modes = s.GetState();
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 ((modes & E4_COMPACTATCLOSE) == 0)
				? (char *) "0" : (char *) "1",
			 -1);
	break;
    }

    return TCL_OK;
}
    
/*
 * Parse storage options given to tgraph::open or $storage configure.
 * Returns 1 on success, 0 on failure.
 */

int
T4Graph_ParseStorageOptions(Tcl_Interp *interp,
			    int objc, 
			    Tcl_Obj *CONST objv[],
			    T4StorageOptions *options)
{
   int i, bv;
   SOptions index;

   for (i = 0; i < objc; i += 2) {

	/*
	 * Parse the next option selector.
	 */

	if (Tcl_GetIndexFromObj(interp, objv[i], 
				(CONST84 char **) optionNames,
				(char *) "option", i, (int *) &index) 
	    != TCL_OK) {
	    return 0;
	}

	/*
	 * Parse the option value.
	 */

	switch (index) {
	case SORWMode:
	    Tcl_AppendResult(interp, 
			     "Cannot set read-only option -rwmode", NULL);
	    return 0;
	case SODriver:
	    Tcl_AppendResult(interp,
			     "Cannot set read-only option -driver", NULL);
	    return 0;
	case SOCommitAtClose:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &bv) == TCL_ERROR) {
		return 0;
	    }
	    if (bv == 1) {
		options->modes |= E4_COMMITATCLOSE;
	    } else {
		options->modes &= (~(E4_COMMITATCLOSE));
	    }
	    break;
	case SOOpenGC:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &bv) == TCL_ERROR) {
		return 0;
	    }
	    if (bv == 1) {
		options->modes |= E4_OPENGC;
	    } else {
		options->modes &= (~(E4_OPENGC));
	    }
	    break;
	case SOGCBeforeCommit:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &bv) == TCL_ERROR) {
		return 0;
	    }
	    if (bv == 1) {
		options->modes |= E4_GCBEFORECOMMIT;
	    } else {
		options->modes &= (~(E4_GCBEFORECOMMIT));
	    }
	    break;
	case SOAutoGC:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &bv) == TCL_ERROR) {
		return 0;
	    }
	    if (bv == 1) {
		options->modes |= E4_AUTOGC;
	    } else {
		options->modes &= (~(E4_AUTOGC));
	    }
	    break;
	case SOBigPrealloc:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &bv) == TCL_ERROR) {
		return 0;
	    }
	    if (bv == 1) {
		options->modes |= E4_BIGPREALLOC;
	    } else {
		options->modes &= (~(E4_BIGPREALLOC));
	    }
	    break;
	case SOCompactAtClose:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &bv) == TCL_ERROR) {
		return 0;
	    }
	    if (bv == 1) {
		options->modes |= E4_COMPACTATCLOSE;
	    } else {
		options->modes &= (~(E4_COMPACTATCLOSE));
	    }
	    break;
	}
   }

   return 1;
}

/*
 * Helper method to set configuration options. Only the behavior modes
 * can be set, the other options are silently ignored.
 */

int
T4Storage::SetStorageOptions(Tcl_Interp *interp, int objc,
			     Tcl_Obj *CONST objv[])
{
    T4StorageOptions options;

    /*
     * Check if the storage is valid.
     */

    if (!s.IsValid()) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			       "$storage configure: invalid storage",
			       NULL);
	return TCL_ERROR;
    }

    /*
     * Initialize the options to the current settings.
     */

    options.modes = s.GetState();

    /*
     * Parse all the options and their values.
     */

    if (!T4Graph_ParseStorageOptions(interp, objc, objv, &options)) {
	return TCL_ERROR;
    }

    /*
     * Make the interpreter result contain a list describing the
     * previous values of all options.
     */

    GetStorageOptions(interp);

    /*
     * Set the new behavior state.
     */

    s.SetState(options.modes);

    /*
     * All done.
     */

    return TCL_OK;
}
