Itcl - the [incr Tcl] extension

	ItclMemberFunc **mfuncPtr)
}
declare 55 {
    int Itcl_ChangeMemberFunc(Tcl_Interp *interp, ItclMemberFunc *mfunc,
        const char *arglist, const char *body)
}
declare 56 {
    void Itcl_DeleteMemberFunc(char *cdata)
}
declare 57 {
    int Itcl_CreateMemberCode(Tcl_Interp *interp, ItclClass *iclsPtr, \
        const char *arglist, const char *body, ItclMemberCode **mcodePtr)
}
declare 58 {
    void Itcl_DeleteMemberCode(char *cdata)

/*
 * itcl2TclOO.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright (c) 2007 by Arnulf P. Wiedemann
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <tclInt.h>
#include <tclOOInt.h>



#include "itclInt.h"

void *
Itcl_GetCurrentCallbackPtr(
    Tcl_Interp *interp)
{
    return TOP_CB(interp);
}

int
Itcl_NRRunCallbacks(
    Tcl_Interp *interp,
    void *rootPtr)
{
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}

static int
CallFinalizePMCall(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *nsPtr = data[0];
    TclOO_PostCallProc *postCallProc = (TclOO_PostCallProc *)data[1];
    ClientData clientData = data[2];

    /*
     * Give the post-call callback a chance to do some cleanup. Note that at
     * this point the call frame itself is invalid; it's already been popped.
     */

    return postCallProc(clientData, interp, NULL, nsPtr, result);
}

static int
FreeCommand(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Command *cmdPtr = data[0];
    Proc *procPtr = data[1];

    ckfree(cmdPtr);
    procPtr->cmdPtr = NULL;

    return result;
}

    Proc *procPtr = pmPtr->procPtr;
    CallFrame *framePtr = NULL;
    CallFrame **framePtrPtr1 = &framePtr;
    Tcl_CallFrame **framePtrPtr = (Tcl_CallFrame **)framePtrPtr1;
    int result;

    if (procPtr->cmdPtr == NULL) {
	Command *cmdPtr = ckalloc(sizeof(Command));

	memset(cmdPtr, 0, sizeof(Command));
	cmdPtr->nsPtr = (Namespace *) nsPtr;
	cmdPtr->clientData = NULL;
	procPtr->cmdPtr = cmdPtr;
	Tcl_NRAddCallback(interp, FreeCommand, cmdPtr, procPtr, NULL, NULL);
    }

     * Now invoke the body of the method. Note that we need to take special
     * action when doing unknown processing to ensure that the missing method
     * name is passed as an argument.
     */

    if (pmPtr->postCallProc) {
	Tcl_NRAddCallback(interp, CallFinalizePMCall, nsPtr,
		(Tcl_NRPostProc *)pmPtr->postCallProc, pmPtr->clientData, NULL);
    }
    return TclNRInterpProcCore(interp, namePtr, 1, pmPtr->errProc);

done:
    return result;
}

int
Itcl_InvokeProcedureMethod(
    ClientData clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    Tcl_Namespace *nsPtr;
    Method *mPtr;

    mPtr = clientData;
    if (mPtr->declaringClassPtr == NULL) {
	/* that is the case for typemethods */
        nsPtr = mPtr->declaringObjectPtr->namespacePtr;
    } else {
        nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr;
    }

    return Tcl_InvokeClassProcedureMethod(interp, mPtr->namePtr, nsPtr,
            mPtr->clientData, objc, objv);
}

static int
FreeProcedureMethod(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ProcedureMethod *pmPtr = data[0];
    ckfree(pmPtr);
    return result;
}

static void
EnsembleErrorProc(
    Tcl_Interp *interp,

    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,       /* namespace to call the method in */
    Tcl_Obj *namePtr,           /* name of the method */
    Tcl_Proc *procPtr,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    ProcedureMethod *pmPtr = ckalloc(sizeof(ProcedureMethod));

    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->procPtr = (Proc *)procPtr;
    pmPtr->flags = USE_DECLARER_NS;
    pmPtr->errProc = EnsembleErrorProc;

 *	function that does call chain creation, management and invokation.
 *
 * ----------------------------------------------------------------------
 */

int
Itcl_PublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_Class clsPtr,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Object oPtr = (Tcl_Object)clientData;
    int result;

Tcl_Method
Itcl_NewProcClassMethod(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Tcl_Class clsPtr,		/* The class to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    ClientData clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which may be NULL; if so, it is equivalent
				 * to an empty list. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ClientData *clientData2)
{
    Tcl_Method result;

    result = TclOONewProcMethodEx(interp, clsPtr, preCallPtr, postCallPtr,
           errProc, clientData, nameObj, argsObj, bodyObj,
           PUBLIC_METHOD | USE_DECLARER_NS, clientData2);
    return result;

Tcl_Method
Itcl_NewProcMethod(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Tcl_Object oPtr,		/* The object to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    ClientData clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which must not be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which must not be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ClientData *clientData2)
{
    return TclOONewProcInstanceMethodEx(interp, oPtr, preCallPtr, postCallPtr,
           errProc, clientData, nameObj, argsObj, bodyObj,
           PUBLIC_METHOD | USE_DECLARER_NS, clientData2);
}

/*

    Tcl_IncrRefCount(namePtr);
    oPtr->cachedNameObj = namePtr;
    return namePtr;
}

int
Itcl_SelfCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;

    if (!Itcl_IsMethodCallFrame(interp)) {
        Tcl_AppendResult(interp, TclGetString(objv[0]),
                " may only be called from inside a method", NULL);
        return TCL_ERROR;
    }

    contextPtr = framePtr->clientData;

    if (objc == 1) {
        Tcl_SetObjResult(interp, Itcl_TclOOObjectName(interp, contextPtr->oPtr));
        return TCL_OK;
    }
    return TCL_ERROR;
}

    "Itcl Foundations",
    Demolition,
    NULL
};

void
Demolition(
    ClientData clientData)
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)clientData;

    infoPtr->clazzObjectPtr = NULL;
    infoPtr->clazzClassPtr = NULL;
}

    RootCallProc,
    NULL,
    NULL
};

static int
RootCallProc(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Object oPtr = Tcl_ObjectContextObject(context);
    ItclObject *ioPtr = Tcl_ObjectGetMetadata(oPtr, &objMDT);
    ItclRootMethodProc *proc = (ItclRootMethodProc *)clientData;

    return (*proc)(ioPtr, interp, objc, objv);
}

/*
 * ------------------------------------------------------------------------

	opt = 1;
    } else {
	opt = atoi(res_option);
    }
    infoPtr->useOldResolvers = opt;
    Itcl_InitStack(&infoPtr->clsStack);

    Tcl_SetAssocData(interp, ITCL_INTERP_DATA, NULL, (ClientData)infoPtr);

    Itcl_PreserveData((ClientData)infoPtr);

    root = Tcl_NewObjectInstance(interp, tclCls, "::itcl::Root",
	    NULL, 0, NULL, 0);

    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("unknown", -1), 0, &itclRootMethodType,
	    ItclUnknownGuts);
    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("ItclConstructBase", -1), 0,
	    &itclRootMethodType, ItclConstructGuts);
    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("info", -1), 1,
	    &itclRootMethodType, ItclInfoGuts);

    /* first create the Itcl base class as root of itcl classes */
    if (Tcl_EvalEx(interp, clazzClassScript, -1, 0) != TCL_OK) {
        Tcl_Panic("cannot create Itcl root class ::itcl::clazz");
    }
    resPtr = Tcl_GetObjResult(interp);
    /*

        return TCL_ERROR;
    }

    /*
     *  Export all commands in the "itcl" namespace so that they
     *  can be imported with something like "namespace import itcl::*"
     */
    itclNs = Tcl_FindNamespace(interp, "::itcl", (Tcl_Namespace*)NULL,
        TCL_LEAVE_ERR_MSG);

    /*
     *  This was changed from a glob export (itcl::*) to explicit
     *  command exports, so that the itcl::is command can *not* be
     *  exported. This is done for concern that the itcl::is command
     *  imported might be confusing ("is").

 *  ItclSetHullWindowName()
 *
 *
 * ------------------------------------------------------------------------
 */
static int
ItclSetHullWindowName(
    ClientData clientData,   /* infoPtr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclObjectInfo *infoPtr;

    infoPtr = (ItclObjectInfo *)clientData;

 *  ItclCheckSetItclHull()
 *
 *
 * ------------------------------------------------------------------------
 */
static int
ItclCheckSetItclHull(
    ClientData clientData,   /* infoPtr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    ItclObject *ioPtr;

    hPtr = Tcl_FindHashEntry(&ioPtr->iclsPtr->variables, (char *)objPtr);
    Tcl_DecrRefCount(objPtr);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "ItclCheckSetItclHull cannot find itcl_hull",
	        " variable for object \"", Tcl_GetString(objv[1]), "\"", NULL);
	return TCL_ERROR;
    }
    ivPtr = Tcl_GetHashValue(hPtr);
    valueStr = Tcl_GetString(objv[2]);
    if (strcmp(valueStr, "2") == 0) {
        ivPtr->initted = 2;
    } else {
        if (strcmp(valueStr, "0") == 0) {
            ivPtr->initted = 0;
	} else {

 *
 *  called when an interp is deleted to free up memory
 *
 * ------------------------------------------------------------------------
 */
static void
FreeItclObjectInfo(
    ClientData clientData)
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)clientData;

    Tcl_DeleteHashTable(&infoPtr->instances);
    Tcl_DeleteHashTable(&infoPtr->classTypes);
    Tcl_DeleteHashTable(&infoPtr->procMethods);
    Tcl_DeleteHashTable(&infoPtr->objectCmds);

	ckfree((char *)infoPtr->class_meta_type);
	infoPtr->class_meta_type = NULL;
    }

    /* clean up list pool */
    Itcl_FinishList();

    Itcl_ReleaseData((ClientData)infoPtr);
}

     */
    Tcl_DStringInit(&buffer);
    for (i=0; i < BiMethodListLen; i++) {
	Tcl_DStringSetLength(&buffer, 0);
	Tcl_DStringAppend(&buffer, "::itcl::builtin::", -1);
	Tcl_DStringAppend(&buffer, BiMethodList[i].name, -1);
        Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
	        BiMethodList[i].proc, (ClientData)infoPtr,
		(Tcl_CmdDeleteProc*)NULL);
    }
    Tcl_DStringFree(&buffer);

    Tcl_CreateObjCommand(interp, "::itcl::builtin::chain", Itcl_BiChainCmd,
            NULL, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itcl::builtin::classunknown",
            ItclBiClassUnknownCmd, infoPtr, (Tcl_CmdDeleteProc*)NULL);

    ItclInfoInit(interp, infoPtr);
    /*
     *  Export all commands in the built-in namespace so we can
     *  import them later on.
     */
    itclBiNs = Tcl_FindNamespace(interp, "::itcl::builtin",
        (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);

    if ((itclBiNs == NULL) ||
        Tcl_Export(interp, itclBiNs, "[a-z]*", /* resetListFirst */ 1) != TCL_OK) {
        return TCL_ERROR;
    }
    /*
     * Install into the master [info] ensemble.

 *  Checks to see if the object has the given <className> anywhere
 *  in its heritage.  Returns 1 if so, and 0 otherwise.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiIsaCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *iclsPtr;
    const char *token;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object isa className\"",
            (char*)NULL);
        return TCL_ERROR;
    }
    if (objc != 2) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"object ", token, " className\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Look for the requested class.  If it is not found, then
     *  try to autoload it.  If it absolutely cannot be found,
     *  signal an error.

 *  option changes, a big of "config" code associated with the option
 *  is executed, to bring the object up to date.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiConfigureCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be ",
            "\"object configure ?-option? ?value -option value...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

	    unparsedObjc = objc;
	}
    }
    /*
     *  HANDLE:  configure
     */
    if (unparsedObjc == 1) {
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
            while (hPtr) {
                ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr);
                if (ivPtr->protection == ITCL_PUBLIC) {
                    objPtr = ItclReportPublicOpt(interp, ivPtr, contextIoPtr);

                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                        objPtr);
                }
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
        return TCL_OK;
    } else {

        /*
         *  HANDLE:  configure -option
         */
        if (unparsedObjc == 2) {
            token = Tcl_GetStringFromObj(unparsedObjv[1], (int*)NULL);
            if (*token != '-') {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "improper usage: should be ",
                    "\"object configure ?-option? ?value -option value...?\"",
                    (char*)NULL);
                return TCL_ERROR;
            }

            vlookup = NULL;
            hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, token+1);
            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

                if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
                    vlookup = NULL;
                }
            }
            if (!vlookup) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "unknown option \"", token, "\"",
                    (char*)NULL);
                return TCL_ERROR;
            }
            resultPtr = ItclReportPublicOpt(interp,
	            vlookup->ivPtr, contextIoPtr);
            Tcl_SetObjResult(interp, resultPtr);
            return TCL_OK;
        }

            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
            }
        }

        if (!vlookup || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
            Tcl_AppendResult(interp, "unknown option \"", token, "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto configureDone;
        }
        if (i == unparsedObjc-1) {
            Tcl_AppendResult(interp, "value for \"", token, "\" missing",
                (char*)NULL);
            result = TCL_ERROR;
            goto configureDone;
        }

        ivPtr = vlookup->ivPtr;
        Tcl_DStringSetLength(&buffer2, 0);
	if (!(ivPtr->flags & ITCL_COMMON)) {
            Tcl_DStringAppend(&buffer2,
	            Tcl_GetString(contextIoPtr->varNsNamePtr), -1);
	}
        Tcl_DStringAppend(&buffer2,
	        Tcl_GetString(ivPtr->iclsPtr->fullNamePtr), -1);
        Tcl_DStringAppend(&buffer2, "::", 2);
        Tcl_DStringAppend(&buffer2,
	        Tcl_GetString(ivPtr->namePtr), -1);
	varName = Tcl_DStringValue(&buffer2);
        lastval = Tcl_GetVar2(interp, varName, (char*)NULL, 0);
        Tcl_DStringSetLength(&buffer, 0);
        Tcl_DStringAppend(&buffer, (lastval) ? lastval : "", -1);

        token = Tcl_GetString(unparsedObjv[i+1]);
        if (Tcl_SetVar2(interp, varName, (char*)NULL, token,
                TCL_LEAVE_ERR_MSG) == NULL) {
    	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
    		    "\n    (error in configuration of public variable \"%s\")",
    		    Tcl_GetString(ivPtr->fullNamePtr)));
            result = TCL_ERROR;
            goto configureDone;
        }

	    Itcl_SetCallFrameNamespace(interp, saveNsPtr);
            if (result == TCL_OK) {
                Tcl_ResetResult(interp);
            } else {
        	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
        		    "\n    (error in configuration of public variable \"%s\")",
        		    Tcl_GetString(ivPtr->fullNamePtr)));
                Tcl_SetVar2(interp, varName,(char*)NULL,
                    Tcl_DStringValue(&buffer), 0);

                goto configureDone;
            }
        }
    }

 *  Tk widgets.  Returns the current value of the public variable
 *  with name <option>.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiCgetCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if ((contextIoPtr == NULL) || objc != 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object cget -option\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

    if (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    }

    if ((vlookup == NULL) || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", name, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    val = Itcl_GetInstanceVar(interp,
            Tcl_GetString(vlookup->ivPtr->namePtr),
            contextIoPtr, vlookup->ivPtr->iclsPtr);

    ItclClass *iclsPtr;
    Tcl_HashEntry *hPtr;
    ItclVarLookup *vlookup;
    Tcl_DString optName;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;

    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

    /*
     *  Determine how the option name should be reported.
     *  If the simple name can be used to find it in the virtual
     *  data table, then use the simple name.  Otherwise, this
     *  is a shadowed variable; use the full name.
     */
    Tcl_DStringInit(&optName);
    Tcl_DStringAppend(&optName, "-", -1);

    iclsPtr = (ItclClass*)contextIoPtr->iclsPtr;
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars,
            Tcl_GetString(ivPtr->fullNamePtr));
    assert(hPtr != NULL);
    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    Tcl_DStringAppend(&optName, vlookup->leastQualName, -1);

    objPtr = Tcl_NewStringObj(Tcl_DStringValue(&optName), -1);
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    Tcl_DStringFree(&optName);


    if (ivPtr->init) {
        objPtr = ivPtr->init;
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);

    val = Itcl_GetInstanceVar(interp, Tcl_GetString(ivPtr->namePtr),
            contextIoPtr, ivPtr->iclsPtr);

    if (val) {
        objPtr = Tcl_NewStringObj((const char *)val, -1);
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);

    return listPtr;
}

/*
 * ------------------------------------------------------------------------
 *  ItclReportOption()

    ItclObject *contextIoPtr) /* object containing this variable */
{
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    ItclDelegatedOption *idoPtr;
    const char *val;

    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
    idoPtr = ioptPtr->iclsPtr->infoPtr->currIdoPtr;
    if (idoPtr != NULL) {
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, idoPtr->namePtr);
	if (idoPtr->resourceNamePtr == NULL) {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                    Tcl_NewStringObj("", -1));
	    /* FIXME possible memory leak */
	} else {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                    idoPtr->resourceNamePtr);
	}
	if (idoPtr->classNamePtr == NULL) {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                    Tcl_NewStringObj("", -1));
	    /* FIXME possible memory leak */
	} else {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
	            idoPtr->classNamePtr);
        }
    } else {
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, ioptPtr->namePtr);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                ioptPtr->resourceNamePtr);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
	        ioptPtr->classNamePtr);
    }
    if (ioptPtr->defaultValuePtr) {
        objPtr = ioptPtr->defaultValuePtr;
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    val = ItclGetInstanceVar(interp, "itcl_options",
            Tcl_GetString(ioptPtr->namePtr),
            contextIoPtr, ioptPtr->iclsPtr);
    if (val) {
        objPtr = Tcl_NewStringObj((const char *)val, -1);
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    return listPtr;
}



/*
 * ------------------------------------------------------------------------

 *  This allows a base class method to be called out in a generic way,
 *  so the code will not have to change if the base class changes.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
NRBiChainCmd(
    ClientData dummy,        /* not used */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result = TCL_OK;

    ItclClass *contextIclsPtr;

     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot chain functions outside of a class context",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Try to get the command name from the current call frame.
     *  If it cannot be determined, do nothing.  Otherwise, trim
     *  off any leading path names.

             *         methods by passing the full name as
             *         the command argument.
             */

            cmdlinePtr = Itcl_CreateArgs(interp,
	            Tcl_GetString(imPtr->fullNamePtr), objc-1, objv+1);

            (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
                &my_objc, &newobjv);

	    if (imPtr->flags & ITCL_CONSTRUCTOR) {
		contextIoPtr = imPtr->iclsPtr->infoPtr->currIoPtr;
            }
            ItclShowArgs(1, "___chain", objc-1, newobjv+1);
            result = Itcl_EvalMemberCode(interp, imPtr, contextIoPtr,

    Tcl_DStringFree(&buffer);
    Itcl_DeleteHierIter(&hier);
    return result;
}
/* ARGSUSED */
int
Itcl_BiChainCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, NRBiChainCmd, clientData, objc, objv);
}

