incr tcl updtaes

2 files changed, 150 insertions, 9 deletions

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index d4ace43..d399426 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -546,7 +546,11 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
     nsPtr->exportArrayPtr  = NULL;
     nsPtr->numExportPatterns = 0;
     nsPtr->maxExportPatterns = 0;
-    nsPtr->cmdRefEpoch     = 0;
+    nsPtr->cmdRefEpoch       = 0;
+    nsPtr->resolverEpoch     = 0;
+    nsPtr->cmdResProc        = NULL;
+    nsPtr->varResProc        = NULL;
+    nsPtr->compiledVarResProc = NULL;
 
     if (parentPtr != NULL) {
         entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
@@ -884,6 +888,7 @@ NamespaceFree(nsPtr)
 
     ckfree((char *) nsPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1212,8 +1217,8 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
 		Tcl_DString ds;
 
 		Tcl_DStringInit(&ds);
-		Tcl_DStringAppend(&ds, currNsPtr->fullName, -1);
-		if (currNsPtr != iPtr->globalNsPtr) {
+		Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+		if (nsPtr != iPtr->globalNsPtr) {
 		    Tcl_DStringAppend(&ds, "::", 2);
 		}
 		Tcl_DStringAppend(&ds, cmdName, -1);
@@ -1794,7 +1799,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
 	    && (nsPtr != globalNsPtr)) {
 	nsPtr = NULL;
     }
-    
+
     *nsPtrPtr    = nsPtr;
     *altNsPtrPtr = altNsPtr;
     Tcl_DStringFree(&buffer);
@@ -1905,12 +1910,59 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
 				  * are given, TCL_GLOBAL_ONLY is
 				  * ignored. */
 {
+    Interp *iPtr = (Interp*)interp;
+
+    ResolverScheme *resPtr;
     Namespace *nsPtr[2], *cxtNsPtr;
     char *simpleName;
     register Tcl_HashEntry *entryPtr;
     register Command *cmdPtr;
     register int search;
     int result;
+    Tcl_Command cmd;
+
+    /*
+     * If this namespace has a command resolver, then give it first
+     * crack at the command resolution.  If the interpreter has any
+     * command resolvers, consult them next.  The command resolver
+     * procedures may return a Tcl_Command value, they may signal
+     * to continue onward, or they may signal an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->cmdResProc) {
+            result = (*cxtNsPtr->cmdResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->cmdResProc) {
+                result = (*resPtr->cmdResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            return cmd;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Command) NULL;
+        }
+    }
 
     /*
      * Find the namespace(s) that contain the command.
@@ -1946,6 +1998,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "unknown command \"", name, "\"", (char *) NULL);
     }
+
     return (Tcl_Command) NULL;
 }
 
@@ -1993,12 +2046,57 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
 				  * are given, TCL_GLOBAL_ONLY is
 				  * ignored. */
 {
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
     Namespace *nsPtr[2], *cxtNsPtr;
     char *simpleName;
     Tcl_HashEntry *entryPtr;
     Var *varPtr;
     register int search;
     int result;
+    Tcl_Var var;
+
+    /*
+     * If this namespace has a variable resolver, then give it first
+     * crack at the variable resolution.  It may return a Tcl_Var
+     * value, it may signal to continue onward, or it may signal
+     * an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            return var;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Var) NULL;
+        }
+    }
 
     /*
      * Find the namespace(s) that contain the variable.
@@ -2710,11 +2808,10 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
     for (i = 2;  i < objc;  i++) {
         name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
 	namespacePtr = Tcl_FindNamespace(interp, name,
-	    (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
-	if (namespacePtr == NULL) {
-            return TCL_ERROR;
+	    (Tcl_Namespace *) NULL, /* flags */ 0);
+	if (namespacePtr) {
+            Tcl_DeleteNamespace(namespacePtr);
         }
-        Tcl_DeleteNamespace(namespacePtr);
     }
     return TCL_OK;
 }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 6725568..d86ca06 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -141,7 +141,8 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
 				 * parens around the index.  Otherwise they
 				 * are NULL. These are needed to restore
 				 * the parens after parsing the name. */
-    Namespace *varNsPtr, *dummy1Ptr, *dummy2Ptr;
+    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
+    ResolverScheme *resPtr;
     Tcl_HashEntry *hPtr;
     register char *p;
     int new, i, result;
@@ -183,6 +184,46 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
     }
 
     /*
+     * If this namespace has a variable resolver, then give it first
+     * crack at the variable resolution.  It may return a Tcl_Var
+     * value, it may signal to continue onward, or it may signal
+     * an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0 || iPtr->varFramePtr == NULL) {
+        cxtNsPtr = iPtr->globalNsPtr;
+    }
+    else {
+        cxtNsPtr = iPtr->varFramePtr->nsPtr;
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, part1,
+                (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, part1,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            varPtr = (Var *) var;
+            goto lookupVarPart2;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Var *) NULL;
+        }
+    }
+
+    /*
      * Look up part1. Look it up as either a namespace variable or as a
      * local variable in a procedure call frame (varFramePtr).
      * Interpret part1 as a namespace variable if:
@@ -310,6 +351,8 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
 	    }
 	}
     }
+
+lookupVarPart2:
     if (openParen != NULL) {
 	*openParen = '(';
 	openParen = NULL;
@@ -4273,6 +4316,7 @@ TclDeleteVars(iPtr, tablePtr)
 	if (TclIsVarArray(varPtr)) {
 	    DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
 	            flags);
+	    varPtr->value.tablePtr = NULL;
 	}
 	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
 	    objPtr = varPtr->value.objPtr;