Itcl - the [incr Tcl] extension

MODULE_SCOPE Tcl_Var Itcl_VarAliasProc(Tcl_Interp *interp,
        Tcl_Namespace *nsPtr, const char *VarName, ClientData clientData);
MODULE_SCOPE int ItclIsClass(Tcl_Interp *interp, Tcl_Command cmd);
MODULE_SCOPE int ItclCheckCallMethod(ClientData clientData, Tcl_Interp *interp,
        Tcl_ObjectContext contextPtr, Tcl_CallFrame *framePtr, int *isFinished);
MODULE_SCOPE int ItclAfterCallMethod(ClientData clientData, Tcl_Interp *interp,
        Tcl_ObjectContext contextPtr, Tcl_Namespace *nsPtr, int result);
MODULE_SCOPE int ItclSetCallFrameClientData(Tcl_Interp *interp,
	ClientData clientData);
MODULE_SCOPE void ItclReportObjectUsage(Tcl_Interp *interp,
        ItclObject *contextIoPtr, Tcl_Namespace *callerNsPtr,
	Tcl_Namespace *contextNsPtr);
MODULE_SCOPE int ItclMapMethodNameProc(Tcl_Interp *interp, Tcl_Object oPtr,
        Tcl_Class *startClsPtr, Tcl_Obj *methodObj);
MODULE_SCOPE int ItclCreateArgList(Tcl_Interp *interp, const char *str,
        int *argcPtr, int *maxArgcPtr, Tcl_Obj **usagePtr,

    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    if (framePtr == NULL) {
        return NULL;
    }
    return framePtr->clientData;
}

int
ItclSetCallFrameClientData(
    Tcl_Interp *interp,
    ClientData clientData)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    if (framePtr == NULL) {
        return TCL_ERROR;
    }
    framePtr->clientData = clientData;
    return TCL_OK;
}

int
Itcl_SetCallFrameNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    if (framePtr == NULL) {

    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *methodNamePtr;
    Tcl_Obj **newObjv;
    Tcl_DString buffer;
    Tcl_Obj *myPtr;
    ItclObjectInfo *infoPtr;
    ItclMemberFunc *imPtr;
    ItclClass *iclsPtr;
    Itcl_ListElem *elem;
    ItclClass *basePtr;
    void *callbackPtr;
    const char *className;
    const char *tail;

    incr = 0;
    found = 0;
    isDirectCall = 0;
    myPtr = NULL;
    imPtr = (ItclMemberFunc *)clientData;
    iclsPtr = imPtr->iclsPtr;


    infoPtr = imPtr->iclsPtr->infoPtr;
    if ((oPtr == NULL) && (clsPtr == NULL)) {
         isDirectCall = 1;
    }
    if (oPtr == NULL) {
	ClientData clientData2;
	if ((imPtr->flags & ITCL_COMMON)
	        && (imPtr->codePtr != NULL)
	        && !(imPtr->codePtr->flags & ITCL_BUILTIN)) {
	    result = Itcl_InvokeProcedureMethod(imPtr->tmPtr, interp,
	            objc, objv);
            return result;
	}
	oPtr = NULL;
	clientData2 = Itcl_GetCallFrameClientData(interp);
	if ((clientData2 == NULL) && (oPtr == NULL)) {
	    if (((imPtr->codePtr != NULL)
	            && (imPtr->codePtr->flags & ITCL_BUILTIN))) {
	        result = Itcl_InvokeProcedureMethod(imPtr->tmPtr, interp,
	                objc, objv);
                return result;
	    }
	    if (infoPtr->currIoPtr != NULL) {
	        /* if we want to call methods in the constructor for example
	         * config* methods, clientData
	         * is still NULL, but we can use infoPtr->currIoPtr
	         * for getting the TclOO object ptr
	         */

	        oPtr = infoPtr->currIoPtr->oPtr;
	    } else {
	        Tcl_AppendResult(interp,
	                "ItclObjectCmd cannot get context object (NULL)", NULL);
	        return TCL_ERROR;
	    }
	}
	if (oPtr == NULL) {
            oPtr = Tcl_ObjectContextObject((Tcl_ObjectContext)clientData2);
        }
    }
    methodNamePtr = NULL;
    if (objv[0] != NULL) {
        Itcl_ParseNamespPath(Tcl_GetString(objv[0]), &buffer,
	        &className, &tail);
        if (className != NULL) {
            methodNamePtr = Tcl_NewStringObj(tail, -1);

CallAfterCallMethod(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ClientData clientData = data[0];
    Tcl_ObjectContext context = data[1];
    ClientData save = data[2];

    ItclSetCallFrameClientData(interp, save);
    return ItclAfterCallMethod(clientData, interp, context, NULL, result);
}

static int
ObjCallProc(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    ItclMemberFunc *imPtr = (ItclMemberFunc *)clientData;
    Tcl_ObjectContext save = Itcl_GetCallFrameClientData(interp);

    if (TCL_ERROR == ItclCheckCallMethod(clientData, interp, context,
	    NULL, NULL)) {
	return TCL_ERROR;
    }

    /*
     * This is an ugly workaround.  Someday Itcl 4 should be generally
     * better designed to replace such nastiness.
     *
     * This exists to fix [Itk Bug 38744a21a0] in Itk 4.1.  Starting
     * with Itcl 4.1, we have the itclObjMethodType to attach Itcl
     * methods coded as C routines to the TclOO foundation.  Trouble
     * happens when one of those C routines calls Tcl*Eval*() and
     * expects an Itcl object context to be in control.
     *
     * The Itcl routine ItclObjectCommand goes looking directly at
     * the clientData of the interp's current frame to get the
     * controlling Tcl_ObjectContext.  This is a horrifying internals
     * intrusion that's been inherited.  Since that routine is expecting
     * to find what's been left there by Tcl's procedure method machinery,
     * we have to duplicate it here in our own method invocation machinery.
     *
     * Note that a lot of Itcl itself could be implemented via direct
     * dispatch to C routines, but even more ugly somersaults are turned
     * to fake passing through procedure methods instead.  This might
     * be a first step to untangling some of those awful knots too.
     */

    if (TCL_OK != ItclSetCallFrameClientData(interp, (ClientData) context)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"ObjCallProc: FAILED to set callframe context"));
	return TCL_ERROR;
    }

    Tcl_NRAddCallback(interp, CallAfterCallMethod, clientData, context,
	    save, NULL);

    if ((imPtr->flags & ITCL_COMMON) == 0) {
	return Itcl_ExecMethod(clientData, interp, objc-1, objv+1);
    } else {
	return Itcl_ExecProc(clientData, interp, objc-1, objv+1);
    }
}