static int
CallCreateObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_CallFrame frame;
    Tcl_Namespace *nsPtr;
    ItclClass *iclsPtr = data[0];
    int objc = PTR2INT(data[1]);
    Tcl_Obj *const *objv = data[2];

    if (result != TCL_OK) {
        return result;
    }
    nsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (Itcl_PushCallFrame(interp, &frame, nsPtr,
            /*isProcCallFrame*/0) != TCL_OK) {

    Tcl_IncrRefCount(newObjv[1]);
    newObjv[2] = Tcl_NewStringObj(iclsPtr->nsPtr->fullName, -1);
    Tcl_IncrRefCount(newObjv[2]);
    memcpy(newObjv+3, objv+offset, (objc-offset) * sizeof(Tcl_Obj *));
    callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
    ItclShowArgs(1, "CREATE", objc+3-offset, newObjv);
    Tcl_NRAddCallback(interp, CallCreateObject, iclsPtr,
            INT2PTR(objc+3-offset), (ClientData)newObjv, NULL);
    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (result != TCL_OK) {
        if (iclsPtr->infoPtr->currIoPtr != NULL) {
            /* we are in a constructor call */
            if (iclsPtr->infoPtr->currIoPtr->hadConstructorError == 0) {
	        iclsPtr->infoPtr->currIoPtr->hadConstructorError = 1;
	    }

 *    classunknown <object> <methodname> ?<arg> <arg>...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclBiClassUnknownCmd(
    ClientData clientData,   /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_HashEntry *hPtr2;
    Tcl_Obj **newObjv;

    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
            (char *)Tcl_GetCurrentNamespace(interp));
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "INTERNAL ERROR: ItclBiClassUnknownCmd ",
	        "cannot find class\n", NULL);
        return TCL_ERROR;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);
    funcName = Tcl_GetString(objv[1]);
    if (strcmp(funcName, "create") == 0) {
        /* check if we have a user method create. If not, it is the builtin
	 * create method and we don't need to check for delegation
	 * and components with ITCL_COMPONENT_INHERIT
	 */
        hPtr = Tcl_FindHashEntry(&iclsPtr->resolveCmds, (char *)objv[1]);

	if (hPtr == NULL) {
	    objPtr = Tcl_NewStringObj("*", -1);
	    Tcl_IncrRefCount(objPtr);
	    hPtr = Tcl_FindHashEntry(&iclsPtr->delegatedFunctions,
	            (char *)objPtr);
	    Tcl_DecrRefCount(objPtr);
	    if (hPtr != NULL) {
	        idmPtr = Tcl_GetHashValue(hPtr);
	        isStar = 1;
	    }
	}
	if (isStar) {
            /* check if the function is in the exceptions */
	    hPtr2 = Tcl_FindHashEntry(&starIdmPtr->exceptions, (char *)objv[1]);
	    if (hPtr2 != NULL) {

		    }
		}
	        Tcl_SetObjResult(interp, objPtr);
		return TCL_ERROR;
	    }
	}
	if (hPtr != NULL) {
	    idmPtr = Tcl_GetHashValue(hPtr);
	    val = NULL;
	    if (idmPtr->icPtr != NULL) {
                if (idmPtr->icPtr->ivPtr->flags & ITCL_COMMON) {
	            val = Tcl_GetVar2(interp,
	                    Tcl_GetString(idmPtr->icPtr->namePtr), NULL, 0);
		} else {
                    ItclClass *contextIclsPtr;

    int isStar;
    int isTypeMethod;
    int isNew;
    int idx;

    if (objc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be one of...",
		(char*)NULL);
        ItclReportObjectUsage(interp, ioPtr, NULL, NULL);
        return TCL_ERROR;
    }
    iclsPtr = ioPtr->iclsPtr;
    lObjc = 0;
    offset = 1;
    isStar = 0;

    if (hPtr == NULL) {
        objPtr = Tcl_NewStringObj("*", -1);
        Tcl_IncrRefCount(objPtr);
        hPtr = Tcl_FindHashEntry(&iclsPtr->delegatedFunctions,
                (char *)objPtr);
        Tcl_DecrRefCount(objPtr);
	if (hPtr != NULL) {
	    idmPtr = Tcl_GetHashValue(hPtr);
            isStar = 1;
	}
    } else {
        found = 1;
	idmPtr = Tcl_GetHashValue(hPtr);
    }
    if (isStar) {
       /* check if the function is in the exceptions */
        hPtr2 = Tcl_FindHashEntry(&idmPtr->exceptions, (char *)objv[1]);
        if (hPtr2 != NULL) {
	    const char *sep = "";
	    objPtr = Tcl_NewStringObj("unknown subcommand \"", -1);

		    sep = " or ";
	        }
	    }
	}
    }
    if (idmPtr == NULL) {
        Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
                "\": should be one of...", (char*)NULL);
        ItclReportObjectUsage(interp, ioPtr, NULL, NULL);
        return TCL_ERROR;
    }
    lObjc = 0;
    if ((idmPtr != NULL) && ((idmPtr->asPtr != NULL) ||
            (idmPtr->usingPtr != NULL))) {
	offset++;

 *  option changes, a big of "config" code associated with the option
 *  is executed, to bring the object up to date.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclExtendedConfigure(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_HashTable unique;
    Tcl_HashEntry *hPtr2;

        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be ",
            "\"object configure ?-option? ?value -option value...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

 *  Tk widgets.  Returns the current value of the public variable
 *  with name <option>.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclExtendedCget(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashEntry *hPtr2;
    Tcl_HashEntry *hPtr3;

    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if ((contextIoPtr == NULL) || objc != 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object cget -option\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

 *  this sets the variable to the value calling a callback if exists:
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclExtendedSetGet(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    usageStr = "improper usage: should be \"object setget varName ?value?\"";
    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                usageStr, (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    infoPtr = contextIclsPtr->infoPtr;
    if (infoPtr->currContextIclsPtr != NULL) {
        contextIclsPtr = infoPtr->currContextIclsPtr;
    }

    hPtr = NULL;
    if (objc < 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                usageStr, (char*)NULL);
        return TCL_ERROR;
    }
    /* look if it is an methodvariable at all */
    hPtr = Tcl_FindHashEntry(&contextIoPtr->objectMethodVariables,
            (char *) objv[1]);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "no such methodvariable \"",

 *      ?-option value -option value ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiInstallComponentCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj ** newObjv;
    ItclClass *contextIclsPtr;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object installcomponent \"",
            (char*)NULL);
        return TCL_ERROR;
    }
    if (objc < 5) {
	/* FIXME strip off the :: parts here properly*/
        token = Tcl_GetString(objv[0])+2;
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", token, " <componentName> using",
	    " <widgetClassName> <widgetPathName>",
	    " ?-option value -option value ...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /* get component name and check, if it exists */
    token = Tcl_GetString(objv[1]);
    if (contextIclsPtr == NULL) {
        Tcl_AppendResult(interp, "cannot find context class for object \"",

 *    destroy
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
Itcl_BiDestroyCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj **newObjv;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

	Tcl_DecrRefCount(newObjv[2]);
	Tcl_DecrRefCount(newObjv[1]);
	Tcl_DecrRefCount(newObjv[0]);
	return result;
    }
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", Tcl_GetString(objv[0]), (char*)NULL);
        return TCL_ERROR;
    }

    if (contextIoPtr != NULL) {
        Tcl_Obj *objPtr = Tcl_NewObj();
        Tcl_GetCommandFullName(interp, contextIoPtr->accessCmd, objPtr);
        Itcl_RenameCommand(interp, Tcl_GetString(objPtr), "");

 *    callinstance <instanceName> ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiCallInstanceCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj **newObjv;

        return TCL_ERROR;
    }

    if (objc < 2) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", token, " <instanceName>",
            (char*)NULL);
        return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&contextIclsPtr->infoPtr->instances,
            Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp,
	        "no such instanceName \"",
		Tcl_GetString(objv[1]), "\"", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    objPtr =Tcl_NewObj();
    Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
    newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * (objc - 1));
    newObjv[0] = objPtr;
    Tcl_IncrRefCount(newObjv[0]);
    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
    result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);

 *    getinstancevar <instanceName> ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiGetInstanceVarCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj **newObjv;

        return TCL_ERROR;
    }

    if (objc < 2) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", token, " <instanceName>",
            (char*)NULL);
        return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&contextIclsPtr->infoPtr->instances,
            Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp,
	        "no such instanceName \"",
		Tcl_GetString(objv[1]), "\"", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    objPtr =Tcl_NewObj();
    Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
    newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * (objc - 1));
    newObjv[0] = objPtr;
    Tcl_IncrRefCount(newObjv[0]);
    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
    result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);
    Tcl_DecrRefCount(newObjv[0]);

 *    mytypemethod ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyTypeMethodCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;

 *    mymethod ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyMethodCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *resultPtr;
    int i;
    ItclClass *contextIclsPtr;

 *    myproc ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyProcCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;

 *    mytypevar ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyTypeVarCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;

 *    myvar ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyVarCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

 *    itcl_hull ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiItclHullCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    const char *val;

 *      createhull <widget_type> <widget_path> ?-class <widgetClassName>?
 *          ?<optionName> <optionValue> <optionName> <optionValue> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiCreateHullCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;

 *      setupcomponent <componentName> using <widgetType> <widget_path>
 *          ?<optionName> <optionValue> <optionName> <optionValue> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiSetupComponentCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;

 *          ?<optionName> <optionValue> <optionName> <optionValue> ...?
 * FIXME !!!! seems no longer been used !!!
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiInitOptionsCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;
    ItclClass *iclsPtr;

 *
 *      keepcomponentoption <componentName> <optionName> ?<optionName> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiKeepComponentOptionCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;

 *
 *      ignorecomponentoption <componentName> <optionName> ?<optionName> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiIgnoreComponentOptionCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashEntry *hPtr2;
    Tcl_Obj *objPtr;

        hPtr = Tcl_FindHashEntry(&ioPtr->objectComponents, (char *)objv[1]);
        if (hPtr == NULL) {
	    Tcl_AppendResult(interp,
	            "ignorecomponentoption cannot find component \"",
	            Tcl_GetString(objv[1]), "\"", NULL);
	    return TCL_ERROR;
	}
        icPtr = Tcl_GetHashValue(hPtr);
	icPtr->haveKeptOptions = 1;
	for (idx = 2; idx < objc; idx++) {
	    hPtr = Tcl_CreateHashEntry(&icPtr->keptOptions, (char *)objv[idx],
	            &isNew);
            if (isNew) {
	        Tcl_SetHashValue(hPtr, objv[idx]);
	    }

 * ------------------------------------------------------------------------
 *  Itcl_DeleteMemberFunc()
 *
 * ------------------------------------------------------------------------
 */

void Itcl_DeleteMemberFunc (
    char *cdata)
{
    /* needed for stubs compatibility */
    ItclMemberFunc *imPtr;

    imPtr = (ItclMemberFunc *)cdata;
    if (imPtr == NULL) {
        /* FIXME need code here */

 * ------------------------------------------------------------------------
 */

static void
ItclDestroyClass2(
    ClientData clientData)      /* The class being deleted. */
{
    ItclClass *iclsPtr = clientData;

    ItclDestroyClassNamesp(iclsPtr);
    ItclReleaseClass(iclsPtr);
}

/*
 * ------------------------------------------------------------------------

    ClientData clientData)
{
    /*
     * This is how we get alerted from TclOO that the object corresponding
     * to an Itcl class (or its namespace...) is being torn down.
     */

    ItclClass *iclsPtr = clientData;
    Tcl_Object oPtr = iclsPtr->oPtr;
    Tcl_Namespace *ooNsPtr = Tcl_GetObjectNamespace(oPtr);

    if (ooNsPtr != iclsPtr->nsPtr) {
	/*
	 * Itcl's idea of the class namespace is different from that of TclOO.
	 * Make sure both get torn down and pulled from tables.


static int
CallNewObjectInstance(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ItclObjectInfo *infoPtr = data[0];
    const char* path = data[1];
    Tcl_Object *oPtr = data[2];
    Tcl_Obj *nameObjPtr = data[3];

    *oPtr = NULL;
    if (infoPtr->clazzClassPtr) {
	*oPtr = Tcl_NewObjectInstance(interp, infoPtr->clazzClassPtr,
                path, path, 0, NULL, 0);
    }
    if (*oPtr == NULL) {

     *  already exist in the current namespace context.  If a
     *  namespace exists, that's okay.  It may have been created
     *  to contain stubs during a "namespace import" operation.
     *  We'll just replace the namespace data below with the
     *  proper class data.
     */
    classNs = Tcl_FindNamespace(interp, (const char *)path,
	    (Tcl_Namespace*)NULL, /* flags */ 0);

    if (classNs != NULL && Itcl_IsClassNamespace(classNs)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "class \"", path, "\" already exists",
            (char*)NULL);
        return TCL_ERROR;
    }

    oPtr = NULL;
    /*
     *  Make sure that a command with the given class name does not
     *  already exist in the current namespace.  This prevents the
     *  usual Tcl commands from being clobbered when a programmer
     *  makes a bogus call like "class info".
     */
    cmd = Tcl_FindCommand(interp, (const char *)path,
	    (Tcl_Namespace*)NULL, /* flags */ TCL_NAMESPACE_ONLY);

    if (cmd != NULL && !Itcl_IsStub(cmd)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "command \"", path, "\" already exists",
            (char*)NULL);

        if (strstr(path,"::") == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                " in namespace \"",
                Tcl_GetCurrentNamespace(interp)->fullName, "\"",
                (char*)NULL);
        }
        return TCL_ERROR;
    }

    /*
     *  Make sure that the class name does not have any goofy
     *  characters:
     *
     *    .  =>  reserved for member access like:  class.publicVar
     */
    Itcl_ParseNamespPath(path, &buffer, &head, &tail);

    if (strstr(tail,".")) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "bad class name \"", tail, "\"",
            (char*)NULL);
        Tcl_DStringFree(&buffer);
        return TCL_ERROR;
    }
    Tcl_DStringFree(&buffer);

    /*
     *  Allocate class definition data.
     */
    iclsPtr = (ItclClass*)ckalloc(sizeof(ItclClass));
    memset(iclsPtr, 0, sizeof(ItclClass));
    iclsPtr->interp = interp;
    iclsPtr->infoPtr = infoPtr;
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_InitObjHashTable(&iclsPtr->variables);
    Tcl_InitObjHashTable(&iclsPtr->functions);
    Tcl_InitObjHashTable(&iclsPtr->options);
    Tcl_InitObjHashTable(&iclsPtr->components);
    Tcl_InitObjHashTable(&iclsPtr->delegatedOptions);
    Tcl_InitObjHashTable(&iclsPtr->delegatedFunctions);

    callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
    /*
     *  Create a command in the current namespace to manage the class:
     *    <className>
     *    <className> <objName> ?<constructor-args>?
     */
    Tcl_NRAddCallback(interp, CallNewObjectInstance, infoPtr,
            (ClientData)path, &oPtr, nameObjPtr);
    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (result == TCL_ERROR) {
	result = TCL_ERROR;
        goto errorOut;
    }
    iclsPtr->clsPtr = Tcl_GetObjectAsClass(oPtr);
    iclsPtr->oPtr = oPtr;
    ItclPreserveClass(iclsPtr);
    Tcl_ObjectSetMetadata(iclsPtr->oPtr, infoPtr->class_meta_type, iclsPtr);
    cmd = Tcl_GetObjectCommand(iclsPtr->oPtr);
    Tcl_GetCommandInfoFromToken(cmd, &cmdInfo);
    cmdInfo.deleteProc = ItclDestroyClass;
    cmdInfo.deleteData = iclsPtr;
    Tcl_SetCommandInfoFromToken(cmd, &cmdInfo);
    ooNs = Tcl_GetObjectNamespace(oPtr);
    classNs = Tcl_FindNamespace(interp, Tcl_GetString(nameObjPtr),
            (Tcl_Namespace*)NULL, /* flags */ 0);
    if (_TclOONamespaceDeleteProc == NULL) {
        _TclOONamespaceDeleteProc = ooNs->deleteProc;
    }

    if (classNs == NULL) {
	Tcl_AppendResult(interp,
	        "ITCL: cannot create/get class namespace for class \"",

    Tcl_IncrRefCount(iclsPtr->namePtr);

    iclsPtr->fullNamePtr = Tcl_NewStringObj(classNs->fullName, -1);
    Tcl_IncrRefCount(iclsPtr->fullNamePtr);

    hPtr = Tcl_CreateHashEntry(&infoPtr->nameClasses,
            (char *)iclsPtr->fullNamePtr, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);


    hPtr = Tcl_CreateHashEntry(&infoPtr->namespaceClasses, (char *)classNs,
            &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);
  if (classNs != ooNs) {
    hPtr = Tcl_CreateHashEntry(&infoPtr->namespaceClasses, (char *)ooNs,
            &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);

    if (classNs->clientData && classNs->deleteProc) {
	(*classNs->deleteProc)(classNs->clientData);
    }
    classNs->clientData = (ClientData)iclsPtr;
    classNs->deleteProc = ItclDestroyClass2;
}

    hPtr = Tcl_CreateHashEntry(&infoPtr->classes, (char *)iclsPtr, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);

    /*
     * now build the namespace for the common private and protected variables
     * public variables go directly to the class namespace
     */
    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1);

            Itcl_ThisCmd, iclsPtr, NULL);

    /*
     *  Add the built-in "type" variable to the list of data members.
     */
    if (iclsPtr->flags & ITCL_TYPE) {
        namePtr = Tcl_NewStringObj("type", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_TYPE_VAR;       /* mark as "type" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }

    if (iclsPtr->flags & (ITCL_ECLASS)) {
        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }
    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        namePtr = Tcl_NewStringObj("self", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELF_VAR;       /* mark as "self" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

        namePtr = Tcl_NewStringObj("selfns", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELFNS_VAR;     /* mark as "selfns" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }
    namePtr = Tcl_NewStringObj("this", -1);
    (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);

    ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
    ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "this" variable */

    hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
            &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

    if (infoPtr->currClassFlags &
            (ITCL_ECLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET)) {
        /*
         *  Add the built-in "itcl_options" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_options", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
                (char*)NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTIONS_VAR;    /* mark as "itcl_options"
	                                      * variable */

        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

    }
    if (infoPtr->currClassFlags &
            ITCL_ECLASS) {
        /*
         *  Add the built-in "itcl_option_components" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_option_components", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
                (char*)NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTION_COMP_VAR; /* mark as "itcl_option_components"
	                                      * variable */

        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /*
         *  Add the built-in "thiswin" variable to the list of data members.
         */
        namePtr = Tcl_NewStringObj("thiswin", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
                (char*)NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "thiswin" variable */

        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /* create the itcl_hull component */
        ItclComponent *icPtr;
        namePtr = Tcl_NewStringObj("itcl_hull", 9);
	/* itcl_hull must not be an ITCL_COMMON!! */
        if (ItclCreateComponent(interp, iclsPtr, namePtr, 0, &icPtr) !=

    Tcl_Interp *interp,
    int result)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch place;
    ItclClass *iclsPtr2 = NULL;
    ItclObject *contextIoPtr;
    ItclClass *iclsPtr = data[0];
    ItclObjectInfo *infoPtr = data[1];
    void *callbackPtr;
    int classIsDeleted;

    if (result != TCL_OK) {
        return result;
    }
    classIsDeleted = 0;

static int
CallDeleteOneClass(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_HashEntry *hPtr;
    ItclClass *iclsPtr = data[0];
    ItclObjectInfo *infoPtr = data[1];
    int isDerivedReleased;

    if (result != TCL_OK) {
        return result;
    }
    isDerivedReleased = iclsPtr->flags & ITCL_CLASS_DERIVED_RELEASED;
    result = Itcl_DeleteClass(interp, iclsPtr);

    Tcl_HashEntry *hPtr;
    ItclObjectInfo *infoPtr;
    ItclClass *iclsPtr2 = NULL;
    Itcl_ListElem *elem;
    void *callbackPtr;
    int result;

    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->classes, (char *)iclsPtr);
    if (hPtr == NULL) {
	/* class has already been deleted */
        return TCL_OK;
    }
    if (iclsPtr->flags & ITCL_CLASS_IS_DELETED) {
        return TCL_OK;

     *  Tear down the virtual method table...
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveCmds, &place);
        if (hPtr == NULL) {
            break;
        }
        clookupPtr = Tcl_GetHashValue(hPtr);
        ckfree((char *)clookupPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->resolveCmds);

    /*
     *  Delete all option definitions.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->options, &place);
        if (hPtr == NULL) {
            break;
        }
        ioptPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
        Itcl_ReleaseData(ioptPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->options);

    /*
     *  Delete all function definitions.

    }
    Tcl_DeleteHashTable(&iclsPtr->delegatedFunctions);

    /*
     *  Delete all components
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->components, &place);
        if (hPtr == NULL) {
            break;
        }
        icPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
	if (icPtr != NULL) {
            ItclDeleteComponent(icPtr);
	}
    }
    Tcl_DeleteHashTable(&iclsPtr->components);

    /*
     *  Delete all variable definitions.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
        if (hPtr == NULL) {
            break;
        }
        ivPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
	if (ivPtr != NULL) {
            Itcl_ReleaseData(ivPtr);
	}
    }
    Tcl_DeleteHashTable(&iclsPtr->variables);

    /*
     *  Free up the object initialization code.
     */
    if (iclsPtr->initCode) {
        Tcl_DecrRefCount(iclsPtr->initCode);
    }

    Itcl_ReleaseData((ClientData)iclsPtr->infoPtr);

    Tcl_DecrRefCount(iclsPtr->namePtr);
    Tcl_DecrRefCount(iclsPtr->fullNamePtr);

    if (iclsPtr->resolvePtr != NULL) {
        ckfree((char *)iclsPtr->resolvePtr->clientData);
        ckfree((char *)iclsPtr->resolvePtr);

     *  Search for a namespace with the specified name, and if
     *  one is found, see if it is a class namespace.
     */

    Tcl_Namespace* classNs = Itcl_FindClassNamespace(interp, path);

    if (classNs) {
	ItclObjectInfo *infoPtr
		= Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
		(char *) classNs);
	if (hPtr) {
	    return (ItclClass *) Tcl_GetHashValue(hPtr);
	}
    }

        Tcl_DStringFree(&buf);

	return Itcl_FindClass(interp, path, 0);
    }

    Tcl_AppendResult(interp, "class \"", path, "\" not found in context \"",
        Tcl_GetCurrentNamespace(interp)->fullName, "\"",
        (char*)NULL);

    return NULL;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_FindClassNamespace()

 *  context, just like the normal command lookup.
 *
 *  This procedure returns a pointer to the desired namespace, or
 *  NULL if the namespace was not found.
 * ------------------------------------------------------------------------
 */
Tcl_Namespace*
Itcl_FindClassNamespace(interp, path)
    Tcl_Interp* interp;        /* interpreter containing class */
    const char* path;                /* path name for class */
{
    Tcl_Namespace* contextNs = Tcl_GetCurrentNamespace(interp);
    Tcl_Namespace *classNs = Tcl_FindNamespace(interp, path, NULL, 0);

    if ( !classNs /* We didn't find it... */
	    && contextNs->parentPtr != NULL	/* context is not global */
	    && (*path != ':' || *(path+1) != ':') /* path not FQ */


static int
FinalizeCreateObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *objNamePtr = data[0];
    ItclClass *iclsPtr = data[1];
    if (result == TCL_OK) {
	if (!(iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR))) {
	    Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, Tcl_GetString(objNamePtr), NULL);
	}
    }
    Tcl_DecrRefCount(objNamePtr);
    return result;
}

static int
CallCreateObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *objNamePtr = data[0];
    ItclClass *iclsPtr = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];

    if (result == TCL_OK) {
        result = ItclCreateObject(interp, Tcl_GetString(objNamePtr), iclsPtr,
                objc, objv);
    }
    return result;
}

    hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objv[2]);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "no such class: \"",
	        Tcl_GetString(objv[1]), "\"", NULL);
	return TCL_ERROR;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  If the object name is "::", and if this is an old-style class
     *  definition, then treat the remaining arguments as a command
     *  in the class namespace.  This used to be the way of invoking
     *  a class proc, but the new syntax is "class::proc" (without
     *  spaces).

        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "syntax \"class :: proc\" is an anachronism\n",
            "[incr Tcl] no longer supports this syntax.\n",
            "Instead, remove the spaces from your procedure invocations:\n",
            "  ",
            Tcl_GetString(objv[1]), "::",
            Tcl_GetString(objv[4]), " ?args?",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Otherwise, we have a proper object name.  Create a new instance
     *  with that name.  If the name contains "#auto", replace this with
     *  a uniquely generated string based on the class name.

            nsPtr = iclsPtr2->nsPtr;

            while (1) {
                hPtr = Tcl_CreateHashEntry(&iclsPtr->resolveVars,
                    Tcl_DStringValue(&buffer), &newEntry);

                if (newEntry) {
                    Tcl_SetHashValue(hPtr, (ClientData)vlookup);
                    vlookup->usage++;

                    if (!vlookup->leastQualName) {
                        vlookup->leastQualName =
                            Tcl_GetHashKey(&iclsPtr->resolveVars, hPtr);
                    }
                }

                if (nsPtr == NULL) {
                    break;
                }

     *  Clear the command resolution table.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveCmds, &place);
        if (hPtr == NULL) {
            break;
        }
        clookupPtr = Tcl_GetHashValue(hPtr);
        ckfree((char *)clookupPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->resolveCmds);
    Tcl_InitObjHashTable(&iclsPtr->resolveCmds);

    /*

                hPtr = Tcl_CreateHashEntry(&iclsPtr->resolveCmds,
                        (char *)objPtr, &newEntry);

                if (newEntry) {
		    clookupPtr = (ItclCmdLookup *)ckalloc(sizeof(ItclCmdLookup));
		    memset(clookupPtr, 0, sizeof(ItclCmdLookup));
		    clookupPtr->imPtr = imPtr;
                    Tcl_SetHashValue(hPtr, (ClientData)clookupPtr);
                } else {
		    Tcl_DecrRefCount(objPtr);
		}

                if (nsPtr == NULL) {
                    break;
                }

     */
    hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr, &newEntry);
    if (!newEntry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "variable name \"", Tcl_GetString(namePtr),
	    "\" already defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this variable has some "config" code, try to capture
     *  its implementation.
     */
    if (config) {
        if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, config,
                &mCodePtr) != TCL_OK) {
            Tcl_DeleteHashEntry(hPtr);
            return TCL_ERROR;
        }
	ItclPreserveMemberCode(mCodePtr);
    } else {
        mCodePtr = NULL;

    if (init != NULL) {
        ivPtr->init = Tcl_NewStringObj(init, -1);
        Tcl_IncrRefCount(ivPtr->init);
    } else {
        ivPtr->init = NULL;
    }

    Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    Itcl_PreserveData((ClientData)ivPtr);
    Itcl_EventuallyFree((ClientData)ivPtr, (Tcl_FreeProc *) Itcl_DeleteVariable);

    *ivPtrPtr = ivPtr;
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------

    hPtr = Tcl_CreateHashEntry(&iclsPtr->options,
            (char *)ioptPtr->namePtr, &newEntry);
    if (!newEntry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "option name \"", Tcl_GetString(ioptPtr->namePtr),
	    "\" already defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    iclsPtr->numOptions++;
    ioptPtr->iclsPtr = iclsPtr;
    ioptPtr->codePtr = NULL;
    ioptPtr->fullNamePtr = Tcl_NewStringObj(
            Tcl_GetString(iclsPtr->fullNamePtr), -1);
    Tcl_AppendToObj(ioptPtr->fullNamePtr, "::", 2);
    Tcl_AppendToObj(ioptPtr->fullNamePtr, Tcl_GetString(ioptPtr->namePtr), -1);
    Tcl_IncrRefCount(ioptPtr->fullNamePtr);
    Tcl_SetHashValue(hPtr, (ClientData)ioptPtr);
    Itcl_PreserveData((ClientData)ioptPtr);
    Itcl_EventuallyFree((ClientData)ioptPtr, (Tcl_FreeProc *) ItclDeleteOption);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_CreateMethodVariable()
 *

    hPtr = Tcl_CreateHashEntry(&iclsPtr->methodVariables,
            (char *)namePtr, &isNew);
    if (!isNew) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "methdovariable name \"", Tcl_GetString(namePtr),
	    "\" already defined in class \"",
            Tcl_GetString (iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }
    Tcl_IncrRefCount(namePtr);

    /*
     *  If everything looks good, create the option definition.
     */

        Tcl_IncrRefCount(imvPtr->callbackPtr);
    }

    if (imvPtr->protection == ITCL_DEFAULT_PROTECT) {
        imvPtr->protection = ITCL_PROTECTED;
    }

    Tcl_SetHashValue(hPtr, (ClientData)imvPtr);

    *imvPtrPtr = imvPtr;
    return TCL_OK;
}




    namePtr = Tcl_NewStringObj(lastCp, -1);
    Tcl_IncrRefCount(namePtr);
    hPtr = Tcl_FindHashEntry(&contextIclsPtr->variables, (char *)namePtr);
    Tcl_DecrRefCount(namePtr);
    if (hPtr == NULL) {
        return NULL;
    }
    ivPtr = Tcl_GetHashValue(hPtr);
    /*
     *  Activate the namespace for the given class.  That installs
     *  the appropriate name resolution rules and by-passes any
     *  security restrictions.
     */

    if (lastCp == name) {
	/* 'name' is a simple name (this is untested!!!!) */

	/* Use the context class passed in */
	oPtr = contextIclsPtr->oPtr;

    } else {
	int code = TCL_ERROR;
	Tcl_Obj *classObjPtr = Tcl_NewStringObj(name, lastCp - name - 2);
	oPtr = Tcl_GetObjectFromObj(interp, classObjPtr);

	if (oPtr) {
	    ItclClass *iclsPtr = Tcl_ObjectGetMetadata(oPtr,
		    contextIclsPtr->infoPtr->class_meta_type);
	    if (iclsPtr) {

		code = TCL_OK;
		assert(oPtr == iclsPtr->oPtr);

		/*

        Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1);
    }
    Tcl_DStringAppend(&buffer, (Tcl_GetObjectNamespace(oPtr))->fullName, -1);
    Tcl_DStringAppend(&buffer, "::", -1);
    Tcl_DStringAppend(&buffer, lastCp, -1);

    val = Tcl_GetVar2(interp, (const char *)Tcl_DStringValue(&buffer),
            (char*)NULL, 0);
    Tcl_DStringFree(&buffer);
    return val;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_InitHierIter()
 *
 *  Initializes an iterator for traversing the hierarchy of the given
 *  class.  Subsequent calls to Itcl_AdvanceHierIter() will return
 *  the base classes in order from most-to-least specific.
 * ------------------------------------------------------------------------
 */
void
Itcl_InitHierIter(iter,iclsPtr)
    ItclHierIter *iter;   /* iterator used for traversal */
    ItclClass *iclsPtr;     /* class definition for start of traversal */
{
    Itcl_InitStack(&iter->stack);
    Itcl_PushStack((ClientData)iclsPtr, &iter->stack);
    iter->current = iclsPtr;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_DeleteHierIter()
 *
 *  Destroys an iterator for traversing class hierarchies, freeing
 *  all memory associated with it.
 * ------------------------------------------------------------------------
 */
void
Itcl_DeleteHierIter(iter)
    ItclHierIter *iter;  /* iterator used for traversal */
{
    Itcl_DeleteStack(&iter->stack);
    iter->current = NULL;
}

/*
 * ------------------------------------------------------------------------

    Tcl_Obj *const objv[])   /* argument objects */
{
    ClientData clientData2;
    Tcl_Object oPtr;
    ItclClass *iclsPtr;

    ItclShowArgs(1, "NRThisCmd", objc, objv);
    iclsPtr = clientData;
    clientData2 = Itcl_GetCallFrameClientData(interp);
    oPtr = Tcl_ObjectContextObject(clientData2);
    return Itcl_PublicObjectCmd(oPtr, interp, iclsPtr->clsPtr, objc, objv);
}
/* ARGSUSED */
int
Itcl_ThisCmd(
    ClientData clientData,
    Tcl_Interp *interp,

    const char *val;
    int result;

    if (objc == 1) {
        return Itcl_SelfCmd(clientData,interp, objc, objv);
    }
    ItclShowArgs(1, "Itcl_ThisCmd", objc, objv);
    iclsPtr = clientData;
    clientData2 = Itcl_GetCallFrameClientData(interp);
    if (clientData2 == NULL) {
	Tcl_AppendResult(interp,
	        "this cannot be invoked without an object context", NULL);
        return TCL_ERROR;
    }
    oPtr = Tcl_ObjectContextObject(clientData2);
    if (oPtr == NULL) {
	Tcl_AppendResult(interp,
	        "this cannot be invoked without an object context", NULL);
        return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_Obj *namePtr = Tcl_NewObj();

     *  Search through all commands in the current namespace first,
     *  in the global namespace next, then in all child namespaces
     *  in this interpreter.  If we find any commands that
     *  represent classes, report them.
     */

    Itcl_InitStack(&search);
    Itcl_PushStack((ClientData)globalNs, &search);
    Itcl_PushStack((ClientData)activeNs, &search);  /* last in, first out! */

    Tcl_InitHashTable(&unique, TCL_ONE_WORD_KEYS);

    handledActiveNs = 0;
    while (Itcl_GetStackSize(&search) > 0) {
        nsPtr = Itcl_PopStack(&search);
        if (nsPtr == activeNs && handledActiveNs) {
            continue;
        }

        hPtr = Tcl_FirstHashEntry(Itcl_GetNamespaceCommandTable(nsPtr),
	        &place);
        while (hPtr) {

                 *      another namespace.
                 *
                 *  Otherwise, report short names.
                 */
                if (forceFullNames || nsPtr != activeNs ||
                    originalCmd != NULL) {

                    objPtr = Tcl_NewStringObj((char*)NULL, 0);
                    Tcl_GetCommandFullName(interp, cmd, objPtr);
                    cmdName = Tcl_GetString(objPtr);
                } else {
                    cmdName = Tcl_GetCommandName(interp, cmd);
                    objPtr = Tcl_NewStringObj((const char *)cmdName, -1);
                }

                if (originalCmd) {
                    cmd = originalCmd;
                }
                Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);

                if (newEntry &&
			((pattern == NULL) ||
			Tcl_StringCaseMatch((const char *)cmdName, pattern, 0))) {
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
			    Tcl_GetObjResult(interp), objPtr);
                } else {
		    /* if not appended to the result, free objPtr. */
		    Tcl_DecrRefCount(objPtr);
		}

            }

     *  Search through all commands in the current namespace first,
     *  in the global namespace next, then in all child namespaces
     *  in this interpreter.  If we find any commands that
     *  represent objects, report them.
     */

    Itcl_InitStack(&search);
    Itcl_PushStack((ClientData)globalNs, &search);
    Itcl_PushStack((ClientData)activeNs, &search);  /* last in, first out! */

    Tcl_InitHashTable(&unique, TCL_ONE_WORD_KEYS);

    handledActiveNs = 0;
    while (Itcl_GetStackSize(&search) > 0) {
        nsPtr = Itcl_PopStack(&search);
        if (nsPtr == activeNs && handledActiveNs) {
            continue;
        }

        entry = Tcl_FirstHashEntry(Itcl_GetNamespaceCommandTable(nsPtr), &place);
        while (entry) {
            cmd = (Tcl_Command)Tcl_GetHashValue(entry);

                 *      another namespace.
                 *
                 *  Otherwise, report short names.
                 */
                if (forceFullNames || nsPtr != activeNs ||
                    originalCmd != NULL) {

                    objPtr = Tcl_NewStringObj((char*)NULL, 0);
                    Tcl_GetCommandFullName(interp, cmd, objPtr);
		    cmdName = Tcl_GetString(objPtr);
                } else {
                    cmdName = Tcl_GetCommandName(interp, cmd);
                    objPtr = Tcl_NewStringObj((const char *)cmdName, -1);
                }

                                match = 1;
                            }
                        }
                    }
                }

                if (match) {
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                        Tcl_GetObjResult(interp), objPtr);
                } else {
                    Tcl_DecrRefCount(objPtr);  /* throw away the name */
                }
            }
            entry = Tcl_NextHashEntry(&place);
        }

 */
