summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-11-01 14:21:48 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-11-01 14:21:48 (GMT)
commit238f64e8e462d705dbf4f894f4b29933e19e865e (patch)
tree4f96d6f5d4e4b3dee8efc50f512316b86d40f1a0 /generic/tclNamesp.c
parentf38a82d52c22bfe1c84be876f895d19e8f8c7bf4 (diff)
downloadtcl-238f64e8e462d705dbf4f894f4b29933e19e865e.zip
tcl-238f64e8e462d705dbf4f894f4b29933e19e865e.tar.gz
tcl-238f64e8e462d705dbf4f894f4b29933e19e865e.tar.bz2
Cleaning up of the namespace guts.
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c1097
1 files changed, 546 insertions, 551 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 34faf71..1db1df8 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1,11 +1,11 @@
/*
* 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. Also includes
+ * 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. Also includes
* the TIP#112 ensemble machinery.
*
* Copyright (c) 1993-1997 Lucent Technologies.
@@ -21,7 +21,7 @@
* 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.64 2004/10/29 15:39:06 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.65 2004/11/01 14:21:50 dkf Exp $
*/
#include "tclInt.h"
@@ -250,8 +250,8 @@ static int NsEnsembleImplementationCmd _ANSI_ARGS_((
int objc, Tcl_Obj *CONST objv[]));
static void BuildEnsembleConfig _ANSI_ARGS_((
EnsembleConfig *ensemblePtr));
-static int NsEnsembleStringOrder _ANSI_ARGS_((CONST VOID *strPtr1,
- CONST VOID *strPtr2));
+static int NsEnsembleStringOrder _ANSI_ARGS_((CONST VOID *strPtr1,
+ CONST VOID *strPtr2));
static void DeleteEnsembleConfig _ANSI_ARGS_((
ClientData clientData));
static void MakeCachedEnsembleCommand _ANSI_ARGS_((
@@ -342,9 +342,9 @@ Tcl_GetCurrentNamespace(interp)
register Namespace *nsPtr;
if (iPtr->varFramePtr != NULL) {
- nsPtr = iPtr->varFramePtr->nsPtr;
+ nsPtr = iPtr->varFramePtr->nsPtr;
} else {
- nsPtr = iPtr->globalNsPtr;
+ nsPtr = iPtr->globalNsPtr;
}
return (Tcl_Namespace *) nsPtr;
}
@@ -429,11 +429,11 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
if (namespacePtr == NULL) {
nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
} else {
- nsPtr = (Namespace *) namespacePtr;
- if (nsPtr->flags & NS_DEAD) {
+ nsPtr = (Namespace *) namespacePtr;
+ if (nsPtr->flags & NS_DEAD) {
Tcl_Panic("Trying to push call frame for dead namespace");
/*NOTREACHED*/
- }
+ }
}
nsPtr->activationCount++;
@@ -444,9 +444,9 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
framePtr->callerPtr = iPtr->framePtr;
framePtr->callerVarPtr = iPtr->varFramePtr;
if (iPtr->varFramePtr != NULL) {
- framePtr->level = (iPtr->varFramePtr->level + 1);
+ framePtr->level = (iPtr->varFramePtr->level + 1);
} else {
- framePtr->level = 1;
+ framePtr->level = 1;
}
framePtr->procPtr = NULL; /* no called procedure */
framePtr->varTablePtr = NULL; /* and no local variables */
@@ -502,12 +502,12 @@ Tcl_PopCallFrame(interp)
iPtr->varFramePtr = framePtr->callerVarPtr;
if (framePtr->varTablePtr != NULL) {
- TclDeleteVars(iPtr, framePtr->varTablePtr);
- ckfree((char *) framePtr->varTablePtr);
- framePtr->varTablePtr = NULL;
+ TclDeleteVars(iPtr, framePtr->varTablePtr);
+ ckfree((char *) framePtr->varTablePtr);
+ framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals > 0) {
- TclDeleteCompiledLocalVars(iPtr, framePtr);
+ TclDeleteCompiledLocalVars(iPtr, framePtr);
}
/*
@@ -518,9 +518,8 @@ Tcl_PopCallFrame(interp)
nsPtr = framePtr->nsPtr;
nsPtr->activationCount--;
- if ((nsPtr->flags & NS_DYING)
- && (nsPtr->activationCount == 0)) {
- Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
+ if ((nsPtr->flags & NS_DYING) && (nsPtr->activationCount == 0)) {
+ Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
}
@@ -679,10 +678,10 @@ ErrorInfoRead(clientData, interp, name1, name2, flags)
Tcl_Namespace *
Tcl_CreateNamespace(interp, name, clientData, deleteProc)
- Tcl_Interp *interp; /* Interpreter in which a new namespace
+ Tcl_Interp *interp; /* Interpreter in which a new namespace
* is being created. Also used for
* error reporting. */
- CONST char *name; /* Name for the new namespace. May be a
+ CONST char *name; /* Name for the new namespace. May be a
* qualified name with names of ancestor
* namespaces separated by "::"s. */
ClientData clientData; /* One-word value to store with
@@ -713,11 +712,12 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
* looking for a parent.
*/
- parentPtr = NULL;
- simpleName = "";
+ parentPtr = NULL;
+ simpleName = "";
} else if (*name == '\0') {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't create namespace \"\": only global namespace can have empty name", -1));
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't create namespace \"\": ",
+ "only global namespace can have empty name", NULL);
return NULL;
} else {
/*
@@ -739,16 +739,16 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
return (Tcl_Namespace *) parentPtr;
}
- /*
- * Check for a bad namespace name and make sure that the name
+ /*
+ * 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) {
+ if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
Tcl_AppendResult(interp, "can't create namespace \"", name,
"\": already exists", (char *) NULL);
- return NULL;
- }
+ return NULL;
+ }
}
/*
@@ -756,7 +756,6 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
* count of namespaces created.
*/
-
nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
nsPtr->name = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
strcpy(nsPtr->name, simpleName);
@@ -787,9 +786,9 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
nsPtr->ensembles = NULL;
if (parentPtr != NULL) {
- entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
- &newEntry);
- Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+ entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
+ &newEntry);
+ Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
} else {
/*
* In the global namespace create traces to maintain the
@@ -808,15 +807,15 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
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);
+ 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);
+ Tcl_DStringSetLength(&buffer2, 0);
+ Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
+ Tcl_DStringSetLength(&buffer1, 0);
}
name = Tcl_DStringValue(&buffer2);
@@ -899,15 +898,15 @@ Tcl_DeleteNamespace(namespacePtr)
*/
if (nsPtr->activationCount > 0) {
- nsPtr->flags |= NS_DYING;
- if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+ 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;
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ nsPtr->parentPtr = NULL;
} else {
/*
* Delete the namespace and everything in it. If this is the global
@@ -915,9 +914,9 @@ Tcl_DeleteNamespace(namespacePtr)
* interpreter is being torn down.
*/
- TclTeardownNamespace(nsPtr);
+ TclTeardownNamespace(nsPtr);
- if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
+ if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
/*
* If this is the global namespace, then it may have residual
* "errorInfo" and "errorCode" variables for errors that
@@ -925,22 +924,22 @@ Tcl_DeleteNamespace(namespacePtr)
* variable list one last time.
*/
- TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
+ TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
- Tcl_DeleteHashTable(&nsPtr->childTable);
- Tcl_DeleteHashTable(&nsPtr->cmdTable);
+ 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 the reference count is 0, then discard the namespace.
+ * Otherwise, mark it as "dead" so that it can't be used.
+ */
- if (nsPtr->refCount == 0) {
- NamespaceFree(nsPtr);
- } else {
- nsPtr->flags |= NS_DEAD;
- }
- } else {
+ if (nsPtr->refCount == 0) {
+ NamespaceFree(nsPtr);
+ } else {
+ nsPtr->flags |= NS_DEAD;
+ }
+ } else {
/* Restore the ::errorInfo and ::errorCode traces */
EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
@@ -997,11 +996,11 @@ TclTeardownNamespace(nsPtr)
*/
if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
- nsPtr->name);
- if (entryPtr != NULL) {
- Tcl_DeleteHashEntry(entryPtr);
- }
+ entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+ nsPtr->name);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
}
nsPtr->parentPtr = NULL;
@@ -1012,26 +1011,30 @@ TclTeardownNamespace(nsPtr)
* 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.
+ *
+ * Don't optimize to Tcl_NextHashEntry() because of traces.
*/
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
- childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
- Tcl_DeleteNamespace(childNsPtr);
+ 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.
+ *
+ * Don't optimize to Tcl_NextHashEntry() because of traces.
*/
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);
+ 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);
@@ -1044,7 +1047,7 @@ TclTeardownNamespace(nsPtr)
for (i = 0; i < nsPtr->numExportPatterns; i++) {
ckfree(nsPtr->exportArrayPtr[i]);
}
- ckfree((char *) nsPtr->exportArrayPtr);
+ ckfree((char *) nsPtr->exportArrayPtr);
nsPtr->exportArrayPtr = NULL;
nsPtr->numExportPatterns = 0;
nsPtr->maxExportPatterns = 0;
@@ -1055,7 +1058,7 @@ TclTeardownNamespace(nsPtr)
*/
if (nsPtr->deleteProc != NULL) {
- (*nsPtr->deleteProc)(nsPtr->clientData);
+ (*nsPtr->deleteProc)(nsPtr->clientData);
}
nsPtr->deleteProc = NULL;
nsPtr->clientData = NULL;
@@ -1102,7 +1105,6 @@ NamespaceFree(nsPtr)
ckfree((char *) nsPtr);
}
-
/*
*----------------------------------------------------------------------
@@ -1131,9 +1133,9 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
Tcl_Interp *interp; /* Current interpreter. */
Tcl_Namespace *namespacePtr; /* Points to the namespace from which
* commands are to be exported. NULL for
- * the current namespace. */
- CONST char *pattern; /* String pattern indicating which commands
- * to export. This pattern may not include
+ * the current namespace. */
+ CONST char *pattern; /* String pattern indicating which commands
+ * to export. This pattern may not include
* any namespace qualifiers; only commands
* in the specified namespace may be
* exported. */
@@ -1152,9 +1154,9 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) currNsPtr;
+ nsPtr = (Namespace *) currNsPtr;
} else {
- nsPtr = (Namespace *) namespacePtr;
+ nsPtr = (Namespace *) namespacePtr;
}
/*
@@ -1211,7 +1213,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
neededElems = nsPtr->numExportPatterns + 1;
if (nsPtr->exportArrayPtr == NULL) {
nsPtr->exportArrayPtr = (char **)
- ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
+ ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
nsPtr->numExportPatterns = 0;
nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
} else if (neededElems > nsPtr->maxExportPatterns) {
@@ -1220,8 +1222,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
size_t newBytes = numNewElems * sizeof(char *);
char **newPtr = (char **) ckalloc((unsigned) newBytes);
- memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,
- currBytes);
+ memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr, currBytes);
ckfree((char *) nsPtr->exportArrayPtr);
nsPtr->exportArrayPtr = (char **) newPtr;
nsPtr->maxExportPatterns = numNewElems;
@@ -1289,9 +1290,9 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
} else {
- nsPtr = (Namespace *) namespacePtr;
+ nsPtr = (Namespace *) namespacePtr;
}
/*
@@ -1318,7 +1319,7 @@ 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
+ * 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.
*
@@ -1339,9 +1340,9 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
Tcl_Interp *interp; /* Current interpreter. */
Tcl_Namespace *namespacePtr; /* Points to the namespace into which the
* commands are to be imported. NULL for
- * the current namespace. */
- CONST char *pattern; /* String pattern indicating which commands
- * to import. This pattern should be
+ * the current namespace. */
+ CONST char *pattern; /* String pattern indicating which commands
+ * to import. This pattern should be
* qualified by the name of the namespace
* from which to import the command(s). */
int allowOverwrite; /* If nonzero, allow existing commands to
@@ -1349,27 +1350,19 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
* If 0, return an error if an imported
* cmd conflicts with an existing one. */
{
- Interp *iPtr = (Interp *) interp;
Namespace *nsPtr, *importNsPtr, *dummyPtr;
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
CONST char *simplePattern;
- char *cmdName;
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- Command *cmdPtr;
- ImportRef *refPtr;
- Tcl_Command autoCmd, importedCmd;
- ImportedCmdData *dataPtr;
- int wasExported, i, result;
/*
* If the specified namespace is NULL, use the current namespace.
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) currNsPtr;
+ nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
} else {
- nsPtr = (Namespace *) namespacePtr;
+ nsPtr = (Namespace *) namespacePtr;
}
/*
@@ -1378,23 +1371,21 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
* 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.
+ *
+ * Note that we don't just call Tcl_EvalObjv() directly because we
+ * do not want absence of the command to be a failure case.
*/
- autoCmd = Tcl_FindCommand(interp, "auto_import",
- (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
-
- if (autoCmd != NULL) {
+ if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) {
Tcl_Obj *objv[2];
+ int result;
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_IncrRefCount(objv[0]);
+ Tcl_IncrRefCount(objv[1]);
+ result = Tcl_EvalObjv(interp, 2, objv, TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(objv[0]);
Tcl_DecrRefCount(objv[1]);
@@ -1412,7 +1403,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
if (strlen(pattern) == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
- return TCL_ERROR;
+ return TCL_ERROR;
}
TclGetNamespaceForQualName(interp, pattern, nsPtr,
/*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
@@ -1421,7 +1412,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
if (importNsPtr == NULL) {
Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
pattern, "\"", (char *) NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (importNsPtr == nsPtr) {
if (pattern == simplePattern) {
@@ -1433,7 +1424,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
"\" tries to import from namespace \"",
importNsPtr->name, "\" into itself", (char *) NULL);
}
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -1444,18 +1435,17 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
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 != NULL); hPtr = Tcl_NextHashEntry(&search)) {
+ char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+ if (Tcl_StringMatch(cmdName, simplePattern)) {
/*
* The command cmdName in the source namespace matches the
* pattern. Check whether it was exported. If it wasn't,
* we ignore it.
*/
Tcl_HashEntry *found;
+ int wasExported = 0, i;
- wasExported = 0;
for (i = 0; i < importNsPtr->numExportPatterns; i++) {
if (Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i])) {
wasExported = 1;
@@ -1464,16 +1454,15 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
}
if (!wasExported) {
continue;
- }
+ }
/*
* Unless there is a name clash, create an imported command
* in the current namespace that refers to cmdPtr.
*/
-
- found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
- if ((found == NULL) || allowOverwrite) {
+ found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
+ if ((found == NULL) || allowOverwrite) {
/*
* Create the imported command and its client data.
* To create the new command in the current namespace,
@@ -1481,10 +1470,14 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
Tcl_DString ds;
+ Tcl_Command importedCmd;
+ ImportedCmdData *dataPtr;
+ Command *cmdPtr;
+ ImportRef *refPtr;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- if (nsPtr != iPtr->globalNsPtr) {
+ if (nsPtr != ((Interp *) interp)->globalNsPtr) {
Tcl_DStringAppend(&ds, "::", 2);
}
Tcl_DStringAppend(&ds, cmdName, -1);
@@ -1496,14 +1489,13 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
- if ((found != NULL)
- && cmdPtr->deleteProc == DeleteImportedCmd) {
-
+ if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
Command *overwrite = (Command *) Tcl_GetHashValue(found);
Command *link = cmdPtr;
+
while (link->deleteProc == DeleteImportedCmd) {
ImportedCmdData *dataPtr;
-
+
dataPtr = (ImportedCmdData *) link->objClientData;
link = dataPtr->realCmdPtr;
if (overwrite == link) {
@@ -1518,11 +1510,10 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
}
}
- dataPtr = (ImportedCmdData *)
- ckalloc(sizeof(ImportedCmdData));
- importedCmd = Tcl_CreateObjCommand(interp,
- Tcl_DStringValue(&ds), InvokeImportedCmd,
- (ClientData) dataPtr, DeleteImportedCmd);
+ 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;
@@ -1534,16 +1525,16 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
* command.
*/
- refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
- refPtr->importedCmdPtr = (Command *) importedCmd;
- refPtr->nextPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = refPtr;
- } else {
+ refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+ refPtr->importedCmdPtr = (Command *) importedCmd;
+ refPtr->nextPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = refPtr;
+ } else {
Tcl_AppendResult(interp, "can't import command \"", cmdName,
"\": already exists", (char *) NULL);
- return TCL_ERROR;
- }
- }
+ return TCL_ERROR;
+ }
+ }
}
return TCL_OK;
}
@@ -1596,9 +1587,9 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
} else {
- nsPtr = (Namespace *) namespacePtr;
+ nsPtr = (Namespace *) namespacePtr;
}
/*
@@ -1611,10 +1602,10 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
&sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (sourceNsPtr == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_AppendResult(interp,
"unknown namespace in namespace forget pattern \"",
pattern, "\"", (char *) NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (strcmp(pattern, simplePattern) == 0) {
@@ -1747,7 +1738,7 @@ InvokeImportedCmd(clientData, interp, objc, objv)
register Command *realCmdPtr = dataPtr->realCmdPtr;
return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
- objc, objv);
+ objc, objv);
}
/*
@@ -1782,8 +1773,8 @@ DeleteImportedCmd(clientData)
register ImportRef *refPtr, *prevPtr;
prevPtr = NULL;
- for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
- refPtr = refPtr->nextPtr) {
+ for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
+ refPtr = refPtr->nextPtr) {
if (refPtr->importedCmdPtr == selfPtr) {
/*
* Remove *refPtr from real command's list of imported commands
@@ -1957,16 +1948,16 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
if ((*qualName == ':') && (*(qualName+1) == ':')) {
start = qualName+2; /* skip over the initial :: */
while (*start == ':') {
- start++; /* skip over a subsequent : */
+ start++; /* skip over a subsequent : */
}
- nsPtr = globalNsPtr;
- if (*start == '\0') { /* qualName is just two or more ":"s */
- *nsPtrPtr = globalNsPtr;
- *altNsPtrPtr = NULL;
+ 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;
- }
+ *simpleNamePtr = start; /* points to empty string */
+ return TCL_OK;
+ }
}
*actualCxtPtrPtr = nsPtr;
@@ -1980,7 +1971,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
altNsPtr = globalNsPtr;
if ((nsPtr == globalNsPtr)
|| (flags & (TCL_NAMESPACE_ONLY | TCL_FIND_ONLY_NS))) {
- altNsPtr = NULL;
+ altNsPtr = NULL;
}
/*
@@ -1990,15 +1981,15 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
Tcl_DStringInit(&buffer);
end = start;
while (*start != '\0') {
- /*
- * Find the next namespace qualifier (i.e., a name ending in "::")
+ /*
+ * 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++) {
+ for (end = start; *end != '\0'; end++) {
if ((*end == ':') && (*(end+1) == ':')) {
end += 2; /* skip over the initial :: */
while (*end == ':') {
@@ -2006,7 +1997,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
}
break; /* exit for loop; end is after ::'s */
}
- len++;
+ len++;
}
if (*end=='\0' && !(end-start>=2 && *(end-1)==':' && *(end-2)==':')) {
@@ -2035,63 +2026,63 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
*/
Tcl_DStringSetLength(&buffer, 0);
- Tcl_DStringAppend(&buffer, start, len);
- nsName = Tcl_DStringValue(&buffer);
- }
+ 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 TCL_CREATE_NS_IF_UNKNOWN is set,
- * create that qualifying namespace. This is needed for procedures
- * like Tcl_CreateCommand that cannot fail.
+ * context. If it isn't found but TCL_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 & TCL_CREATE_NS_IF_UNKNOWN) {
+ if (nsPtr != NULL) {
+ entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
+ if (entryPtr != NULL) {
+ nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+ } else if (flags & TCL_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) {
- Tcl_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;
- }
+ (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
+
+ nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
+ (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+ Tcl_PopCallFrame(interp);
+
+ if (nsPtr == NULL) {
+ Tcl_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;
}
@@ -2174,7 +2165,7 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
flags|TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
if (nsPtr != NULL) {
- return (Tcl_Namespace *) nsPtr;
+ return (Tcl_Namespace *) nsPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "unknown namespace \"", name,
@@ -2204,9 +2195,9 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
Tcl_Command
Tcl_FindCommand(interp, name, contextNsPtr, flags)
- Tcl_Interp *interp; /* The interpreter in which to find the
+ Tcl_Interp *interp; /* The interpreter in which to find the
* command and to report errors. */
- CONST char *name; /* Command's name. If it starts with "::",
+ CONST char *name; /* Command's name. If it starts with "::",
* will be looked up in global namespace.
* Else, looked up first in contextNsPtr
* (current namespace if contextNsPtr is
@@ -2215,7 +2206,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
* 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:
+ 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
@@ -2244,36 +2235,36 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
* to continue onward, or they may signal an error.
*/
if ((flags & TCL_GLOBAL_ONLY) != 0) {
- cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+ cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
} else if (contextNsPtr != NULL) {
- cxtNsPtr = (Namespace *) contextNsPtr;
+ cxtNsPtr = (Namespace *) contextNsPtr;
} else {
- cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ 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;
- }
+ 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;
+ }
}
/*
@@ -2291,16 +2282,16 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
cmdPtr = NULL;
for (search = 0; (search < 2) && (cmdPtr == NULL); search++) {
- if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+ if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
simpleName);
- if (entryPtr != NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
- }
- }
+ if (entryPtr != NULL) {
+ cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ }
+ }
}
if (cmdPtr != NULL) {
- return (Tcl_Command) cmdPtr;
+ return (Tcl_Command) cmdPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "unknown command \"", name,
@@ -2371,36 +2362,36 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
* an error.
*/
if ((flags & TCL_GLOBAL_ONLY) != 0) {
- cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+ cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
} else if (contextNsPtr != NULL) {
- cxtNsPtr = (Namespace *) contextNsPtr;
+ cxtNsPtr = (Namespace *) contextNsPtr;
} else {
- cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ 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;
- }
+ 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;
+ }
}
/*
@@ -2418,13 +2409,12 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
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 ((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;
@@ -2470,8 +2460,8 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
void
TclResetShadowedCmdRefs(interp, newCmdPtr)
- Tcl_Interp *interp; /* Interpreter containing the new command. */
- Command *newCmdPtr; /* Points to the new command. */
+ Tcl_Interp *interp; /* Interpreter containing the new command. */
+ Command *newCmdPtr; /* Points to the new command. */
{
char *cmdName;
Tcl_HashEntry *hPtr;
@@ -2511,8 +2501,8 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
for (nsPtr = newCmdPtr->nsPtr;
(nsPtr != NULL) && (nsPtr != globalNsPtr);
- nsPtr = nsPtr->parentPtr) {
- /*
+ 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
@@ -2521,31 +2511,31 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
* actually contains a command cmdName.
*/
- found = 1;
- shadowNsPtr = globalNsPtr;
+ found = 1;
+ shadowNsPtr = globalNsPtr;
- for (i = trailFront; i >= 0; i--) {
- trailNsPtr = trailPtr[i];
- hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
+ 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 (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,
+ * all of the command refs cached in nsPtr. As a boundary case,
* shadowNsPtr is initially :: and we check for case 1. above.
*/
- if (found) {
- hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
- if (hPtr != NULL) {
- nsPtr->cmdRefEpoch++;
+ if (found) {
+ hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
+ if (hPtr != NULL) {
+ nsPtr->cmdRefEpoch++;
/*
* If the shadowed command was compiled to bytecodes, we
@@ -2557,10 +2547,10 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL) {
nsPtr->resolverEpoch++;
}
- }
- }
+ }
+ }
- /*
+ /*
* Insert nsPtr at the front of the trail list: i.e., at the end
* of the trailPtr array.
*/
@@ -2653,10 +2643,10 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
*/
if (objPtr->typePtr != &tclNsNameType) {
- result = tclNsNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
+ result = tclNsNameType.setFromAnyProc(interp, objPtr);
+ if (result != TCL_OK) {
goto done;
- }
+ }
}
resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
@@ -2673,23 +2663,23 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
if ((resNamePtr != NULL)
&& (resNamePtr->refNsPtr == currNsPtr)
&& (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
- nsPtr = resNamePtr->nsPtr;
+ nsPtr = resNamePtr->nsPtr;
if (nsPtr->flags & NS_DEAD) {
nsPtr = NULL;
}
}
if (nsPtr == NULL) { /* try again */
- result = tclNsNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
+ result = tclNsNameType.setFromAnyProc(interp, objPtr);
+ if (result != TCL_OK) {
goto done;
- }
- resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
- if (resNamePtr != NULL) {
- nsPtr = resNamePtr->nsPtr;
- if (nsPtr->flags & NS_DEAD) {
- nsPtr = NULL;
- }
- }
+ }
+ resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+ if (resNamePtr != NULL) {
+ nsPtr = resNamePtr->nsPtr;
+ if (nsPtr->flags & NS_DEAD) {
+ nsPtr = NULL;
+ }
+ }
}
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
@@ -2760,8 +2750,8 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
int index, result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+ return TCL_ERROR;
}
/*
@@ -2775,54 +2765,54 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
}
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 NSEnsembleIdx:
- result = NamespaceEnsembleCmd(clientData, interp, objc, objv);
- break;
- case NSEvalIdx:
- result = NamespaceEvalCmd(clientData, interp, objc, objv);
- break;
- case NSExistsIdx:
- result = NamespaceExistsCmd(clientData, interp, objc, objv);
- break;
- case NSExportIdx:
- result = NamespaceExportCmd(clientData, interp, objc, objv);
- break;
- case NSForgetIdx:
- result = NamespaceForgetCmd(clientData, interp, objc, objv);
- break;
- case NSImportIdx:
- result = NamespaceImportCmd(clientData, interp, objc, objv);
- break;
- case NSInscopeIdx:
- result = NamespaceInscopeCmd(clientData, interp, objc, objv);
- break;
- case NSOriginIdx:
- result = NamespaceOriginCmd(clientData, interp, objc, objv);
- break;
- case NSParentIdx:
- result = NamespaceParentCmd(clientData, interp, objc, objv);
- break;
- case NSQualifiersIdx:
- result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
- break;
- case NSTailIdx:
- result = NamespaceTailCmd(clientData, interp, objc, objv);
- break;
- case NSWhichIdx:
- result = NamespaceWhichCmd(clientData, interp, objc, objv);
- break;
+ 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 NSEnsembleIdx:
+ result = NamespaceEnsembleCmd(clientData, interp, objc, objv);
+ break;
+ case NSEvalIdx:
+ result = NamespaceEvalCmd(clientData, interp, objc, objv);
+ break;
+ case NSExistsIdx:
+ result = NamespaceExistsCmd(clientData, interp, objc, objv);
+ break;
+ case NSExportIdx:
+ result = NamespaceExportCmd(clientData, interp, objc, objv);
+ break;
+ case NSForgetIdx:
+ result = NamespaceForgetCmd(clientData, interp, objc, objv);
+ break;
+ case NSImportIdx:
+ result = NamespaceImportCmd(clientData, interp, objc, objv);
+ break;
+ case NSInscopeIdx:
+ result = NamespaceInscopeCmd(clientData, interp, objc, objv);
+ break;
+ case NSOriginIdx:
+ result = NamespaceOriginCmd(clientData, interp, objc, objv);
+ break;
+ case NSParentIdx:
+ result = NamespaceParentCmd(clientData, interp, objc, objv);
+ break;
+ case NSQualifiersIdx:
+ result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
+ break;
+ case NSTailIdx:
+ result = NamespaceTailCmd(clientData, interp, objc, objv);
+ break;
+ case NSWhichIdx:
+ result = NamespaceWhichCmd(clientData, interp, objc, objv);
+ break;
}
return result;
}
@@ -2871,19 +2861,19 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
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) {
+ if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (namespacePtr == NULL) {
Tcl_AppendResult(interp, "unknown namespace \"",
TclGetString(objv[2]),
"\" in namespace children command", (char *) NULL);
- return TCL_ERROR;
- }
- nsPtr = (Namespace *) namespacePtr;
+ return TCL_ERROR;
+ }
+ nsPtr = (Namespace *) namespacePtr;
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -2892,18 +2882,18 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
Tcl_DStringInit(&buffer);
if (objc == 4) {
- char *name = TclGetString(objv[3]);
+ char *name = TclGetString(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);
- }
+ 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);
+ }
}
/*
@@ -2914,13 +2904,13 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
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);
+ 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);
@@ -2970,7 +2960,7 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "arg");
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3002,7 +2992,7 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj("::namespace", -1));
+ Tcl_NewStringObj("::namespace", -1));
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj("inscope", -1));
@@ -3052,7 +3042,7 @@ NamespaceCurrentCmd(dummy, interp, objc, objv)
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3117,8 +3107,8 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
register int i;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
+ return TCL_ERROR;
}
/*
@@ -3128,15 +3118,15 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
*/
for (i = 2; i < objc; i++) {
- name = TclGetString(objv[i]);
+ name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name,
(Tcl_Namespace *) NULL, /*flags*/ 0);
- if (namespacePtr == NULL) {
+ if (namespacePtr == NULL) {
Tcl_AppendResult(interp, "unknown namespace \"",
TclGetString(objv[i]),
"\" in namespace delete command", (char *) NULL);
- return TCL_ERROR;
- }
+ return TCL_ERROR;
+ }
}
/*
@@ -3144,12 +3134,12 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
*/
for (i = 2; i < objc; i++) {
- name = TclGetString(objv[i]);
+ name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name,
- (Tcl_Namespace *) NULL, /* flags */ 0);
+ (Tcl_Namespace *) NULL, /* flags */ 0);
if (namespacePtr) {
- Tcl_DeleteNamespace(namespacePtr);
- }
+ Tcl_DeleteNamespace(namespacePtr);
+ }
}
return TCL_OK;
}
@@ -3189,15 +3179,13 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
- CallFrame frame;
- CallFrame *framep;
+ CallFrame frame, *framePtr;
Tcl_Obj *objPtr;
- char *name;
- int length, result;
+ int result;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+ return TCL_ERROR;
}
/*
@@ -3207,7 +3195,7 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
if (result != TCL_OK) {
- return result;
+ return result;
}
/*
@@ -3215,9 +3203,9 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
*/
if (namespacePtr == NULL) {
- name = Tcl_GetStringFromObj(objv[2], &length);
+ char *name = TclGetString(objv[2]);
namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL,
- (Tcl_NamespaceDeleteProc *) NULL);
+ (Tcl_NamespaceDeleteProc *) NULL);
if (namespacePtr == NULL) {
return TCL_ERROR;
}
@@ -3229,26 +3217,27 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
*/
/* This is needed to satisfy GCC 3.3's strict aliasing rules */
- framep = &frame;
- result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framep,
- namespacePtr, /*isProcCallFrame*/ 0);
+ framePtr = &frame;
+ result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+ namespacePtr, /*isProcCallFrame*/ 0);
if (result != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
frame.objc = objc;
- frame.objv = objv; /* ref counts do not need to be incremented here */
+ frame.objv = objv; /* ref counts do not need to be incremented here */
if (objc == 4) {
- result = Tcl_EvalObjEx(interp, objv[3], 0);
+ 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);
+ objPtr = Tcl_ConcatObj(objc-3, objv+3);
+ result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
+
if (result == TCL_ERROR) {
Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
Tcl_Obj *msg = Tcl_NewStringObj("\n (in namespace eval \"", -1);
@@ -3259,7 +3248,7 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
Tcl_AppendObjToObj(msg, errorLine);
Tcl_DecrRefCount(errorLine);
Tcl_AppendToObj(msg, ")", -1);
- TclAppendObjToErrorInfo(interp, msg);
+ TclAppendObjToErrorInfo(interp, msg);
Tcl_DecrRefCount(msg);
}
@@ -3302,8 +3291,8 @@ NamespaceExistsCmd(dummy, interp, objc, objv)
Tcl_Namespace *namespacePtr;
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
}
/*
@@ -3311,7 +3300,7 @@ NamespaceExistsCmd(dummy, interp, objc, objv)
*/
if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(namespacePtr != NULL));
@@ -3368,7 +3357,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3413,9 +3402,9 @@ NamespaceExportCmd(dummy, interp, objc, objv)
pattern = TclGetString(objv[i]);
result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
((i == firstArg)? resetListFirst : 0));
- if (result != TCL_OK) {
- return result;
- }
+ if (result != TCL_OK) {
+ return result;
+ }
}
return TCL_OK;
}
@@ -3461,16 +3450,16 @@ NamespaceForgetCmd(dummy, interp, objc, objv)
register int i, result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+ return TCL_ERROR;
}
for (i = 2; i < objc; i++) {
- pattern = TclGetString(objv[i]);
+ pattern = TclGetString(objv[i]);
result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
- if (result != TCL_OK) {
- return result;
- }
+ if (result != TCL_OK) {
+ return result;
+ }
}
return TCL_OK;
}
@@ -3525,8 +3514,8 @@ NamespaceImportCmd(dummy, interp, objc, objv)
int firstArg;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
+ return TCL_ERROR;
}
/*
@@ -3547,12 +3536,12 @@ NamespaceImportCmd(dummy, interp, objc, objv)
*/
for (i = firstArg; i < objc; i++) {
- pattern = TclGetString(objv[i]);
+ pattern = TclGetString(objv[i]);
result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
- allowOverwrite);
- if (result != TCL_OK) {
- return result;
- }
+ allowOverwrite);
+ if (result != TCL_OK) {
+ return result;
+ }
}
return TCL_OK;
}
@@ -3608,7 +3597,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3617,12 +3606,12 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
if (result != TCL_OK) {
- return result;
+ return result;
}
if (namespacePtr == NULL) {
Tcl_AppendResult(interp, "unknown namespace \"", TclGetString(objv[2]),
"\" in inscope namespace command", (char *) NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3632,7 +3621,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
/*isProcCallFrame*/ 0);
if (result != TCL_OK) {
- return result;
+ return result;
}
/*
@@ -3643,33 +3632,39 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
*/
if (objc == 4) {
- result = Tcl_EvalObjEx(interp, objv[3], 0);
+ 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++) {
+ 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;
- }
- }
+ 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);
+ 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);
+ if (result == TCL_ERROR) {
+ Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
+ Tcl_Obj *msg = Tcl_NewStringObj("\n (in namespace inscope \"", -1);
+ Tcl_IncrRefCount(errorLine);
+ Tcl_IncrRefCount(msg);
+ TclAppendLimitedToObj(msg, namespacePtr->fullName, -1, 200, "");
+ Tcl_AppendToObj(msg, "\" script line ", -1);
+ Tcl_AppendObjToObj(msg, errorLine);
+ Tcl_DecrRefCount(errorLine);
+ Tcl_AppendToObj(msg, ")", -1);
+ TclAppendObjToErrorInfo(interp, msg);
+ Tcl_DecrRefCount(msg);
}
/*
@@ -3720,8 +3715,8 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
Tcl_Obj *resultPtr;
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
}
command = Tcl_GetCommandFromObj(interp, objv[2]);
@@ -3779,21 +3774,21 @@ NamespaceParentCmd(dummy, interp, objc, objv)
int result;
if (objc == 2) {
- nsPtr = Tcl_GetCurrentNamespace(interp);
+ nsPtr = Tcl_GetCurrentNamespace(interp);
} else if (objc == 3) {
result = GetNamespaceFromObj(interp, objv[2], &nsPtr);
- if (result != TCL_OK) {
- return result;
- }
- if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"",
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (nsPtr == NULL) {
+ Tcl_AppendResult(interp, "unknown namespace \"",
TclGetString(objv[2]),
"\" in namespace parent command", (char *) NULL);
- return TCL_ERROR;
- }
+ return TCL_ERROR;
+ }
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?name?");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+ return TCL_ERROR;
}
/*
@@ -3801,8 +3796,8 @@ NamespaceParentCmd(dummy, interp, objc, objv)
*/
if (nsPtr->parentPtr != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- nsPtr->parentPtr->fullName, -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ nsPtr->parentPtr->fullName, -1));
}
return TCL_OK;
}
@@ -3845,7 +3840,7 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "string");
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3858,17 +3853,17 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
/* empty body */
}
while (--p >= name) {
- if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
+ 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;
+ length = p-name+1;
Tcl_SetObjResult(interp, Tcl_NewStringObj(name, length));
}
return TCL_OK;
@@ -3911,7 +3906,7 @@ NamespaceTailCmd(dummy, interp, objc, objv)
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "string");
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -3924,14 +3919,14 @@ NamespaceTailCmd(dummy, interp, objc, objv)
/* empty body */
}
while (--p > name) {
- if ((*p == ':') && (*(p-1) == ':')) {
- p++; /* just after the last "::" */
- break;
- }
+ if ((*p == ':') && (*(p-1) == ':')) {
+ p++; /* just after the last "::" */
+ break;
+ }
}
if (p >= name) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1));
}
return TCL_OK;
}
@@ -3960,10 +3955,10 @@ NamespaceTailCmd(dummy, interp, objc, objv)
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. */
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
static CONST char *opts[] = {
"-command", "-variable", NULL
@@ -3972,9 +3967,9 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
Tcl_Obj *resultPtr;
if (objc < 3 || objc > 4) {
- badArgs:
- Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
- return TCL_ERROR;
+ badArgs:
+ Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
+ return TCL_ERROR;
} else if (objc == 4) {
/*
* Look for a flag controlling the lookup.
@@ -3994,18 +3989,18 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
switch (lookupType) {
case 0: { /* -command */
Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
- if (cmd != (Tcl_Command) NULL) {
+ if (cmd != (Tcl_Command) NULL) {
Tcl_GetCommandFullName(interp, cmd, resultPtr);
- }
- break;
+ }
+ break;
}
case 1: { /* -variable */
Tcl_Var var = Tcl_FindNamespaceVar(interp,
TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
- if (var != (Tcl_Var) NULL) {
- Tcl_GetVariableFullName(interp, var, resultPtr);
- }
- break;
+ if (var != (Tcl_Var) NULL) {
+ Tcl_GetVariableFullName(interp, var, resultPtr);
+ }
+ break;
}
}
Tcl_SetObjResult(interp, resultPtr);
@@ -4034,10 +4029,10 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
static void
FreeNsNameInternalRep(objPtr)
register Tcl_Obj *objPtr; /* nsName object with internal
- * representation to free */
+ * representation to free */
{
- register ResolvedNsName *resNamePtr =
- (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+ register ResolvedNsName *resNamePtr = (ResolvedNsName *)
+ objPtr->internalRep.otherValuePtr;
Namespace *nsPtr;
/*
@@ -4046,22 +4041,22 @@ FreeNsNameInternalRep(objPtr)
*/
if (resNamePtr != NULL) {
- resNamePtr->refCount--;
- if (resNamePtr->refCount == 0) {
+ 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);
- }
+ nsPtr = resNamePtr->nsPtr;
+ nsPtr->refCount--;
+ if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+ NamespaceFree(nsPtr);
+ }
+ ckfree((char *) resNamePtr);
+ }
}
}
@@ -4086,15 +4081,15 @@ FreeNsNameInternalRep(objPtr)
static void
DupNsNameInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+ 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;
+ register ResolvedNsName *resNamePtr = (ResolvedNsName *)
+ srcPtr->internalRep.otherValuePtr;
copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
if (resNamePtr != NULL) {
- resNamePtr->refCount++;
+ resNamePtr->refCount++;
}
copyPtr->typePtr = &tclNsNameType;
}
@@ -4151,7 +4146,7 @@ SetNsNameFromAny(interp, objPtr)
*/
TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
- TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+ TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
/*
* If we found a namespace, then create a new ResolvedNsName structure
@@ -4160,16 +4155,16 @@ SetNsNameFromAny(interp, objPtr)
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;
+ (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;
+ resNamePtr = NULL;
}
/*
@@ -4208,20 +4203,20 @@ UpdateStringOfNsName(objPtr)
register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
{
ResolvedNsName *resNamePtr =
- (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+ (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;
- }
+ nsPtr = resNamePtr->nsPtr;
+ if (nsPtr->flags & NS_DEAD) {
+ nsPtr = NULL;
+ }
+ if (nsPtr != NULL) {
+ name = nsPtr->fullName;
+ }
}
/*
@@ -5622,15 +5617,15 @@ BuildEnsembleConfig(ensemblePtr)
*
* NsEnsembleStringOrder --
*
- * Helper function to compare two pointers to two strings for use
- * with qsort().
+ * Helper function to compare two pointers to two strings for use
+ * with qsort().
*
* Results:
- * -1 if the first string is smaller, 1 if the second string is
- * smaller, and 0 if they are equal.
+ * -1 if the first string is smaller, 1 if the second string is
+ * smaller, and 0 if they are equal.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/