/[dtapublic]/projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclnamesp.c

Diff of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclnamesp.c

Parent Directory | Revision Log | View Patch Patch

-revision 66 by dashley,
Sun Oct 30 21:57:38 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * 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.1.1.1 2001/06/13 04:43:37 dtashley 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              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:
   *      The namespace object type is registered with the Tcl compiler.
   *
   *----------------------------------------------------------------------
   */
  void
  TclInitNamespaceSubsystem()
  {
      Tcl_RegisterObjType(&tclNsNameType);
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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;
      int saveErrFlag;
      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;
      /*
       * Delete the local variables. As a hack, we save then restore the
       * ERR_IN_PROGRESS flag in the interpreter. The problem is that there
       * could be unset traces on the variables, which cause scripts to be
       * evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack
       * trace information if the procedure was exiting with an error. The
       * code below preserves the flag. Unfortunately, that isn't really
       * enough: we really should preserve the errorInfo variable too
       * (otherwise a nested error in the trace script will trash errorInfo).
       * What's really needed is a general-purpose mechanism for saving and
       * restoring interpreter state.
       */
      saveErrFlag = (iPtr->flags & ERR_IN_PROGRESS);
      if (framePtr->varTablePtr != NULL) {
          TclDeleteVars(iPtr, framePtr->varTablePtr);
          ckfree((char *) framePtr->varTablePtr);
          framePtr->varTablePtr = NULL;
      }
      if (framePtr->numCompiledLocals > 0) {
          TclDeleteCompiledLocalVars(iPtr, framePtr);
      }
      iPtr->flags |= saveErrFlag;
      /*
       * 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. */
      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;
      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 {
          /*
           * 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.
           */
          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.
               */
              TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
              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;
              }
          }
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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, so be careful to preserve the
           * "errorInfo" and "errorCode" variables. These might be needed
           * later on if errors occur while deleting commands. We are careful
           * to destroy and recreate the "errorInfo" and "errorCode"
           * variables, in case they had any traces on them.
           */
          char *str, *errorInfoStr, *errorCodeStr;
          str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY);
          if (str != NULL) {
              errorInfoStr = ckalloc((unsigned) (strlen(str)+1));
              strcpy(errorInfoStr, str);
          } else {
              errorInfoStr = NULL;
          }
          str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY);
          if (str != NULL) {
              errorCodeStr = ckalloc((unsigned) (strlen(str)+1));
              strcpy(errorCodeStr, str);
          } else {
              errorCodeStr = NULL;
          }
          TclDeleteVars(iPtr, &nsPtr->varTable);
          Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
          if (errorInfoStr != NULL) {
              Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr,
                  TCL_GLOBAL_ONLY);
              ckfree(errorInfoStr);
          }
          if (errorCodeStr != NULL) {
              Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr,
                  TCL_GLOBAL_ONLY);
              ckfree(errorCodeStr);
          }
      } else {
          /*
           * Variable table should be cleared but not freed! TclDeleteVars
           * frees it, so we reinitialize it afterwards.
           */
          TclDeleteVars(iPtr, &nsPtr->varTable);
          Tcl_InitHashTable(&nsPtr->varTable, 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);
      }
      /*
       * 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);
      /*
       * 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. */
      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.
                                    * If 0, return an error if an imported
                                    * cmd conflicts with an existing one. */
  {
  #define INIT_EXPORT_PATTERNS 5
      Namespace *nsPtr, *exportNsPtr, *dummyPtr;
      Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      char *simplePattern, *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, &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. */
      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);
      char *simplePattern, *cmdName;
      register Tcl_HashEntry *hPtr;
      Tcl_HashSearch search;
      Command *cmdPtr, *realCmdPtr;
      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,
 , 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, &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.
               */
              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.
               */
              if ((Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == 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->real
                   * command references that also would destroy an existing
                   * "real" command already in the current namespace.
                   */
                  cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
                  if (cmdPtr->deleteProc == DeleteImportedCmd) {
                      realCmdPtr = (Command *) TclGetOriginalCommand(
                              (Tcl_Command) cmdPtr);
                      if ((realCmdPtr != NULL)
                              && (realCmdPtr->nsPtr == currNsPtr)
                              && (Tcl_FindHashEntry(&currNsPtr->cmdTable,
                                      cmdName) != NULL)) {
                          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                                  "import pattern \"", pattern,
                                  "\" would create a loop containing command \"",
                                  Tcl_DStringValue(&ds), "\"", (char *) NULL);
                          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;
                  /*
                   * 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 {
                  Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                          "can't import command \"", cmdName,
                          "\": already exists", (char *) NULL);
                  return TCL_ERROR;
              }
          }
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ForgetImport --
   *
   *      Deletes previously imported commands. Given a pattern that may
   *      include the name of an exporting namespace, this procedure first
   *      finds all matching exported commands. It then looks in the namespace
   *      specified by namespacePtr for any corresponding previously imported
   *      commands, which it deletes. If namespacePtr is NULL, commands are
   *      deleted from the current namespace.
   *
   * Results:
   *      Returns TCL_OK if successful. If there is an error, returns
   *      TCL_ERROR and puts an error message in the interpreter's result
   *      object.
   *
   * 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. */
      char *pattern;               /* String pattern indicating which imported
                                    * commands to remove. This pattern should
                                    * be qualified by the name of the
                                    * namespace from which the command(s) were
                                    * imported. */
  {
      Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr;
      char *simplePattern, *cmdName;
      register Tcl_HashEntry *hPtr;
      Tcl_HashSearch search;
      Command *cmdPtr;
      /*
       * If the specified namespace is NULL, use the current namespace.
       */
      if (namespacePtr == NULL) {
          nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      } else {
          nsPtr = (Namespace *) namespacePtr;
      }
      /*
       * From the pattern, find the namespace from which we are importing
       * and get the simple pattern (no namespace qualifiers or ::'s) at
       * the end.
       */
      TclGetNamespaceForQualName(interp, pattern, nsPtr,
              /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
              &actualCtxPtr, &simplePattern);
      if (importNsPtr == NULL) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "unknown namespace in namespace forget pattern \"",
                  pattern, "\"", (char *) NULL);
          return TCL_ERROR;
      }
      /*
       * Scan through the command table in the source namespace and look for
       * exported commands that match the string pattern. If the current
       * namespace has an imported command that refers to one of those real
       * commands, delete it.
       */
      for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
              (hPtr != NULL);
              hPtr = Tcl_NextHashEntry(&search)) {
          cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
          if (Tcl_StringMatch(cmdName, simplePattern)) {
              hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
              if (hPtr != NULL) { /* cmd of same name in current namespace */
                  cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
                  if (cmdPtr->deleteProc == DeleteImportedCmd) {
                      Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
                  }
              }
          }
      }
      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. */
      register 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 or
                                    * TCL_NAMESPACE_ONLY are 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. */
      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;
      register char *start, *end;
      char *nsName;
      Tcl_HashEntry *entryPtr;
      Tcl_DString buffer;
      int len;
      /*
       * Determine the context namespace nsPtr in which to start the primary
       * search. If TCL_NAMESPACE_ONLY or FIND_ONLY_NS was specified, search
       * from the current namespace. If the qualName name starts with a "::"
       * or TCL_GLOBAL_ONLY was specified, search from the global
       * namespace. Otherwise, use the given 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_NAMESPACE_ONLY | FIND_ONLY_NS)) {
          nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      } else 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. */
      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;
      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. */
      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;
      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. */
      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;
      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++;
              }
          }
          /*
           * 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. */
  {
      register ResolvedNsName *resNamePtr;
      register Namespace *nsPtr;
      Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      int result;
      /*
       * 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) {
              return TCL_ERROR;
          }
      }
      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) {
              return TCL_ERROR;
          }
          resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
          if (resNamePtr != NULL) {
              nsPtr = resNamePtr->nsPtr;
              if (nsPtr->flags & NS_DEAD) {
                  nsPtr = NULL;
              }
          }
      }
      *nsPtrPtr = (Tcl_Namespace *) nsPtr;
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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 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 char *subCmds[] = {
              "children", "code", "current", "delete",
              "eval", "export", "forget", "import",
              "inscope", "origin", "parent", "qualifiers",
              "tail", "which", (char *) NULL};
      enum NSSubCmdIdx {
              NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
              NSEvalIdx, 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 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;
      }
      /*
       * Get the glob-style pattern, if any, used to narrow the search.
       */
      Tcl_DStringInit(&buffer);
      if (objc == 4) {
          char *name = Tcl_GetString(objv[3]);
          if ((*name == ':') && (*(name+1) == ':')) {
              pattern = name;
          } else {
              Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
              if (nsPtr != globalNsPtr) {
                  Tcl_DStringAppend(&buffer, "::", 2);
              }
              Tcl_DStringAppend(&buffer, name, -1);
              pattern = Tcl_DStringValue(&buffer);
          }
      }
      /*
       * Create a list containing the full names of all child namespaces
       * whose names match the specified pattern, if any.
       */
      listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
      entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
      while (entryPtr != NULL) {
          childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
          if ((pattern == NULL)
                  || Tcl_StringMatch(childNsPtr->fullName, pattern)) {
              elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
              Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
          }
          entryPtr = Tcl_NextHashEntry(&search);
      }
      Tcl_SetObjResult(interp, listPtr);
      Tcl_DStringFree(&buffer);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceCodeCmd --
   *
   *      Invoked to implement the "namespace code" command to capture the
   *      namespace context of a command. Handles the following syntax:
   *
   *          namespace code arg
   *
   *      Here "arg" can be a list. "namespace code arg" produces a result
   *      equivalent to that produced by the command
   *
   *          list namespace inscope [namespace current] $arg
   *
   *      However, if "arg" is itself a scoped value starting with
   *      "namespace inscope", then the result is just "arg".
   *
   * Results:
   *      Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
   *
   * Side effects:
   *      If anything goes wrong, this procedure returns an error
   *      message as the result in the interpreter's result object.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceCodeCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      Namespace *currNsPtr;
      Tcl_Obj *listPtr, *objPtr;
      register char *arg, *p;
      int length;
      if (objc != 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "arg");
          return TCL_ERROR;
      }
      /*
       * If "arg" is already a scoped value, then return it directly.
       */
      arg = Tcl_GetStringFromObj(objv[2], &length);
      if ((*arg == 'n') && (length > 17)
              && (strncmp(arg, "namespace", 9) == 0)) {
          for (p = (arg + 9);  (*p == ' ');  p++) {
              /* empty body: skip over spaces */
          }
          if ((*p == 'i') && ((p + 7) <= (arg + length))
                  && (strncmp(p, "inscope", 7) == 0)) {
              Tcl_SetObjResult(interp, objv[2]);
              return TCL_OK;
          }
      }
      /*
       * Otherwise, construct a scoped command by building a list with
       * "namespace inscope", the full name of the current namespace, and
       * the argument "arg". By constructing a list, we ensure that scoped
       * commands are interpreted properly when they are executed later,
       * by the "namespace inscope" command.
       */
      listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
      Tcl_ListObjAppendElement(interp, listPtr,
              Tcl_NewStringObj("namespace", -1));
      Tcl_ListObjAppendElement(interp, listPtr,
              Tcl_NewStringObj("inscope", -1));
      currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
          objPtr = Tcl_NewStringObj("::", -1);
      } else {
          objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
      }
      Tcl_ListObjAppendElement(interp, listPtr, objPtr);
      Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
      Tcl_SetObjResult(interp, listPtr);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceCurrentCmd --
   *
   *      Invoked to implement the "namespace current" command which returns
   *      the fully-qualified name of the current namespace. Handles the
   *      following syntax:
   *
   *          namespace current
   *
   * 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
  NamespaceCurrentCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      register Namespace *currNsPtr;
      if (objc != 2) {
          Tcl_WrongNumArgs(interp, 2, objv, NULL);
          return TCL_ERROR;
      }
      /*
       * The "real" name of the global namespace ("::") is the null string,
       * but we return "::" for it as a convenience to programmers. Note that
       * "" and "::" are treated as synonyms by the namespace code so that it
       * is still easy to do things like:
       *
       *    namespace [namespace current]::bar { ... }
       */
      currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
      if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
          Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
      } else {
          Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceDeleteCmd --
   *
   *      Invoked to implement the "namespace delete" command to delete
   *      namespace(s). Handles the following syntax:
   *
   *          namespace delete ?name name...?
   *
   *      Each name identifies a namespace. It may include a sequence of
   *      namespace qualifiers separated by "::"s. If a namespace is found, it
   *      is deleted: all variables and procedures contained in that namespace
   *      are deleted. If that namespace is being used on the call stack, it
   *      is kept alive (but logically deleted) until it is removed from the
   *      call stack: that is, it can no longer be referenced by name but any
   *      currently executing procedure that refers to it is allowed to do so
   *      until the procedure returns. If the namespace can't be found, this
   *      procedure returns an error. If no namespaces are specified, this
   *      command does nothing.
   *
   * Results:
   *      Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
   *
   * Side effects:
   *      Deletes the specified namespaces. If anything goes wrong, this
   *      procedure returns an error message in the interpreter's
   *      result object.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceDeleteCmd(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;
      char *name;
      register int i;
      if (objc < 2) {
          Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
          return TCL_ERROR;
      }
      /*
       * Destroying one namespace may cause another to be destroyed. Break
       * this into two passes: first check to make sure that all namespaces on
       * the command line are valid, and report any errors.
       */
      for (i = 2;  i < objc;  i++) {
          name = Tcl_GetString(objv[i]);
          namespacePtr = Tcl_FindNamespace(interp, name,
                  (Tcl_Namespace *) NULL, /*flags*/ 0);
          if (namespacePtr == NULL) {
              Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                      "unknown namespace \"", Tcl_GetString(objv[i]),
                      "\" in namespace delete command", (char *) NULL);
              return TCL_ERROR;
          }
      }
      /*
       * Okay, now delete each namespace.
       */
      for (i = 2;  i < objc;  i++) {
          name = Tcl_GetString(objv[i]);
          namespacePtr = Tcl_FindNamespace(interp, name,
              (Tcl_Namespace *) NULL, /* flags */ 0);
          if (namespacePtr) {
              Tcl_DeleteNamespace(namespacePtr);
          }
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceEvalCmd --
   *
   *      Invoked to implement the "namespace eval" command. Executes
   *      commands in a namespace. If the namespace does not already exist,
   *      it is created. Handles the following syntax:
   *
   *          namespace eval name arg ?arg...?
   *
   *      If more than one arg argument is specified, the command that is
   *      executed is the result of concatenating the arguments together with
   *      a space between each argument.
   *
   * Results:
   *      Returns TCL_OK if the namespace is found and the commands are
   *      executed successfully. Returns TCL_ERROR if anything goes wrong.
   *
   * Side effects:
   *      Returns the result of the command in the interpreter's result
   *      object. If anything goes wrong, this procedure returns an error
   *      message as the result.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceEvalCmd(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;
      Tcl_CallFrame frame;
      Tcl_Obj *objPtr;
      char *name;
      int length, result;
      if (objc < 4) {
          Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
          return TCL_ERROR;
      }
      /*
       * Try to resolve the namespace reference, caching the result in the
       * namespace object along the way.
       */
      result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
      if (result != TCL_OK) {
          return result;
      }
      /*
       * If the namespace wasn't found, try to create it.
       */
      if (namespacePtr == NULL) {
          name = Tcl_GetStringFromObj(objv[2], &length);
          namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL,
                  (Tcl_NamespaceDeleteProc *) NULL);
          if (namespacePtr == NULL) {
              return TCL_ERROR;
          }
      }
      /*
       * Make the specified namespace the current namespace and evaluate
       * the command(s).
       */
      result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
              /*isProcCallFrame*/ 0);
      if (result != TCL_OK) {
          return TCL_ERROR;
      }
      if (objc == 4) {
          result = Tcl_EvalObjEx(interp, objv[3], 0);
      } else {
          /*
           * More than one argument: concatenate them together with spaces
           * between, then evaluate the result.  Tcl_EvalObjEx will delete
           * the object when it decrements its refcount after eval'ing it.
           */
          objPtr = Tcl_ConcatObj(objc-3, objv+3);
          result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
      }
      if (result == TCL_ERROR) {
          char msg[256 + TCL_INTEGER_SPACE];
          sprintf(msg, "\n    (in namespace eval \"%.200s\" script line %d)",
              namespacePtr->fullName, interp->errorLine);
          Tcl_AddObjErrorInfo(interp, msg, -1);
      }
      /*
       * Restore the previous "current" namespace.
       */
      Tcl_PopCallFrame(interp);
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceExportCmd --
   *
   *      Invoked to implement the "namespace export" command that specifies
   *      which commands are exported from a namespace. The exported commands
   *      are those that can be imported into another namespace using
   *      "namespace import". Both commands defined in a namespace and
   *      commands the namespace has imported can be exported by a
   *      namespace. This command has the following syntax:
   *
   *          namespace export ?-clear? ?pattern pattern...?
   *
   *      Each pattern may contain "string match"-style pattern matching
   *      special characters, but the pattern may not include any namespace
   *      qualifiers: that is, the pattern must specify commands in the
   *      current (exporting) namespace. The specified patterns are appended
   *      onto the namespace's list of export patterns.
   *
   *      To reset the namespace's export pattern list, specify the "-clear"
   *      flag.
   *
   *      If there are no export patterns and the "-clear" flag isn't given,
   *      this command returns the namespace's current export list.
   *
   * 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
  NamespaceExportCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
      char *pattern, *string;
      int resetListFirst = 0;
      int firstArg, patternCt, i, result;
      if (objc < 2) {
          Tcl_WrongNumArgs(interp, 2, objv,
                  "?-clear? ?pattern pattern...?");
          return TCL_ERROR;
      }
      /*
       * Process the optional "-clear" argument.
       */
      firstArg = 2;
      if (firstArg < objc) {
          string = Tcl_GetString(objv[firstArg]);
          if (strcmp(string, "-clear") == 0) {
              resetListFirst = 1;
              firstArg++;
          }
      }
      /*
       * If no pattern arguments are given, and "-clear" isn't specified,
       * return the namespace's current export pattern list.
       */
      patternCt = (objc - firstArg);
      if (patternCt == 0) {
          if (firstArg > 2) {
              return TCL_OK;
          } else {                /* create list with export patterns */
              Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
              result = Tcl_AppendExportList(interp,
                      (Tcl_Namespace *) currNsPtr, listPtr);
              if (result != TCL_OK) {
                  return result;
              }
              Tcl_SetObjResult(interp, listPtr);
              return TCL_OK;
          }
      }
      /*
       * Add each pattern to the namespace's export pattern list.
       */
      for (i = firstArg;  i < objc;  i++) {
          pattern = Tcl_GetString(objv[i]);
          result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
                  ((i == firstArg)? resetListFirst : 0));
          if (result != TCL_OK) {
              return result;
          }
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceForgetCmd --
   *
   *      Invoked to implement the "namespace forget" command to remove
   *      imported commands from a namespace. Handles the following syntax:
   *
   *          namespace forget ?pattern pattern...?
   *
   *      Each pattern is a name like "foo::*" or "a::b::x*". That is, the
   *      pattern may include the special pattern matching characters
   *      recognized by the "string match" command, but only in the command
   *      name at the end of the qualified name; the special pattern
   *      characters may not appear in a namespace name. All of the commands
   *      that match that pattern are checked to see if they have an imported
   *      command in the current namespace that refers to the matched
   *      command. If there is an alias, it is removed.
   *
   * Results:
   *      Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
   *
   * Side effects:
   *      Imported commands are removed from the current namespace. If
   *      anything goes wrong, this procedure returns an error message in the
   *      interpreter's result object.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceForgetCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      char *pattern;
      register int i, result;
      if (objc < 2) {
          Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
          return TCL_ERROR;
      }
      for (i = 2;  i < objc;  i++) {
          pattern = Tcl_GetString(objv[i]);
          result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
          if (result != TCL_OK) {
              return result;
          }
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceImportCmd --
   *
   *      Invoked to implement the "namespace import" command that imports
   *      commands into a namespace. Handles the following syntax:
   *
   *          namespace import ?-force? ?pattern pattern...?
   *
   *      Each pattern is a namespace-qualified name like "foo::*",
   *      "a::b::x*", or "bar::p". That is, the pattern may include the
   *      special pattern matching characters recognized by the "string match"
   *      command, but only in the command name at the end of the qualified
   *      name; the special pattern characters may not appear in a namespace
   *      name. All of the commands that match the pattern and which are
   *      exported from their namespace are made accessible from the current
   *      namespace context. This is done by creating a new "imported command"
   *      in the current namespace that points to the real command in its
   *      original namespace; when the imported command is called, it invokes
   *      the real command.
   *
   *      If an imported command conflicts with an existing command, it is
   *      treated as an error. But if the "-force" option is included, then
   *      existing commands are overwritten by the imported commands.
   *
   * Results:
   *      Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
   *
   * Side effects:
   *      Adds imported commands to the current namespace. If anything goes
   *      wrong, this procedure returns an error message in the interpreter's
   *      result object.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceImportCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      int allowOverwrite = 0;
      char *string, *pattern;
      register int i, result;
      int firstArg;
      if (objc < 2) {
          Tcl_WrongNumArgs(interp, 2, objv,
                  "?-force? ?pattern pattern...?");
          return TCL_ERROR;
      }
      /*
       * Skip over the optional "-force" as the first argument.
       */
      firstArg = 2;
      if (firstArg < objc) {
          string = Tcl_GetString(objv[firstArg]);
          if ((*string == '-') && (strcmp(string, "-force") == 0)) {
              allowOverwrite = 1;
              firstArg++;
          }
      }
      /*
       * Handle the imports for each of the patterns.
       */
      for (i = firstArg;  i < objc;  i++) {
          pattern = Tcl_GetString(objv[i]);
          result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
                  allowOverwrite);
          if (result != TCL_OK) {
              return result;
          }
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceInscopeCmd --
   *
   *      Invoked to implement the "namespace inscope" command that executes a
   *      script in the context of a particular namespace. This command is not
   *      expected to be used directly by programmers; calls to it are
   *      generated implicitly when programs use "namespace code" commands
   *      to register callback scripts. Handles the following syntax:
   *
   *          namespace inscope name arg ?arg...?
   *
   *      The "namespace inscope" command is much like the "namespace eval"
   *      command except that it has lappend semantics and the namespace must
   *      already exist. It treats the first argument as a list, and appends
   *      any arguments after the first onto the end as proper list elements.
   *      For example,
   *
   *          namespace inscope ::foo a b c d
   *
   *      is equivalent to
   *
   *          namespace eval ::foo [concat a [list b c d]]
   *
   *      This lappend semantics is important because many callback scripts
   *      are actually prefixes.
   *
   * Results:
   *      Returns TCL_OK to indicate success, or TCL_ERROR to indicate
   *      failure.
   *
   * Side effects:
   *      Returns a result in the Tcl interpreter's result object.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceInscopeCmd(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;
      Tcl_CallFrame frame;
      int i, result;
      if (objc < 4) {
          Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
          return TCL_ERROR;
      }
      /*
       * Resolve the namespace reference.
       */
      result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
      if (result != TCL_OK) {
          return result;
      }
      if (namespacePtr == NULL) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "unknown namespace \"", Tcl_GetString(objv[2]),
                  "\" in inscope namespace command", (char *) NULL);
          return TCL_ERROR;
      }
      /*
       * Make the specified namespace the current namespace.
       */
      result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
              /*isProcCallFrame*/ 0);
      if (result != TCL_OK) {
          return result;
      }
      /*
       * Execute the command. If there is just one argument, just treat it as
       * a script and evaluate it. Otherwise, create a list from the arguments
       * after the first one, then concatenate the first argument and the list
       * of extra arguments to form the command to evaluate.
       */
      if (objc == 4) {
          result = Tcl_EvalObjEx(interp, objv[3], 0);
      } else {
          Tcl_Obj *concatObjv[2];
          register Tcl_Obj *listPtr, *cmdObjPtr;
          listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
          for (i = 4;  i < objc;  i++) {
              result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
              if (result != TCL_OK) {
                  Tcl_DecrRefCount(listPtr); /* free unneeded obj */
                  return result;
              }
          }
          concatObjv[0] = objv[3];
          concatObjv[1] = listPtr;
          cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
          result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
          Tcl_DecrRefCount(listPtr);    /* we're done with the list object */
      }
      if (result == TCL_ERROR) {
          char msg[256 + TCL_INTEGER_SPACE];
          sprintf(msg,
              "\n    (in namespace inscope \"%.200s\" script line %d)",
              namespacePtr->fullName, interp->errorLine);
          Tcl_AddObjErrorInfo(interp, msg, -1);
      }
      /*
       * Restore the previous "current" namespace.
       */
      Tcl_PopCallFrame(interp);
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceOriginCmd --
   *
   *      Invoked to implement the "namespace origin" command to return the
   *      fully-qualified name of the "real" command to which the specified
   *      "imported command" refers. Handles the following syntax:
   *
   *          namespace origin name
   *
   * Results:
   *      An imported command is created in an namespace when that namespace
   *      imports a command from another namespace. If a command is imported
   *      into a sequence of namespaces a, b,...,n where each successive
   *      namespace just imports the command from the previous namespace, this
   *      command returns the fully-qualified name of the original command in
   *      the first namespace, a. If "name" does not refer to an alias, its
   *      fully-qualified name is returned. The returned name is stored in the
   *      interpreter's result object. This procedure returns TCL_OK if
   *      successful, and TCL_ERROR if anything goes wrong.
   *
   * Side effects:
   *      If anything goes wrong, this procedure returns an error message in
   *      the interpreter's result object.
   *
   *----------------------------------------------------------------------
   */
  static int
  NamespaceOriginCmd(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_Command command, origCommand;
      if (objc != 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "name");
          return TCL_ERROR;
      }
      command = Tcl_GetCommandFromObj(interp, objv[2]);
      if (command == (Tcl_Command) NULL) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "invalid command name \"", Tcl_GetString(objv[2]),
                  "\"", (char *) NULL);
          return TCL_ERROR;
      }
      origCommand = TclGetOriginalCommand(command);
      if (origCommand == (Tcl_Command) NULL) {
          /*
           * The specified command isn't an imported command. Return the
           * command's name qualified by the full name of the namespace it
           * was defined in.
           */
          Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
      } else {
          Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceParentCmd --
   *
   *      Invoked to implement the "namespace parent" command that returns the
   *      fully-qualified name of the parent namespace for a specified
   *      namespace. Handles the following syntax:
   *
   *          namespace parent ?name?
   *
   * 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
  NamespaceParentCmd(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 *nsPtr;
      int result;
      if (objc == 2) {
          nsPtr = Tcl_GetCurrentNamespace(interp);
      } else if (objc == 3) {
          result = GetNamespaceFromObj(interp, objv[2], &nsPtr);
          if (result != TCL_OK) {
              return result;
          }
          if (nsPtr == NULL) {
              Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                      "unknown namespace \"", Tcl_GetString(objv[2]),
                      "\" in namespace parent command", (char *) NULL);
              return TCL_ERROR;
          }
      } else {
          Tcl_WrongNumArgs(interp, 2, objv, "?name?");
          return TCL_ERROR;
      }
      /*
       * Report the parent of the specified namespace.
       */
      if (nsPtr->parentPtr != NULL) {
          Tcl_SetStringObj(Tcl_GetObjResult(interp),
                  nsPtr->parentPtr->fullName, -1);
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceQualifiersCmd --
   *
   *      Invoked to implement the "namespace qualifiers" command that returns
   *      any leading namespace qualifiers in a string. These qualifiers are
   *      namespace names separated by "::"s. For example, for "::foo::p" this
   *      command returns "::foo", and for "::" it returns "". This command
   *      is the complement of the "namespace tail" command. Note that this
   *      command does not check whether the "namespace" names are, in fact,
   *      the names of currently defined namespaces. Handles the following
   *      syntax:
   *
   *          namespace qualifiers string
   *
   * 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
  NamespaceQualifiersCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      register char *name, *p;
      int length;
      if (objc != 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "string");
          return TCL_ERROR;
      }
      /*
       * Find the end of the string, then work backward and find
       * the start of the last "::" qualifier.
       */
      name = Tcl_GetString(objv[2]);
      for (p = name;  *p != '\0';  p++) {
          /* empty body */
      }
      while (--p >= name) {
          if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
              p -= 2;             /* back up over the :: */
              while ((p >= name) && (*p == ':')) {
                  p--;            /* back up over the preceeding : */
              }
              break;
          }
      }
      if (p >= name) {
          length = p-name+1;
          Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceTailCmd --
   *
   *      Invoked to implement the "namespace tail" command that returns the
   *      trailing name at the end of a string with "::" namespace
   *      qualifiers. These qualifiers are namespace names separated by
   *      "::"s. For example, for "::foo::p" this command returns "p", and for
   *      "::" it returns "". This command is the complement of the "namespace
   *      qualifiers" command. Note that this command does not check whether
   *      the "namespace" names are, in fact, the names of currently defined
   *      namespaces. Handles the following syntax:
   *
   *          namespace tail string
   *
   * 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
  NamespaceTailCmd(dummy, interp, objc, objv)
      ClientData dummy;           /* Not used. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int objc;                   /* Number of arguments. */
      Tcl_Obj *CONST objv[];      /* Argument objects. */
  {
      register char *name, *p;
      if (objc != 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "string");
          return TCL_ERROR;
      }
      /*
       * Find the end of the string, then work backward and find the
       * last "::" qualifier.
       */
      name = Tcl_GetString(objv[2]);
      for (p = name;  *p != '\0';  p++) {
          /* empty body */
      }
      while (--p > name) {
          if ((*p == ':') && (*(p-1) == ':')) {
              p++;                /* just after the last "::" */
              break;
          }
      }
      if (p >= name) {
          Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * NamespaceWhichCmd --
   *
   *      Invoked to implement the "namespace which" command that returns the
   *      fully-qualified name of a command or variable. If the specified
   *      command or variable does not exist, it returns "". Handles the
   *      following syntax:
   *
   *          namespace which ?-command? ?-variable? name
   *
   * 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
  NamespaceWhichCmd(dummy, interp, objc, objv)
      ClientData dummy;                   /* Not used. */
      Tcl_Interp *interp;                 /* Current interpreter. */
      int objc;                           /* Number of arguments. */
      Tcl_Obj *CONST objv[];              /* Argument objects. */
  {
      register char *arg;
      Tcl_Command cmd;
      Tcl_Var variable;
      int argIndex, lookup;
      if (objc < 3) {
          badArgs:
          Tcl_WrongNumArgs(interp, 2, objv,
                  "?-command? ?-variable? name");
          return TCL_ERROR;
      }
      /*
       * Look for a flag controlling the lookup.
       */
      argIndex = 2;
      lookup = 0;                 /* assume command lookup by default */
      arg = Tcl_GetString(objv[2]);
      if (*arg == '-') {
          if (strncmp(arg, "-command", 8) == 0) {
              lookup = 0;
          } else if (strncmp(arg, "-variable", 9) == 0) {
              lookup = 1;
          } else {
              goto badArgs;
          }
          argIndex = 3;
      }
      if (objc != (argIndex + 1)) {
          goto badArgs;
      }
      switch (lookup) {
      case 0:                     /* -command */
          cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
          if (cmd == (Tcl_Command) NULL) {
              return TCL_OK;      /* cmd not found, just return (no error) */
          }
          Tcl_GetCommandFullName(interp, cmd, Tcl_GetObjResult(interp));
          break;
      case 1:                     /* -variable */
          arg = Tcl_GetString(objv[argIndex]);
          variable = Tcl_FindNamespaceVar(interp, arg, (Tcl_Namespace *) NULL,
                  /*flags*/ 0);
          if (variable != (Tcl_Var) NULL) {
              Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
          }
          break;
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * FreeNsNameInternalRep --
   *
   *      Frees the resources associated with a nsName object's internal
   *      representation.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Decrements the ref count of any Namespace structure pointed
   *      to by the nsName's internal representation. If there are no more
   *      references to the namespace, it's structure will be freed.
   *
   *----------------------------------------------------------------------
   */
  static void
  FreeNsNameInternalRep(objPtr)
      register Tcl_Obj *objPtr;   /* nsName object with internal
                                   * representation to free */
  {
      register ResolvedNsName *resNamePtr =
          (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
      Namespace *nsPtr;
      /*
       * Decrement the reference count of the namespace. If there are no
       * more references, free it up.
       */
      if (resNamePtr != NULL) {
          resNamePtr->refCount--;
          if (resNamePtr->refCount == 0) {
              /*
               * Decrement the reference count for the cached namespace.  If
               * the namespace is dead, and there are no more references to
               * it, free it.
               */
              nsPtr = resNamePtr->nsPtr;
              nsPtr->refCount--;
              if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
                  NamespaceFree(nsPtr);
              }
              ckfree((char *) resNamePtr);
          }
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * DupNsNameInternalRep --
   *
   *      Initializes the internal representation of a nsName object to a copy
   *      of the internal representation of another nsName object.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      copyPtr's internal rep is set to refer to the same namespace
   *      referenced by srcPtr's internal rep. Increments the ref count of
   *      the ResolvedNsName structure used to hold the namespace reference.
   *
   *----------------------------------------------------------------------
   */
  static void
  DupNsNameInternalRep(srcPtr, copyPtr)
      Tcl_Obj *srcPtr;                /* Object with internal rep to copy. */
      register Tcl_Obj *copyPtr;      /* Object with internal rep to set. */
  {
      register ResolvedNsName *resNamePtr =
          (ResolvedNsName *) srcPtr->internalRep.otherValuePtr;
      copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
      if (resNamePtr != NULL) {
          resNamePtr->refCount++;
      }
      copyPtr->typePtr = &tclNsNameType;
  }
  /*
   *----------------------------------------------------------------------
   *
   * SetNsNameFromAny --
   *
   *      Attempt to generate a nsName internal representation for a
   *      Tcl object.
   *
   * Results:
   *      Returns TCL_OK if the value could be converted to a proper
   *      namespace reference. Otherwise, it returns TCL_ERROR, along
   *      with an error message in the interpreter's result object.
   *
   * Side effects:
   *      If successful, the object is made a nsName object. Its internal rep
   *      is set to point to a ResolvedNsName, which contains a cached pointer
   *      to the Namespace. Reference counts are kept on both the
   *      ResolvedNsName and the Namespace, so we can keep track of their
   *      usage and free them when appropriate.
   *
   *----------------------------------------------------------------------
   */
  static int
  SetNsNameFromAny(interp, objPtr)
      Tcl_Interp *interp;         /* Points to the namespace in which to
                                   * resolve name. Also used for error
                                   * reporting if not NULL. */
      register Tcl_Obj *objPtr;   /* The object to convert. */
  {
      register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
      char *name, *dummy;
      Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
      register ResolvedNsName *resNamePtr;
      /*
       * Get the string representation. Make it up-to-date if necessary.
       */
      name = objPtr->bytes;
      if (name == NULL) {
          name = Tcl_GetString(objPtr);
      }
      /*
       * Look for the namespace "name" in the current namespace. If there is
       * an error parsing the (possibly qualified) name, return an error.
       * If the namespace isn't found, we convert the object to an nsName
       * object with a NULL ResolvedNsName* internal rep.
       */
      TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
              FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
      /*
       * If we found a namespace, then create a new ResolvedNsName structure
       * that holds a reference to it.
       */
      if (nsPtr != NULL) {
          Namespace *currNsPtr =
                  (Namespace *) Tcl_GetCurrentNamespace(interp);
          nsPtr->refCount++;
          resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
          resNamePtr->nsPtr = nsPtr;
          resNamePtr->nsId = nsPtr->nsId;
          resNamePtr->refNsPtr = currNsPtr;
          resNamePtr->refCount = 1;
      } else {
          resNamePtr = NULL;
      }
      /*
       * Free the old internalRep before setting the new one.
       * We do this as late as possible to allow the conversion code
       * (in particular, Tcl_GetStringFromObj) to use that old internalRep.
       */
      if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
          oldTypePtr->freeIntRepProc(objPtr);
      }
      objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
      objPtr->typePtr = &tclNsNameType;
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * UpdateStringOfNsName --
   *
   *      Updates the string representation for a nsName object.
   *      Note: This procedure does not free an existing old string rep
   *      so storage will be lost if this has not already been done.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      The object's string is set to a copy of the fully qualified
   *      namespace name.
   *
   *----------------------------------------------------------------------
   */
  static void
  UpdateStringOfNsName(objPtr)
      register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
  {
      ResolvedNsName *resNamePtr =
          (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
      register Namespace *nsPtr;
      char *name = "";
      int length;
      if ((resNamePtr != NULL)
              && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
          nsPtr = resNamePtr->nsPtr;
          if (nsPtr->flags & NS_DEAD) {
              nsPtr = NULL;
          }
          if (nsPtr != NULL) {
              name = nsPtr->fullName;
          }
      }
      /*
       * The following sets the string rep to an empty string on the heap
       * if the internal rep is NULL.
       */
      length = strlen(name);
      if (length == 0) {
          objPtr->bytes = tclEmptyStringRep;
      } else {
          objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
          memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
          objPtr->bytes[length] = '\0';
      }
      objPtr->length = length;
  }
  /* End of tclnamesp.c */

 Legend:



Removed from v.66
 


changed lines


 
Added in v.71
 Legend:



Removed from v.66
 


changed lines


 
Added in v.71
-Removed from v.66
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25