static int
CallDeleteObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ItclObject *contextIoPtr = data[0];
    if (contextIoPtr->destructorHasBeenCalled) {
	Tcl_AppendResult(interp, "can't delete an object while it is being ",
	        "destructed", NULL);
        return TCL_ERROR;
    }
    if (result == TCL_OK) {
        result = Itcl_DeleteObject(interp, contextIoPtr);

    ItclShowArgs(1, "Itcl_DelObjectCmd", objc, objv);
    /*
     *  Scan through the list of objects and attempt to delete them.
     *  If anything goes wrong (i.e., destructors fail), then
     *  abort with an error.
     */
    for (i=1; i < objc; i++) {
        name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
	contextIoPtr = NULL;
        if (Itcl_FindObject(interp, name, &contextIoPtr) != TCL_OK) {
            return TCL_ERROR;
        }

        if (contextIoPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "object \"", name, "\" not found",
                (char*)NULL);
            return TCL_ERROR;
        }

        callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
        Tcl_NRAddCallback(interp, CallDeleteObject, contextIoPtr,
	        NULL, NULL, NULL);
        result = Itcl_NRRunCallbacks(interp, callbackPtr);

    contextNsPtr = Tcl_GetCurrentNamespace(interp);
    openParen = NULL;
    result = TCL_OK;
    /*
     *  If this looks like a fully qualified name already,
     *  then return it as is.
     */
    token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
    if (*token == ':' && *(token+1) == ':') {
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }

    /*
     *  If the variable name is an array reference, pick out

     *    the array variable as the variable name.  We must be
     *    careful to add the index (everything from openParen
     *    onward) as well.
     */
    contextIoPtr = NULL;
    contextIclsPtr = NULL;
    oPtr = NULL;
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)contextNsPtr);
    if (hPtr != NULL) {
        contextIclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
    if (Itcl_IsClassNamespace(contextNsPtr)) {
	ClientData clientData;

        entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, token);
        if (!entry) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "variable \"", token, "\" not found in class \"",
                Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;
        }
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);

        if (vlookup->ivPtr->flags & ITCL_COMMON) {
            Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

	        contextIoPtr = infoPtr->currIoPtr;
	    }
	}
        if (contextIoPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "can't scope variable \"", token,
                "\": missing object context",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;
        }

        doAppend = 1;
        if (contextIclsPtr->flags & ITCL_ECLASS) {
            if (strcmp(token, "itcl_options") == 0) {
	        doAppend = 0;
            }
        }

        objPtr2 = Tcl_NewStringObj((char*)NULL, 0);
        Tcl_IncrRefCount(objPtr2);
	Tcl_AppendToObj(objPtr2, ITCL_VARIABLES_NAMESPACE, -1);
	Tcl_AppendToObj(objPtr2,
		(Tcl_GetObjectNamespace(contextIoPtr->oPtr))->fullName, -1);

        if (doAppend) {
            Tcl_AppendToObj(objPtr2,

        var = Itcl_FindNamespaceVar(interp, token, contextNsPtr,
            TCL_NAMESPACE_ONLY);

        if (!var) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "variable \"", token, "\" not found in namespace \"",
                contextNsPtr->fullName, "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;
        }

        Itcl_GetVariableFullName(interp, var, resultPtr);
        if (openParen) {
            *openParen = '(';

    int pos;

    ItclShowArgs(1, "Itcl_CodeCmd", objc, objv);
    /*
     *  Handle flags like "-namespace"...
     */
    for (pos=1; pos < objc; pos++) {
        token = Tcl_GetStringFromObj(objv[pos], (int*)NULL);
        if (*token != '-') {
            break;
        }

        if (strcmp(token, "-namespace") == 0) {
            if (objc == 2) {
                Tcl_WrongNumArgs(interp, 1, objv,
                    "?-namespace name? command ?arg arg...?");
                return TCL_ERROR;
            } else {
                token = Tcl_GetString(objv[pos+1]);
                contextNs = Tcl_FindNamespace(interp, token,
                    (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);

                if (!contextNs) {
                    return TCL_ERROR;
                }
                pos++;
            }
        } else {
	    if (strcmp(token, "--") == 0) {
                pos++;
                break;
            } else {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "bad option \"", token, "\": should be -namespace or --",
                    (char*)NULL);
                return TCL_ERROR;
            }
        }
    }

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv,
            "?-namespace name? command ?arg arg...?");
        return TCL_ERROR;
    }

    /*
     *  Now construct a scoped command by integrating the
     *  current namespace context, and appending the remaining
     *  arguments AS A LIST...
     */
    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

    Tcl_ListObjAppendElement(interp, listPtr,
        Tcl_NewStringObj("namespace", -1));
    Tcl_ListObjAppendElement(interp, listPtr,
        Tcl_NewStringObj("inscope", -1));

    if (contextNs == Tcl_GetGlobalNamespace(interp)) {

    ItclClass *iclsPtr;

    ItclShowArgs(1, "Itcl_ForwardAddCmd", objc, objv);
    if (objc < 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "<forwardName> <targetName> ?<arg> ...?");
        return TCL_ERROR;
    }
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    iclsPtr = (ItclClass*)Itcl_PeekStack(&infoPtr->clsStack);
    if (iclsPtr == NULL) {
	Tcl_HashEntry *hPtr;
        hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objv[1]);
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "class: \"", Tcl_GetString(objv[1]),
	            "\" not found", NULL);
	    return TCL_ERROR;
	}
        iclsPtr = Tcl_GetHashValue(hPtr);
    }
    prefixObj = Tcl_NewListObj(objc-2, objv+2);
    mPtr = Itcl_NewForwardClassMethod(interp, iclsPtr->clsPtr, 1,
            objv[1], prefixObj);
    if (mPtr == NULL) {
        return TCL_ERROR;
    }

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objv[1]);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "class \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);
    protectionStr = Tcl_GetString(objv[2]);
    pLevel = -1;
    if (strcmp(protectionStr, "public") == 0) {
        pLevel = ITCL_PUBLIC;
    }
    if (strcmp(protectionStr, "protected") == 0) {
        pLevel = ITCL_PROTECTED;
    }
    if (strcmp(protectionStr, "private") == 0) {
        pLevel = ITCL_PRIVATE;
    }
    if (pLevel == -1) {
	Tcl_AppendResult(interp, "bad protection \"", protectionStr, "\"",
	        NULL);
        return TCL_ERROR;
    }
    Itcl_PushStack((ClientData)iclsPtr, &infoPtr->clsStack);
    result = Itcl_ClassOptionCmd(clientData, interp, objc-2, objv+2);
    Itcl_PopStack(&infoPtr->clsStack);
    if (result != TCL_OK) {
        return result;
    }
    result = DelegatedOptionsInstall(interp, iclsPtr);
    return result;

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->objectCmds, (char *)cmd);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    protectionStr = Tcl_GetString(objv[2]);
    pLevel = -1;
    if (strcmp(protectionStr, "public") == 0) {
        pLevel = ITCL_PUBLIC;
    }
    if (strcmp(protectionStr, "protected") == 0) {
        pLevel = ITCL_PROTECTED;

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->objectCmds, (char *)cmd);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    result = Itcl_HandleDelegateOptionCmd(interp, ioPtr, NULL, &idoPtr,
            objc-3, objv+3);
    if (result != TCL_OK) {
        return result;
    }
    hPtr = Tcl_CreateHashEntry(&ioPtr->objectDelegatedOptions,
            (char *)idoPtr->namePtr, &isNew);

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->objectCmds, (char *)cmd);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    result = Itcl_HandleDelegateMethodCmd(interp, ioPtr, NULL, &idmPtr,
            objc-3, objv+3);
    if (result != TCL_OK) {
        return result;
    }
    componentNamePtr = idmPtr->icPtr->namePtr;
    Itcl_InitHierIter(&hier, ioPtr->iclsPtr);

        NULL, 0);
    hPtr = Tcl_FindHashEntry(&contextIclsPtr->variables, (char *)objv[2]);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "Itcl_AddComponentCmd cannot find component",
	        " \"", Tcl_GetString(objv[2]), "\"in class variables", NULL);
        return TCL_ERROR;
    }
    ivPtr = Tcl_GetHashValue(hPtr);
    /* add entry to the virtual tables */
    vlookup = (ItclVarLookup *)ckalloc(sizeof(ItclVarLookup));
    vlookup->ivPtr = ivPtr;
    vlookup->usage = 0;
    vlookup->leastQualName = NULL;

    /*

    Tcl_DStringInit(&buffer2);
    while (1) {
        hPtr = Tcl_CreateHashEntry(&contextIclsPtr->resolveVars,
            Tcl_DStringValue(&buffer), &isNew);

        if (isNew) {
            Tcl_SetHashValue(hPtr, (ClientData)vlookup);
            vlookup->usage++;

            if (!vlookup->leastQualName) {
                vlookup->leastQualName =
                    Tcl_GetHashKey(&contextIclsPtr->resolveVars, hPtr);
            }
        }

        if (nsPtr == NULL) {
            break;
        }

    contextIoPtr = NULL;
    ItclShowArgs(1, "Itcl_SetComponentCmd", objc, objv);
    if (objc < 4) {
        Tcl_WrongNumArgs(interp, 1, objv,
	        "objectName componentName value");
	return TCL_ERROR;
    }
    name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
    if (Itcl_FindObject(interp, name, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (contextIoPtr == NULL) {
	Tcl_AppendResult(interp, "Itcl_SetComponentCmd contextIoPtr "
	       "for \"", Tcl_GetString(objv[1]), "\" == NULL", NULL);
        return TCL_ERROR;

    }
    Itcl_DeleteHierIter(&hier);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" has no component \"", Tcl_GetString(objv[2]), "\"", NULL);
        return TCL_ERROR;
    }
    icPtr = Tcl_GetHashValue(hPtr);
    val = ItclGetInstanceVar(interp, Tcl_GetString(icPtr->namePtr), NULL,
            contextIoPtr, contextIclsPtr);
    if ((val != NULL) && (strlen(val) != 0)) {
        /* delete delegated options to the old component here !! */
        Itcl_InitHierIter(&hier, contextIoPtr->iclsPtr);
        while ((iclsPtr = Itcl_AdvanceHierIter(&hier)) != NULL) {
            FOREACH_HASH_VALUE(idoPtr, &iclsPtr->delegatedOptions) {

    char *name;                 /* name of this part */
    Tcl_Obj *namePtr;
    Tcl_Command cmdPtr;         /* command handling this part */
    char *usage;                /* usage string describing syntax */
    struct Ensemble* ensemble;  /* ensemble containing this part */
    ItclArgList *arglistPtr;    /* the parsed argument list */
    Tcl_ObjCmdProc *objProc;    /* handling procedure for part */
    ClientData *clientData;     /* the procPtr for the part */
    Tcl_CmdDeleteProc *deleteProc;
                                /* procedure used to destroy client data */
    int minChars;               /* chars needed to uniquely identify part */
    int flags;
    Tcl_Interp *interp;
    Tcl_Obj *mapNamePtr;
    Tcl_Obj *subEnsemblePtr;

int
Itcl_EnsembleInit(
    Tcl_Interp *interp)         /* interpreter being initialized */
{
    Tcl_DString buffer;
    ItclObjectInfo *infoPtr;

    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    Tcl_CreateObjCommand(interp, "::itcl::ensemble",
        Itcl_EnsembleCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, ITCL_COMMANDS_NAMESPACE, -1);
    Tcl_DStringAppend(&buffer, "::ensembles", -1);
    infoPtr->ensembleInfo->ensembleNsPtr = Tcl_CreateNamespace(interp,
            Tcl_DStringValue(&buffer), NULL, NULL);
    Tcl_DStringFree(&buffer);

    if (Tcl_SplitList(interp, (const char *)ensName, &nameArgc,
	    &nameArgv) != TCL_OK) {
        goto ensCreateFail;
    }
    if (nameArgc < 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "invalid ensemble name \"", ensName, "\"",
            (char*)NULL);
        goto ensCreateFail;
    }

    /*
     *  If there is more than one path component, then follow
     *  the path down to the last component, to find the containing
     *  ensemble.
     */
    parentEnsData = NULL;
    if (nameArgc > 1) {
        if (FindEnsemble(interp, nameArgv, nameArgc-1, &parentEnsData)
            != TCL_OK) {
            goto ensCreateFail;
        }

        if (parentEnsData == NULL) {
            char *pname = Tcl_Merge(nameArgc-1, nameArgv);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "invalid ensemble name \"", pname, "\"",
                (char*)NULL);
            ckfree(pname);
            goto ensCreateFail;
        }
    }

    /*
     *  Create the ensemble.

        goto ensPartFail;
    }

    if (ensData == NULL) {
        char *pname = Tcl_Merge(nameArgc, nameArgv);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "invalid ensemble name \"", pname, "\"",
            (char*)NULL);
        ckfree(pname);
        goto ensPartFail;
    }

    /*
     *  Install the new part into the part list.
     */

    /*
     *  Build the trail of ensemble names leading to this part.
     */
    Tcl_DStringInit(&buffer);
    Itcl_InitList(&trail);
    for (part=ensPart; part; part=part->ensemble->parent) {
        Itcl_InsertList(&trail, (ClientData)part);
    }

    while (ensData->parent != NULL) {
        ensData = ensData->parent->ensemble;
    }
    cmdPtr = ensData->cmdPtr;
    name = Tcl_GetCommandName(interp, cmdPtr);

    int isNew;
    char buf[20];
    Tcl_Obj *unkObjPtr;

    /*
     *  Create the data associated with the ensemble.
     */
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    infoPtr->ensembleInfo->numEnsembles++;
    ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
    memset(ensData, 0, sizeof(Ensemble));
    ensData->namePtr = Tcl_NewStringObj(ensName, -1);
    Tcl_IncrRefCount(ensData->namePtr);
    ensData->interp = interp;
    ensData->numParts = 0;

		Tcl_GetCurrentNamespace(interp), TCL_ENSEMBLE_PREFIX);
	hPtr = Tcl_CreateHashEntry(&infoPtr->ensembleInfo->ensembles,
		(char *)ensData->cmdPtr, &isNew);
	if (!isNew) {
	    result = TCL_ERROR;
	    goto finish;
	}
	Tcl_SetHashValue(hPtr, (ClientData)ensData);
	unkObjPtr = Tcl_NewStringObj(ITCL_COMMANDS_NAMESPACE, -1);
	Tcl_AppendToObj(unkObjPtr, "::ensembles::unknown", -1);
	if (Tcl_SetEnsembleUnknownHandler(NULL, ensData->cmdPtr,
		unkObjPtr) != TCL_OK) {
	    Tcl_DecrRefCount(unkObjPtr);
	    result = TCL_ERROR;
	    goto finish;
	}

	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1));
	result = TCL_OK;
	goto finish;
    }

    /*
     *  Otherwise, this ensemble is contained within another parent.
     *  Install the new ensemble as a part within its parent.
     */
    if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
            != TCL_OK) {
        DeleteEnsemble((ClientData)ensData);
        result = TCL_ERROR;
        goto finish;
    }
    Tcl_DStringSetLength(&buffer, 0);
    Tcl_DStringAppend(&buffer, infoPtr->ensembleInfo->ensembleNsPtr->fullName, -1);
    Tcl_DStringAppend(&buffer, "::subensembles::", -1);
    sprintf(buf, "%d", parentEnsData->ensembleId);

            Tcl_GetCurrentNamespace(interp), TCL_ENSEMBLE_PREFIX);
    hPtr = Tcl_CreateHashEntry(&infoPtr->ensembleInfo->ensembles,
            (char *)ensPart->cmdPtr, &isNew);
    if (!isNew) {
        result = TCL_ERROR;
        goto finish;
    }
    Tcl_SetHashValue(hPtr, (ClientData)ensData);
    unkObjPtr = Tcl_NewStringObj(ITCL_COMMANDS_NAMESPACE, -1);
    Tcl_AppendToObj(unkObjPtr, "::ensembles::unknown", -1);
    if (Tcl_SetEnsembleUnknownHandler(NULL, ensPart->cmdPtr,
            unkObjPtr) != TCL_OK) {
        result = TCL_ERROR;
        goto finish;
    }

     *  Install the new part into the part list.
     */
    if (CreateEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
        return TCL_ERROR;
    }

    if (usageInfo) {
        ensPart->usage = ckalloc((unsigned)(strlen(usageInfo)+1));
        strcpy(ensPart->usage, usageInfo);
    }
    ensPart->objProc = objProc;
    ensPart->clientData = clientData;
    ensPart->deleteProc = deleteProc;
    ensPart->flags = flags;

    while (ensData->numParts > 0) {
        DeleteEnsemblePart(ensData->parts[0]);
    }
    Tcl_DecrRefCount(ensData->namePtr);
    ckfree((char*)ensData->parts);
    ensData->parts = NULL;
    ensData->numParts = 0;
    infoPtr = Tcl_GetAssocData(ensData->interp, ITCL_INTERP_DATA, NULL);
    FOREACH_HASH_VALUE(ensData2, &infoPtr->ensembleInfo->ensembles) {
        if (ensData2 == ensData) {
            Tcl_DeleteHashEntry(hPtr);
	}
    }
    ckfree((char*)ensData);
}

    objPtr = Tcl_NewStringObj(nameArgv[0], -1);
    cmdPtr = Tcl_FindEnsemble(interp, objPtr, 0);
    Tcl_DecrRefCount(objPtr);

    if (cmdPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "command \"", nameArgv[0], "\" is not an ensemble",
            (char*)NULL);
        return TCL_ERROR;
    }
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmdPtr);
    if (hPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "command \"", nameArgv[0], "\" is not an ensemble",
            (char*)NULL);
        return TCL_ERROR;
    }
    ensData = (Ensemble *)Tcl_GetHashValue(hPtr);

    /*
     *  Follow the trail of sub-ensemble names.
     */
    for (i=1; i < nameArgc; i++) {
        if (FindEnsemblePart(interp, ensData, nameArgv[i], &ensPart)
            != TCL_OK) {
            return TCL_ERROR;
        }
        if (ensPart == NULL) {
            char *pname = Tcl_Merge(i, nameArgv);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "invalid ensemble name \"", pname, "\"",
                (char*)NULL);
            ckfree(pname);
            return TCL_ERROR;
        }

        cmdPtr = ensPart->cmdPtr;
        if (cmdPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "part \"", nameArgv[i], "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
        }
	if (!Tcl_IsEnsemble(cmdPtr)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "part \"", nameArgv[i], "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
	}
        if (Tcl_GetCommandInfoFromToken(cmdPtr, &cmdInfo) != 1) {
            return TCL_ERROR;
        }
        ensData = (Ensemble*)cmdInfo.objClientData;
    }

    /*
     *  If a matching entry was found, then return an error.
     */
    if (FindEnsemblePartIndex(ensData, partName, &pos)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "part \"", partName, "\" already exists in ensemble",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Otherwise, make room for a new entry.  Keep the parts in
     *  lexicographical order, so we can search them quickly
     *  later.

    for (i=ensData->numParts; i > pos; i--) {
        ensData->parts[i] = ensData->parts[i-1];
    }
    ensData->numParts++;

    ensPart = (EnsemblePart*)ckalloc(sizeof(EnsemblePart));
    memset(ensPart, 0, sizeof(EnsemblePart));
    ensPart->name = (char*)ckalloc((unsigned)(strlen(partName)+1));
    strcpy(ensPart->name, partName);
    ensPart->namePtr = Tcl_NewStringObj(ensPart->name, -1);
    ensPart->ensemble = ensData;
    ensPart->interp = interp;

    ensData->parts[pos] = ensPart;

     */
    if ((ensPart->deleteProc != NULL) && (ensPart->clientData != NULL)) {
        (*ensPart->deleteProc)(ensPart->clientData);
    }

    /* if it is a subensemble remove the command to free the data */
    if (ensPart->subEnsemblePtr != NULL) {
        infoPtr = Tcl_GetAssocData(ensData->interp, ITCL_INTERP_DATA, NULL);
	hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->subEnsembles,
	        (char *)ensPart->subEnsemblePtr);
        if (hPtr != NULL) {
	    ensData2 = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteNamespace(ensData2->nsPtr);
	    Tcl_DeleteHashEntry(hPtr);
	}
        Tcl_SetEnsembleUnknownHandler(NULL, ensPart->cmdPtr, NULL);
	hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles,
	        (char *)ensPart->ensemble->cmdPtr);
        if (hPtr != NULL) {
	    ensData2 = Tcl_GetHashValue(hPtr);
            Tcl_GetEnsembleMappingDict(NULL, ensData2->cmdPtr, &mapDict);
            if (mapDict != NULL) {
	        Tcl_DictObjRemove(ensPart->interp, mapDict,
	                ensPart->namePtr);
	        Tcl_SetEnsembleMappingDict(NULL, ensData2->cmdPtr, mapDict);
	    }
	}

            if (strncmp(partName, ensData->parts[pos]->name, nlen) != 0) {
                pos++;
                break;
            }
        }
    }
    if (nlen < ensData->parts[pos]->minChars) {
        Tcl_Obj *resultPtr = Tcl_NewStringObj((char*)NULL, 0);

        Tcl_AppendStringsToObj(resultPtr,
            "ambiguous option \"", partName, "\": should be one of...",
            (char*)NULL);

        for (i=pos; i < ensData->numParts; i++) {
            if (strncmp(partName, ensData->parts[i]->name, nlen) != 0) {
                break;
            }
            Tcl_AppendToObj(resultPtr, "\n  ", 3);
            GetEnsemblePartUsage(interp, ensData, ensData->parts[i], resultPtr);

    ItclShowArgs(1, "Itcl_EnsembleCmd", objc, objv);
    /*
     *  Make sure that an ensemble name was specified.
     */
    if (objc < 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"",
            Tcl_GetStringFromObj(objv[0], (int*)NULL),
            " name ?command arg arg...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this is the "ensemble" command in the main interpreter,
     *  then the client data will be null.  Otherwise, it is
     *  the "ensemble" command in the ensemble body parser, and

            if (FindEnsemblePart(ensInfo->master, ensData, ensName, &ensPart)
                    != TCL_OK) {
                Tcl_Panic("Itcl_EnsembleCmd: can't create ensemble");
            }
        }

        cmd = ensPart->cmdPtr;
        infoPtr = Tcl_GetAssocData(ensInfo->master, ITCL_INTERP_DATA, NULL);
        hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles,
	        (char *)ensPart->cmdPtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "part \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
                "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
	}
        ensData = (Ensemble *)Tcl_GetHashValue(hPtr);
    } else {

        /*
         *  Otherwise, the desired ensemble is a top-level ensemble.
         *  Find or create the access command for the ensemble, and
         *  then get its data.
         */
        cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
        if (cmd == NULL) {
            if (CreateEnsemble(interp, (Ensemble*)NULL, ensName)
                != TCL_OK) {
                return TCL_ERROR;
            }
            cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
        }

        if (cmd == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
                "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
        }
        infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
        hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmd);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
                "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
        }
        ensData = (Ensemble *)Tcl_GetHashValue(hPtr);
    }

    /*
     *  At this point, we have the data for the ensemble that is

     *  master interpreter.  If an error was encountered,
     *  copy the error info first, and then set the result.
     *  Otherwise, the offending command is reported twice.
     */
    if (status == TCL_ERROR) {
	/* no longer needed, no extra interpreter !! */
        const char *errInfo = Tcl_GetVar2(ensInfo->parser, "::errorInfo",
            (char*)NULL, TCL_GLOBAL_ONLY);

        if (errInfo) {
        	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(errInfo, -1));
        }

        if (objc == 3) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(

    Tcl_DeleteNamespace(Tcl_GetGlobalNamespace(ensInfo->parser));
    /*
     *  Add the allowed commands to the parser interpreter:
     *  part, delete, ensemble
     */
    Tcl_CreateObjCommand(ensInfo->parser, "part", Itcl_EnsPartCmd,
        (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(ensInfo->parser, "option", Itcl_EnsPartCmd,
        (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(ensInfo->parser, "ensemble", Itcl_EnsembleCmd,
        (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);

    /*
     *  Install the parser data, so we'll have it the next time
     *  we call this procedure.
     */
    (void) Tcl_SetAssocData(interp, "itcl_ensembleParser",
            DeleteEnsParser, (ClientData)ensInfo);

    return ensInfo;
}


/*
 *----------------------------------------------------------------------

    int maxArgc;
    Tcl_CmdInfo cmdInfo;

    ItclShowArgs(1, "Itcl_EnsPartCmd", objc, objv);
    if (objc != 4) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"",
            Tcl_GetStringFromObj(objv[0], (int*)NULL),
            " name args body\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Create a Tcl-style proc definition using the specified args
     *  and body.  This is not a proc in the usual sense.  It belongs
     *  to the namespace that contains the ensemble, but it is
     *  accessed through the ensemble, not through a Tcl command.
     */
    partName = Tcl_GetStringFromObj(objv[1], (int*)NULL);

    if (ItclCreateArgList(interp, Tcl_GetString(objv[2]), &argc, &maxArgc,
            &usagePtr, &arglistPtr, NULL, partName) != TCL_OK) {
	result = TCL_ERROR;
	goto errorOut;
    }
    if (Tcl_GetCommandInfoFromToken(ensData->cmdPtr, &cmdInfo) != 1) {

    /*
     *  Create a new part within the ensemble.  If successful,
     *  plug the command token into the proc; we'll need it later
     *  if we try to compile the Tcl code for the part.  If
     *  anything goes wrong, clean up before bailing out.
     */
    result = AddEnsemblePart(ensInfo->master, ensData, partName, usage,
        Tcl_GetObjInterpProc(), (ClientData)procPtr, _Tcl_ProcDeleteProc,
        ITCL_ENSEMBLE_ENSEMBLE, &ensPart);
    if (result == TCL_ERROR) {
	_Tcl_ProcDeleteProc(procPtr);
    }
    Tcl_TransferResult(ensInfo->master, result, interp);

errorOut:

    Ensemble *ensData = (Ensemble*)clientData;

    char *cmdName;
    Tcl_Obj *objPtr;

    cmdName = Tcl_GetString(objv[0]);

    objPtr = Tcl_NewStringObj((char*)NULL, 0);
    Tcl_AppendStringsToObj(objPtr,
        "bad option \"", cmdName, "\": should be one of...\n",
        (char*)NULL);
    GetEnsembleUsage(interp, ensData, objPtr);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * EnsembleSubCmd --
 *
 *----------------------------------------------------------------------
 */

static int
CallInvokeEnsembleMethod(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *nsPtr = data[0];
    EnsemblePart *ensPart = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj *const*objv = data[3];

    result = Itcl_InvokeEnsembleMethod(interp, nsPtr, ensPart->namePtr,
	        (Tcl_Proc *)ensPart->clientData, objc, objv);
    return result;
}

static int
CallInvokeEnsembleMethod2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    EnsemblePart *ensPart = data[0];
    int objc = PTR2INT(data[1]);
    Tcl_Obj *const*objv = data[2];
    result = (*ensPart->objProc)(ensPart->clientData, interp, objc, objv);
    return result;
}

static int
EnsembleSubCmd(
    ClientData clientData,      /* ensPart struct pointer */

    nsPtr = Tcl_GetCurrentNamespace(interp);
    callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
    if (ensPart->flags & ITCL_ENSEMBLE_ENSEMBLE) {
	/* FIXME !!! */
	if (ensPart->clientData == NULL) {
	    return TCL_ERROR;
	}
	Tcl_NRAddCallback(interp, CallInvokeEnsembleMethod, nsPtr, ensPart, INT2PTR(objc), (ClientData)objv);
    } else {
	Tcl_NRAddCallback(interp, CallInvokeEnsembleMethod2, ensPart, INT2PTR(objc), (ClientData)objv, NULL);
    }
    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    return result;
}
/*
 * ------------------------------------------------------------------------
 *  EnsembleUnknownCmd()

    ItclShowArgs(2, "EnsembleUnknownCmd", objc, objv);
    cmd = Tcl_GetCommandFromObj(interp, objv[1]);
    if (cmd == NULL) {
        Tcl_AppendResult(interp, "EnsembleUnknownCmd, ensemble not found!",
	        Tcl_GetString(objv[1]), NULL);
        return TCL_ERROR;
    }
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmd);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "EnsembleUnknownCmd, ensemble struct not ",
	        "found!", Tcl_GetString(objv[1]), NULL);
        return TCL_ERROR;
    }
    ensData = (Ensemble *)Tcl_GetHashValue(hPtr);

    if (FindEnsemblePart(interp, ensData, "@error", &ensPart) != TCL_OK) {
        Tcl_AppendResult(interp, "FindEnsemblePart error", NULL);
        return TCL_ERROR;
    }
    if (ensPart != NULL) {
        Tcl_Obj *listPtr;

	listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
	Tcl_ListObjAppendElement(NULL, listPtr, objv[1]);
	Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("@error", -1));
	Tcl_ListObjAppendElement(NULL, listPtr, objv[2]);
	Tcl_SetObjResult(interp, listPtr);
        return TCL_OK;
    }

        }
        hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmdPtr);
        if (hPtr == NULL) {
            Tcl_AppendResult(interp, "no such ensemble \"",
	    Tcl_GetString(objv[i]), "\"", NULL);
            return TCL_ERROR;
        }
        ensData = Tcl_GetHashValue(hPtr);
        Itcl_RenameCommand(ensData->interp, Tcl_GetString(ensData->namePtr), "");
	if (Tcl_FindNamespace(interp, ensData->nsPtr->fullName, NULL, 0)
	        != NULL) {
	    Tcl_DeleteNamespace(ensData->nsPtr);
        }
    }
    return TCL_OK;

	        result = TCL_ERROR;
	        break;
	    }
	    if (defaultArgc > 2) {
	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	            "too many fields in argument specifier \"",
		    argv[i], "\"",
		    (char*)NULL);
		ckfree((char *) defaultArgv);
	        result = TCL_ERROR;
	        break;
	    }
	    if (strstr(defaultArgv[0],"::")) {
	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		        "bad argument name \"", defaultArgv[0], "\"",
			(char*)NULL);
		ckfree((char *) defaultArgv);
		result = TCL_ERROR;
		break;
	    }
            arglistPtr = (ItclArgList *)ckalloc(sizeof(ItclArgList));
	    memset(arglistPtr, 0, sizeof(ItclArgList));
            if (*arglistPtrPtr == NULL) {

        cmd = Tcl_FindCommand(interp, "unknown",
            (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);

        if (cmd == NULL) {
            Tcl_ResetResult(interp);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "invalid command name \"",
                Tcl_GetStringFromObj(objv[0], NULL), "\"", NULL);
            return TCL_ERROR;
        }

        cmdlinePtr = Itcl_CreateArgs(interp, "unknown", objc, objv);
        Tcl_ListObjGetElements(NULL, cmdlinePtr, &cmdlinec, &cmdlinev);
    }

    ItclCallContext *popped;

    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->frameContext,
	    (char *) framePtr);

    Itcl_Stack *stackPtr = (Itcl_Stack *) Tcl_GetHashValue(hPtr);

    popped = Itcl_PopStack(stackPtr);

    if (Itcl_GetStackSize(stackPtr) == 0) {
	Itcl_DeleteStack(stackPtr);
	ckfree((char *)stackPtr);
	Tcl_DeleteHashEntry(hPtr);
    }

	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: " \
		    "\n  namespace eval className { info class }", -1));

    int result;
    int i;

    ItclShowArgs(1, "Itcl_BiInfoClassOptionsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info options ",
	        "?pattern?", NULL);
        return TCL_ERROR;
    }

    ItclShowArgs(1, "Itcl_BiInfoContextCmd", objc, objv);
    iclsPtr = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get object context ", (char*)NULL);
        return TCL_ERROR;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    objPtr = Tcl_NewStringObj(Tcl_GetString(iclsPtr->namePtr), -1);
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
    objPtr = Tcl_NewStringObj(Tcl_GetString(ioPtr->namePtr), -1);
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);

        return TCL_ERROR;
    }

    /*
     *  Return the list of base classes.
     */

    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
    elem = Itcl_FirstListElem(&contextIclsPtr->bases);
    while (elem) {
	Tcl_Obj *objPtr;
	ItclClass *iclsPtr = (ItclClass*)Itcl_GetListValue(elem);
            objPtr = Tcl_NewStringObj(iclsPtr->nsPtr->fullName, -1);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
        elem = Itcl_NextListElem(elem);
    }

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}


        return TCL_ERROR;
    }

    /*
     *  Traverse through the derivation hierarchy and return
     *  base class names.
     */
    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
    Itcl_InitHierIter(&hier, contextIclsPtr);
    while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
        if (iclsPtr->nsPtr == NULL) {
            Tcl_AppendResult(interp, "ITCL: iclsPtr->nsPtr == NULL",
	            Tcl_GetString(iclsPtr->fullNamePtr), NULL);
            return TCL_ERROR;
        }
            objPtr = Tcl_NewStringObj(iclsPtr->nsPtr->fullName, -1);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    }
    Itcl_DeleteHierIter(&hier);

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

{
    char *cmdName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;

    static const char *options[] = {
        "-args", "-body", "-name", "-protection", "-type",
        (char*)NULL
    };
    enum BIfIdx {
        BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
    } *iflist, iflistStorage[5];

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,

        entry = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objPtr);
	Tcl_DecrRefCount(objPtr);
	objPtr = NULL;
        if (entry == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a member function in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

	clookup = (ItclCmdLookup *)Tcl_GetHashValue(entry);
	imPtr = clookup->imPtr;
        mcode = imPtr->codePtr;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {

                    objPtr = Tcl_NewStringObj(val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            entry = Tcl_FirstHashEntry(&iclsPtr->functions, &place);
            while (entry) {
	        int useIt = 1;

		            useIt = 0;
		        }
		    }
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
		            resultPtr, objPtr);
                }

                entry = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    char *varName;
    const char *val;
    int i;
    int result;

    static const char *options[] = {
        "-config", "-init", "-name", "-protection", "-type",
        "-value", (char*)NULL
    };
    enum BIvIdx {
        BIvConfigIdx, BIvInitIdx, BIvNameIdx, BIvProtectIdx,
        BIvTypeIdx, BIvValueIdx
    } *ivlist, ivlistStorage[6];

    static enum BIvIdx DefInfoVariable[5] = {

     */
    if (varName) {
        entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
        if (entry == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a variable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

        vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
        ivPtr = vlookup->ivPtr;

        /*

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ivlist[i]) {
                case BIvConfigIdx:
                    if (ivPtr->codePtr &&
		            Itcl_IsMemberCodeImplemented(ivPtr->codePtr)) {

                    /*
                     *  If this is the built-in "this" variable, then
                     *  report the object name as its initialization string.
                     */
                    if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                        if ((contextIoPtr != NULL) &&
			        (contextIoPtr->accessCmd != NULL)) {
                            objPtr = Tcl_NewStringObj((char*)NULL, 0);
                            Tcl_GetCommandFullName(
                                contextIoPtr->iclsPtr->interp,
                                contextIoPtr->accessCmd, objPtr);
                        } else {
                            objPtr = Tcl_NewStringObj("<objectName>", -1);
                        }
                    } else {

                            if (objc > 1) {
			        Tcl_DecrRefCount(resultPtr);
			    }
                            Tcl_ResetResult(interp);
                            Tcl_AppendResult(interp,
                                    "cannot access object-specific info ",
                                    "without an object context",
                                    (char*)NULL);
                            return TCL_ERROR;
                        } else {
                            val = Itcl_GetInstanceVar(interp,
			            Tcl_GetString(ivPtr->namePtr),
                                    contextIoPtr, ivPtr->iclsPtr);
                        }
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, Tcl_GetString(resultPtr), NULL);
	Tcl_DecrRefCount(resultPtr);
    } else {

        /*
         *  Return the list of available variables.  Report the built-in
         *  "this" variable only once, for the most-specific class.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            entry = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
            while (entry) {
                ivPtr = (ItclVariable*)Tcl_GetHashValue(entry);
                if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                    if (iclsPtr == contextIclsPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ivPtr->fullNamePtr), -1);
                        Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                            resultPtr, objPtr);
                    }
                } else {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(ivPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                        resultPtr, objPtr);
                }
                entry = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

	    if (hPtr != NULL) {
		Itcl_List varList;
		Tcl_Obj *resultListPtr;
		Tcl_Obj *namePtr;
		int numElems;

		Itcl_InitList(&varList);
		iclsPtr = Tcl_GetHashValue(hPtr);
		resultListPtr = Tcl_GetObjResult(interp);
		numElems = 0;
/* FIXME !! should perhaps skip ___DO_NOT_DELETE_THIS_VARIABLE here !! */
		FOREACH_HASH_VALUE(ivPtr, &iclsPtr->variables) {
		    if ((ivPtr->flags & ITCL_VARIABLE) != 0) {
		        if (head != NULL) {
		            namePtr = Tcl_NewStringObj(

	if (contextIclsPtr->flags &
	        (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	    hPtr = Tcl_FindHashEntry(&contextIclsPtr->delegatedFunctions,
	            (char *)objv[1]);
	}

    if (hPtr) {
	ItclDelegatedFunction *idmPtr = Tcl_GetHashValue(hPtr);
        Tcl_Obj *objPtr = Tcl_NewStringObj("delegated ", -1);

	if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    what = "typemethod";
	}
	Tcl_AppendToObj(objPtr, what, -1);
	Tcl_AppendToObj(objPtr, " \"", -1);

    if (contextIclsPtr->flags
	    & (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	hPtr = Tcl_FindHashEntry(&contextIclsPtr->delegatedFunctions,
		(char *)objv[1]);
    }

    if (hPtr) {
	ItclDelegatedFunction *idmPtr = Tcl_GetHashValue(hPtr);
        Tcl_Obj *objPtr = Tcl_NewStringObj("delegated ", -1);

	if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    what = "typemethod";
	}
	Tcl_AppendToObj(objPtr, what, -1);
	Tcl_AppendToObj(objPtr, " \"", -1);

    static const char *options[] = {
        "-cgetmethod", "-cgetmethodvar","-class",
	"-configuremethod", "-configuremethodvar",
	"-default",
	"-name", "-protection", "-resource",
	"-validatemethod", "-validatemethodvar",
        "-value", (char*)NULL
    };
    enum BOptIdx {
        BOptCgetMethodIdx,
        BOptCgetMethodVarIdx,
	BOptClassIdx,
	BOptConfigureMethodIdx,
	BOptConfigureMethodVarIdx,

    /*
     *  Return info for a specific option.
     */
    if (optionName) {
	if (contextIoPtr == NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot access object-specific info ",
		    "without an object context", (char*)NULL);
	    return TCL_ERROR;
	}
	optionNamePtr = Tcl_NewStringObj(optionName, -1);
        hPtr = Tcl_FindHashEntry(&contextIoPtr->objectOptions,
	        (char *)optionNamePtr);
        Tcl_DecrRefCount(optionNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", optionName, "\" isn't a option in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        ioptPtr = (ItclOption*)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptCgetMethodIdx:
                    if (ioptPtr->cgetMethodPtr) {
                        objPtr = Tcl_NewStringObj(

                case BOptValueIdx:
		    if (contextIoPtr == NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendResult(interp,
                                "cannot access object-specific info ",
                                "without an object context",
                                (char*)NULL);
                        return TCL_ERROR;
                    } else {
                        val = ItclGetInstanceVar(interp, "itcl_options",
		                Tcl_GetString(ioptPtr->namePtr),
                                    contextIoPtr, ioptPtr->iclsPtr);
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->options, &place);
            while (hPtr) {
                ioptPtr = (ItclOption*)Tcl_GetHashValue(hPtr);
                objPtr = ioptPtr->namePtr;
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }

{
    char *componentName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;
    Tcl_Obj *componentNamePtr;

    static const char *components[] = {
	"-name", "-inherit", "-value", (char*)NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,

    infoPtr = contextIclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "cannot find class name for namespace \"",
	        nsPtr->fullName, "\"", NULL);
	return TCL_ERROR;
    }
    contextIclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  Process args:
     *  ?componentName? ?-inherit? ?-name? ?-value?
     */
    objv++;  /* skip over command name */
    objc--;

	}
	Tcl_DecrRefCount(componentNamePtr);
	Itcl_DeleteHierIter(&hier);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", componentName, "\" isn't a component in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        icPtr = (ItclComponent *)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (icomplist[i]) {
                case BCompNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(icPtr->ivPtr->fullNamePtr), -1);

                case BCompValueIdx:
		    if (contextIoPtr == NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendResult(interp,
                                "cannot access object-specific info ",
                                "without an object context",
                                (char*)NULL);
                        return TCL_ERROR;
                    } else {
                        val = ItclGetInstanceVar(interp,
			        Tcl_GetString(icPtr->namePtr), NULL,
                                    contextIoPtr, icPtr->ivPtr->iclsPtr);
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available components.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->components, &place);
            while (hPtr) {
                icPtr = (ItclComponent *)Tcl_GetHashValue(hPtr);
                objPtr = Tcl_NewStringObj(
		        Tcl_GetString(icPtr->ivPtr->fullNamePtr), -1);
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }

    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoWidgetCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info widget\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info widget ... }", -1));

    ClientData clientData, /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
#ifdef NOTYET
    static const char *components[] = {
	"-name", "-inherit", "-value", (char*)NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,

    ClientData clientData, /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
#ifdef NOTYET
    static const char *components[] = {
	"-name", "-inherit", "-value", (char*)NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,

    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoTypeCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info type\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info type ...}", -1));

    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    ItclShowArgs(1, "Itcl_BiInfoHullTypeCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info hulltype\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info hulltype ... }", -1));

    const char *val;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-args", "-body", "-name", "-protection", "-type",
        (char*)NULL
    };
    enum BIfIdx {
        BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
    } *iflist, iflistStorage[5];

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,

        hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objPtr);
	Tcl_DecrRefCount(objPtr);
	objPtr = NULL;
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a method in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

	clookup = (ItclCmdLookup *)Tcl_GetHashValue(hPtr);
	imPtr = clookup->imPtr;
        mcode = imPtr->codePtr;
        if (imPtr->flags & ITCL_COMMON) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a method in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
	}

        /*
         *  By default, return everything.
         */
        if (objc == 0) {

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {

                    objPtr = Tcl_NewStringObj(val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->functions, &place);
            while (hPtr) {
	        int useIt = 1;

                imPtr = (ItclMemberFunc*)Tcl_GetHashValue(hPtr);
		if (!(imPtr->flags & ITCL_METHOD)) {
		    useIt = 0;
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
		            resultPtr, objPtr);
                }

                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoMethodsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);

    int result;
    int i;

    ItclShowArgs(1, "Itcl_BiInfoOptionsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info options ",

    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoComponentsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (iclsPtr == NULL) {
        Tcl_AppendResult(interp, "INTERNAL ERROR in Itcl_BiInfoComponentsCmd",

    const char *val;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-args", "-body", "-name", "-protection", "-type",
        (char*)NULL
    };
    enum BIfIdx {
        BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
    } *iflist, iflistStorage[5];

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,

        hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objPtr);
	Tcl_DecrRefCount(objPtr);
	objPtr = NULL;
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a typemethod in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

	clookup = (ItclCmdLookup *)Tcl_GetHashValue(hPtr);
	imPtr = clookup->imPtr;
        mcode = imPtr->codePtr;
	if (!(imPtr->flags & ITCL_TYPE_METHOD)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a typemethod in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
	}

        /*
         *  By default, return everything.
         */
        if (objc == 0) {

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {

                    objPtr = Tcl_NewStringObj(val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->functions, &place);
            while (hPtr) {
	        int useIt = 1;

                imPtr = (ItclMemberFunc*)Tcl_GetHashValue(hPtr);
		if (!(imPtr->flags & ITCL_TYPE_METHOD)) {
		    useIt = 0;
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
		            resultPtr, objPtr);
                }

                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoTypeMethodsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc > 1) {
        pattern = Tcl_GetString(objv[1]);

	Tcl_AppendResult(interp,
	        "wrong # args should be: info typevars ?pattern?", NULL);
        return TCL_ERROR;
    }
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);

    char *varName;
    const char *val;
    int i;
    int result;

    static const char *options[] = {
        "-init", "-name", "-protection", "-type",
        "-value", (char*)NULL
    };
    enum BIvIdx {
        BIvInitIdx,
	BIvNameIdx,
	BIvProtectIdx,
        BIvTypeIdx,
	BIvValueIdx

     */
    if (varName) {
        hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
        if (!(ivPtr->flags & ITCL_TYPE_VARIABLE)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ivlist = DefInfoVariable;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ivlist[i]) {
                case BIvInitIdx:
                    /*
                     *  If this is the built-in "this" variable, then
                     *  report the object name as its initialization string.
                     */
                    if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                        if ((contextIoPtr != NULL) &&
			        (contextIoPtr->accessCmd != NULL)) {
                            objPtr = Tcl_NewStringObj((char*)NULL, 0);
                            Tcl_GetCommandFullName(
                                contextIoPtr->iclsPtr->interp,
                                contextIoPtr->accessCmd, objPtr);
                        } else {
                            objPtr = Tcl_NewStringObj("<objectName>", -1);
                        }
                    } else {

                            if (objc > 1) {
			        Tcl_DecrRefCount(resultPtr);
			    }
                            Tcl_ResetResult(interp);
                            Tcl_AppendResult(interp,
                                    "cannot access object-specific info ",
                                    "without an object context",
                                    (char*)NULL);
                            return TCL_ERROR;
                        } else {
                            val = Itcl_GetInstanceVar(interp,
			            Tcl_GetString(ivPtr->namePtr),
                                    contextIoPtr, ivPtr->iclsPtr);
                        }
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, Tcl_GetString(resultPtr), NULL);
	Tcl_DecrRefCount(resultPtr);
    } else {

        /*
         *  Return the list of available variables.  Report the built-in
         *  "this" variable only once, for the most-specific class.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
            while (hPtr) {
                ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr);
		if (ivPtr->flags & ITCL_TYPE_VAR) {
                    if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                        if (iclsPtr == contextIclsPtr) {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(ivPtr->fullNamePtr), -1);
                            Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                                resultPtr, objPtr);
                        }
                    } else {
                        objPtr = Tcl_NewStringObj(
		                Tcl_GetString(ivPtr->fullNamePtr), -1);
                        Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                            resultPtr, objPtr);
                    }
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoWidgetadaptorCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info widgetadaptor\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info widgetadaptor ... }", -1));

	Tcl_AppendResult(interp,
	        "wrong # args should be: info instances ?pattern?", NULL);
        return TCL_ERROR;
    }
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);

    ItclClass *iclsPtr;
    char *optionName;
    int i;
    int result;

    static const char *options[] = {
        "-as", "-class", "-component", "-exceptions",
	"-name", "-resource", (char*)NULL
    };
    enum BOptIdx {
        BOptAsIdx, BOptClassIdx, BOptComponentIdx, BOptExceptionsIdx,
	BOptNameIdx, BOptResourceIdx
    } *ioptlist, ioptlistStorage[6];

    static enum BOptIdx DefInfoOption[6] = {

    infoPtr = contextIclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "cannot find class name for namespace \"",
	        nsPtr->fullName, "\"", NULL);
	return TCL_ERROR;
    }
    contextIclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  Process args:
     *  ?optionName? ?-name? ?-resource? ?-class?
     * ?-as? ?-exceptions?
     */
    objv++;  /* skip over command name */

    /*
     *  Return info for a specific option.
     */
    if (optionName) {
	if (contextIoPtr == NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot access object-specific info ",
		    "without an object context", (char*)NULL);
	    return TCL_ERROR;
	}
	optionNamePtr = Tcl_NewStringObj(optionName, -1);
        hPtr = Tcl_FindHashEntry(&contextIoPtr->objectDelegatedOptions,
	        (char *)optionNamePtr);
        Tcl_DecrRefCount(optionNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", optionName, "\" isn't an option in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        idoptPtr = (ItclDelegatedOption*)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idoptPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(

                    break;

            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->delegatedOptions, &place);
            while (hPtr) {
                idoptPtr = (ItclDelegatedOption*)Tcl_GetHashValue(hPtr);
                objPtr = idoptPtr->namePtr;
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }

    ItclClass *iclsPtr;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-as", "-component", "-exceptions",
	"-name", "-using", (char*)NULL
    };
    enum BOptIdx {
        BOptAsIdx,
	BOptComponentIdx,
	BOptExceptionsIdx,
	BOptNameIdx,
	BOptUsingIdx

	            (char *)cmdNamePtr);
	}
	Tcl_DecrRefCount(cmdNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated method in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        idmPtr = (ItclDelegatedFunction*)Tcl_GetHashValue(hPtr);
        if (!(idmPtr->flags & ITCL_METHOD)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated method in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idmPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(

                    break;

            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->delegatedFunctions, &place);
            while (hPtr) {
                idmPtr = (ItclDelegatedFunction *)Tcl_GetHashValue(hPtr);
		if (idmPtr->flags & ITCL_METHOD) {
                    objPtr = idmPtr->namePtr;
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
		            objPtr);
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    ItclClass *iclsPtr;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-as", "-component", "-exceptions",
	"-name", "-using", (char*)NULL
    };
    enum BOptIdx {
        BOptAsIdx,
	BOptComponentIdx,
	BOptExceptionsIdx,
	BOptNameIdx,
	BOptUsingIdx

	}
	Tcl_DecrRefCount(cmdNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated typemethod in ",
		contextIoPtr ? "object \"" : "class \"",
		contextIoPtr ?  Tcl_GetString(contextIoPtr->namePtr)
		: Tcl_GetString(contextIclsPtr->namePtr), "\"", (char*)NULL);
            return TCL_ERROR;
        }
        idmPtr = (ItclDelegatedFunction*)Tcl_GetHashValue(hPtr);
        if (!(idmPtr->flags & ITCL_TYPE_METHOD)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated typemethod in ",
		contextIoPtr ? "object \"" : "class \"",
		contextIoPtr ?  Tcl_GetString(contextIoPtr->namePtr)
		: Tcl_GetString(contextIclsPtr->namePtr), "\"", (char*)NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idmPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(

                    break;

            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->delegatedFunctions, &place);
            while (hPtr) {
                idmPtr = (ItclDelegatedFunction *)Tcl_GetHashValue(hPtr);
		if (idmPtr->flags & ITCL_TYPE_METHOD) {
                    objPtr = idmPtr->namePtr;
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
		            objPtr);
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

#endif

/*
 * MSVC 8.0 started to mark many standard C library functions depreciated
 * including the *printf family and others. Tell it to shut up.
 * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
 */
#if defined(_MSC_VER) && (_MSC_VER >= 1400)
#   pragma warning(disable:4244)

#   pragma warning(disable:4267)
#   pragma warning(disable:4996)

#endif

/*
 * Since the Tcl/Tk distribution doesn't perform any asserts,
 * dynamic loading can fail to find the __assert function.
 * As a workaround, we'll include our own.
 */

 * only iterates over values.
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
            ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
            (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
            ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))

/*
 * What sort of size of things we like to allocate.

				const char *arglist, const char *body,
				ItclMemberFunc **mfuncPtr);
/* 55 */
ITCLAPI int		Itcl_ChangeMemberFunc(Tcl_Interp *interp,
				ItclMemberFunc *mfunc, const char *arglist,
				const char *body);
/* 56 */
ITCLAPI void		Itcl_DeleteMemberFunc(char *cdata);
/* 57 */
ITCLAPI int		Itcl_CreateMemberCode(Tcl_Interp *interp,
				ItclClass *iclsPtr, const char *arglist,
				const char *body, ItclMemberCode **mcodePtr);
/* 58 */
ITCLAPI void		Itcl_DeleteMemberCode(char *cdata);
/* 59 */

    void (*reserved49)(void);
    int (*itcl_BodyCmd) (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 50 */
    int (*itcl_ConfigBodyCmd) (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 51 */
    int (*itcl_CreateMethod) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *namePtr, const char *arglist, const char *body); /* 52 */
    int (*itcl_CreateProc) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *namePtr, const char *arglist, const char *body); /* 53 */
    int (*itcl_CreateMemberFunc) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *name, const char *arglist, const char *body, ItclMemberFunc **mfuncPtr); /* 54 */
    int (*itcl_ChangeMemberFunc) (Tcl_Interp *interp, ItclMemberFunc *mfunc, const char *arglist, const char *body); /* 55 */
    void (*itcl_DeleteMemberFunc) (char *cdata); /* 56 */
    int (*itcl_CreateMemberCode) (Tcl_Interp *interp, ItclClass *iclsPtr, const char *arglist, const char *body, ItclMemberCode **mcodePtr); /* 57 */
    void (*itcl_DeleteMemberCode) (char *cdata); /* 58 */
    int (*itcl_GetMemberCode) (Tcl_Interp *interp, ItclMemberFunc *mfunc); /* 59 */
    void (*reserved60)(void);
    int (*itcl_EvalMemberCode) (Tcl_Interp *interp, ItclMemberFunc *mfunc, ItclObject *contextObj, int objc, Tcl_Obj *const objv[]); /* 61 */
    void (*reserved62)(void);
    void (*reserved63)(void);

 *  this procedure returns an error.
 *
 *  Returns TCL_OK on success, or TCL_ERROR (along with an error message
 *  in interp->result) if anything goes wrong.
 * ------------------------------------------------------------------------
 */
int
Itcl_RegisterC(interp, name, proc, clientData, deleteProc)
    Tcl_Interp *interp;             /* interpreter handling this registration */
    const char *name;               /* symbolic name for procedure */
    Tcl_CmdProc *proc;              /* procedure handling Tcl command */
    ClientData clientData;          /* client data associated with proc */
    Tcl_CmdDeleteProc *deleteProc;  /* proc called to free up client data */
{
    int newEntry;
    Tcl_HashEntry *entry;
    Tcl_HashTable *procTable;
    ItclCfunc *cfunc;

    /*
     *  Make sure that a proc was specified.
     */
    if (!proc) {
        Tcl_AppendResult(interp, "initialization error: null pointer for ",
            "C procedure \"", name, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Add a new entry for the given procedure.  If an entry with
     *  this name already exists, then make sure that it was defined
     *  with the same proc.
     */
    procTable = ItclGetRegisteredProcs(interp);
    entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
    if (!newEntry) {
        cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
        if (cfunc->argCmdProc != NULL && cfunc->argCmdProc != proc) {
            Tcl_AppendResult(interp, "initialization error: C procedure ",
                "with name \"", name, "\" already defined",
                (char*)NULL);
            return TCL_ERROR;
        }

        if (cfunc->deleteProc != NULL) {
            (*cfunc->deleteProc)(cfunc->clientData);
        }
    } else {
        cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
        cfunc->objCmdProc = NULL;
    }

    cfunc->argCmdProc = proc;
    cfunc->clientData = clientData;
    cfunc->deleteProc = deleteProc;

    Tcl_SetHashValue(entry, (ClientData)cfunc);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_RegisterObjC()

 *  this procedure returns an error.
 *
 *  Returns TCL_OK on success, or TCL_ERROR (along with an error message
 *  in interp->result) if anything goes wrong.
 * ------------------------------------------------------------------------
 */
int
Itcl_RegisterObjC(interp, name, proc, clientData, deleteProc)
    Tcl_Interp *interp;     /* interpreter handling this registration */
    const char *name;       /* symbolic name for procedure */
    Tcl_ObjCmdProc *proc;   /* procedure handling Tcl command */
    ClientData clientData;          /* client data associated with proc */
    Tcl_CmdDeleteProc *deleteProc;  /* proc called to free up client data */
{
    int newEntry;
    Tcl_HashEntry *entry;
    Tcl_HashTable *procTable;
    ItclCfunc *cfunc;

    /*
     *  Make sure that a proc was specified.
     */
    if (!proc) {
        Tcl_AppendResult(interp, "initialization error: null pointer for ",
            "C procedure \"", name, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Add a new entry for the given procedure.  If an entry with
     *  this name already exists, then make sure that it was defined
     *  with the same proc.
     */
    procTable = ItclGetRegisteredProcs(interp);
    entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
    if (!newEntry) {
        cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
        if (cfunc->objCmdProc != NULL && cfunc->objCmdProc != proc) {
            Tcl_AppendResult(interp, "initialization error: C procedure ",
                "with name \"", name, "\" already defined",
                (char*)NULL);
            return TCL_ERROR;
        }

        if (cfunc->deleteProc != NULL) {
            (*cfunc->deleteProc)(cfunc->clientData);
        }
    }
    else {
        cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
        cfunc->argCmdProc = NULL;
    }

    cfunc->objCmdProc = proc;
    cfunc->clientData = clientData;
    cfunc->deleteProc = deleteProc;

    Tcl_SetHashValue(entry, (ClientData)cfunc);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_FindC()

    *argProcPtr = NULL;  /* assume info won't be found */
    *objProcPtr = NULL;
    *cDataPtr   = NULL;

    if (interp) {
        procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
            "itcl_RegC", (Tcl_InterpDeleteProc**)NULL);

        if (procTable) {
            entry = Tcl_FindHashEntry(procTable, name);
            if (entry) {
                cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
                *argProcPtr = cfunc->argCmdProc;
                *objProcPtr = cfunc->objCmdProc;

 *
 *  Returns a pointer to a hash table containing the list of registered
 *  procs in the specified interpreter.  If the hash table does not
 *  already exist, it is created.
 * ------------------------------------------------------------------------
 */
static Tcl_HashTable*
ItclGetRegisteredProcs(interp)
    Tcl_Interp *interp;  /* interpreter handling this registration */
{
    Tcl_HashTable* procTable;

    /*
     *  If the registration table does not yet exist, then create it.
     */
    procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp, "itcl_RegC",
        (Tcl_InterpDeleteProc**)NULL);

    if (!procTable) {
        procTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
        Tcl_InitHashTable(procTable, TCL_STRING_KEYS);
        Tcl_SetAssocData(interp, "itcl_RegC", ItclFreeC,
            (ClientData)procTable);
    }
    return procTable;
}


/*
 * ------------------------------------------------------------------------
 *  ItclFreeC()
 *
 *  When an interpreter is deleted, this procedure is called to
 *  free up the associated data created by Itcl_RegisterC and
 *  Itcl_RegisterObjC.
 * ------------------------------------------------------------------------
 */
static void
ItclFreeC(clientData, interp)
    ClientData clientData;       /* associated data */
    Tcl_Interp *interp;          /* intepreter being deleted */
{
    Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
    Tcl_HashSearch place;
    Tcl_HashEntry *entry;
    ItclCfunc *cfunc;

    entry = Tcl_FirstHashEntry(tablePtr, &place);

    ItclShowArgs(2, "Itcl_BodyCmd", objc, objv);
    if (objc != 4) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"",
            token, " class::func arglist body\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Parse the member name "namesp::namesp::class::func".
     *  Make sure that a class name was specified, and that the
     *  class exists.
     */
    token = Tcl_GetString(objv[1]);
    Itcl_ParseNamespPath(token, &buffer, &head, &tail);

    if (!head || *head == '\0') {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "missing class specifier for body declaration \"", token, "\"",
            (char*)NULL);
        status = TCL_ERROR;
        goto bodyCmdDone;
    }

    iclsPtr = Itcl_FindClass(interp, head, /* autoload */ 1);
    if (iclsPtr == NULL) {
        status = TCL_ERROR;

        }
    }

    if (imPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "function \"", tail, "\" is not defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        status = TCL_ERROR;
        goto bodyCmdDone;
    }

    arglist = Tcl_GetString(objv[2]);
    body    = Tcl_GetString(objv[3]);

     */
    token = Tcl_GetString(objv[1]);
    Itcl_ParseNamespPath(token, &buffer, &head, &tail);

    if ((head == NULL) || (*head == '\0')) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "missing class specifier for body declaration \"", token, "\"",
            (char*)NULL);
        status = TCL_ERROR;
        goto configBodyCmdDone;
    }

    iclsPtr = Itcl_FindClass(interp, head, /* autoload */ 1);
    if (iclsPtr == NULL) {
        status = TCL_ERROR;

        }
    }

    if (vlookup == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "option \"", tail, "\" is not defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        status = TCL_ERROR;
        goto configBodyCmdDone;
    }
    ivPtr = vlookup->ivPtr;

    if (ivPtr->protection != ITCL_PUBLIC) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "option \"", Tcl_GetString(ivPtr->fullNamePtr),
                "\" is not a public configuration option",
                (char*)NULL);
        status = TCL_ERROR;
        goto configBodyCmdDone;
    }

    token = Tcl_GetString(objv[2]);

    if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, token,
            &mcode) != TCL_OK) {
        status = TCL_ERROR;
        goto configBodyCmdDone;
    }

    ItclPreserveMemberCode(mcode);

    /*
     *  Make sure that the method name does not contain anything
     *  goofy like a "::" scope qualifier.
     */
    if (strstr(Tcl_GetString(namePtr),"::")) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "bad method name \"", Tcl_GetString(namePtr), "\"",
            (char*)NULL);
	Tcl_DecrRefCount(namePtr);
        return TCL_ERROR;
    }

    /*
     *  Create the method definition.
     */

    /*
     *  Make sure that the proc name does not contain anything
     *  goofy like a "::" scope qualifier.
     */
    if (strstr(Tcl_GetString(namePtr),"::")) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "bad proc name \"", Tcl_GetString(namePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Create the proc definition.
     */
    if (ItclCreateMemberFunc(interp, iclsPtr, namePtr, arglist,

     *  same name doesn't already exist.
     */
    hPtr = Tcl_CreateHashEntry(&iclsPtr->functions, (char *)namePtr, &newEntry);
    if (!newEntry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "\"", Tcl_GetString(namePtr), "\" already defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Try to create the implementation for this command member.
     */
    if (ItclCreateMemberCode(interp, iclsPtr, arglist, body,

	Tcl_IncrRefCount(mcode->bodyPtr);
        imPtr->flags |= ITCL_CONSTRUCTOR;
    }
    if (strcmp(name, "destructor") == 0) {
        imPtr->flags |= ITCL_DESTRUCTOR;
    }

    Tcl_SetHashValue(hPtr, (ClientData)imPtr);
    imPtr->refCount = 1;

    *imPtrPtr = imPtr;
    return TCL_OK;
}

/*

	} else {
	    argsStr = "";
	}
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "argument list changed for function \"",
            Tcl_GetString(imPtr->fullNamePtr), "\": should be \"",
            argsStr, "\"",
            (char*)NULL);

        Itcl_DeleteMemberCode((char*)mcode);
        return TCL_ERROR;
    }

    if (imPtr->flags & ITCL_CONSTRUCTOR) {
	/*

     *  Free up the old implementation and install the new one.
     */
    ItclPreserveMemberCode(mcode);
    ItclReleaseMemberCode(imPtr->codePtr);
    imPtr->codePtr = mcode;
    if (mcode->flags & ITCL_IMPLEMENT_TCL) {
	ClientData pmPtr;
        imPtr->tmPtr = (ClientData)Itcl_NewProcClassMethod(interp,
	    imPtr->iclsPtr->clsPtr, ItclCheckCallMethod, ItclAfterCallMethod,
	    ItclProcErrorProc, imPtr, imPtr->namePtr, mcode->argumentPtr,
	    mcode->bodyPtr, &pmPtr);
        hPtr = Tcl_CreateHashEntry(&imPtr->iclsPtr->infoPtr->procMethods,
                (char *)imPtr->tmPtr, &isNewEntry);
        if (isNewEntry) {
            Tcl_SetHashValue(hPtr, imPtr);

	        isDone = 1;
	    }
	    if (!isDone) {
                if (!Itcl_FindC(interp, body+1, &argCmdProc, &objCmdProc,
		        &cdata)) {
		    Tcl_AppendResult(interp,
                            "no registered C procedure with name \"",
			    body+1, "\"", (char*)NULL);
                    Itcl_DeleteMemberCode((char*)mcode);
                    return TCL_ERROR;
                }

	/*
	 * WARNING! WARNING! WARNING!
	 * This is a pretty dangerous approach.  What's done here is

    mcode = imPtr->codePtr;
    assert(mcode != NULL);

    if (!Itcl_IsMemberCodeImplemented(mcode)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "member function \"", Tcl_GetString(imPtr->fullNamePtr),
            "\" is not defined and cannot be autoloaded",
            (char*)NULL);
        return TCL_ERROR;
    }

    return TCL_OK;
}



static int
CallItclObjectCmd(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Object oPtr;
    ItclMemberFunc *imPtr = data[0];
    ItclObject *ioPtr = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];

    ItclShowArgs(1, "CallItclObjectCmd", objc, objv);
    if (ioPtr != NULL) {
        ioPtr->hadConstructorError = 0;
    }
    if (imPtr->flags & (ITCL_CONSTRUCTOR|ITCL_DESTRUCTOR)) {
        oPtr = ioPtr->oPtr;

            result = (*mcode->cfunc.objCmd)(mcode->clientData,
                    interp, objc, objv);
        } else {
            if ((mcode->flags & ITCL_IMPLEMENT_ARGCMD) != 0) {
                char **argv;
                argv = (char**)ckalloc( (unsigned)(objc*sizeof(char*)) );
                for (i=0; i < objc; i++) {
                    argv[i] = Tcl_GetStringFromObj(objv[i], (int*)NULL);
                }

                result = (*mcode->cfunc.argCmd)(mcode->clientData,
                    interp, objc, (const char **)argv);

                ckfree((char*)argv);
	    }

{
    Tcl_CallFrame *framePtr = Itcl_GetUplevelCallFrame(interp, 0);
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->frameContext,
	    (char *)framePtr);
    Itcl_Stack *stackPtr = (Itcl_Stack *) Tcl_GetHashValue(hPtr);
    ItclCallContext *contextPtr = Itcl_PopStack(stackPtr);

    if (Itcl_GetStackSize(stackPtr) > 0) {
	Tcl_Panic("frame context stack not empty!");
    }
    Itcl_DeleteStack(stackPtr);
    ckfree((char *) stackPtr);
    Tcl_DeleteHashEntry(hPtr);

    ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->frameContext,
	    (char *)framePtr);
    if (hPtr) {
	/* Frame maps to a context stack. */
	Itcl_Stack *stackPtr = (Itcl_Stack *)Tcl_GetHashValue(hPtr);
	ItclCallContext *contextPtr = Itcl_PeekStack(stackPtr);

	assert(contextPtr);

	if (contextPtr->objectFlags & ITCL_OBJECT_ROOT_METHOD) {
	    ItclObject *ioPtr = contextPtr->ioPtr;

	    *iclsPtrPtr = ioPtr->iclsPtr;

                Tcl_AppendToObj(objPtr, Tcl_GetString(imPtr->fullNamePtr), -1);
            }
        } else {
	    if (contextIoPtr && contextIoPtr->accessCmd) {
                name = (char *) Tcl_GetCommandName(
		    contextIoPtr->iclsPtr->interp, contextIoPtr->accessCmd);
                Tcl_AppendStringsToObj(objPtr, name, " ",
		        Tcl_GetString(imPtr->namePtr), (char*)NULL);
            } else {
                Tcl_AppendStringsToObj(objPtr, "<object> ",
		        Tcl_GetString(imPtr->namePtr), (char*)NULL);
	    }
        }
    } else {
        Tcl_AppendToObj(objPtr, Tcl_GetString(imPtr->fullNamePtr), -1);
    }

    /*

    iclsPtr = imPtr->iclsPtr;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot access object-specific info without an object context",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Make sure that this command member can be accessed from
     *  the current namespace context.
     *  That is now done in ItclMapMethodNameProc !!

     *  the current namespace context.
     */
    if (imPtr->protection != ITCL_PUBLIC) {
        if (!Itcl_CanAccessFunc(imPtr, Tcl_GetCurrentNamespace(interp))) {
	    ItclMemberFunc *imPtr2 = NULL;
            Tcl_HashEntry *hPtr;
	    Tcl_ObjectContext context;
	    context = Itcl_GetCallFrameClientData(interp);
            if (context == NULL) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                        "can't access \"", Tcl_GetString(imPtr->fullNamePtr),
			"\": ", Itcl_ProtectionStr(imPtr->protection),
			" function", (char*)NULL);
                return TCL_ERROR;
            }
	    hPtr = Tcl_FindHashEntry(&imPtr->iclsPtr->infoPtr->procMethods,
	            (char *)Tcl_ObjectContextMethod(context));
	    if (hPtr != NULL) {
	        imPtr2 = Tcl_GetHashValue(hPtr);
	    }
	    if ((imPtr->protection & ITCL_PRIVATE) && (imPtr2 != NULL) &&
	            (imPtr->iclsPtr->nsPtr != imPtr2->iclsPtr->nsPtr)) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	                "invalid command name \"",
		        Tcl_GetString(objv[0]),
		        "\"", NULL);
	        return TCL_ERROR;
	    }
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "can't access \"", Tcl_GetString(imPtr->fullNamePtr),
		    "\": ", Itcl_ProtectionStr(imPtr->protection),
		    " function", (char*)NULL);
            return TCL_ERROR;
        }
    }

    /*
     *  Execute the code for the proc.  Be careful to protect
     *  the proc in case it gets deleted during execution.
     */
    ItclPreserveIMF(imPtr);

    result = Itcl_EvalMemberCode(interp, imPtr, (ItclObject*)NULL,
        objc, objv);
    ItclReleaseIMF(imPtr);
    return result;
}

/* ARGSUSED */
int


static int
CallInvokeMethodIfExists(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ItclClass *iclsPtr = data[0];
    ItclObject *contextObj = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj* const* objv = data[3];

    result = Itcl_InvokeMethodIfExists(interp, "constructor",
            iclsPtr, contextObj, objc, (Tcl_Obj* const*)objv);

    if (result != TCL_OK) {
        return TCL_ERROR;
    }

        imPtr  = (ItclMemberFunc*)Tcl_GetHashValue(hPtr);

        /*
         *  Prepend the method name to the list of arguments.
         */
        cmdlinePtr = Itcl_CreateArgs(interp, name, objc, objv);

        (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
            &cmdlinec, &cmdlinev);

        ItclShowArgs(1, "EMC", cmdlinec, cmdlinev);
        /*
         *  Execute the code for the method.  Be careful to protect
         *  the method in case it gets deleted during execution.
         */

        iclsPtr = resolveInfoPtr->iclsPtr;
    }
    infoPtr = iclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr == NULL) {
	return NULL;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);
    objPtr = Tcl_NewStringObj(cmdName, -1);
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveCmds, (char *)objPtr);
    Tcl_DecrRefCount(objPtr);
    if (hPtr == NULL) {
	if (strcmp(cmdName, "@itcl-builtin-cget") == 0) {
	    return Tcl_FindCommand(interp, "::itcl::builtin::cget", NULL, 0);
	}

    } else {
        ioPtr = NULL;
        iclsPtr = resolveInfoPtr->iclsPtr;
    }
    infoPtr = iclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr != NULL) {
        iclsPtr = Tcl_GetHashValue(hPtr);
    }
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, varName);
    if (hPtr == NULL) {
	/* no class/object variable */
        return NULL;
    }
    ivlPtr = Tcl_GetHashValue(hPtr);
    if (ivlPtr == NULL) {
        return NULL;
    }
    if (!ivlPtr->accessible) {
        return NULL;
    }

	    if (ioPtr != NULL) {
                hPtr = Tcl_FindHashEntry(&ioPtr->objectVariables,
	                (char *)ivlPtr->ivPtr);
	    }
	}
    }
    if (hPtr != NULL) {
        varPtr = Tcl_GetHashValue(hPtr);
    }
    return varPtr;
}

