Undo mistaken commit to wrong branch caused by CVS fumble... :-}

1 files changed, 0 insertions, 953 deletions

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
deleted file mode 100644
index 9f2635b..0000000
--- a/generic/tclOODefineCmds.c
+++ /dev/null
@@ -1,953 +0,0 @@
-/*
- * tclOODefineCmds.c --
- *
- *	This file contains the implementation of the ::oo::define command,
- *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
- *
- * Copyright (c) 2006 by Donal K. Fellows
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOODefineCmds.c,v 1.2 2006/10/20 14:04:01 dkf Exp $
- */
-
-#include "tclInt.h"
-#include "tclOO.h"
-
-static Object *		GetDefineCmdContext(Tcl_Interp *interp);
-
-int
-TclOODefineObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    CallFrame *framePtr, **framePtrPtr;
-    Foundation *fPtr = ((Interp *) interp)->ooFoundation;
-    int result;
-    Object *oPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the oo::define namespace the current namespace and evaluate the
-     * command(s).
-     */
-
-    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
-    framePtrPtr = &framePtr;
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
-	    (Tcl_Namespace *) fPtr->defineNs, FRAME_IS_OO_DEFINE);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-    framePtr->ooContextPtr = oPtr;
-    framePtr->objc = objc;
-    framePtr->objv = objv;	/* Reference counts do not need to be
-				 * incremented here. */
-
-    if (objc == 3) {
-	result = Tcl_EvalObjEx(interp, objv[2], 0);
-
-	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
-	    int limit = 200;
-	    int overflow = (length > limit);
-
-	    TclFormatToErrorInfo(interp,
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), interp->errorLine);
-	}
-    } else {
-	Tcl_Obj *objPtr, *obj2Ptr, **objs;
-	Interp *iPtr = (Interp *) interp;
-	Tcl_Command cmd;
-	int dummy;
-
-	/*
-	 * More than one argument: fire them through the ensemble processing
-	 * engine so that everything appears to be good and proper in error
-	 * messages. Note that we cannot just concatenate and send through
-	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
-	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
-	 * the command, as that finds command names in the wrong namespace at
-	 * the moment. Ugly!
-	 */
-
-	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-	    iPtr->ensembleRewrite.sourceObjs = objv;
-	    iPtr->ensembleRewrite.numRemovedObjs = 3;
-	    iPtr->ensembleRewrite.numInsertedObjs = 1;
-	} else {
-	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
-	    if (ni < 3) {
-		iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
-	    } else {
-		iPtr->ensembleRewrite.numInsertedObjs -= 2;
-	    }
-	}
-
-	/*
-	 * Build the list of arguments using a Tcl_Obj as a workspace. See
-	 * comments above for why these contortions are necessary.
-	 */
-
-	TclNewObj(objPtr);
-	TclNewObj(obj2Ptr);
-	cmd = Tcl_FindCommand(interp, TclGetString(objv[2]), fPtr->defineNs,
-		TCL_NAMESPACE_ONLY);
-	if (cmd == NULL) {
-	    /* punt this case! */
-	    Tcl_AppendObjToObj(obj2Ptr, objv[2]);
-	} else {
-	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
-	}
-	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
-	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
-	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
-	result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
-	TclDecrRefCount(objPtr);
-    }
-
-    /*
-     * Restore the previous "current" namespace.
-     */
-
-    TclPopStackFrame(interp);
-    return result;
-}
-
-static Object *
-GetDefineCmdContext(
-    Tcl_Interp *interp)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if ((iPtr->framePtr == NULL)
-	    || (iPtr->framePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
-	Tcl_AppendResult(interp, "this command may only be called from within"
-		" the context of the ::oo::define command", NULL);
-	return NULL;
-    }
-    return (Object *) iPtr->framePtr->ooContextPtr;
-}
-
-int
-TclOODefineConstructorObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr;
-    Class *clsPtr;
-    int bodyLength;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Extract and validate the context, which is the class that we wish to
-     * modify.
-     */
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (oPtr->classPtr == NULL) {
-	Tcl_AppendResult(interp, "only classes may have constructors defined",
-		NULL);
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-
-    (void) Tcl_GetStringFromObj(objv[2], &bodyLength);
-    if (bodyLength > 0) {
-	/*
-	 * Create the method structure.
-	 */
-
-	Method *mPtr;
-
-	mPtr = TclOONewProcClassMethod(interp, clsPtr, 1, NULL, objv[1],
-		objv[2]);
-	if (mPtr == NULL) {
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Place the method structure in the class record. Note that we might
-	 * not immediately delete the constructor as this might be being done
-	 * during execution of the constructor itself.
-	 */
-
-	TclOODeleteMethod(clsPtr->constructorPtr);
-	clsPtr->constructorPtr = mPtr;
-    } else {
-	/*
-	 * Delete the constructor method record and set the field in the class
-	 * record to NULL.
-	 */
-
-	TclOODeleteMethod(clsPtr->constructorPtr);
-	clsPtr->constructorPtr = NULL;
-    }
-
-    return TCL_OK;
-}
-
-int
-TclOODefineCopyObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Tcl_Object oPtr, o2Ptr;
-
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?targetName?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Tcl_Object) GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Create a cloned object of the correct class. Note that constructors are
-     * not called. Also note that we must resolve the object name ourselves
-     * because we do not want to create the object in the current namespace,
-     * but rather in the context of the namespace of the caller of the overall
-     * [oo::define] command.
-     */
-
-    if (objc == 1) {
-	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL);
-    } else {
-	char *name;
-	Tcl_DString buffer;
-
-	name = TclGetString(objv[1]);
-	Tcl_DStringInit(&buffer);
-	if (name[0]!=':' || name[1]!=':') {
-	    Interp *iPtr = (Interp *) interp;
-	    CallFrame *callerFramePtr = iPtr->varFramePtr->callerVarPtr;
-
-	    if (callerFramePtr != NULL) {
-		Tcl_DStringAppend(&buffer,
-			callerFramePtr->nsPtr->fullName, -1);
-	    }
-	    Tcl_DStringAppend(&buffer, "::", 2);
-	    Tcl_DStringAppend(&buffer, name, -1);
-	    name = Tcl_DStringValue(&buffer);
-	}
-	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name);
-	Tcl_DStringFree(&buffer);
-    }
-
-    if (o2Ptr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Return the name of the cloned object.
-     */
-
-    Tcl_GetCommandFullName(interp, Tcl_GetObjectCommand(o2Ptr),
-	    Tcl_GetObjResult(interp));
-    return TCL_OK;
-}
-
-int
-TclOODefineDestructorObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr;
-    Class *clsPtr;
-    int bodyLength;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "body");
-	return TCL_ERROR;
-    }
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (oPtr->classPtr == NULL) {
-	Tcl_AppendResult(interp, "only classes may have destructors defined",
-		NULL);
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-
-    (void) Tcl_GetStringFromObj(objv[1], &bodyLength);
-    if (bodyLength > 0) {
-	/*
-	 * Create the method structure.
-	 */
-
-	Method *mPtr;
-
-	mPtr = TclOONewProcClassMethod(interp, clsPtr, 1, NULL, NULL,
-		objv[1]);
-	if (mPtr == NULL) {
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Place the method structure in the class record. Note that we might
-	 * not immediately delete the destructor as this might be being done
-	 * during execution of the destructor itself.
-	 */
-
-	TclOODeleteMethod(clsPtr->destructorPtr);
-	clsPtr->destructorPtr = mPtr;
-    } else {
-	/*
-	 * Delete the destructor method record and set the field in the class
-	 * record to NULL.
-	 */
-
-	TclOODeleteMethod(clsPtr->destructorPtr);
-	clsPtr->destructorPtr = NULL;
-    }
-
-    return TCL_OK;
-}
-
-int
-TclOODefineExportObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isSelfExport = (clientData != NULL);
-    Object *oPtr;
-    Method *mPtr;
-    Tcl_HashEntry *hPtr;
-    Class *clsPtr;
-    int i, isNew;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-    isSelfExport |= (clsPtr == NULL);
-
-    for (i=1 ; i<objc ; i++) {
-	if (isSelfExport) {
-	    hPtr = Tcl_CreateHashEntry(&oPtr->methods, (char *) objv[i],
-		    &isNew);
-	} else {
-	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
-		    &isNew);
-	}
-
-	if (isNew) {
-	    mPtr = (Method *) ckalloc(sizeof(Method));
-	    memset(mPtr, 0, sizeof(Method));
-	    Tcl_SetHashValue(hPtr, mPtr);
-	} else {
-	    mPtr = Tcl_GetHashValue(hPtr);
-	}
-	mPtr->flags |= PUBLIC_METHOD;
-    }
-    if (isSelfExport) {
-	oPtr->epoch++;
-    } else {
-	((Interp *)interp)->ooFoundation->epoch++;
-    }
-    return TCL_OK;
-}
-
-int
-TclOODefineFilterObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isSelfFilter = (clientData != NULL);
-    Object *oPtr;
-    int i;
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    isSelfFilter |= (oPtr->classPtr == NULL);
-
-    if (!isSelfFilter) {
-	if (oPtr->classPtr->filters.num) {
-	    Tcl_Obj *filterObj;
-
-	    FOREACH(filterObj, oPtr->classPtr->filters) {
-		TclDecrRefCount(filterObj);
-	    }
-	}
-
-	if (objc == 1) {
-	    // deleting filters
-	    ckfree((char *) oPtr->classPtr->filters.list);
-	    oPtr->classPtr->filters.list = NULL;
-	    oPtr->classPtr->filters.num = 0;
-	} else {
-	    // creating filters
-	    Tcl_Obj **filters;
-
-	    if (oPtr->classPtr->filters.num == 0) {
-		filters = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc-1));
-	    } else {
-		filters = (Tcl_Obj **) ckrealloc(
-			(char *) oPtr->classPtr->filters.list,
-			sizeof(Tcl_Obj *) * (objc-1));
-	    }
-	    for (i=1 ; i<objc ; i++) {
-		filters[i-1] = objv[i];
-		Tcl_IncrRefCount(objv[i]);
-	    }
-	    oPtr->classPtr->filters.list = filters;
-	    oPtr->classPtr->filters.num = objc-1;
-	}
-	// may be many objects affected
-	((Interp *)interp)->ooFoundation->epoch++;
-    } else {
-	if (oPtr->filters.num) {
-	    Tcl_Obj *filterObj;
-
-	    FOREACH(filterObj, oPtr->filters) {
-		TclDecrRefCount(filterObj);
-	    }
-	}
-	if (objc == 1) {
-	    // deleting filters
-	    ckfree((char *) oPtr->filters.list);
-	    oPtr->filters.list = NULL;
-	    oPtr->filters.num = 0;
-	} else {
-	    // creating filters
-	    Tcl_Obj **filters;
-
-	    if (oPtr->filters.num == 0) {
-		filters = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc-1));
-	    } else {
-		filters = (Tcl_Obj **) ckrealloc((char *) oPtr->filters.list,
-			sizeof(Tcl_Obj *) * (objc-1));
-	    }
-	    for (i=1 ; i<objc ; i++) {
-		filters[i-1] = objv[i];
-		Tcl_IncrRefCount(objv[i]);
-	    }
-	    oPtr->filters.list = filters;
-	    oPtr->filters.num = objc-1;
-	}
-	oPtr->epoch++; // per-object
-    }
-    return TCL_OK;
-}
-
-int
-TclOODefineForwardObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isSelfForward = (clientData != NULL);
-    Object *oPtr;
-    Method *mPtr;
-    int isPublic;
-    Tcl_Obj *prefixObj;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name cmdName ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    isSelfForward |= (oPtr->classPtr == NULL);
-    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*");
-
-    /*
-     * Create the method structure.
-     */
-
-    prefixObj = Tcl_NewListObj(objc-2, objv+2);
-    if (isSelfForward) {
-	mPtr = TclOONewForwardMethod(interp, oPtr, isPublic, objv[1],
-		prefixObj);
-    } else {
-	mPtr = TclOONewForwardClassMethod(interp, oPtr->classPtr, isPublic,
-		objv[1], prefixObj);
-    }
-    if (mPtr == NULL) {
-	TclDecrRefCount(prefixObj);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-int
-TclOODefineMethodObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isSelfMethod = (clientData != NULL);
-    Object *oPtr;
-    int bodyLength;
-
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
-	return TCL_ERROR;
-    }
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    isSelfMethod |= (oPtr->classPtr == NULL);
-
-    (void) Tcl_GetStringFromObj(objv[3], &bodyLength);
-    if (bodyLength > 0) {
-	/*
-	 * Create the method structure.
-	 */
-
-	Method *mPtr;
-	int isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*");
-
-	if (isSelfMethod) {
-	    mPtr = TclOONewProcMethod(interp, oPtr, isPublic, objv[1],
-		    objv[2], objv[3]);
-	} else {
-	    mPtr = TclOONewProcClassMethod(interp, oPtr->classPtr, isPublic,
-		    objv[1], objv[2], objv[3]);
-	}
-	if (mPtr == NULL) {
-	    return TCL_ERROR;
-	}
-    } else {
-	/*
-	 * Delete the method structure from the appropriate hash table.
-	 */
-
-	Tcl_HashEntry *hPtr;
-
-	if (isSelfMethod) {
-	    hPtr = Tcl_FindHashEntry(&oPtr->methods, (char *)objv[1]);
-	} else {
-	    hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
-		    (char *)objv[1]);
-	}
-	if (hPtr != NULL) {
-	    Method *mPtr = (Method *) Tcl_GetHashValue(hPtr);
-
-	    Tcl_DeleteHashEntry(hPtr);
-	    TclOODeleteMethod(mPtr);
-	}
-    }
-
-    return TCL_OK;
-}
-
-int
-TclOODefineMixinObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    const int objc,
-    Tcl_Obj *const *objv)
-{
-    int isSelfMixin = (clientData != NULL);
-    Object *oPtr = GetDefineCmdContext(interp);
-    Class *mixinPtr;
-    int i;
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    isSelfMixin |= (oPtr->classPtr == NULL);
-
-    if (isSelfMixin) {
-	if (objc == 1) {
-	    if (oPtr->mixins.num != 0) {
-		FOREACH(mixinPtr, oPtr->mixins) {
-		    TclOORemoveFromInstances(oPtr, mixinPtr);
-		}
-		ckfree((char *) oPtr->mixins.list);
-		oPtr->mixins.num = 0;
-	    }
-	} else {
-	    Class **mixins = (Class **) ckalloc(sizeof(Class *) * (objc-1));
-
-	    for (i=1 ; i<objc ; i++) {
-		Object *o2Ptr;
-
-		o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[i]);
-		if (o2Ptr == NULL) {
-		    goto freeAndErrorSelf;
-		}
-		if (o2Ptr->classPtr == NULL) {
-		    Tcl_AppendResult(interp, "may only mix in classes; \"",
-			    TclGetString(objv[i]), "\" is not a class", NULL);
-		freeAndErrorSelf:
-		    ckfree((char *) mixins);
-		    return TCL_ERROR;
-		}
-		mixins[i-1] = o2Ptr->classPtr;
-	    }
-	    if (oPtr->mixins.num != 0) {
-		FOREACH(mixinPtr, oPtr->mixins) {
-		    if (mixinPtr != oPtr->selfCls) {
-			TclOORemoveFromInstances(oPtr, mixinPtr);
-		    }
-		}
-		ckfree((char *) oPtr->mixins.list);
-	    }
-	    oPtr->mixins.num = objc-1;
-	    oPtr->mixins.list = mixins;
-	    FOREACH(mixinPtr, oPtr->mixins) {
-		if (mixinPtr != oPtr->selfCls) {
-		    TclOOAddToInstances(oPtr, mixinPtr);
-		}
-	    }
-	}
-	oPtr->epoch++;
-    } else {
-	register Class *clsPtr = oPtr->classPtr;
-
-	if (objc == 1) {
-	    if (clsPtr->mixins.num != 0) {
-		FOREACH(mixinPtr, clsPtr->mixins) {
-		    TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
-		}
-		ckfree((char *) clsPtr->mixins.list);
-		clsPtr->mixins.num = 0;
-	    }
-	} else {
-	    Class **mixins = (Class **) ckalloc(sizeof(Class *) * (objc-1));
-
-	    for (i=1 ; i<objc ; i++) {
-		Object *o2Ptr;
-
-		o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[i]);
-		if (o2Ptr == NULL) {
-		    goto freeAndErrorClass;
-		}
-		if (o2Ptr->classPtr == NULL) {
-		    Tcl_AppendResult(interp, "may only mix in classes; \"",
-			    TclGetString(objv[i]), "\" is not a class", NULL);
-		freeAndErrorClass:
-		    ckfree((char *) mixins);
-		    return TCL_ERROR;
-		}
-		mixins[i-1] = o2Ptr->classPtr;
-	    }
-	    if (clsPtr->mixins.num != 0) {
-		FOREACH(mixinPtr, clsPtr->mixins) {
-		    TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
-		}
-		ckfree((char *) clsPtr->mixins.list);
-	    }
-	    clsPtr->mixins.num = objc-1;
-	    clsPtr->mixins.list = mixins;
-	    FOREACH(mixinPtr, clsPtr->mixins) {
-		TclOOAddToMixinSubs(clsPtr, mixinPtr);
-	    }
-	}
-	((Interp *)interp)->ooFoundation->epoch++;
-    }
-    return TCL_OK;
-}
-
-#ifdef SUPPORT_OO_PARAMETERS
-// Not sure whether we want to retain this in the core oo system since it is
-// easy to add "after market".
-int
-TclOODefineParameterObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = GetDefineCmdContext(interp);
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Must nail down the semantics of this!
-     */
-
-    Tcl_AppendResult(interp, "TODO: not yet finished", NULL);
-    return TCL_ERROR;
-}
-#endif
-
-int
-TclOODefineSelfClassObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr, *o2Ptr;
-    Foundation *fPtr = ((Interp *)interp)->ooFoundation;
-
-    /*
-     * Parse the context to get the object to operate on.
-     */
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (oPtr == fPtr->objectCls->thisPtr) {
-	Tcl_AppendResult(interp,
-		"may not modify the class of the root object", NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr == fPtr->classCls->thisPtr) {
-	Tcl_AppendResult(interp,
-		"may not modify the class of the class of classes", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Parse the argument to get the class to set the object's class to.
-     */
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (o2Ptr == NULL) {
-	return TCL_ERROR;
-    }
-    if (o2Ptr->classPtr == NULL) {
-	Tcl_AppendResult(interp, "the class of an object must be a class",
-		NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Apply semantic checks. In particular, classes and non-classes are not
-     * interchangable (too complicated to do the conversion!) so we must
-     * produce an error if any attempt is made to swap from one to the other.
-     */
-
-    if ((oPtr->classPtr == NULL) == TclOOIsReachable(fPtr->classCls,
-	    o2Ptr->classPtr)) {
-	Tcl_AppendResult(interp, "may not change a ",
-		(oPtr->classPtr==NULL ? "non-" : ""), "class object into a ",
-		(oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Set the object's class.
-     */
-
-    if (oPtr->selfCls != o2Ptr->classPtr) {
-	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
-	oPtr->selfCls = o2Ptr->classPtr;
-	TclOOAddToInstances(oPtr, oPtr->selfCls);
-	if (oPtr->classPtr != NULL) {
-	    fPtr->epoch++;
-	} else {
-	    oPtr->epoch++;
-	}
-    }
-    return TCL_OK;
-}
-
-int
-TclOODefineSuperclassObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr, *o2Ptr;
-    Foundation *fPtr = ((Interp *)interp)->ooFoundation;
-    Class **superclasses, *superPtr;
-    int i, j;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className ?className ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the class to operate on.
-     */
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (oPtr->classPtr == NULL) {
-	Tcl_AppendResult(interp, "only classes may have superclasses defined",
-		NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr == fPtr->objectCls->thisPtr) {
-	Tcl_AppendResult(interp,
-		"may not modify the superclass of the root object", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Allocate some working space.
-     */
-
-    superclasses = (Class **) ckalloc(sizeof(Class *) * (objc-1));
-
-    /*
-     * Parse the arguments to get the class to use as superclasses.
-     */
-
-    for (i=0 ; i<objc-1 ; i++) {
-	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[i+1]);
-	if (o2Ptr == NULL) {
-	    goto failedAfterAlloc;
-	}
-	if (o2Ptr->classPtr == NULL) {
-	    Tcl_AppendResult(interp, "only a class can be a superclass",NULL);
-	    goto failedAfterAlloc;
-	}
-	for (j=0 ; j<i ; j++) {
-	    if (superclasses[j] == o2Ptr->classPtr) {
-		Tcl_AppendResult(interp,
-			"class should only be a direct superclass once",NULL);
-		goto failedAfterAlloc;
-	    }
-	}
-	if (TclOOIsReachable(oPtr->classPtr, o2Ptr->classPtr)) {
-	    Tcl_AppendResult(interp,
-		    "attempt to form circular dependency graph", NULL);
-	failedAfterAlloc:
-	    ckfree((char *) superclasses);
-	    return TCL_ERROR;
-	}
-	superclasses[i] = o2Ptr->classPtr;
-    }
-
-    /*
-     * Install the list of superclasses into the class. Note that this also
-     * involves splicing the class out of the superclasses' subclass list that
-     * it used to be a member of and splicing it into the new superclasses'
-     * subclass list.
-     */
-
-    if (oPtr->classPtr->superclasses.num != 0) {
-	FOREACH(superPtr, oPtr->classPtr->superclasses) {
-	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
-	}
-	ckfree((char *) oPtr->classPtr->superclasses.list);
-    }
-    oPtr->classPtr->superclasses.list = superclasses;
-    oPtr->classPtr->superclasses.num = objc-1;
-    FOREACH(superPtr, oPtr->classPtr->superclasses) {
-	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
-    }
-    fPtr->epoch++;
-
-    return TCL_OK;
-}
-
-int
-TclOODefineUnexportObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isSelfUnexport = (clientData != NULL);
-    Object *oPtr;
-    Method *mPtr;
-    Tcl_HashEntry *hPtr;
-    Class *clsPtr;
-    int i, isNew;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = GetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-    isSelfUnexport |= (oPtr->classPtr == NULL);
-
-    for (i=1 ; i<objc ; i++) {
-	if (isSelfUnexport) {
-	    hPtr = Tcl_CreateHashEntry(&oPtr->methods, (char *) objv[i],
-		    &isNew);
-	} else {
-	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
-		    &isNew);
-	}
-
-	if (isNew) {
-	    mPtr = (Method *) ckalloc(sizeof(Method));
-	    memset(mPtr, 0, sizeof(Method));
-	    Tcl_SetHashValue(hPtr, mPtr);
-	} else {
-	    mPtr = Tcl_GetHashValue(hPtr);
-	}
-	mPtr->flags &= ~PUBLIC_METHOD;
-    }
-    if (isSelfUnexport) {
-	oPtr->epoch++;
-    } else {
-	((Interp *)interp)->ooFoundation->epoch++;
-    }
-    return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */