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;

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);
    }
}