/*
 * ------------------------------------------------------------------------
 *  ItclCheckCallProc()

	    Tcl_AppendResult(interp,
	            "ItclCheckCallMethod cannot get context object (NULL)",
                    " for ", Tcl_GetString(imPtr->fullNamePtr),
		    NULL);
	    result = TCL_ERROR;
	    goto finishReturn;
	}
        oPtr = Tcl_ObjectContextObject(contextPtr);
	ioPtr = Tcl_ObjectGetMetadata(oPtr,
	        imPtr->iclsPtr->infoPtr->object_meta_type);
    }
    if ((imPtr->codePtr != NULL) &&
            (imPtr->codePtr->flags & ITCL_IMPLEMENT_NONE)) {
        Tcl_AppendResult(interp, "member function \"",
	        Tcl_GetString(imPtr->fullNamePtr),
		"\" is not defined and cannot be autoloaded", NULL);

  }
    isNew = 0;
    callContextPtr = NULL;
    currNsPtr = Tcl_GetCurrentNamespace(interp);
    if (ioPtr != NULL) {
        hPtr = Tcl_CreateHashEntry(&ioPtr->contextCache, (char *)imPtr, &isNew);
        if (!isNew) {
	    callContextPtr2 = Tcl_GetHashValue(hPtr);
	    if (callContextPtr2->refCount == 0) {
	        callContextPtr = callContextPtr2;
                callContextPtr->objectFlags = ioPtr->flags;
                callContextPtr->nsPtr = Tcl_GetCurrentNamespace(interp);
                callContextPtr->ioPtr = ioPtr;
                callContextPtr->imPtr = imPtr;
                callContextPtr->refCount = 1;

    ItclObjectInfo *infoPtr = imPtr->infoPtr;
    Tcl_CallFrame *framePtr;
    Itcl_Stack *stackPtr;

    hPtr = Tcl_FindHashEntry(&infoPtr->frameContext, (char *)contextPtr);
    assert(hPtr);
    stackPtr = (Itcl_Stack *)Tcl_GetHashValue(hPtr);
    framePtr = Itcl_PopStack(stackPtr);
    if (Itcl_GetStackSize(stackPtr) == 0) {
	Itcl_DeleteStack(stackPtr);
	ckfree((char *) stackPtr);
	Tcl_DeleteHashEntry(hPtr);
    }

    hPtr = Tcl_FindHashEntry(&infoPtr->frameContext, (char *)framePtr);
    assert(hPtr);
    stackPtr = (Itcl_Stack *)Tcl_GetHashValue(hPtr);
    callContextPtr = Itcl_PopStack(stackPtr);
    if (Itcl_GetStackSize(stackPtr) == 0) {
	Itcl_DeleteStack(stackPtr);
	ckfree((char *) stackPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    }
    if (callContextPtr == NULL) {

    if (hPtr == NULL) {
	/* Can this happen? */
	return;
    }

    /* Frame maps to a context stack. */
    stackPtr = (Itcl_Stack *)Tcl_GetHashValue(hPtr);
    callContextPtr = Itcl_PeekStack(stackPtr);

    if (callContextPtr == NULL) {
	return;
    }

    currIclsPtr = NULL;
    objPtr = NULL;

