/*

  * tclNamesp.c --

  *

  *      Contains support for namespaces, which provide a separate context of

  *      commands and global variables. The global :: namespace is the

  *      traditional Tcl "global" scope. Other namespaces are created as

  *      children of the global namespace. These other namespaces contain

  *      special-purpose commands and variables for packages.

  *

  * Copyright (c) 1993-1997 Lucent Technologies.

  * Copyright (c) 1997 Sun Microsystems, Inc.

  * Copyright (c) 1998-1999 by Scriptics Corporation.

  *

  * Originally implemented by

  *   Michael J. McLennan

  *   Bell Labs Innovations for Lucent Technologies

  *   mmclennan@lucent.com

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.14 2007/05/15 18:32:18 dgp Exp $

  */

 #include "tclInt.h"

 /*

  * Flag passed to TclGetNamespaceForQualName to indicate that it should

  * search for a namespace rather than a command or variable inside a

  * namespace. Note that this flag's value must not conflict with the values

  * of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or CREATE_NS_IF_UNKNOWN.

  */

 #define FIND_ONLY_NS	0x1000

 /*

  * Initial size of stack allocated space for tail list - used when resetting

  * shadowed command references in the functin: TclResetShadowedCmdRefs.

  */

 #define NUM_TRAIL_ELEMS 5

 /*

  * Count of the number of namespaces created. This value is used as a

  * unique id for each namespace.

  */

 static long numNsCreated = 0; 

 TCL_DECLARE_MUTEX(nsMutex)

 /*

  * This structure contains a cached pointer to a namespace that is the

  * result of resolving the namespace's name in some other namespace. It is

  * the internal representation for a nsName object. It contains the

  * pointer along with some information that is used to check the cached

  * pointer's validity.

  */

 typedef struct ResolvedNsName {

     Namespace *nsPtr;		/* A cached namespace pointer. */

     long nsId;			/* nsPtr's unique namespace id. Used to

 				 * verify that nsPtr is still valid

 				 * (e.g., it's possible that the namespace

 				 * was deleted and a new one created at

 				 * the same address). */

     Namespace *refNsPtr;	/* Points to the namespace containing the

 				 * reference (not the namespace that

 				 * contains the referenced namespace). */

     int refCount;		/* Reference count: 1 for each nsName

 				 * object that has a pointer to this

 				 * ResolvedNsName structure as its internal

 				 * rep. This structure can be freed when

 				 * refCount becomes zero. */

 } ResolvedNsName;

 /*

  * Declarations for procedures local to this file:

  */

 static void		DeleteImportedCmd _ANSI_ARGS_((

 			    ClientData clientData));

 static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,

 			    Tcl_Obj *copyPtr));

 static void		FreeNsNameInternalRep _ANSI_ARGS_((

 			    Tcl_Obj *objPtr));

 static int		GetNamespaceFromObj _ANSI_ARGS_((

 			    Tcl_Interp *interp, Tcl_Obj *objPtr,

 			    Tcl_Namespace **nsPtrPtr));

 static int		InvokeImportedCmd _ANSI_ARGS_((

 			    ClientData clientData, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceChildrenCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceCodeCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceCurrentCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceDeleteCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceEvalCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceExistsCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceExportCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceForgetCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static void		NamespaceFree _ANSI_ARGS_((Namespace *nsPtr));

 static int		NamespaceImportCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceInscopeCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceOriginCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceParentCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceQualifiersCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceTailCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		NamespaceWhichCmd _ANSI_ARGS_((

 			    ClientData dummy, Tcl_Interp *interp,

 			    int objc, Tcl_Obj *CONST objv[]));

 static int		SetNsNameFromAny _ANSI_ARGS_((

 			    Tcl_Interp *interp, Tcl_Obj *objPtr));

 static void		UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));

 /*

  * This structure defines a Tcl object type that contains a

  * namespace reference.  It is used in commands that take the

  * name of a namespace as an argument.  The namespace reference

  * is resolved, and the result in cached in the object.

  */

 Tcl_ObjType tclNsNameType = {

     "nsName",			/* the type's name */

     FreeNsNameInternalRep,	/* freeIntRepProc */

     DupNsNameInternalRep,	/* dupIntRepProc */

     UpdateStringOfNsName,	/* updateStringProc */

     SetNsNameFromAny		/* setFromAnyProc */

 };

 /*

  *----------------------------------------------------------------------

  *

  * TclInitNamespaceSubsystem --

  *

  *	This procedure is called to initialize all the structures that 

  *	are used by namespaces on a per-process basis.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 void

 TclInitNamespaceSubsystem()

 {

     /*

      * Does nothing for now.

      */

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetCurrentNamespace --

  *

  *	Returns a pointer to an interpreter's currently active namespace.

  *

  * Results:

  *	Returns a pointer to the interpreter's current namespace.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Namespace *

 Tcl_GetCurrentNamespace(interp)

     register Tcl_Interp *interp; /* Interpreter whose current namespace is

 				  * being queried. */

 {

     register Interp *iPtr = (Interp *) interp;

     register Namespace *nsPtr;

     if (iPtr->varFramePtr != NULL) {

         nsPtr = iPtr->varFramePtr->nsPtr;

     } else {

         nsPtr = iPtr->globalNsPtr;

     }

     return (Tcl_Namespace *) nsPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetGlobalNamespace --

  *

  *	Returns a pointer to an interpreter's global :: namespace.

  *

  * Results:

  *	Returns a pointer to the specified interpreter's global namespace.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Namespace *

 Tcl_GetGlobalNamespace(interp)

     register Tcl_Interp *interp; /* Interpreter whose global namespace 

 				  * should be returned. */

 {

     register Interp *iPtr = (Interp *) interp;

     return (Tcl_Namespace *) iPtr->globalNsPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PushCallFrame --

  *

  *	Pushes a new call frame onto the interpreter's Tcl call stack.

  *	Called when executing a Tcl procedure or a "namespace eval" or

  *	"namespace inscope" command. 

  *

  * Results:

  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error

  *	message in the interpreter's result object) if something goes wrong.

  *

  * Side effects:

  *	Modifies the interpreter's Tcl call stack.

  *

  *----------------------------------------------------------------------

  */

 int

 Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)

     Tcl_Interp *interp;		 /* Interpreter in which the new call frame

 				  * is to be pushed. */

     Tcl_CallFrame *callFramePtr; /* Points to a call frame structure to

 				  * push. Storage for this has already been

 				  * allocated by the caller; typically this

 				  * is the address of a CallFrame structure

 				  * allocated on the caller's C stack.  The

 				  * call frame will be initialized by this

 				  * procedure. The caller can pop the frame

 				  * later with Tcl_PopCallFrame, and it is

 				  * responsible for freeing the frame's

 				  * storage. */

     Tcl_Namespace *namespacePtr; /* Points to the namespace in which the

 				  * frame will execute. If NULL, the

 				  * interpreter's current namespace will

 				  * be used. */

     int isProcCallFrame;	 /* If nonzero, the frame represents a

 				  * called Tcl procedure and may have local

 				  * vars. Vars will ordinarily be looked up

 				  * in the frame. If new variables are

 				  * created, they will be created in the

 				  * frame. If 0, the frame is for a

 				  * "namespace eval" or "namespace inscope"

 				  * command and var references are treated

 				  * as references to namespace variables. */

 {

     Interp *iPtr = (Interp *) interp;

     register CallFrame *framePtr = (CallFrame *) callFramePtr;

     register Namespace *nsPtr;

     if (namespacePtr == NULL) {

 	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

     } else {

         nsPtr = (Namespace *) namespacePtr;

         if (nsPtr->flags & NS_DEAD) {

 	    panic("Trying to push call frame for dead namespace");

 	    /*NOTREACHED*/

         }

     }

     nsPtr->activationCount++;

     framePtr->nsPtr = nsPtr;

     framePtr->isProcCallFrame = isProcCallFrame;

     framePtr->objc = 0;

     framePtr->objv = NULL;

     framePtr->callerPtr = iPtr->framePtr;

     framePtr->callerVarPtr = iPtr->varFramePtr;

     if (iPtr->varFramePtr != NULL) {

         framePtr->level = (iPtr->varFramePtr->level + 1);

     } else {

         framePtr->level = 1;

     }

     framePtr->procPtr = NULL; 	   /* no called procedure */

     framePtr->varTablePtr = NULL;  /* and no local variables */

     framePtr->numCompiledLocals = 0;

     framePtr->compiledLocals = NULL;

     /*

      * Push the new call frame onto the interpreter's stack of procedure

      * call frames making it the current frame.

      */

     iPtr->framePtr = framePtr;

     iPtr->varFramePtr = framePtr;

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PopCallFrame --

  *

  *	Removes a call frame from the Tcl call stack for the interpreter.

  *	Called to remove a frame previously pushed by Tcl_PushCallFrame.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Modifies the call stack of the interpreter. Resets various fields of

  *	the popped call frame. If a namespace has been deleted and

  *	has no more activations on the call stack, the namespace is

  *	destroyed.

  *

  *----------------------------------------------------------------------

  */

 void

 Tcl_PopCallFrame(interp)

     Tcl_Interp* interp;		/* Interpreter with call frame to pop. */

 {

     register Interp *iPtr = (Interp *) interp;

     register CallFrame *framePtr = iPtr->framePtr;

     Namespace *nsPtr;

     /*

      * It's important to remove the call frame from the interpreter's stack

      * of call frames before deleting local variables, so that traces

      * invoked by the variable deletion don't see the partially-deleted

      * frame.

      */

     iPtr->framePtr = framePtr->callerPtr;

     iPtr->varFramePtr = framePtr->callerVarPtr;

     if (framePtr->varTablePtr != NULL) {

         TclDeleteVars(iPtr, framePtr->varTablePtr);

         ckfree((char *) framePtr->varTablePtr);

         framePtr->varTablePtr = NULL;

     }

     if (framePtr->numCompiledLocals > 0) {

         TclDeleteCompiledLocalVars(iPtr, framePtr);

     }

     /*

      * Decrement the namespace's count of active call frames. If the

      * namespace is "dying" and there are no more active call frames,

      * call Tcl_DeleteNamespace to destroy it.

      */

     nsPtr = framePtr->nsPtr;

     nsPtr->activationCount--;

     if ((nsPtr->flags & NS_DYING)

 	    && (nsPtr->activationCount == 0)) {

         Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);

     }

     framePtr->nsPtr = NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_CreateNamespace --

  *

  *	Creates a new namespace with the given name. If there is no

  *	active namespace (i.e., the interpreter is being initialized),

  *	the global :: namespace is created and returned.

  *

  * Results:

  *	Returns a pointer to the new namespace if successful. If the

  *	namespace already exists or if another error occurs, this routine

  *	returns NULL, along with an error message in the interpreter's

  *	result object.

  *

  * Side effects:

  *	If the name contains "::" qualifiers and a parent namespace does

  *	not already exist, it is automatically created. 

  *

  *----------------------------------------------------------------------

  */

 Tcl_Namespace *

 Tcl_CreateNamespace(interp, name, clientData, deleteProc)

     Tcl_Interp *interp;             /* Interpreter in which a new namespace

 				     * is being created. Also used for

 				     * error reporting. */

     CONST char *name;               /* Name for the new namespace. May be a

 				     * qualified name with names of ancestor

 				     * namespaces separated by "::"s. */

     ClientData clientData;	    /* One-word value to store with

 				     * namespace. */

     Tcl_NamespaceDeleteProc *deleteProc;

     				    /* Procedure called to delete client

 				     * data when the namespace is deleted.

 				     * NULL if no procedure should be

 				     * called. */

 {

     Interp *iPtr = (Interp *) interp;

     register Namespace *nsPtr, *ancestorPtr;

     Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;

     Namespace *globalNsPtr = iPtr->globalNsPtr;

     CONST char *simpleName;

     Tcl_HashEntry *entryPtr;

     Tcl_DString buffer1, buffer2;

     int newEntry;

     /*

      * If there is no active namespace, the interpreter is being

      * initialized. 

      */

     if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {

 	/*

 	 * Treat this namespace as the global namespace, and avoid

 	 * looking for a parent.

 	 */

         parentPtr = NULL;

         simpleName = "";

     } else if (*name == '\0') {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);

 	return NULL;

     } else {

 	/*

 	 * Find the parent for the new namespace.

 	 */

 	TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,

 		/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),

 		&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);

 	/*

 	 * If the unqualified name at the end is empty, there were trailing

 	 * "::"s after the namespace's name which we ignore. The new

 	 * namespace was already (recursively) created and is pointed to

 	 * by parentPtr.

 	 */

 	if (*simpleName == '\0') {

 	    return (Tcl_Namespace *) parentPtr;

 	}

         /*

          * Check for a bad namespace name and make sure that the name

 	 * does not already exist in the parent namespace.

 	 */

         if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		    "can't create namespace \"", name,

     	    	    "\": already exists", (char *) NULL);

             return NULL;

         }

     }

     /*

      * Create the new namespace and root it in its parent. Increment the

      * count of namespaces created.

      */

     nsPtr = (Namespace *) ckalloc(sizeof(Namespace));

     nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));

     strcpy(nsPtr->name, simpleName);

     nsPtr->fullName        = NULL;   /* set below */

     nsPtr->clientData      = clientData;

     nsPtr->deleteProc      = deleteProc;

     nsPtr->parentPtr       = parentPtr;

     Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);

     Tcl_MutexLock(&nsMutex);

     numNsCreated++;

     nsPtr->nsId            = numNsCreated;

     Tcl_MutexUnlock(&nsMutex);

     nsPtr->interp          = interp;

     nsPtr->flags           = 0;

     nsPtr->activationCount = 0;

     nsPtr->refCount        = 0;

     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

     Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);

     nsPtr->exportArrayPtr  = NULL;

     nsPtr->numExportPatterns = 0;

     nsPtr->maxExportPatterns = 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,

 	        &newEntry);

         Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);

     }

     /*

      * Build the fully qualified name for this namespace.

      */

     Tcl_DStringInit(&buffer1);

     Tcl_DStringInit(&buffer2);

     for (ancestorPtr = nsPtr;  ancestorPtr != NULL;

 	    ancestorPtr = ancestorPtr->parentPtr) {

         if (ancestorPtr != globalNsPtr) {

             Tcl_DStringAppend(&buffer1, "::", 2);

             Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);

         }

         Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);

         Tcl_DStringSetLength(&buffer2, 0);

         Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);

         Tcl_DStringSetLength(&buffer1, 0);

     }

     name = Tcl_DStringValue(&buffer2);

     nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));

     strcpy(nsPtr->fullName, name);

     Tcl_DStringFree(&buffer1);

     Tcl_DStringFree(&buffer2);

     /*

      * Return a pointer to the new namespace.

      */

     return (Tcl_Namespace *) nsPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_DeleteNamespace --

  *

  *	Deletes a namespace and all of the commands, variables, and other

  *	namespaces within it.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	When a namespace is deleted, it is automatically removed as a

  *	child of its parent namespace. Also, all its commands, variables

  *	and child namespaces are deleted.

  *

  *----------------------------------------------------------------------

  */

 void

 Tcl_DeleteNamespace(namespacePtr)

     Tcl_Namespace *namespacePtr;   /* Points to the namespace to delete. */

 {

     register Namespace *nsPtr = (Namespace *) namespacePtr;

     Interp *iPtr = (Interp *) nsPtr->interp;

     Namespace *globalNsPtr =

 	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);

     Tcl_HashEntry *entryPtr;

     /*

      * If the namespace is on the call frame stack, it is marked as "dying"

      * (NS_DYING is OR'd into its flags): the namespace can't be looked up

      * by name but its commands and variables are still usable by those

      * active call frames. When all active call frames referring to the

      * namespace have been popped from the Tcl stack, Tcl_PopCallFrame will

      * call this procedure again to delete everything in the namespace.

      * If no nsName objects refer to the namespace (i.e., if its refCount 

      * is zero), its commands and variables are deleted and the storage for

      * its namespace structure is freed. Otherwise, if its refCount is

      * nonzero, the namespace's commands and variables are deleted but the

      * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's

      * flags to allow the namespace resolution code to recognize that the

      * namespace is "deleted". The structure's storage is freed by

      * FreeNsNameInternalRep when its refCount reaches 0.

      */

     if (nsPtr->activationCount > 0) {

         nsPtr->flags |= NS_DYING;

         if (nsPtr->parentPtr != NULL) {

             entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,

 		    nsPtr->name);

             if (entryPtr != NULL) {

                 Tcl_DeleteHashEntry(entryPtr);

             }

         }

         nsPtr->parentPtr = NULL;

     } else if (!(nsPtr->flags & NS_KILLED)) {

 	/*

 	 * Delete the namespace and everything in it. If this is the global

 	 * namespace, then clear it but don't free its storage unless the

 	 * interpreter is being torn down. Set the NS_KILLED flag to avoid

 	 * recursive calls here - if the namespace is really in the process of

 	 * being deleted, ignore any second call.

 	 */

 	nsPtr->flags |= (NS_DYING|NS_KILLED);

         TclTeardownNamespace(nsPtr);

         if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {

             /*

 	     * If this is the global namespace, then it may have residual

              * "errorInfo" and "errorCode" variables for errors that

              * occurred while it was being torn down.  Try to clear the

              * variable list one last time.

 	     */

             TclDeleteNamespaceVars(nsPtr);

             Tcl_DeleteHashTable(&nsPtr->childTable);

             Tcl_DeleteHashTable(&nsPtr->cmdTable);

             /*

              * If the reference count is 0, then discard the namespace.

              * Otherwise, mark it as "dead" so that it can't be used.

              */

             if (nsPtr->refCount == 0) {

                 NamespaceFree(nsPtr);

             } else {

                 nsPtr->flags |= NS_DEAD;

             }

         } else {

 	    /*

 	     * We didn't really kill it, so remove the KILLED marks, so

 	     * it can get killed later, avoiding mem leaks

 	     */

 	     nsPtr->flags &= ~(NS_DYING|NS_KILLED);

 	}

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclTeardownNamespace --

  *

  *	Used internally to dismantle and unlink a namespace when it is

  *	deleted. Divorces the namespace from its parent, and deletes all

  *	commands, variables, and child namespaces.

  *

  *	This is kept separate from Tcl_DeleteNamespace so that the global

  *	namespace can be handled specially. Global variables like

  *	"errorInfo" and "errorCode" need to remain intact while other

  *	namespaces and commands are torn down, in case any errors occur.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Removes this namespace from its parent's child namespace hashtable.

  *	Deletes all commands, variables and namespaces in this namespace.

  *	If this is the global namespace, the "errorInfo" and "errorCode"

  *	variables are left alone and deleted later.

  *

  *----------------------------------------------------------------------

  */

 void

 TclTeardownNamespace(nsPtr)

     register Namespace *nsPtr;	/* Points to the namespace to be dismantled

 				 * and unlinked from its parent. */

 {

     Interp *iPtr = (Interp *) nsPtr->interp;

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     Tcl_Namespace *childNsPtr;

     Tcl_Command cmd;

     Namespace *globalNsPtr =

 	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);

     int i;

     /*

      * Start by destroying the namespace's variable table,

      * since variables might trigger traces.

      */

     if (nsPtr == globalNsPtr) {

 	/*

 	 * This is the global namespace.  Tearing it down will destroy the

 	 * ::errorInfo and ::errorCode variables.  We save and restore them

 	 * in case there are any errors in progress, so the error details

 	 * they contain will not be lost.  See test namespace-8.5

 	 */

 	Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo",

 		NULL, TCL_GLOBAL_ONLY);

 	Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode",

 		NULL, TCL_GLOBAL_ONLY);

 	if (errorInfo) {

 	    Tcl_IncrRefCount(errorInfo);

 	}

 	if (errorCode) {

 	    Tcl_IncrRefCount(errorCode);

 	}

         TclDeleteNamespaceVars(nsPtr);

         Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);

 	if (errorInfo) {

 	    Tcl_SetVar2Ex(nsPtr->interp, "errorInfo", NULL,

 		    errorInfo, TCL_GLOBAL_ONLY);

 	    Tcl_DecrRefCount(errorInfo);

 	}

 	if (errorCode) {

 	    Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL,

 		    errorCode, TCL_GLOBAL_ONLY);

 	    Tcl_DecrRefCount(errorCode);

 	}

     } else {

 	/*

 	 * Variable table should be cleared but not freed! TclDeleteVars

 	 * frees it, so we reinitialize it afterwards.

 	 */

         TclDeleteNamespaceVars(nsPtr);

         Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);

     }

     /*

      * Delete all commands in this namespace. Be careful when traversing the

      * hash table: when each command is deleted, it removes itself from the

      * command table.

      */

     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);

             entryPtr != NULL;

             entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {

         cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);

         Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);

     }

     Tcl_DeleteHashTable(&nsPtr->cmdTable);

     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

     /*

      * Remove the namespace from its parent's child hashtable.

      */

     if (nsPtr->parentPtr != NULL) {

         entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,

 	        nsPtr->name);

         if (entryPtr != NULL) {

             Tcl_DeleteHashEntry(entryPtr);

         }

     }

     nsPtr->parentPtr = NULL;

     /*

      * Delete all the child namespaces.

      *

      * BE CAREFUL: When each child is deleted, it will divorce

      *    itself from its parent. You can't traverse a hash table

      *    properly if its elements are being deleted. We use only

      *    the Tcl_FirstHashEntry function to be safe.

      */

     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);

             entryPtr != NULL;

             entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {

         childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);

         Tcl_DeleteNamespace(childNsPtr);

     }

     /*

      * Free the namespace's export pattern array.

      */

     if (nsPtr->exportArrayPtr != NULL) {

 	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {

 	    ckfree(nsPtr->exportArrayPtr[i]);

 	}

         ckfree((char *) nsPtr->exportArrayPtr);

 	nsPtr->exportArrayPtr = NULL;

 	nsPtr->numExportPatterns = 0;

 	nsPtr->maxExportPatterns = 0;

     }

     /*

      * Free any client data associated with the namespace.

      */

     if (nsPtr->deleteProc != NULL) {

         (*nsPtr->deleteProc)(nsPtr->clientData);

     }

     nsPtr->deleteProc = NULL;

     nsPtr->clientData = NULL;

     /*

      * Reset the namespace's id field to ensure that this namespace won't

      * be interpreted as valid by, e.g., the cache validation code for

      * cached command references in Tcl_GetCommandFromObj.

      */

     nsPtr->nsId = 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * NamespaceFree --

  *

  *	Called after a namespace has been deleted, when its

  *	reference count reaches 0.  Frees the data structure

  *	representing the namespace.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static void

 NamespaceFree(nsPtr)

     register Namespace *nsPtr;	/* Points to the namespace to free. */

 {

     /*

      * Most of the namespace's contents are freed when the namespace is

      * deleted by Tcl_DeleteNamespace. All that remains is to free its names

      * (for error messages), and the structure itself.

      */

     ckfree(nsPtr->name);

     ckfree(nsPtr->fullName);

     ckfree((char *) nsPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_Export --

  *

  *	Makes all the commands matching a pattern available to later be

  *	imported from the namespace specified by namespacePtr (or the

  *	current namespace if namespacePtr is NULL). The specified pattern is

  *	appended onto the namespace's export pattern list, which is

  *	optionally cleared beforehand.

  *

  * Results:

  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error

  *	message in the interpreter's result) if something goes wrong.

  *

  * Side effects:

  *	Appends the export pattern onto the namespace's export list.

  *	Optionally reset the namespace's export pattern list.

  *

  *----------------------------------------------------------------------

  */

 int

 Tcl_Export(interp, namespacePtr, pattern, resetListFirst)

     Tcl_Interp *interp;		 /* Current interpreter. */

     Tcl_Namespace *namespacePtr; /* Points to the namespace from which 

 				  * commands are to be exported. NULL for

                                   * the current namespace. */

     CONST char *pattern;         /* String pattern indicating which commands

                                   * to export. This pattern may not include

 				  * any namespace qualifiers; only commands

 				  * in the specified namespace may be

 				  * exported. */

     int resetListFirst;		 /* If nonzero, resets the namespace's

 				  * export list before appending. */

 {

 #define INIT_EXPORT_PATTERNS 5    

     Namespace *nsPtr, *exportNsPtr, *dummyPtr;

     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

     CONST char *simplePattern;

     char *patternCpy;

     int neededElems, len, i;

     /*

      * If the specified namespace is NULL, use the current namespace.

      */

     if (namespacePtr == NULL) {

         nsPtr = (Namespace *) currNsPtr;

     } else {

         nsPtr = (Namespace *) namespacePtr;

     }

     /*

      * If resetListFirst is true (nonzero), clear the namespace's export

      * pattern list.

      */

     if (resetListFirst) {

 	if (nsPtr->exportArrayPtr != NULL) {

 	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {

 		ckfree(nsPtr->exportArrayPtr[i]);

 	    }

 	    ckfree((char *) nsPtr->exportArrayPtr);

 	    nsPtr->exportArrayPtr = NULL;

 	    nsPtr->numExportPatterns = 0;

 	    nsPtr->maxExportPatterns = 0;

 	}

     }

     /*

      * Check that the pattern doesn't have namespace qualifiers.

      */

     TclGetNamespaceForQualName(interp, pattern, nsPtr,

 	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),

 	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

     if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 	        "invalid export pattern \"", pattern,

 		"\": pattern can't specify a namespace",

 		(char *) NULL);

 	return TCL_ERROR;

     }

     /*

      * Make sure that we don't already have the pattern in the array

      */

     if (nsPtr->exportArrayPtr != NULL) {

 	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {

 	    if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {

 		/*

 		 * The pattern already exists in the list

 		 */

 		return TCL_OK;

 	    }

 	}

     }

     /*

      * Make sure there is room in the namespace's pattern array for the

      * new pattern.

      */

     neededElems = nsPtr->numExportPatterns + 1;

     if (nsPtr->exportArrayPtr == NULL) {

 	nsPtr->exportArrayPtr = (char **)

 	        ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));

 	nsPtr->numExportPatterns = 0;

 	nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;

     } else if (neededElems > nsPtr->maxExportPatterns) {

 	int numNewElems = 2 * nsPtr->maxExportPatterns;

 	size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);

 	size_t newBytes  = numNewElems * sizeof(char *);

 	char **newPtr = (char **) ckalloc((unsigned) newBytes);

 	memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,

 	        currBytes);

 	ckfree((char *) nsPtr->exportArrayPtr);

 	nsPtr->exportArrayPtr = (char **) newPtr;

 	nsPtr->maxExportPatterns = numNewElems;

     }

     /*

      * Add the pattern to the namespace's array of export patterns.

      */

     len = strlen(pattern);

     patternCpy = (char *) ckalloc((unsigned) (len + 1));

     strcpy(patternCpy, pattern);

     nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;

     nsPtr->numExportPatterns++;

     return TCL_OK;

 #undef INIT_EXPORT_PATTERNS

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_AppendExportList --

  *

  *	Appends onto the argument object the list of export patterns for the

  *	specified namespace.

  *

  * Results:

  *	The return value is normally TCL_OK; in this case the object

  *	referenced by objPtr has each export pattern appended to it. If an

  *	error occurs, TCL_ERROR is returned and the interpreter's result

  *	holds an error message.

  *

  * Side effects:

  *	If necessary, the object referenced by objPtr is converted into

  *	a list object.

  *

  *----------------------------------------------------------------------

  */

 int

 Tcl_AppendExportList(interp, namespacePtr, objPtr)

     Tcl_Interp *interp;		 /* Interpreter used for error reporting. */

     Tcl_Namespace *namespacePtr; /* Points to the namespace whose export

 				  * pattern list is appended onto objPtr.

 				  * NULL for the current namespace. */

     Tcl_Obj *objPtr;		 /* Points to the Tcl object onto which the

 				  * export pattern list is appended. */

 {

     Namespace *nsPtr;

     int i, result;

     /*

      * If the specified namespace is NULL, use the current namespace.

      */

     if (namespacePtr == NULL) {

         nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);

     } else {

         nsPtr = (Namespace *) namespacePtr;

     }

     /*

      * Append the export pattern list onto objPtr.

      */

     for (i = 0;  i < nsPtr->numExportPatterns;  i++) {

 	result = Tcl_ListObjAppendElement(interp, objPtr,

 		Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1));

 	if (result != TCL_OK) {

 	    return result;

 	}

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_Import --

  *

  *	Imports all of the commands matching a pattern into the namespace

  *	specified by namespacePtr (or the current namespace if contextNsPtr

  *	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.

  *

  * Side effects:

  *	Creates new commands in the importing namespace. These indirect

  *	calls back to the real command and are deleted if the real commands

  *	are deleted.

  *

  *----------------------------------------------------------------------

  */

 int

 Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)

     Tcl_Interp *interp;		 /* Current interpreter. */

     Tcl_Namespace *namespacePtr; /* Points to the namespace into which the

 				  * commands are to be imported. NULL for

                                   * the current namespace. */

     CONST char *pattern;         /* String pattern indicating which commands

                                   * to import. This pattern should be

 				  * qualified by the name of the namespace

 				  * from which to import the command(s). */

     int allowOverwrite;		 /* If nonzero, allow existing commands to

 				  * be overwritten by imported commands.

 				  * If 0, return an error if an imported

 				  * cmd conflicts with an existing one. */

 {

     Interp *iPtr = (Interp *) interp;

     Namespace *nsPtr, *importNsPtr, *dummyPtr;

     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

     CONST char *simplePattern;

     char *cmdName;

     register Tcl_HashEntry *hPtr;

     Tcl_HashSearch search;

     Command *cmdPtr;

     ImportRef *refPtr;

     Tcl_Command autoCmd, importedCmd;

     ImportedCmdData *dataPtr;

     int wasExported, i, result;

     /*

      * If the specified namespace is NULL, use the current namespace.

      */

     if (namespacePtr == NULL) {

         nsPtr = (Namespace *) currNsPtr;

     } 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

      * and get the simple pattern (no namespace qualifiers or ::'s) at

      * the end.

      */

     if (strlen(pattern) == 0) {

 	Tcl_SetStringObj(Tcl_GetObjResult(interp),

 	        "empty import pattern", -1);

         return TCL_ERROR;

     }

     TclGetNamespaceForQualName(interp, pattern, nsPtr,

 	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),

 	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

     if (importNsPtr == NULL) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"unknown namespace in import pattern \"",

 		pattern, "\"", (char *) NULL);

         return TCL_ERROR;

     }

     if (importNsPtr == nsPtr) {

 	if (pattern == simplePattern) {

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		    "no namespace specified in import pattern \"", pattern,

 		    "\"", (char *) NULL);

 	} else {

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		    "import pattern \"", pattern,

 		    "\" tries to import from namespace \"",

 		    importNsPtr->name, "\" into itself", (char *) NULL);

 	}

         return TCL_ERROR;

     }

     /*

      * Scan through the command table in the source namespace and look for

      * exported commands that match the string pattern. Create an "imported

      * command" in the current namespace for each imported command; these

      * commands redirect their invocations to the "real" command.

      */

     for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);

 	    (hPtr != NULL);

 	    hPtr = Tcl_NextHashEntry(&search)) {

         cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);

         if (Tcl_StringMatch(cmdName, simplePattern)) {

 	    /*

 	     * The command cmdName in the source namespace matches the

 	     * pattern. Check whether it was exported. If it wasn't,

 	     * we ignore it.

 	     */

 	    Tcl_HashEntry *found;

 	    wasExported = 0;

 	    for (i = 0;  i < importNsPtr->numExportPatterns;  i++) {

 		if (Tcl_StringMatch(cmdName,

 			importNsPtr->exportArrayPtr[i])) {

 		    wasExported = 1;

 		    break;

 		}

 	    }

 	    if (!wasExported) {

 		continue;

             }

 	    /*

 	     * Unless there is a name clash, create an imported command

 	     * in the current namespace that refers to cmdPtr.

 	     */

 	    found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);

 	    if ((found == NULL) || allowOverwrite) {

 		/*

 		 * Create the imported command and its client data.

 		 * To create the new command in the current namespace, 

 		 * generate a fully qualified name for it.

 		 */

 		Tcl_DString ds;

 		Tcl_DStringInit(&ds);

 		Tcl_DStringAppend(&ds, nsPtr->fullName, -1);

 		if (nsPtr != iPtr->globalNsPtr) {

 		    Tcl_DStringAppend(&ds, "::", 2);

 		}

 		Tcl_DStringAppend(&ds, cmdName, -1);

 		/*

 		 * Check whether creating the new imported command in the

 		 * current namespace would create a cycle of imported

 		 * command references.

 		 */

 		cmdPtr = (Command *) Tcl_GetHashValue(hPtr);

 		if ((found != NULL)

 			&& cmdPtr->deleteProc == DeleteImportedCmd) {

 		    Command *overwrite = (Command *) Tcl_GetHashValue(found);

 		    Command *link = cmdPtr;

 		    while (link->deleteProc == DeleteImportedCmd) {

 			ImportedCmdData *dataPtr;

 			dataPtr = (ImportedCmdData *) link->objClientData;

 			link = dataPtr->realCmdPtr;

 			if (overwrite == link) {

 			    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 				    "import pattern \"", pattern,

 				    "\" would create a loop containing ",

 				    "command \"", Tcl_DStringValue(&ds),

 				    "\"", (char *) NULL);

 			    Tcl_DStringFree(&ds);

 			    return TCL_ERROR;

 			}

 		    }

 		}

 		dataPtr = (ImportedCmdData *)

 		        ckalloc(sizeof(ImportedCmdData));

                 importedCmd = Tcl_CreateObjCommand(interp, 

                         Tcl_DStringValue(&ds), InvokeImportedCmd,

                         (ClientData) dataPtr, DeleteImportedCmd);

 		dataPtr->realCmdPtr = cmdPtr;

 		dataPtr->selfPtr = (Command *) importedCmd;

 		dataPtr->selfPtr->compileProc = cmdPtr->compileProc;

 		Tcl_DStringFree(&ds);

 		/*

 		 * Create an ImportRef structure describing this new import

 		 * command and add it to the import ref list in the "real"

 		 * command.

 		 */

                 refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));

                 refPtr->importedCmdPtr = (Command *) importedCmd;

                 refPtr->nextPtr = cmdPtr->importRefPtr;

                 cmdPtr->importRefPtr = refPtr;

             } else {

 		Command *overwrite = (Command *) Tcl_GetHashValue(found);

 		if (overwrite->deleteProc == DeleteImportedCmd) {

 		    ImportedCmdData *dataPtr =

 			    (ImportedCmdData *) overwrite->objClientData;

 		    if (dataPtr->realCmdPtr

 			    == (Command *) Tcl_GetHashValue(hPtr)) {

 			/* Repeated import of same command -- acceptable */

 			return TCL_OK;

 		    }

 		}

 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		        "can't import command \"", cmdName,

 			"\": already exists", (char *) NULL);

                 return TCL_ERROR;

             }

         }

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ForgetImport --

  *

  *	Deletes commands previously imported into the namespace indicated.  The

  *	by namespacePtr, or the current namespace of interp, when

  *	namespacePtr is NULL.  The pattern controls which imported commands

  *	are deleted.  A simple pattern, one without namespace separators,

  *	matches the current command names of imported commands in the

  *	namespace.  Matching imported commands are deleted.  A qualified

  *	pattern is interpreted as deletion selection on the basis of where

  *	the command is imported from.  The original command and "first link"

  *	command for each imported command are determined, and they are matched

  *	against the pattern.  A match leads to deletion of the imported

  *	command.

  *

  * Results:

  * 	Returns TCL_ERROR and records an error message in the interp

  * 	result if a namespace qualified pattern refers to a namespace

  * 	that does not exist.  Otherwise, returns TCL_OK.

  *

  * Side effects:

  *	May delete commands. 

  *

  *----------------------------------------------------------------------

  */

 int

 Tcl_ForgetImport(interp, namespacePtr, pattern)

     Tcl_Interp *interp;		 /* Current interpreter. */

     Tcl_Namespace *namespacePtr; /* Points to the namespace from which

 				  * previously imported commands should be

 				  * removed. NULL for current namespace. */

     CONST char *pattern;	 /* String pattern indicating which imported

 				  * commands to remove. */

 {

     Namespace *nsPtr, *sourceNsPtr, *dummyPtr;

     CONST char *simplePattern;

     char *cmdName;

     register Tcl_HashEntry *hPtr;

     Tcl_HashSearch search;

     /*

      * If the specified namespace is NULL, use the current namespace.

      */

     if (namespacePtr == NULL) {

         nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

     } else {

         nsPtr = (Namespace *) namespacePtr;

     }

     /*

      * Parse the pattern into its namespace-qualification (if any)

      * and the simple pattern.

      */

     TclGetNamespaceForQualName(interp, pattern, nsPtr,

 	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),

 	    &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

     if (sourceNsPtr == NULL) {

         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"unknown namespace in namespace forget pattern \"",

 		pattern, "\"", (char *) NULL);

         return TCL_ERROR;

     }

     if (strcmp(pattern, simplePattern) == 0) {

 	/*

 	 * The pattern is simple.

 	 * Delete any imported commands that match it.

 	 */

 	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);

 		(hPtr != NULL);

 		hPtr = Tcl_NextHashEntry(&search)) {

 	    Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr);

 	    if (cmdPtr->deleteProc != DeleteImportedCmd) {

 		continue;

 	    }

 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);

 	    if (Tcl_StringMatch(cmdName, simplePattern)) {

 		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);

 	    }

 	}

 	return TCL_OK;

     }

     /* The pattern was namespace-qualified */

     for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL);

 	    hPtr = Tcl_NextHashEntry(&search)) {

 	Tcl_CmdInfo info;

 	Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr);

 	Tcl_Command origin = TclGetOriginalCommand(token);

 	if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) {

 	    continue;	/* Not an imported command */

 	}

 	if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {

 	    /*

 	     * Original not in namespace we're matching.

 	     * Check the first link in the import chain.

 	     */

 	    Command *cmdPtr = (Command *) token;

 	    ImportedCmdData *dataPtr =

 		    (ImportedCmdData *) cmdPtr->objClientData;

 	    Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;

 	    if (firstToken == origin) {

 		continue;

 	    }

 	    Tcl_GetCommandInfoFromToken(firstToken, &info);

 	    if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {

 		continue;

 	    }

 	    origin = firstToken;

 	}

 	if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) {

 	    Tcl_DeleteCommandFromToken(interp, token);

 	}

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclGetOriginalCommand --

  *

  *	An imported command is created in an namespace when a "real" command

  *	is imported from another namespace. If the specified command is an

  *	imported command, this procedure returns the original command it

  *	refers to. 

  *

  * Results:

  *	If the command was imported into a sequence of namespaces a, b,...,n

  *	where each successive namespace just imports the command from the

  *	previous namespace, this procedure returns the Tcl_Command token in

  *	the first namespace, a. Otherwise, if the specified command is not

  *	an imported command, the procedure returns NULL.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Command

 TclGetOriginalCommand(command)

     Tcl_Command command;	/* The imported command for which the

 				 * original command should be returned. */

 {

     register Command *cmdPtr = (Command *) command;

     ImportedCmdData *dataPtr;

     if (cmdPtr->deleteProc != DeleteImportedCmd) {

 	return (Tcl_Command) NULL;

     }

     while (cmdPtr->deleteProc == DeleteImportedCmd) {

 	dataPtr = (ImportedCmdData *) cmdPtr->objClientData;

 	cmdPtr = dataPtr->realCmdPtr;

     }

     return (Tcl_Command) cmdPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * InvokeImportedCmd --

  *

  *	Invoked by Tcl whenever the user calls an imported command that

  *	was created by Tcl_Import. Finds the "real" command (in another

  *	namespace), and passes control to it.

  *

  * Results:

  *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.

  *

  * Side effects:

  *	Returns a result in the interpreter's result object. If anything

  *	goes wrong, the result object is set to an error message.

  *

  *----------------------------------------------------------------------

  */

 static int

 InvokeImportedCmd(clientData, interp, objc, objv)

     ClientData clientData;	/* Points to the imported command's

 				 * ImportedCmdData structure. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* The argument objects. */

 {

     register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;

     register Command *realCmdPtr = dataPtr->realCmdPtr;

     return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,

             objc, objv);

 }

 /*

  *----------------------------------------------------------------------

  *

  * DeleteImportedCmd --

  *

  *	Invoked by Tcl whenever an imported command is deleted. The "real"

  *	command keeps a list of all the imported commands that refer to it,

  *	so those imported commands can be deleted when the real command is

  *	deleted. This procedure removes the imported command reference from

  *	the real command's list, and frees up the memory associated with

  *	the imported command.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Removes the imported command from the real command's import list.

  *

  *----------------------------------------------------------------------

  */

 static void

 DeleteImportedCmd(clientData)

     ClientData clientData;	/* Points to the imported command's

 				 * ImportedCmdData structure. */

 {

     ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;

     Command *realCmdPtr = dataPtr->realCmdPtr;

     Command *selfPtr = dataPtr->selfPtr;

     register ImportRef *refPtr, *prevPtr;

     prevPtr = NULL;

     for (refPtr = realCmdPtr->importRefPtr;  refPtr != NULL;

             refPtr = refPtr->nextPtr) {

 	if (refPtr->importedCmdPtr == selfPtr) {

 	    /*

 	     * Remove *refPtr from real command's list of imported commands

 	     * that refer to it.

 	     */

 	    if (prevPtr == NULL) { /* refPtr is first in list */

 		realCmdPtr->importRefPtr = refPtr->nextPtr;

 	    } else {

 		prevPtr->nextPtr = refPtr->nextPtr;

 	    }

 	    ckfree((char *) refPtr);

 	    ckfree((char *) dataPtr);

 	    return;

 	}

 	prevPtr = refPtr;

     }

     panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclGetNamespaceForQualName --

  *

  *	Given a qualified name specifying a command, variable, or namespace,

  *	and a namespace in which to resolve the name, this procedure returns

  *	a pointer to the namespace that contains the item. A qualified name

  *	consists of the "simple" name of an item qualified by the names of

  *	an arbitrary number of containing namespace separated by "::"s. If

  *	the qualified name starts with "::", it is interpreted absolutely

  *	from the global namespace. Otherwise, it is interpreted relative to

  *	the namespace specified by cxtNsPtr if it is non-NULL. If cxtNsPtr

  *	is NULL, the name is interpreted relative to the current namespace.

  *

  *	A relative name like "foo::bar::x" can be found starting in either

  *	the current namespace or in the global namespace. So each search

  *	usually follows two tracks, and two possible namespaces are

  *	returned. If the procedure sets either *nsPtrPtr or *altNsPtrPtr to

  *	NULL, then that path failed.

  *

  *	If "flags" contains TCL_GLOBAL_ONLY, the relative qualified name is

  *	sought only in the global :: namespace. The alternate search

  *	(also) starting from the global namespace is ignored and

  *	*altNsPtrPtr is set NULL. 

  *

  *	If "flags" contains TCL_NAMESPACE_ONLY, the relative qualified

  *	name is sought only in the namespace specified by cxtNsPtr. The

  *	alternate search starting from the global namespace is ignored and

  *	*altNsPtrPtr is set NULL. If both TCL_GLOBAL_ONLY and

  *	TCL_NAMESPACE_ONLY are specified, TCL_GLOBAL_ONLY is ignored and

  *	the search starts from the namespace specified by cxtNsPtr.

  *

  *	If "flags" contains CREATE_NS_IF_UNKNOWN, all namespace

  *	components of the qualified name that cannot be found are

  *	automatically created within their specified parent. This makes sure

  *	that functions like Tcl_CreateCommand always succeed. There is no

  *	alternate search path, so *altNsPtrPtr is set NULL.

  *

  *	If "flags" contains FIND_ONLY_NS, the qualified name is treated as a

  *	reference to a namespace, and the entire qualified name is

  *	followed. If the name is relative, the namespace is looked up only

  *	in the current namespace. A pointer to the namespace is stored in

  *	*nsPtrPtr and NULL is stored in *simpleNamePtr. Otherwise, if

  *	FIND_ONLY_NS is not specified, only the leading components are

  *	treated as namespace names, and a pointer to the simple name of the

  *	final component is stored in *simpleNamePtr.

  *

  * Results:

  *	It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible

  *	namespaces which represent the last (containing) namespace in the

  *	qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr

  *	to NULL, then the search along that path failed.  The procedure also

  *	stores a pointer to the simple name of the final component in

  *	*simpleNamePtr. If the qualified name is "::" or was treated as a

  *	namespace reference (FIND_ONLY_NS), the procedure stores a pointer

  *	to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets

  *	*simpleNamePtr to point to an empty string.

  *

  *	If there is an error, this procedure returns TCL_ERROR. If "flags"

  *	contains TCL_LEAVE_ERR_MSG, an error message is returned in the

  *	interpreter's result object. Otherwise, the interpreter's result

  *	object is left unchanged.

  *

  *	*actualCxtPtrPtr is set to the actual context namespace. It is

  *	set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr

  *	is NULL, it is set to the current namespace context.

  *

  *	For backwards compatibility with the TclPro byte code loader,

  *	this function always returns TCL_OK.

  *

  * Side effects:

  *	If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be

  *	created.

  *

  *----------------------------------------------------------------------

  */

 int

 TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,

 	nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)

     Tcl_Interp *interp;		 /* Interpreter in which to find the

 				  * namespace containing qualName. */

     CONST char *qualName;	 /* A namespace-qualified name of an

 				  * command, variable, or namespace. */

     Namespace *cxtNsPtr;	 /* The namespace in which to start the

 				  * search for qualName's namespace. If NULL

 				  * start from the current namespace.

 				  * Ignored if TCL_GLOBAL_ONLY is set. */

     int flags;			 /* Flags controlling the search: an OR'd

 				  * combination of TCL_GLOBAL_ONLY,

 				  * TCL_NAMESPACE_ONLY,

 				  * CREATE_NS_IF_UNKNOWN, and

 				  * FIND_ONLY_NS. */

     Namespace **nsPtrPtr;	 /* Address where procedure stores a pointer

 				  * to containing namespace if qualName is

 				  * found starting from *cxtNsPtr or, if

 				  * TCL_GLOBAL_ONLY is set, if qualName is

 				  * found in the global :: namespace. NULL

 				  * is stored otherwise. */

     Namespace **altNsPtrPtr;	 /* Address where procedure stores a pointer

 				  * to containing namespace if qualName is

 				  * found starting from the global ::

 				  * namespace. NULL is stored if qualName

 				  * isn't found starting from :: or if the

 				  * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,

 				  * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag

 				  * is set. */

     Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer

 				  * to the actual namespace from which the

 				  * search started. This is either cxtNsPtr,

 				  * the :: namespace if TCL_GLOBAL_ONLY was

 				  * specified, or the current namespace if

 				  * cxtNsPtr was NULL. */

     CONST char **simpleNamePtr;	 /* Address where procedure stores the

 				  * simple name at end of the qualName, or

 				  * NULL if qualName is "::" or the flag

 				  * FIND_ONLY_NS was specified. */

 {

     Interp *iPtr = (Interp *) interp;

     Namespace *nsPtr = cxtNsPtr;

     Namespace *altNsPtr;

     Namespace *globalNsPtr = iPtr->globalNsPtr;

     CONST char *start, *end;

     CONST char *nsName;

     Tcl_HashEntry *entryPtr;

     Tcl_DString buffer;

     int len;

     /*

      * Determine the context namespace nsPtr in which to start the primary

      * search.  If the qualName name starts with a "::" or TCL_GLOBAL_ONLY

      * was specified, search from the global namespace. Otherwise, use the

      * namespace given in cxtNsPtr, or if that is NULL, use the current

      * namespace context. Note that we always treat two or more

      * adjacent ":"s as a namespace separator.

      */

     if (flags & TCL_GLOBAL_ONLY) {

 	nsPtr = globalNsPtr;

     } else if (nsPtr == NULL) {

 	if (iPtr->varFramePtr != NULL) {

 	    nsPtr = iPtr->varFramePtr->nsPtr;

 	} else {

 	    nsPtr = iPtr->globalNsPtr;

 	}

     }

     start = qualName;		/* pts to start of qualifying namespace */

     if ((*qualName == ':') && (*(qualName+1) == ':')) {

 	start = qualName+2;	/* skip over the initial :: */

 	while (*start == ':') {

             start++;		/* skip over a subsequent : */

 	}

         nsPtr = globalNsPtr;

         if (*start == '\0') {	/* qualName is just two or more ":"s */

             *nsPtrPtr        = globalNsPtr;

             *altNsPtrPtr     = NULL;

 	    *actualCxtPtrPtr = globalNsPtr;

             *simpleNamePtr   = start; /* points to empty string */

             return TCL_OK;

         }

     }

     *actualCxtPtrPtr = nsPtr;

     /*

      * Start an alternate search path starting with the global namespace.

      * However, if the starting context is the global namespace, or if the

      * flag is set to search only the namespace *cxtNsPtr, ignore the

      * alternate search path.

      */

     altNsPtr = globalNsPtr;

     if ((nsPtr == globalNsPtr)

 	    || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {

         altNsPtr = NULL;

     }

     /*

      * Loop to resolve each namespace qualifier in qualName.

      */

     Tcl_DStringInit(&buffer);

     end = start;

     while (*start != '\0') {

         /*

          * Find the next namespace qualifier (i.e., a name ending in "::")

 	 * or the end of the qualified name  (i.e., a name ending in "\0").

 	 * Set len to the number of characters, starting from start,

 	 * in the name; set end to point after the "::"s or at the "\0".

          */

 	len = 0;

         for (end = start;  *end != '\0';  end++) {

 	    if ((*end == ':') && (*(end+1) == ':')) {

 		end += 2;	/* skip over the initial :: */

 		while (*end == ':') {

 		    end++;	/* skip over the subsequent : */

 		}

 		break;		/* exit for loop; end is after ::'s */

 	    }

             len++;

 	}

 	if ((*end == '\0')

 	        && !((end-start >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) {

 	    /*

 	     * qualName ended with a simple name at start. If FIND_ONLY_NS

 	     * was specified, look this up as a namespace. Otherwise,

 	     * start is the name of a cmd or var and we are done.

 	     */

 	    if (flags & FIND_ONLY_NS) {

 		nsName = start;

 	    } else {

 		*nsPtrPtr      = nsPtr;

 		*altNsPtrPtr   = altNsPtr;

 		*simpleNamePtr = start;

 		Tcl_DStringFree(&buffer);

 		return TCL_OK;

 	    }

 	} else {

 	    /*

 	     * start points to the beginning of a namespace qualifier ending

 	     * in "::". end points to the start of a name in that namespace

 	     * that might be empty. Copy the namespace qualifier to a

 	     * buffer so it can be null terminated. We can't modify the

 	     * incoming qualName since it may be a string constant.

 	     */

 	    Tcl_DStringSetLength(&buffer, 0);

             Tcl_DStringAppend(&buffer, start, len);

             nsName = Tcl_DStringValue(&buffer);

         }

         /*

 	 * Look up the namespace qualifier nsName in the current namespace

          * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set,

          * create that qualifying namespace. This is needed for procedures

          * like Tcl_CreateCommand that cannot fail.

 	 */

         if (nsPtr != NULL) {

             entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);

             if (entryPtr != NULL) {

                 nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);

             } else if (flags & CREATE_NS_IF_UNKNOWN) {

 		Tcl_CallFrame frame;

 		(void) Tcl_PushCallFrame(interp, &frame,

 		        (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);

                 nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,

 		        (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);

                 Tcl_PopCallFrame(interp);

                 if (nsPtr == NULL) {

                     panic("Could not create namespace '%s'", nsName);

                 }

             } else {		/* namespace not found and wasn't created */

                 nsPtr = NULL;

             }

         }

         /*

          * Look up the namespace qualifier in the alternate search path too.

          */

         if (altNsPtr != NULL) {

             entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);

             if (entryPtr != NULL) {

                 altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);

             } else {

                 altNsPtr = NULL;

             }

         }

         /*

          * If both search paths have failed, return NULL results.

          */

         if ((nsPtr == NULL) && (altNsPtr == NULL)) {

             *nsPtrPtr      = NULL;

             *altNsPtrPtr   = NULL;

             *simpleNamePtr = NULL;

             Tcl_DStringFree(&buffer);

             return TCL_OK;

         }

 	start = end;

     }

     /*

      * We ignore trailing "::"s in a namespace name, but in a command or

      * variable name, trailing "::"s refer to the cmd or var named {}.

      */

     if ((flags & FIND_ONLY_NS)

 	    || ((end > start ) && (*(end-1) != ':'))) {

 	*simpleNamePtr = NULL; /* found namespace name */

     } else {

 	*simpleNamePtr = end;  /* found cmd/var: points to empty string */

     }

     /*

      * As a special case, if we are looking for a namespace and qualName

      * is "" and the current active namespace (nsPtr) is not the global

      * namespace, return NULL (no namespace was found). This is because

      * namespaces can not have empty names except for the global namespace.

      */

     if ((flags & FIND_ONLY_NS) && (*qualName == '\0')

 	    && (nsPtr != globalNsPtr)) {

 	nsPtr = NULL;

     }

     *nsPtrPtr    = nsPtr;

     *altNsPtrPtr = altNsPtr;

     Tcl_DStringFree(&buffer);

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FindNamespace --

  *

  *	Searches for a namespace.

  *

  * Results:

  *	Returns a pointer to the namespace if it is found. Otherwise,

  *	returns NULL and leaves an error message in the interpreter's

  *	result object if "flags" contains TCL_LEAVE_ERR_MSG.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Namespace *

 Tcl_FindNamespace(interp, name, contextNsPtr, flags)

     Tcl_Interp *interp;		 /* The interpreter in which to find the

 				  * namespace. */

     CONST char *name;		 /* Namespace name. If it starts with "::",

 				  * will be looked up in global namespace.

 				  * Else, looked up first in contextNsPtr

 				  * (current namespace if contextNsPtr is

 				  * NULL), then in global namespace. */

     Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag is set

 				  * or if the name starts with "::".

 				  * Otherwise, points to namespace in which

 				  * to resolve name; if NULL, look up name

 				  * in the current namespace. */

     register int flags;		 /* Flags controlling namespace lookup: an

 				  * OR'd combination of TCL_GLOBAL_ONLY and

 				  * TCL_LEAVE_ERR_MSG flags. */

 {

     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;

     CONST char *dummy;

     /*

      * Find the namespace(s) that contain the specified namespace name.

      * Add the FIND_ONLY_NS flag to resolve the name all the way down

      * to its last component, a namespace.

      */

     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,

 	    (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

     if (nsPtr != NULL) {

        return (Tcl_Namespace *) nsPtr;

     } else if (flags & TCL_LEAVE_ERR_MSG) {

 	Tcl_ResetResult(interp);

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "unknown namespace \"", name, "\"", (char *) NULL);

     }

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FindCommand --

  *

  *	Searches for a command.

  *

  * Results:

  *	Returns a token for the command if it is found. Otherwise, if it

  *	can't be found or there is an error, returns NULL and leaves an

  *	error message in the interpreter's result object if "flags"

  *	contains TCL_LEAVE_ERR_MSG.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Command

 Tcl_FindCommand(interp, name, contextNsPtr, flags)

     Tcl_Interp *interp;         /* The interpreter in which to find the

 				  * command and to report errors. */

     CONST char *name;	         /* Command's name. If it starts with "::",

 				  * will be looked up in global namespace.

 				  * Else, looked up first in contextNsPtr

 				  * (current namespace if contextNsPtr is

 				  * NULL), then in global namespace. */

     Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.

 				  * Otherwise, points to namespace in which

 				  * to resolve name. If NULL, look up name

 				  * in the current namespace. */

     int flags;                   /* An OR'd combination of flags:

 				  * TCL_GLOBAL_ONLY (look up name only in

 				  * global namespace), TCL_NAMESPACE_ONLY

 				  * (look up only in contextNsPtr, or the

 				  * current namespace if contextNsPtr is

 				  * NULL), and TCL_LEAVE_ERR_MSG. If both

 				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY

 				  * are given, TCL_GLOBAL_ONLY is

 				  * ignored. */

 {

     Interp *iPtr = (Interp*)interp;

     ResolverScheme *resPtr;

     Namespace *nsPtr[2], *cxtNsPtr;

     CONST 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.

      */

     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,

 	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

     /*

      * Look for the command in the command table of its namespace.

      * Be sure to check both possible search paths: from the specified

      * namespace context and from the global namespace.

      */

     cmdPtr = NULL;

     for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {

         if ((nsPtr[search] != NULL) && (simpleName != NULL)) {

 	    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,

 		    simpleName);

 	    if (entryPtr != NULL) {

 		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);

 	    }

 	}

     }

     if (cmdPtr != NULL) {

         return (Tcl_Command) cmdPtr;

     } else if (flags & TCL_LEAVE_ERR_MSG) {

 	Tcl_ResetResult(interp);

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "unknown command \"", name, "\"", (char *) NULL);

     }

     return (Tcl_Command) NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FindNamespaceVar --

  *

  *	Searches for a namespace variable, a variable not local to a

  *	procedure. The variable can be either a scalar or an array, but

  *	may not be an element of an array.

  *

  * Results:

  *	Returns a token for the variable if it is found. Otherwise, if it

  *	can't be found or there is an error, returns NULL and leaves an

  *	error message in the interpreter's result object if "flags"

  *	contains TCL_LEAVE_ERR_MSG.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Var

 Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)

     Tcl_Interp *interp;		 /* The interpreter in which to find the

 				  * variable. */

     CONST char *name;		 /* Variable's name. If it starts with "::",

 				  * will be looked up in global namespace.

 				  * Else, looked up first in contextNsPtr

 				  * (current namespace if contextNsPtr is

 				  * NULL), then in global namespace. */

     Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.

 				  * Otherwise, points to namespace in which

 				  * to resolve name. If NULL, look up name

 				  * in the current namespace. */

     int flags;			 /* An OR'd combination of flags:

 				  * TCL_GLOBAL_ONLY (look up name only in

 				  * global namespace), TCL_NAMESPACE_ONLY

 				  * (look up only in contextNsPtr, or the

 				  * current namespace if contextNsPtr is

 				  * NULL), and TCL_LEAVE_ERR_MSG. If both

 				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY

 				  * are given, TCL_GLOBAL_ONLY is

 				  * ignored. */

 {

     Interp *iPtr = (Interp*)interp;

     ResolverScheme *resPtr;

     Namespace *nsPtr[2], *cxtNsPtr;

     CONST 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.

      */

     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,

 	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

     /*

      * Look for the variable in the variable table of its namespace.

      * Be sure to check both possible search paths: from the specified

      * namespace context and from the global namespace.

      */

     varPtr = NULL;

     for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {

         if ((nsPtr[search] != NULL) && (simpleName != NULL)) {

             entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable,

 		    simpleName);

             if (entryPtr != NULL) {

                 varPtr = (Var *) Tcl_GetHashValue(entryPtr);

             }

         }

     }

     if (varPtr != NULL) {

 	return (Tcl_Var) varPtr;

     } else if (flags & TCL_LEAVE_ERR_MSG) {

 	Tcl_ResetResult(interp);

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "unknown variable \"", name, "\"", (char *) NULL);

     }

     return (Tcl_Var) NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclResetShadowedCmdRefs --

  *

  *	Called when a command is added to a namespace to check for existing

  *	command references that the new command may invalidate. Consider the

  *	following cases that could happen when you add a command "foo" to a

  *	namespace "b":

  *	   1. It could shadow a command named "foo" at the global scope.

  *	      If it does, all command references in the namespace "b" are

  *	      suspect.

  *	   2. Suppose the namespace "b" resides in a namespace "a".

  *	      Then to "a" the new command "b::foo" could shadow another

  *	      command "b::foo" in the global namespace. If so, then all

  *	      command references in "a" are suspect.

  *	The same checks are applied to all parent namespaces, until we

  *	reach the global :: namespace.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	If the new command shadows an existing command, the cmdRefEpoch

  *	counter is incremented in each namespace that sees the shadow.

  *	This invalidates all command references that were previously cached

  *	in that namespace. The next time the commands are used, they are

  *	resolved from scratch.

  *

  *----------------------------------------------------------------------

  */

 void

 TclResetShadowedCmdRefs(interp, newCmdPtr)

     Tcl_Interp *interp;	       /* Interpreter containing the new command. */

     Command *newCmdPtr;	       /* Points to the new command. */

 {

     char *cmdName;

     Tcl_HashEntry *hPtr;

     register Namespace *nsPtr;

     Namespace *trailNsPtr, *shadowNsPtr;

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

     int found, i;

     /*

      * This procedure generates an array used to hold the trail list. This

      * starts out with stack-allocated space but uses dynamically-allocated

      * storage if needed.

      */

     Namespace *(trailStorage[NUM_TRAIL_ELEMS]);

     Namespace **trailPtr = trailStorage;

     int trailFront = -1;

     int trailSize = NUM_TRAIL_ELEMS;

     /*

      * Start at the namespace containing the new command, and work up

      * through the list of parents. Stop just before the global namespace,

      * since the global namespace can't "shadow" its own entries.

      *

      * The namespace "trail" list we build consists of the names of each

      * namespace that encloses the new command, in order from outermost to

      * innermost: for example, "a" then "b". Each iteration of this loop

      * eventually extends the trail upwards by one namespace, nsPtr. We use

      * this trail list to see if nsPtr (e.g. "a" in 2. above) could have

      * now-invalid cached command references. This will happen if nsPtr

      * (e.g. "a") contains a sequence of child namespaces (e.g. "b")

      * such that there is a identically-named sequence of child namespaces

      * starting from :: (e.g. "::b") whose tail namespace contains a command

      * also named cmdName.

      */

     cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);

     for (nsPtr = newCmdPtr->nsPtr;

 	    (nsPtr != NULL) && (nsPtr != globalNsPtr);

             nsPtr = nsPtr->parentPtr) {

         /*

 	 * Find the maximal sequence of child namespaces contained in nsPtr

 	 * such that there is a identically-named sequence of child

 	 * namespaces starting from ::. shadowNsPtr will be the tail of this

 	 * sequence, or the deepest namespace under :: that might contain a

 	 * command now shadowed by cmdName. We check below if shadowNsPtr

 	 * actually contains a command cmdName.

 	 */

         found = 1;

         shadowNsPtr = globalNsPtr;

         for (i = trailFront;  i >= 0;  i--) {

             trailNsPtr = trailPtr[i];

             hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,

 		    trailNsPtr->name);

             if (hPtr != NULL) {

                 shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr);

             } else {

                 found = 0;

                 break;

             }

         }

         /*

 	 * If shadowNsPtr contains a command named cmdName, we invalidate

          * all of the command refs cached in nsPtr. As a boundary case,

 	 * shadowNsPtr is initially :: and we check for case 1. above.

 	 */

         if (found) {

             hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);

             if (hPtr != NULL) {

                 nsPtr->cmdRefEpoch++;

 		/* 

 		 * If the shadowed command was compiled to bytecodes, we

 		 * invalidate all the bytecodes in nsPtr, to force a new

 		 * compilation. We use the resolverEpoch to signal the need

 		 * for a fresh compilation of every bytecode.

 		 */

 		if ((((Command *) Tcl_GetHashValue(hPtr))->compileProc) != NULL) {

 		    nsPtr->resolverEpoch++;

 		}

             }

         }

         /*

 	 * Insert nsPtr at the front of the trail list: i.e., at the end

 	 * of the trailPtr array.

 	 */

 	trailFront++;

 	if (trailFront == trailSize) {

 	    size_t currBytes = trailSize * sizeof(Namespace *);

 	    int newSize = 2*trailSize;

 	    size_t newBytes = newSize * sizeof(Namespace *);

 	    Namespace **newPtr =

 		    (Namespace **) ckalloc((unsigned) newBytes);

 	    memcpy((VOID *) newPtr, (VOID *) trailPtr, currBytes);

 	    if (trailPtr != trailStorage) {

 		ckfree((char *) trailPtr);

 	    }

 	    trailPtr = newPtr;

 	    trailSize = newSize;

 	}

 	trailPtr[trailFront] = nsPtr;

     }

     /*

      * Free any allocated storage.

      */

     if (trailPtr != trailStorage) {

 	ckfree((char *) trailPtr);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * GetNamespaceFromObj --

  *

  *	Gets the namespace specified by the name in a Tcl_Obj.

  *

  * Results:

  *	Returns TCL_OK if the namespace was resolved successfully, and

  *	stores a pointer to the namespace in the location specified by

  *	nsPtrPtr. If the namespace can't be found, the procedure stores

  *	NULL in *nsPtrPtr and returns TCL_OK. If anything else goes wrong,

  *	this procedure returns TCL_ERROR.

  *

  * Side effects:

  *	May update the internal representation for the object, caching the

  *	namespace reference. The next time this procedure is called, the

  *	namespace value can be found quickly.

  *

  *	If anything goes wrong, an error message is left in the

  *	interpreter's result object.

  *

  *----------------------------------------------------------------------

  */

 static int

 GetNamespaceFromObj(interp, objPtr, nsPtrPtr)

     Tcl_Interp *interp;		/* The current interpreter. */

     Tcl_Obj *objPtr;		/* The object to be resolved as the name

 				 * of a namespace. */

     Tcl_Namespace **nsPtrPtr;	/* Result namespace pointer goes here. */

 {

     Interp *iPtr = (Interp *) interp;

     register ResolvedNsName *resNamePtr;

     register Namespace *nsPtr;

     Namespace *currNsPtr;

     CallFrame *savedFramePtr;

     int result = TCL_OK;

     char *name;

     /*

      * If the namespace name is fully qualified, do as if the lookup were

      * done from the global namespace; this helps avoid repeated lookups 

      * of fully qualified names. 

      */

     savedFramePtr = iPtr->varFramePtr;

     name = Tcl_GetString(objPtr);

     if ((*name++ == ':') && (*name == ':')) {

 	iPtr->varFramePtr = NULL;

     }

     currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

     /*

      * Get the internal representation, converting to a namespace type if

      * needed. The internal representation is a ResolvedNsName that points

      * to the actual namespace.

      */

     if (objPtr->typePtr != &tclNsNameType) {

         result = tclNsNameType.setFromAnyProc(interp, objPtr);

         if (result != TCL_OK) {

 	    goto done;

         }

     }

     resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;

     /*

      * Check the context namespace of the resolved symbol to make sure that

      * it is fresh. If not, then force another conversion to the namespace

      * type, to discard the old rep and create a new one. Note that we

      * verify that the namespace id of the cached namespace is the same as

      * the id when we cached it; this insures that the namespace wasn't

      * deleted and a new one created at the same address.

      */

     nsPtr = NULL;

     if ((resNamePtr != NULL)

 	    && (resNamePtr->refNsPtr == currNsPtr)

 	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {

         nsPtr = resNamePtr->nsPtr;

 	if (nsPtr->flags & NS_DEAD) {

 	    nsPtr = NULL;

 	}

     }

     if (nsPtr == NULL) {	/* try again */

         result = tclNsNameType.setFromAnyProc(interp, objPtr);

         if (result != TCL_OK) {

 	    goto done;

         }

         resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;

         if (resNamePtr != NULL) {

             nsPtr = resNamePtr->nsPtr;

             if (nsPtr->flags & NS_DEAD) {

                 nsPtr = NULL;

             }

         }

     }

     *nsPtrPtr = (Tcl_Namespace *) nsPtr;

     done:

     iPtr->varFramePtr = savedFramePtr;

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_NamespaceObjCmd --

  *

  *	Invoked to implement the "namespace" command that creates, deletes,

  *	or manipulates Tcl namespaces. Handles the following syntax:

  *

  *	    namespace children ?name? ?pattern?

  *	    namespace code arg

  *	    namespace current

  *	    namespace delete ?name name...?

  *	    namespace eval name arg ?arg...?

  *	    namespace exists name

  *	    namespace export ?-clear? ?pattern pattern...?

  *	    namespace forget ?pattern pattern...?

  *	    namespace import ?-force? ?pattern pattern...?

  *	    namespace inscope name arg ?arg...?

  *	    namespace origin name

  *	    namespace parent ?name?

  *	    namespace qualifiers string

  *	    namespace tail string

  *	    namespace which ?-command? ?-variable? name

  *

  * Results:

  *	Returns TCL_OK if the command is successful. Returns TCL_ERROR if

  *	anything goes wrong.

  *

  * Side effects:

  *	Based on the subcommand name (e.g., "import"), this procedure

  *	dispatches to a corresponding procedure NamespaceXXXCmd defined

  *	statically in this file. This procedure's side effects depend on

  *	whatever that subcommand procedure does. If there is an error, this

  *	procedure returns an error message in the interpreter's result

  *	object. Otherwise it may return a result in the interpreter's result

  *	object.

  *

  *----------------------------------------------------------------------

  */

 int

 Tcl_NamespaceObjCmd(clientData, interp, objc, objv)

     ClientData clientData;		/* Arbitrary value passed to cmd. */

     Tcl_Interp *interp;			/* Current interpreter. */

     register int objc;			/* Number of arguments. */

     register Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     static CONST char *subCmds[] = {

 	"children", "code", "current", "delete",

 	"eval", "exists", "export", "forget", "import",

 	"inscope", "origin", "parent", "qualifiers",

 	"tail", "which", (char *) NULL

     };

     enum NSSubCmdIdx {

 	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,

 	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,

 	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,

 	NSTailIdx, NSWhichIdx

     };

     int index, result;

     if (objc < 2) {

         Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");

         return TCL_ERROR;

     }

     /*

      * Return an index reflecting the particular subcommand.

      */

     result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds,

 	    "option", /*flags*/ 0, (int *) &index);

     if (result != TCL_OK) {

 	return result;

     }

     switch (index) {

         case NSChildrenIdx:

 	    result = NamespaceChildrenCmd(clientData, interp, objc, objv);

             break;

         case NSCodeIdx:

 	    result = NamespaceCodeCmd(clientData, interp, objc, objv);

             break;

         case NSCurrentIdx:

 	    result = NamespaceCurrentCmd(clientData, interp, objc, objv);

             break;

         case NSDeleteIdx:

 	    result = NamespaceDeleteCmd(clientData, interp, objc, objv);

             break;

         case NSEvalIdx:

 	    result = NamespaceEvalCmd(clientData, interp, objc, objv);

             break;

         case NSExistsIdx:

 	    result = NamespaceExistsCmd(clientData, interp, objc, objv);

             break;

         case NSExportIdx:

 	    result = NamespaceExportCmd(clientData, interp, objc, objv);

             break;

         case NSForgetIdx:

 	    result = NamespaceForgetCmd(clientData, interp, objc, objv);

             break;

         case NSImportIdx:

 	    result = NamespaceImportCmd(clientData, interp, objc, objv);

             break;

         case NSInscopeIdx:

 	    result = NamespaceInscopeCmd(clientData, interp, objc, objv);

             break;

         case NSOriginIdx:

 	    result = NamespaceOriginCmd(clientData, interp, objc, objv);

             break;

         case NSParentIdx:

 	    result = NamespaceParentCmd(clientData, interp, objc, objv);

             break;

         case NSQualifiersIdx:

 	    result = NamespaceQualifiersCmd(clientData, interp, objc, objv);

             break;

         case NSTailIdx:

 	    result = NamespaceTailCmd(clientData, interp, objc, objv);

             break;

         case NSWhichIdx:

 	    result = NamespaceWhichCmd(clientData, interp, objc, objv);

             break;

     }

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * NamespaceChildrenCmd --

  *

  *	Invoked to implement the "namespace children" command that returns a

  *	list containing the fully-qualified names of the child namespaces of

  *	a given namespace. Handles the following syntax:

  *

  *	    namespace children ?name? ?pattern?

  *

  * Results:

  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.

  *

  * Side effects:

  *	Returns a result in the interpreter's result object. If anything

  *	goes wrong, the result is an error message.

  *

  *----------------------------------------------------------------------

  */

 static int

 NamespaceChildrenCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     Tcl_Namespace *namespacePtr;

     Namespace *nsPtr, *childNsPtr;

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

     char *pattern = NULL;

     Tcl_DString buffer;

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     Tcl_Obj *listPtr, *elemPtr;

     /*

      * Get a pointer to the specified namespace, or the current namespace.

      */

     if (objc == 2) {

 	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

     } else if ((objc == 3) || (objc == 4)) {

         if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {

             return TCL_ERROR;

         }

         if (namespacePtr == NULL) {

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                     "unknown namespace \"", Tcl_GetString(objv[2]),

 		    "\" in namespace children command", (char *) NULL);

             return TCL_ERROR;

         }

         nsPtr = (Namespace *) namespacePtr;

     } else {

 	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");

         return TCL_ERROR;

     }