merging changes from 8.0.3 into 8.1a2

1 files changed, 151 insertions, 27 deletions

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index e159f98..af1b8a9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -9,6 +9,7 @@
  *
  * Copyright (c) 1993-1997 Lucent Technologies.
  * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
  *
  * Originally implemented by
  *   Michael J. McLennan
@@ -18,7 +19,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclNamesp.c 1.38 98/02/04 16:21:40
+ * RCS: @(#) $Id: tclNamesp.c,v 1.1.2.2 1998/09/24 23:58:57 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -33,27 +34,19 @@
 #define FIND_ONLY_NS	0x1000
 
 /*
- * Count of the number of namespaces created. This value is used as a
- * unique id for each namespace.
+ * Initial size of stack allocated space for tail list - used when resetting
+ * shadowed command references in the functin: TclResetShadowedCmdRefs.
  */
 
-static long numNsCreated = 0;
-static Tcl_Mutex nsMutex;
+#define NUM_TRAIL_ELEMS 5
 
 /*
- * Data structure used as the ClientData of imported commands: commands
- * created in an namespace when it imports a "real" command from another
- * namespace.
+ * Count of the number of namespaces created. This value is used as a
+ * unique id for each namespace.
  */
 
-typedef struct ImportedCmdData {
-    Command *realCmdPtr;	/* "Real" command that this imported command
-                                 * refers to. */
-    Command *selfPtr;		/* Pointer to this imported command. Needed
-				 * only when deleting it in order to remove
-				 * it from the real command's linked list of
-				 * imported commands that refer to it. */
-} ImportedCmdData;
+static long numNsCreated = 0; 
+static Tcl_Mutex nsMutex;
 
 /*
  * This structure contains a cached pointer to a namespace that is the
@@ -538,7 +531,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,
@@ -876,6 +873,7 @@ NamespaceFree(nsPtr)
 
     ckfree((char *) nsPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1072,6 +1070,10 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
  *	is NULL). This is done by creating a new command (the "imported
  *	command") that points to the real command in its original namespace.
  *
+ *      If matching commands are on the autoload path but haven't been
+ *	loaded yet, this command forces them to be loaded, then creates
+ *	the links to them.
+ *
  * Results:
  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
  *	message in the interpreter's result) if something goes wrong.
@@ -1107,7 +1109,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
     Tcl_HashSearch search;
     Command *cmdPtr, *realCmdPtr;
     ImportRef *refPtr;
-    Tcl_Command importedCmd;
+    Tcl_Command autoCmd, importedCmd;
     ImportedCmdData *dataPtr;
     int wasExported, i, result;
 
@@ -1120,6 +1122,38 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
     } else {
         nsPtr = (Namespace *) namespacePtr;
     }
+ 
+    /*
+     * First, invoke the "auto_import" command with the pattern
+     * being imported.  This command is part of the Tcl library.
+     * It looks for imported commands in autoloaded libraries and
+     * loads them in.  That way, they will be found when we try
+     * to create links below.
+     */
+    
+    autoCmd = Tcl_FindCommand(interp, "auto_import",
+ 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+ 
+    if (autoCmd != NULL) {
+	Tcl_Obj *objv[2];
+ 
+	objv[0] = Tcl_NewStringObj("auto_import", -1);
+	Tcl_IncrRefCount(objv[0]);
+	objv[1] = Tcl_NewStringObj(pattern, -1);
+	Tcl_IncrRefCount(objv[1]);
+ 
+	cmdPtr = (Command *) autoCmd;
+	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+		2, objv);
+ 
+	Tcl_DecrRefCount(objv[0]);
+	Tcl_DecrRefCount(objv[1]);
+ 
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_ResetResult(interp);
+    }
 
     /*
      * From the pattern, find the namespace from which we are importing
@@ -1204,8 +1238,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);
@@ -1808,7 +1842,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
 	    && (nsPtr != globalNsPtr)) {
 	nsPtr = NULL;
     }
-    
+
     *nsPtrPtr    = nsPtr;
     *altNsPtrPtr = altNsPtr;
     Tcl_DStringFree(&buffer);
@@ -1919,12 +1953,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.
@@ -1960,6 +2041,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "unknown command \"", name, "\"", (char *) NULL);
     }
+
     return (Tcl_Command) NULL;
 }
 
@@ -2007,12 +2089,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.
@@ -2101,7 +2228,6 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
      * storage if needed.
      */
 
-#define NUM_TRAIL_ELEMS 5
     Namespace *(trailStorage[NUM_TRAIL_ELEMS]);
     Namespace **trailPtr = trailStorage;
     int trailFront = -1;
@@ -2195,7 +2321,6 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
     if (trailPtr != trailStorage) {
 	ckfree((char *) trailPtr);
     }
-#undef NUM_TRAIL_ELEMS
 }
 
 /*
@@ -2722,11 +2847,10 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
     for (i = 2;  i < objc;  i++) {
         name = Tcl_GetString(objv[i]);
 	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;
 }