ObjectRenamedTrace(
    ClientData clientData,      /* The object being deleted. */
    Tcl_Interp *interp,         /* The interpreter containing the object. */
    const char *oldName,        /* What the object was (last) called. */
    const char *newName,        /* Always NULL ??. not for itk!! */
    int flags)                  /* Why was the object deleted? */
{
    ItclObject *ioPtr = clientData;
    Itcl_InterpState istate;

    if (newName != NULL) {
	/* FIXME should enter the new name in the hashtables for objects etc. */
        return;
    }
    if (ioPtr->flags & ITCL_OBJECT_CLASS_DESTRUCTED) {

            TCL_TRACE_RENAME|TCL_TRACE_DELETE, ObjectRenamedTrace, ioPtr);
	Tcl_DecrRefCount(tmp);
    }
    Tcl_ObjectSetMethodNameMapper(ioPtr->oPtr, ItclMapMethodNameProc);

    ioPtr->accessCmd = Tcl_GetObjectCommand(ioPtr->oPtr);
    Tcl_GetCommandInfoFromToken(ioPtr->accessCmd, &cmdInfo);
    cmdInfo.deleteProc = (void *)ItclDestroyObject;
    cmdInfo.deleteData = ioPtr;
    Tcl_SetCommandInfoFromToken(ioPtr->accessCmd, &cmdInfo);
    ioPtr->resolvePtr = (Tcl_Resolve *)ckalloc(sizeof(Tcl_Resolve));
    ioPtr->resolvePtr->cmdProcPtr = Itcl_CmdAliasProc;
    ioPtr->resolvePtr->varProcPtr = Itcl_VarAliasProc;
    resolveInfoPtr = (ItclResolveInfo *)ckalloc(sizeof(ItclResolveInfo));
    memset (resolveInfoPtr, 0, sizeof(ItclResolveInfo));
    resolveInfoPtr->flags = ITCL_RESOLVE_OBJECT;
    resolveInfoPtr->ioPtr = ioPtr;
    ioPtr->resolvePtr->clientData = resolveInfoPtr;

    Tcl_ObjectSetMetadata(ioPtr->oPtr, iclsPtr->infoPtr->object_meta_type,
            ioPtr);

    /* make the object known, if it is used in the constructor already! */
    hPtr = Tcl_CreateHashEntry(&iclsPtr->infoPtr->objectCmds,
        (char*)ioPtr->accessCmd, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)ioPtr);

    hPtr = Tcl_CreateHashEntry(&iclsPtr->infoPtr->objects,
        (char*)ioPtr, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)ioPtr);

    /* Use the TclOO object namespaces as a unique key in case the
     * object is renamed. Used by mytypemethod, etc. */

    hPtr = Tcl_CreateHashEntry(&iclsPtr->infoPtr->instances,
	(Tcl_GetObjectNamespace(ioPtr->oPtr))->fullName, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)ioPtr);

    /*
     *  Now construct the object.  Look for a constructor in the
     *  most-specific class, and if there is one, invoke it.
     *  This will cause a chain reaction, making sure that all
     *  base classes constructors are invoked as well, in order
     *  from least- to most-specific.  Any constructors that are

	    result = DelegationInstall(interp, ioPtr, iclsPtr);
	    if (result != TCL_OK) {
		goto errorReturn;
	    }
	}
        hPtr = Tcl_CreateHashEntry(&iclsPtr->infoPtr->objectCmds,
                (char*)ioPtr->accessCmd, &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ioPtr);
        hPtr = Tcl_CreateHashEntry(&iclsPtr->infoPtr->objects,
                (char*)ioPtr, &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ioPtr);

	/*
	 * This is an inelegant hack, left behind until the need for it
	 * can be eliminated by getting the inheritance tree right.
	 */

        if (iclsPtr->flags
		& (ITCL_ECLASS|ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
	    Tcl_NewInstanceMethod(interp, ioPtr->oPtr,
		    Tcl_NewStringObj("unknown", -1), 0,
		    &itclRootMethodType, ItclUnknownGuts);
	}

        if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGETADAPTOR)) {
            Tcl_Obj *objPtr = Tcl_NewObj();
            Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
            if (iclsPtr->flags & ITCL_WIDGETADAPTOR) {
	        /* skip over the leading :: */

                if (Itcl_PushCallFrame(interp, &frame, varNsPtr2,
                        /*isProcCallFrame*/0) != TCL_OK) {
		    goto errorCleanup2;
                }
                Tcl_TraceVar2(interp, "itcl_options",
                        NULL,
                        TCL_TRACE_READS|TCL_TRACE_WRITES,
                        ItclTraceOptionVar, (ClientData)ioPtr);
	        Itcl_PopCallFrame(interp);
                if (Itcl_PushCallFrame(interp, &frame, varNsPtr,
                        /*isProcCallFrame*/0) != TCL_OK) {
		    goto errorCleanup2;
                }
                hPtr = Tcl_NextHashEntry(&place);
	        continue;
            }
            if (ivPtr->flags & ITCL_COMPONENT_VAR) {
		hPtr2 = Tcl_FindHashEntry(&ivPtr->iclsPtr->components,
		        (char *)ivPtr->namePtr);
		if (hPtr2 == NULL) {
		    Tcl_AppendResult(interp, "cannot find component \"",
		            Tcl_GetString(ivPtr->namePtr), "\" in class \"",
			    Tcl_GetString(ivPtr->iclsPtr->namePtr), NULL);
		    goto errorCleanup;
		}
		icPtr = Tcl_GetHashValue(hPtr2);
		if (icPtr->flags & ITCL_COMPONENT_INHERIT) {
		    if (inheritComponentName != NULL) {
		        Tcl_AppendResult(interp, "object \"",
			        Tcl_GetString(ioPtr->namePtr),
				"\" can only have one component with inherit.",
				" Had already component \"",
				inheritComponentName,

			        " variable \"", varNsPtr->fullName, "::",
				varName, "\"\n", NULL);
		        goto errorCleanup;
	            }
	        if (ivPtr->flags & ITCL_THIS_VAR) {
	            Tcl_TraceVar2(interp, varName, NULL,
		        TCL_TRACE_READS|TCL_TRACE_WRITES, ItclTraceThisVar,
		        (ClientData)ioPtr);
                    isDone = 1;
		}
	        if (!isDone && ivPtr->flags & ITCL_TYPE_VAR) {
	            Tcl_TraceVar2(interp, varName, NULL,
		        TCL_TRACE_READS|TCL_TRACE_WRITES, ItclTraceTypeVar,
		        (ClientData)ioPtr);
                    isDone = 1;
		}
	        if (!isDone && ivPtr->flags & ITCL_SELF_VAR) {
	            Tcl_TraceVar2(interp, varName, NULL,
		        TCL_TRACE_READS|TCL_TRACE_WRITES, ItclTraceSelfVar,
		        (ClientData)ioPtr);
                    isDone = 1;
		}
	        if (!isDone && ivPtr->flags & ITCL_SELFNS_VAR) {
	            Tcl_TraceVar2(interp, varName, NULL,
		        TCL_TRACE_READS|TCL_TRACE_WRITES, ItclTraceSelfnsVar,
		        (ClientData)ioPtr);
                    isDone = 1;
		}
	        if (!isDone && ivPtr->flags & ITCL_WIN_VAR) {
	            Tcl_TraceVar2(interp, varName, NULL,
		        TCL_TRACE_READS|TCL_TRACE_WRITES, ItclTraceWinVar,
		        (ClientData)ioPtr);
                    isDone = 1;
		}
		} else {
	            if (ivPtr->flags & ITCL_HULL_VAR) {
	                Tcl_TraceVar2(interp, varName, NULL,
		            TCL_TRACE_READS|TCL_TRACE_WRITES,
			    ItclTraceItclHullVar,
		            (ClientData)ioPtr);
		    } else {
	              if (ivPtr->init != NULL) {
			if (Tcl_SetVar2(interp,
			        Tcl_GetString(ivPtr->namePtr), NULL,
			        Tcl_GetString(ivPtr->init),
				TCL_NAMESPACE_ONLY) == NULL) {
			    goto errorCleanup;

                            val = Tcl_SetVar2(interp,
			            Tcl_DStringValue(&buffer3), argv[i],
                                    argv[i + 1], TCL_NAMESPACE_ONLY);
                            if (!val) {
                                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                                    "cannot initialize variable \"",
                                    Tcl_GetString(ivPtr->namePtr), "\"",
                                    (char*)NULL);
                                return TCL_ERROR;
                            }
	                    i++;
                        }
			Tcl_DStringFree(&buffer3);
		        ckfree((char *)argv);
		        }
		      }
		    }
	        } else {
	            if (ivPtr->flags & ITCL_HULL_VAR) {
	                Tcl_TraceVar2(interp, varName, NULL,
		            TCL_TRACE_READS|TCL_TRACE_WRITES,
			    ItclTraceItclHullVar,
		            (ClientData)ioPtr);
		    }
	            hPtr2 = Tcl_FindHashEntry(&iclsPtr2->classCommons,
		            (char *)ivPtr);
		    if (hPtr2 == NULL) {
		        goto errorCleanup;
		    }
		    varPtr = Tcl_GetHashValue(hPtr2);
	            hPtr2 = Tcl_CreateHashEntry(&ioPtr->objectVariables,
		            (char *)ivPtr, &isNew);
	            if (isNew) {
			Itcl_PreserveVar(varPtr);
		        Tcl_SetHashValue(hPtr2, varPtr);
	        }
	        if (ivPtr->flags & ITCL_COMPONENT_VAR) {
	            if (ivPtr->flags & ITCL_COMMON) {
                        Tcl_Obj *objPtr2;
		        objPtr2 = Tcl_NewStringObj(ITCL_VARIABLES_NAMESPACE,
			        -1);
			Tcl_AppendToObj(objPtr2, (Tcl_GetObjectNamespace(
				ivPtr->iclsPtr->oPtr))->fullName, -1);
                        Tcl_AppendToObj(objPtr2, "::", -1);
                        Tcl_AppendToObj(objPtr2, varName, -1);
			/* itcl_hull is traced in itclParse.c */
			if (strcmp(varName, "itcl_hull") == 0) {
                            Tcl_TraceVar2(interp,
                                    Tcl_GetString(objPtr2), NULL,
	                            TCL_TRACE_WRITES, ItclTraceItclHullVar,
	                            (ClientData)ioPtr);
			} else {
                            Tcl_TraceVar2(interp,
                                    Tcl_GetString(objPtr2), NULL,
	                            TCL_TRACE_WRITES, ItclTraceComponentVar,
	                            (ClientData)ioPtr);
		        }
		        Tcl_DecrRefCount(objPtr2);
		    } else {
                        Tcl_TraceVar2(interp,
		                varName, NULL,
	                        TCL_TRACE_WRITES, ItclTraceComponentVar,
	                        (ClientData)ioPtr);
	            }
	        }
	    }
            hPtr = Tcl_NextHashEntry(&place);
        }
	Itcl_PopCallFrame(interp);
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);

			    TCL_NAMESPACE_ONLY) == NULL) {
	                Itcl_PopCallFrame(interp);
		        return TCL_ERROR;
                    }
                    Tcl_TraceVar2(interp, "itcl_options",
                            NULL,
                            TCL_TRACE_READS|TCL_TRACE_WRITES,
                            ItclTraceOptionVar, (ClientData)ioPtr);
		}
	        Itcl_PopCallFrame(interp);
            }
            hPtr = Tcl_NextHashEntry(&place);
        }
	/* now check for options which are delegated */
        hPtr = Tcl_FirstHashEntry(&iclsPtr2->delegatedOptions, &place);


