diff options
author | stanton <stanton> | 1998-09-24 23:58:14 (GMT) |
---|---|---|
committer | stanton <stanton> | 1998-09-24 23:58:14 (GMT) |
commit | 9995355714bc90faf7c2e345b3d6a1d041447097 (patch) | |
tree | 2ad97c5b1994495118cef4df947cf16b55e326f2 /generic/tclNamesp.c | |
parent | e13392595faf8e8d0d1c3c514ce160cfadc3d372 (diff) | |
download | tcl-9995355714bc90faf7c2e345b3d6a1d041447097.zip tcl-9995355714bc90faf7c2e345b3d6a1d041447097.tar.gz tcl-9995355714bc90faf7c2e345b3d6a1d041447097.tar.bz2 |
merging changes from 8.0.3 into 8.1a2
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 178 |
1 files changed, 151 insertions, 27 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index e159f98..af1b8a9 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -9,6 +9,7 @@ * * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * Originally implemented by * Michael J. McLennan @@ -18,7 +19,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: @(#) tclNamesp.c 1.38 98/02/04 16:21:40 + * RCS: @(#) $Id: tclNamesp.c,v 1.1.2.2 1998/09/24 23:58:57 stanton Exp $ */ #include "tclInt.h" @@ -33,27 +34,19 @@ #define FIND_ONLY_NS 0x1000 /* - * Count of the number of namespaces created. This value is used as a - * unique id for each namespace. + * Initial size of stack allocated space for tail list - used when resetting + * shadowed command references in the functin: TclResetShadowedCmdRefs. */ -static long numNsCreated = 0; -static Tcl_Mutex nsMutex; +#define NUM_TRAIL_ELEMS 5 /* - * Data structure used as the ClientData of imported commands: commands - * created in an namespace when it imports a "real" command from another - * namespace. + * Count of the number of namespaces created. This value is used as a + * unique id for each namespace. */ -typedef struct ImportedCmdData { - Command *realCmdPtr; /* "Real" command that this imported command - * refers to. */ - Command *selfPtr; /* Pointer to this imported command. Needed - * only when deleting it in order to remove - * it from the real command's linked list of - * imported commands that refer to it. */ -} ImportedCmdData; +static long numNsCreated = 0; +static Tcl_Mutex nsMutex; /* * This structure contains a cached pointer to a namespace that is the @@ -538,7 +531,11 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc) nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; - nsPtr->cmdRefEpoch = 0; + nsPtr->cmdRefEpoch = 0; + nsPtr->resolverEpoch = 0; + nsPtr->cmdResProc = NULL; + nsPtr->varResProc = NULL; + nsPtr->compiledVarResProc = NULL; if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName, @@ -876,6 +873,7 @@ NamespaceFree(nsPtr) ckfree((char *) nsPtr); } + /* *---------------------------------------------------------------------- @@ -1072,6 +1070,10 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr) * is NULL). This is done by creating a new command (the "imported * command") that points to the real command in its original namespace. * + * If matching commands are on the autoload path but haven't been + * loaded yet, this command forces them to be loaded, then creates + * the links to them. + * * Results: * Returns TCL_OK if successful, or TCL_ERROR (along with an error * message in the interpreter's result) if something goes wrong. @@ -1107,7 +1109,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite) Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; ImportRef *refPtr; - Tcl_Command importedCmd; + Tcl_Command autoCmd, importedCmd; ImportedCmdData *dataPtr; int wasExported, i, result; @@ -1120,6 +1122,38 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite) } else { nsPtr = (Namespace *) namespacePtr; } + + /* + * First, invoke the "auto_import" command with the pattern + * being imported. This command is part of the Tcl library. + * It looks for imported commands in autoloaded libraries and + * loads them in. That way, they will be found when we try + * to create links below. + */ + + autoCmd = Tcl_FindCommand(interp, "auto_import", + (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); + + if (autoCmd != NULL) { + Tcl_Obj *objv[2]; + + objv[0] = Tcl_NewStringObj("auto_import", -1); + Tcl_IncrRefCount(objv[0]); + objv[1] = Tcl_NewStringObj(pattern, -1); + Tcl_IncrRefCount(objv[1]); + + cmdPtr = (Command *) autoCmd; + result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, + 2, objv); + + Tcl_DecrRefCount(objv[0]); + Tcl_DecrRefCount(objv[1]); + + if (result != TCL_OK) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); + } /* * From the pattern, find the namespace from which we are importing @@ -1204,8 +1238,8 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite) Tcl_DString ds; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, currNsPtr->fullName, -1); - if (currNsPtr != iPtr->globalNsPtr) { + Tcl_DStringAppend(&ds, nsPtr->fullName, -1); + if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, "::", 2); } Tcl_DStringAppend(&ds, cmdName, -1); @@ -1808,7 +1842,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, && (nsPtr != globalNsPtr)) { nsPtr = NULL; } - + *nsPtrPtr = nsPtr; *altNsPtrPtr = altNsPtr; Tcl_DStringFree(&buffer); @@ -1919,12 +1953,59 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) * are given, TCL_GLOBAL_ONLY is * ignored. */ { + Interp *iPtr = (Interp*)interp; + + ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; char *simpleName; register Tcl_HashEntry *entryPtr; register Command *cmdPtr; register int search; int result; + Tcl_Command cmd; + + /* + * If this namespace has a command resolver, then give it first + * crack at the command resolution. If the interpreter has any + * command resolvers, consult them next. The command resolver + * procedures may return a Tcl_Command value, they may signal + * to continue onward, or they may signal an error. + */ + if ((flags & TCL_GLOBAL_ONLY) != 0) { + cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + } + else if (contextNsPtr != NULL) { + cxtNsPtr = (Namespace *) contextNsPtr; + } + else { + cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + } + + if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) { + resPtr = iPtr->resolverPtr; + + if (cxtNsPtr->cmdResProc) { + result = (*cxtNsPtr->cmdResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &cmd); + } else { + result = TCL_CONTINUE; + } + + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->cmdResProc) { + result = (*resPtr->cmdResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &cmd); + } + resPtr = resPtr->nextPtr; + } + + if (result == TCL_OK) { + return cmd; + } + else if (result != TCL_CONTINUE) { + return (Tcl_Command) NULL; + } + } /* * Find the namespace(s) that contain the command. @@ -1960,6 +2041,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown command \"", name, "\"", (char *) NULL); } + return (Tcl_Command) NULL; } @@ -2007,12 +2089,57 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags) * are given, TCL_GLOBAL_ONLY is * ignored. */ { + Interp *iPtr = (Interp*)interp; + ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; char *simpleName; Tcl_HashEntry *entryPtr; Var *varPtr; register int search; int result; + Tcl_Var var; + + /* + * If this namespace has a variable resolver, then give it first + * crack at the variable resolution. It may return a Tcl_Var + * value, it may signal to continue onward, or it may signal + * an error. + */ + if ((flags & TCL_GLOBAL_ONLY) != 0) { + cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + } + else if (contextNsPtr != NULL) { + cxtNsPtr = (Namespace *) contextNsPtr; + } + else { + cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + } + + if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + resPtr = iPtr->resolverPtr; + + if (cxtNsPtr->varResProc) { + result = (*cxtNsPtr->varResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &var); + } else { + result = TCL_CONTINUE; + } + + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->varResProc) { + result = (*resPtr->varResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &var); + } + resPtr = resPtr->nextPtr; + } + + if (result == TCL_OK) { + return var; + } + else if (result != TCL_CONTINUE) { + return (Tcl_Var) NULL; + } + } /* * Find the namespace(s) that contain the variable. @@ -2101,7 +2228,6 @@ TclResetShadowedCmdRefs(interp, newCmdPtr) * storage if needed. */ -#define NUM_TRAIL_ELEMS 5 Namespace *(trailStorage[NUM_TRAIL_ELEMS]); Namespace **trailPtr = trailStorage; int trailFront = -1; @@ -2195,7 +2321,6 @@ TclResetShadowedCmdRefs(interp, newCmdPtr) if (trailPtr != trailStorage) { ckfree((char *) trailPtr); } -#undef NUM_TRAIL_ELEMS } /* @@ -2722,11 +2847,10 @@ NamespaceDeleteCmd(dummy, interp, objc, objv) for (i = 2; i < objc; i++) { name = Tcl_GetString(objv[i]); namespacePtr = Tcl_FindNamespace(interp, name, - (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG); - if (namespacePtr == NULL) { - return TCL_ERROR; + (Tcl_Namespace *) NULL, /* flags */ 0); + if (namespacePtr) { + Tcl_DeleteNamespace(namespacePtr); } - Tcl_DeleteNamespace(namespacePtr); } return TCL_OK; } |