change in ProcMethod execution

Index: tclOO.c
===================================================================
RCS file: /cvsroot/tcl/oocore/generic/tclOO.c,v
retrieving revision 1.25
diff -b -u -r1.25 tclOO.c
--- tclOO.c     3 Sep 2007 09:49:40 -0000       1.25
+++ tclOO.c     9 Sep 2007 19:38:38 -0000
@@ -442,6 +442,7 @@
     oPtr->flags = 0;
     oPtr->creationEpoch = creationEpoch;
     oPtr->metadataPtr = NULL;
+    oPtr->mapCmdNameProc = NULL;

     /*
      * Initialize the traces.
@@ -1752,21 +1753,32 @@
 {
     CallContext *contextPtr;
     int result;
+    Tcl_Obj *cmdNamePtr;

     if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?");
        return TCL_ERROR;
     }
+    cmdNamePtr = objv[1];
+    if (oPtr->mapCmdNameProc != NULL) {
+        int res;
+       Class **stClsPtr = &startCls;
+       Tcl_Class *startClsPtr = (Tcl_Class *)stClsPtr;
+       cmdNamePtr = Tcl_NewStringObj(Tcl_GetString(objv[1]), -1);
+       Tcl_IncrRefCount(cmdNamePtr);
+       res = oPtr->mapCmdNameProc(oPtr, interp, cmdNamePtr, startClsPtr);
+
+    }

     /*
      * Get the call chain.
      */

     contextPtr = TclOOGetCallContext(TclOOGetFoundation(interp), oPtr,
-           objv[1], flags | (oPtr->flags & FILTER_HANDLING), cachePtr);
+            cmdNamePtr, flags | (oPtr->flags & FILTER_HANDLING), cachePtr);
     if (contextPtr == NULL) {
        Tcl_AppendResult(interp, "impossible to invoke method \"",
-               TclGetString(objv[1]),
+                cmdNamePtr,
                "\": no defined method or unknown method", NULL);
        return TCL_ERROR;
     }
@@ -1803,6 +1815,9 @@
     Tcl_Preserve(oPtr);
     result = TclOOInvokeContext(interp, contextPtr, objc, objv);

+    if (oPtr->mapCmdNameProc != NULL) {
+        Tcl_DecrRefCount(cmdNamePtr);
+    }
     /*
      * Dispose of the call chain, either back into the ether or into the
      * chain cache.
@@ -1829,6 +1844,7 @@
      */

     Tcl_Release(oPtr);
+
     return result;
 }
 ^L
@@ -2991,6 +3007,13 @@
 {
     return (Tcl_Object) ((Class *)clazz)->thisPtr;
 }
+void
+Tcl_ObjectSetMapCmdNameProc(
+    Tcl_Object oPtr,
+    TclOO_MapCmdName mapCmdNameProc)
+{
+    ((Object *)oPtr)->mapCmdNameProc = mapCmdNameProc;
+}
 ^L
 /*
  * Local Variables:
Index: tclOOInt.h
===================================================================
RCS file: /cvsroot/tcl/oocore/generic/tclOOInt.h,v
retrieving revision 1.12
diff -b -u -r1.12 tclOOInt.h
--- tclOOInt.h  8 Aug 2007 12:21:21 -0000       1.12
+++ tclOOInt.h  9 Sep 2007 19:38:56 -0000
@@ -57,6 +57,8 @@
        Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
 typedef void (*TclOO_PmCDDeleteProc)(ClientData clientData);
 typedef ClientData (*TclOO_PmCDCloneProc)(ClientData clientData);
+typedef int (*TclOO_MapCmdName)(ClientData clientData, Tcl_Interp *interp,
+        Tcl_Obj *mappedCmd, Tcl_Class *clsPtr);

 /*
  * Procedure-like methods have the following extra information. It is a
@@ -162,6 +164,7 @@
     Tcl_Obj *cachedNameObj;    /* Cache of the name of the object. */
     Tcl_HashTable publicContextCache;  /* Place to keep unused contexts. */
     Tcl_HashTable privateContextCache; /* Place to keep unused contexts. */
+    TclOO_MapCmdName mapCmdNameProc;
 } Object;

 #define OBJECT_DELETED 1       /* Flag to say that an object has been