static int
FinalizeDeleteObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ItclObject *contextIoPtr = data[0];
    if (result == TCL_OK) {
	ItclDeleteObjectVariablesNamespace(interp, contextIoPtr);
        Tcl_ResetResult(interp);
    }

    Tcl_DeleteHashTable(contextIoPtr->destructed);
    ckfree((char*)contextIoPtr->destructed);
    contextIoPtr->destructed = NULL;
    return result;
}

static int
CallDestructBase(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *objPtr;
    ItclObject *contextIoPtr = data[0];
    int flags = PTR2INT(data[1]);

    if (result != TCL_OK) {
        return result;
    }
    result = ItclDestructBase(interp, contextIoPtr, contextIoPtr->iclsPtr,
            flags);

     *  being destructed.  Flag an error, unless errors are being
     *  ignored.
     */
    if (contextIoPtr->destructed) {
        if ((flags & ITCL_IGNORE_ERRS) == 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "can't delete an object while it is being destructed",
                (char*)NULL);
            return TCL_ERROR;
        }
        return TCL_OK;
    }

    result = TCL_OK;
    if (contextIoPtr->oPtr != NULL) {

    /*
     *  Look for a destructor in this class, and if found,
     *  invoke it.
     */
    if (Tcl_FindHashEntry(contextIoPtr->destructed,
            (char *)contextIclsPtr->namePtr) == NULL) {
        result = Itcl_InvokeMethodIfExists(interp, "destructor",
            contextIclsPtr, contextIoPtr, 0, (Tcl_Obj* const*)NULL);
        if (result != TCL_OK) {
            return TCL_ERROR;
        }
    }

    /*
     *  Scan through the list of base classes recursively and destruct

     *  the appropriate command handler.
     */
    cmd = Tcl_FindCommand(interp, cmdName, contextNs, /* flags */ 0);
    if (cmd != NULL && Itcl_IsObject(cmd)) {
        if (Tcl_GetCommandInfoFromToken(cmd, &cmdInfo) != 1) {
            *roPtr = NULL;
        }
        *roPtr = cmdInfo.deleteData;
    } else {
        *roPtr = NULL;
    }

    ckfree(cmdName);

    return TCL_OK;

     *  Make sure that the current namespace context includes an
     *  object that is being manipulated.
     */
    if (contextIoPtr == NULL) {
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot access object-specific info without an object context",
            (char*)NULL);
        return NULL;
    }

    /* get the variable definition to check if that is an ITCL_COMMON */
    if (contextIclsPtr == NULL) {
        iclsPtr = contextIoPtr->iclsPtr;
    } else {
        iclsPtr = contextIclsPtr;
    }
    ivPtr = NULL;
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)name1);
    if (hPtr != NULL) {
        vlookup = Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    /*
     *  Install the object context and access the data member
     *  like any other variable.
     */
    hPtr = Tcl_FindHashEntry(&contextIoPtr->objectVariables, (char *)ivPtr);
    if (hPtr) {
	Tcl_Obj *varName = Tcl_NewObj();
	Tcl_Var varPtr = Tcl_GetHashValue(hPtr);
	Tcl_GetVariableFullName(interp, varPtr, varName);

	val = Tcl_GetVar2(interp, Tcl_GetString(varName), name2,
		TCL_LEAVE_ERR_MSG);
	Tcl_DecrRefCount(varName);
	if (val) {
	    return val;

     *  Make sure that the current namespace context includes an
     *  object that is being manipulated.
     */
    if (contextIoPtr == NULL) {
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot access object-specific info without an object context",
            (char*)NULL);
        return NULL;
    }

    /*
     *  Install the object context and access the data member
     *  like any other variable.
     */

     *  Make sure that the current namespace context includes an
     *  object that is being manipulated.
     */
    if (contextIoPtr == NULL) {
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot access object-specific info without an object context",
            (char*)NULL);
        return NULL;
    }
    /* get the variable definition to check if that is an ITCL_COMMON */
    if (contextIclsPtr == NULL) {
        iclsPtr = contextIoPtr->iclsPtr;
    } else {
        iclsPtr = contextIclsPtr;
    }
    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)name1);
    if (hPtr != NULL) {
        vlookup = Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
    } else {
        return NULL;
    }
    /*
     *  Install the object context and access the data member
     *  like any other variable.
     */

    hPtr = Tcl_FindHashEntry(&contextIoPtr->objectVariables, (char *)ivPtr);
    if (hPtr) {
	Tcl_Obj *varName = Tcl_NewObj();
	Tcl_Var varPtr = Tcl_GetHashValue(hPtr);
	Tcl_GetVariableFullName(interp, varPtr, varName);

	val = Tcl_SetVar2(interp, Tcl_GetString(varName), name2, value,
		TCL_LEAVE_ERR_MSG);
	Tcl_DecrRefCount(varName);
	return val;
    }

    ItclObjectInfo * infoPtr = NULL;
    char *name;
    int ignore;
    int cmp;

    if (contextIoPtr == NULL) {
        resultPtr = Tcl_GetObjResult(interp);
        infoPtr = (ClientData)Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
        if (infoPtr == NULL) {
            Tcl_AppendResult(interp, " PANIC cannot get Itcl AssocData in ItclReportObjectUsage", NULL);
	    return;
        }
	if (contextNsPtr == NULL) {
            Tcl_AppendResult(interp, " PANIC cannot get contextNsPtr in ItclReportObjectUsage", NULL);
	    return;
	}

	entry = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
		(char *)contextNsPtr);
	if (entry) {
	    iclsPtr = Tcl_GetHashValue(entry);
	}

        if (iclsPtr == NULL) {
          Tcl_AppendResult(interp, " PANIC cannot get class from contextNsPtr ItclReportObjectUsage", NULL);
          return;
        }
    } else {

        if (imPtr) {
            elem = Itcl_FirstListElem(&cmdList);
            while (elem) {
                cmpFunc = (ItclMemberFunc*)Itcl_GetListValue(elem);
                cmp = strcmp(Tcl_GetString(imPtr->namePtr),
		        Tcl_GetString(cmpFunc->namePtr));
                if (cmp < 0) {
                    Itcl_InsertListElem(elem, (ClientData)imPtr);
                    imPtr = NULL;
                    break;
                } else {
		    if (cmp == 0) {
                        imPtr = NULL;
                        break;
		    }
                }
                elem = Itcl_NextListElem(elem);
            }
            if (imPtr) {
                Itcl_AppendList(&cmdList, (ClientData)imPtr);
            }
        }
        entry = Tcl_NextHashEntry(&place);
    }

    /*
     *  Add a series of statements showing usage info.

	    if (ioPtr->noComponentTrace) {
	        return NULL;
	    }
            /* need to redo the delegation for this component !! */
            if (hPtr == NULL) {
                return (char *)" INTERNAL ERROR cannot get component to write to";
            }
            icPtr = Tcl_GetHashValue(hPtr);
	    val = ItclGetInstanceVar(interp, name1, NULL, ioPtr,
                    ioPtr->iclsPtr);
	    if ((val == NULL) || (strlen(val) == 0)) {
	        return (char *)" INTERNAL ERROR cannot get value for component";
	    }
	    componentValuePtr = Tcl_NewStringObj(val, -1);
            Tcl_IncrRefCount(componentValuePtr);

	}
        objPtr = Tcl_NewStringObj(name1, -1);
	hPtr = Tcl_FindHashEntry(&ioPtr->iclsPtr->variables, (char *)objPtr);
        Tcl_DecrRefCount(objPtr);
	if (hPtr == NULL) {
	    return (char *)"INTERNAL ERROR cannot find itcl_hull variable in class definition!!";
	}
	ivPtr = Tcl_GetHashValue(hPtr);
        /*
         *  Handle write traces
         */
        if ((flags & TCL_TRACE_WRITES) != 0) {
	    if (ivPtr->initted == 0) {
		ivPtr->initted = 1;
                return NULL;

        ckfree((char*)ioPtr->destructed);
    }
    ItclDeleteObjectsDictInfo(ioPtr->interp, ioPtr);
    /*
     *  Delete all context definitions.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&ioPtr->contextCache, &place);
        if (hPtr == NULL) {
            break;
        }
        callContextPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
        ckfree((char *)callContextPtr);
    }
    FOREACH_HASH_VALUE(var, &ioPtr->objectVariables) {
	Itcl_ReleaseVar(var);
    }

    Tcl_DeleteHashTable(&ioPtr->contextCache);
    Tcl_DeleteHashTable(&ioPtr->objectVariables);

static int
CallPublicObjectCmd(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Object *oPtr = data[0];
    Tcl_Class clsPtr = data[1];
    Tcl_Obj *const* objv = data[3];
    int objc = PTR2INT(data[2]);

    ItclShowArgs(1, "CallPublicObjectCmd", objc, objv);
    result = Itcl_PublicObjectCmd(oPtr, interp, clsPtr, objc, objv);
    ItclShowArgs(1, "CallPublicObjectCmd DONE", objc, objv);
    return result;
}

	ItclShowArgs(1, "run CallPublicObjectCmd1", objc+incr, newObjv);
	Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,
	        INT2PTR(objc+incr), newObjv);

    } else {
	ItclShowArgs(1, "run CallPublicObjectCmd2", objc, objv);
	Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,
		INT2PTR(objc), (ClientData)objv);
    }

    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (methodNamePtr != NULL) {
        ckfree((char *)newObjv);
        Tcl_DecrRefCount(methodNamePtr);
    }

                ITCL_INTERP_DATA, NULL);
    }
    /* as a last chance try with className in hash table */
    objPtr = Tcl_NewStringObj(className, -1);
    Tcl_IncrRefCount(objPtr);
    hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objPtr);
    if (hPtr != NULL) {
        iclsPtr = Tcl_GetHashValue(hPtr);
    } else {
        iclsPtr = NULL;
    }
    Tcl_DecrRefCount(objPtr);
    return iclsPtr;
}


        if (!Itcl_CanAccessFunc(imPtr, nsPtr)) {
	    char *token = Tcl_GetString(imPtr->namePtr);
	    if ((*token != 'i') || (strcmp(token, "info") != 0)) {
		/* needed for test protect-2.5 */
	        ItclMemberFunc *imPtr2 = NULL;
                Tcl_HashEntry *hPtr;
	        Tcl_ObjectContext context;
	        context = Itcl_GetCallFrameClientData(interp);
                if (context != NULL) {
	            hPtr = Tcl_FindHashEntry(
		            &imPtr->iclsPtr->infoPtr->procMethods,
	                    (char *)Tcl_ObjectContextMethod(context));
	            if (hPtr != NULL) {
	                imPtr2 = Tcl_GetHashValue(hPtr);
	            }
		    if ((imPtr->protection & ITCL_PRIVATE) &&
		            (imPtr2 != NULL) &&
		            (imPtr->iclsPtr->nsPtr != imPtr2->iclsPtr->nsPtr)) {
                        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		                "invalid command name \"",
			        token,

                    Tcl_Obj * objPtr;
	            ItclMemberFunc *imPtr2 = NULL;
                    ItclCmdLookup *clookupPtr;

                    objPtr = Tcl_NewStringObj(token, -1);
                    hPtr = Tcl_FindHashEntry(&iclsPtr->resolveCmds, (char *)objPtr);
	            if (hPtr != NULL) {
	                clookupPtr = Tcl_GetHashValue(hPtr);
                        imPtr2 = clookupPtr->imPtr;
                    }
		    if ((imPtr->protection & ITCL_PRIVATE) &&
		            (imPtr2 != NULL) &&
		            (imPtr->iclsPtr->nsPtr == imPtr2->iclsPtr->nsPtr)) {
                        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		                "invalid command name \"",
			        token,
			        "\"", NULL);
		        return TCL_ERROR;
		    }
                } else {
                    Tcl_AppendResult(interp,
                           "bad option \"", token, "\": should be one of...",
                        (char*)NULL);
	            ItclReportObjectUsage(interp, ioPtr, nsPtr, nsPtr);
                    return TCL_ERROR;

                }
            }
        }
    }

	    search = search2;
	} else {
            hPtr2 = Tcl_FindHashEntry(&iclsPtr->options,
	            (char *)idoPtr->namePtr);
	    if (hPtr2 == NULL) {
		ioptPtr = NULL;
	    } else {
	        ioptPtr = Tcl_GetHashValue(hPtr2);
	        ioptPtr->idoPtr = idoPtr;
	    }
	    idoPtr->ioptPtr = ioptPtr;
        }
    }
    return TCL_OK;
}

    Tcl_HashEntry *hPtr;
    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(((Namespace *)nsPtr)->interp,
	ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&(infoPtr->namespaceClasses), nsPtr);
    if (hPtr == NULL) {
	return NULL;
    }
    return Tcl_GetHashValue(hPtr);
}

    int i;

    /*
     *  Create the "itcl::parser" namespace used to parse class
     *  definitions.
     */
    parserNs = Tcl_CreateNamespace(interp, "::itcl::parser",
        (ClientData)infoPtr, Itcl_ReleaseData);

    if (!parserNs) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            " (cannot initialize itcl parser)",
            (char*)NULL);
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    /*
     *  Add commands for parsing class definitions.
     */
    Tcl_DStringInit(&buffer);
    for (i=0 ; parseCmds[i].name ; i++) {
        Tcl_DStringAppend(&buffer, "::itcl::parser::", 16);
        Tcl_DStringAppend(&buffer, parseCmds[i].name, -1);
        Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
                parseCmds[i].objProc, (ClientData) infoPtr, NULL);
        Tcl_DStringFree(&buffer);
    }

    for (i=0 ; protectionCmds[i].name ; i++) {
        Tcl_DStringAppend(&buffer, "::itcl::parser::", 16);
        Tcl_DStringAppend(&buffer, protectionCmds[i].name, -1);
        pInfoPtr = (ProtectionCmdInfo*)ckalloc(sizeof(ProtectionCmdInfo));
        pInfoPtr->pLevel = protectionCmds[i].protection;
        pInfoPtr->infoPtr = infoPtr;
        Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
                protectionCmds[i].objProc, (ClientData) pInfoPtr,
		(Tcl_CmdDeleteProc*) ItclFreeParserCommandData);
        Tcl_DStringFree(&buffer);
    }

    /*
     *  Set the runtime variable resolver for the parser namespace,
     *  to control access to "common" data members while parsing
     *  the class definition.
     */
    if (infoPtr->useOldResolvers) {
        ItclSetParserResolver(parserNs);
    }
    /*
     *  Install the "class" command for defining new classes.
     */
    Tcl_CreateObjCommand(interp, "::itcl::class", Itcl_ClassCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::body", Itcl_BodyCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itcl::configbody", Itcl_ConfigBodyCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    Itcl_EventuallyFree((ClientData)infoPtr, (Tcl_FreeProc *) ItclDelObjectInfo);

    /*
     *  Create the "itcl::find" command for high-level queries.
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::find") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::find",
            "classes", "?pattern?",
            Itcl_FindClassesCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::find",
            "objects", "?-class className? ?-isa className? ?pattern?",
            Itcl_FindObjectsCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);


    /*
     *  Create the "itcl::delete" command to delete objects
     *  and classes.
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::delete") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::delete",
            "class", "name ?name...?",
            Itcl_DelClassCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::delete",
            "object", "name ?name...?",
            Itcl_DelObjectCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::delete",
            "ensemble", "name ?name...?",
            Itcl_EnsembleDeleteCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    /*
     *  Create the "itcl::is" command to test object
     *  and classes existence.
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::is") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::is",
            "class", "name", Itcl_IsClassCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::is",
            "object", "?-class classname? name", Itcl_IsObjectCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);


    /*
     *  Add "code" and "scope" commands for handling scoped values.
     */
    Tcl_CreateObjCommand(interp, "::itcl::code", Itcl_CodeCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itcl::scope", Itcl_ScopeCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    /*
     *  Add the "filter" commands (add/delete)
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::filter") != TCL_OK) {
        return TCL_ERROR;
    }
    if (Itcl_AddEnsemblePart(interp, "::itcl::filter",
            "add", "objectOrClass filter ? ... ?", Itcl_FilterAddCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::filter",
            "delete", "objectOrClass filter ? ... ?", Itcl_FilterDeleteCmd,
            (ClientData)infoPtr, Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }

    Itcl_PreserveData((ClientData)infoPtr);

    /*
     *  Add the "forward" commands (add/delete)
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::forward") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::forward",
            "add", "objectOrClass srcCommand targetCommand ? options ... ?",
	    Itcl_ForwardAddCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::forward",
            "delete", "objectOrClass targetCommand ? ... ?",
	    Itcl_ForwardDeleteCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    /*
     *  Add the "mixin" (add/delete) commands.
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::mixin") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::mixin",
            "add", "objectOrClass class ? class ... ?",
	    Itcl_MixinAddCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::mixin",
            "delete", "objectOrClass class ? class ... ?",
	    Itcl_MixinDeleteCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    /*
     *  Add commands for handling import stubs at the Tcl level.
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::import::stub") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::import::stub",
            "create", "name", Itcl_StubCreateCmd,
            (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Itcl_AddEnsemblePart(interp, "::itcl::import::stub",
            "exists", "name", Itcl_StubExistsCmd,
            (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "::itcl::type", Itcl_TypeClassCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::widget", Itcl_WidgetCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::widgetadaptor", Itcl_WidgetAdaptorCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::nwidget", Itcl_NWidgetCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::addoption", Itcl_AddOptionCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::addobjectoption",
        Itcl_AddObjectOptionCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::adddelegatedoption",
        Itcl_AddDelegatedOptionCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::adddelegatedmethod",
        Itcl_AddDelegatedFunctionCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::addcomponent", Itcl_AddComponentCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::setcomponent", Itcl_SetComponentCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, "::itcl::extendedclass", Itcl_ExtendedClassCmd,
        (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_CreateObjCommand(interp, ITCL_COMMANDS_NAMESPACE "::genericclass",
        ItclGenericClassCmd, (ClientData)infoPtr, Itcl_ReleaseData);
    Itcl_PreserveData((ClientData)infoPtr);

    /*
     *  Add the "delegate" (method/option) commands.
     */
    if (Itcl_CreateEnsemble(interp, "::itcl::parser::delegate") != TCL_OK) {
        return TCL_ERROR;
    }

    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::delegate",
            "method", "name to targetName as scipt using script",
	    Itcl_ClassDelegateMethodCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::delegate",
            "typemethod", "name to targetName as scipt using script",
	    Itcl_ClassDelegateTypeMethodCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::delegate",
            "option", "option to targetOption as script",
	    Itcl_ClassDelegateOptionCmd, (ClientData)infoPtr,
	    Itcl_ReleaseData) != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)infoPtr);

    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------