Posted to tcl by apw at Tue Jul 31 20:26:09 GMT 2007view raw
- 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;
- }