Posted to tcl by apw at Tue Jul 31 20:26:09 GMT 2007view pretty

typedef int (Tcl_PreCallProc)(Tcl_Interp *interp, ClientData clientData, int *isFinished);
typedef int (Tcl_PostCallProc)(Tcl_Interp *interp, ClientData clientData, int result);
typedef void (Tcl_ErrProc)(Tcl_Interp *,Tcl_Obj *);
typedef void (Tcl_RenderDeclarerProc)(ClientData clientData);

typedef struct Tcl_ProcedureMethod {
    int version;
    Proc *procPtr;
    int flags;
    Tcl_PreCallProc *preCallPtr;
    Tcl_PostCallProc *postCallPtr;
    Tcl_ErrProc *errProc;
    Tcl_RenderDeclarerProc *renderDelcarerProc;
    ClientData clientData;
} Tcl_ProcedureMethod;


/*
 * ----------------------------------------------------------------------
 *
 * InvokeProcedureMethod --
 *
 *      How to invoke a procedure-like method.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeProcedureMethod(
    ClientData clientData,      /* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,  /* The method calling context. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const *objv)       /* Arguments as actually seen. */
{
    CallContext *contextPtr = (CallContext *) context;
    ItclProcedureMethod *pmPtr = clientData;
    int result, flags = FRAME_IS_METHOD, skip = contextPtr->skip;
    CallFrame *framePtr, **framePtrPtr;
    Object *oPtr = contextPtr->oPtr;
   Command cmd;
    const char *namePtr;
    Tcl_Obj *nameObj;
    void (*errProc)(Tcl_Interp *,Tcl_Obj *);
    ExtraFrameInfo efi;
    struct PNI pni;
    Tcl_Namespace *nsPtr = oPtr->namespacePtr;

    nameObj = Tcl_MethodName(Tcl_ObjectContextMethod(context));
    namePtr = TclGetString(nameObj);
    errProc = pmPtr->errProc;

    /*
     * Magic to enable things like [incr Tcl], which wants methods to run in
     * their class's namespace.
     */

    if (pmPtr->flags & USE_DECLARER_NS) {
        register Method *mPtr = contextPtr->callChain[contextPtr->index].mPtr;

        if (mPtr->declaringClassPtr != NULL) {
            nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr;
        } else {
           nsPtr = mPtr->declaringObjectPtr->namespacePtr;
        }
    }
    if (pmPtr->preCallPtr != NULL) {
        int isFinished;
        result = (* pmPtr->preCallPtr)(interp, oPtr, nsPtr, pmPtr, &isFinished);
        if (isFinished) {
            return result;
        }
        if (result != TCL_OK) {
            return result;
        }
    }

    efi.length = 2;
    memset(&cmd, 0, sizeof(Command));
    cmd.nsPtr = (Namespace *) nsPtr;
    cmd.clientData = &efi;
    pmPtr->procPtr->cmdPtr = &cmd;
    result = TclProcCompileProc(interp, pmPtr->procPtr,
            pmPtr->procPtr->bodyPtr, (Namespace *) nsPtr, "body of method",
            namePtr);
    if (result != TCL_OK) {
        return result;
    }

    flags |= FRAME_IS_PROC;
    framePtrPtr = &framePtr;
    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, nsPtr,
            flags);
    if (result != TCL_OK) {
        return result;
    }

    framePtr->clientData = contextPtr;
    framePtr->objc = objc;
    framePtr->objv = objv;      /* ref counts for args are incremented below */
    framePtr->procPtr = pmPtr->procPtr;

    framePtr->resolvePtr = oPtr->resolvePtr;
    /*
     * Finish filling out the extra frame info.
     */

    efi.fields[0].name = "method";
    efi.fields[0].proc = NULL;
    efi.fields[0].clientData = nameObj;
    pni.interp = interp;
    pni.method = Tcl_ObjectContextMethod(context);
    efi.fields[1].proc = *pmPtr->renderDeclarerProc;
    efi.fields[1].clientData = &pni;
    if (Tcl_MethodDeclarerObject(pni.method) != NULL) {
        efi.fields[1].name = "object";
    } else {
        efi.fields[1].name = "class";
    }

    /*
     * Ensure that the method name itself is part of the arguments when we're
     * doing unknown processing.
     */

    if (contextPtr->flags & OO_UNKNOWN_METHOD) {
        skip--;
    }

    /*
     * Now invoke the body of the method.
     */

    result = TclObjInterpProcCore(interp, nameObj, skip, errProc);
    if (pmPtr->postCallPtr != NULL) {
        result = (* pmPtr->postCallPtr)(interp, oPtr, nsPtr, pmPtr, result);
    }

    return result;
}