summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-03-09 14:06:53 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-03-09 14:06:53 (GMT)
commit1111254200cc2b8bc8aa2d899f43d56884f1f1cb (patch)
tree321682fffd0f114d52e16ad5231ed933e40ad10e /generic/tclNamesp.c
parent47412dd55bfb480602e28ca7d73b0aef74b622cb (diff)
downloadtcl-1111254200cc2b8bc8aa2d899f43d56884f1f1cb.zip
tcl-1111254200cc2b8bc8aa2d899f43d56884f1f1cb.tar.gz
tcl-1111254200cc2b8bc8aa2d899f43d56884f1f1cb.tar.bz2
Turn namespace into an ensemble. Not yet on trunk because of some mysterious failures that need resolving...
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c363
1 files changed, 161 insertions, 202 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index a777d27..69411c2 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -103,6 +103,8 @@ static int NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+static int NRNamespaceEvalCmd(ClientData dummy,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceExistsCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp,
@@ -114,6 +116,8 @@ static int NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceInscopeCmd(ClientData dummy,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int NRNamespaceInscopeCmd(ClientData dummy,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp,
@@ -127,8 +131,7 @@ static int NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
static int NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceUnknownCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -150,6 +153,34 @@ static const Tcl_ObjType nsNameType = {
NULL, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
+
+/*
+ * Array of values describing how to implement each standard subcommand of the
+ * "namespace" command.
+ */
+
+static const EnsembleImplMap defaultNamespaceMap[] = {
+ {"children", NamespaceChildrenCmd},
+ {"code", NamespaceCodeCmd},
+ {"current", NamespaceCurrentCmd},
+ {"delete", NamespaceDeleteCmd},
+ {"ensemble", TclNamespaceEnsembleCmd},
+ {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd},
+ {"exists", NamespaceExistsCmd},
+ {"export", NamespaceExportCmd},
+ {"forget", NamespaceForgetCmd},
+ {"import", NamespaceImportCmd},
+ {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd},
+ {"origin", NamespaceOriginCmd},
+ {"parent", NamespaceParentCmd},
+ {"path", NamespacePathCmd},
+ {"qualifiers", NamespaceQualifiersCmd},
+ {"tail", NamespaceTailCmd},
+ {"unknown", NamespaceUnknownCmd},
+ {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd},
+ {"which", NamespaceWhichCmd},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+};
/*
*----------------------------------------------------------------------
@@ -2742,7 +2773,7 @@ TclGetNamespaceFromObj(
* Get the current namespace name.
*/
- NamespaceCurrentCmd(NULL, interp, 2, NULL);
+ NamespaceCurrentCmd(NULL, interp, 1, NULL);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"namespace \"%s\" not found in \"%s\"", name,
Tcl_GetStringResult(interp)));
@@ -2790,132 +2821,25 @@ GetNamespaceFromObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_NamespaceObjCmd --
+ * TclInitNamespaceCmd --
*
- * 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 ensemble subcommand ?arg...?
- * namespace eval name arg ?arg...?
- * namespace exists name
- * namespace export ?-clear? ?pattern pattern...?
- * namespace forget ?pattern pattern...?
- * namespace import ?-force? ?pattern pattern...?
- * namespace inscope name arg ?arg...?
- * namespace origin name
- * namespace parent ?name?
- * namespace qualifiers string
- * namespace tail string
- * namespace which ?-command? ?-variable? name
+ * This function is called to create the "namespace" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
- * Returns TCL_OK if the command is successful. Returns TCL_ERROR if
- * anything goes wrong.
+ * Handle for the namespace command, or NULL on failure.
*
* Side effects:
- * Based on the subcommand name (e.g., "import"), this function
- * dispatches to a corresponding function NamespaceXXXCmd defined
- * statically in this file. This function's side effects depend on
- * whatever that subcommand function does. If there is an error, this
- * function returns an error message in the interpreter's result object.
- * Otherwise it may return a result in the interpreter's result object.
+ * none
*
*----------------------------------------------------------------------
*/
-int
-Tcl_NamespaceObjCmd(
- ClientData clientData, /* Arbitrary value passed to cmd. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- return Tcl_NRCallObjProc(interp, TclNRNamespaceObjCmd, clientData, objc,
- objv);
-}
-
-int
-TclNRNamespaceObjCmd(
- ClientData clientData, /* Arbitrary value passed to cmd. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
+Tcl_Command
+TclInitNamespaceCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
{
- static const char *const subCmds[] = {
- "children", "code", "current", "delete", "ensemble",
- "eval", "exists", "export", "forget", "import",
- "inscope", "origin", "parent", "path", "qualifiers",
- "tail", "unknown", "upvar", "which", NULL
- };
- enum NSSubCmdIdx {
- NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
- NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
- NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
- NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
- };
- int index;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
- }
-
- /*
- * Return an index reflecting the particular subcommand.
- */
-
- if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", /*flags*/ 0,
- (int *) &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- switch (index) {
- case NSChildrenIdx:
- return NamespaceChildrenCmd(clientData, interp, objc, objv);
- case NSCodeIdx:
- return NamespaceCodeCmd(clientData, interp, objc, objv);
- case NSCurrentIdx:
- return NamespaceCurrentCmd(clientData, interp, objc, objv);
- case NSDeleteIdx:
- return NamespaceDeleteCmd(clientData, interp, objc, objv);
- case NSEnsembleIdx:
- return TclNamespaceEnsembleCmd(clientData, interp, objc, objv);
- case NSEvalIdx:
- return NamespaceEvalCmd(clientData, interp, objc, objv);
- case NSExistsIdx:
- return NamespaceExistsCmd(clientData, interp, objc, objv);
- case NSExportIdx:
- return NamespaceExportCmd(clientData, interp, objc, objv);
- case NSForgetIdx:
- return NamespaceForgetCmd(clientData, interp, objc, objv);
- case NSImportIdx:
- return NamespaceImportCmd(clientData, interp, objc, objv);
- case NSInscopeIdx:
- return NamespaceInscopeCmd(clientData, interp, objc, objv);
- case NSOriginIdx:
- return NamespaceOriginCmd(clientData, interp, objc, objv);
- case NSParentIdx:
- return NamespaceParentCmd(clientData, interp, objc, objv);
- case NSPathIdx:
- return NamespacePathCmd(clientData, interp, objc, objv);
- case NSQualifiersIdx:
- return NamespaceQualifiersCmd(clientData, interp, objc, objv);
- case NSTailIdx:
- return NamespaceTailCmd(clientData, interp, objc, objv);
- case NSUpvarIdx:
- return NamespaceUpvarCmd(clientData, interp, objc, objv);
- case NSUnknownIdx:
- return NamespaceUnknownCmd(clientData, interp, objc, objv);
- case NSWhichIdx:
- return NamespaceWhichCmd(clientData, interp, objc, objv);
- default:
- Tcl_Panic("unhandled namespace subcommand");
- }
- return TCL_ERROR;
+ return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);
}
/*
@@ -2959,15 +2883,15 @@ NamespaceChildrenCmd(
* Get a pointer to the specified namespace, or the current namespace.
*/
- if (objc == 2) {
+ if (objc == 1) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- } else if ((objc == 3) || (objc == 4)) {
- if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK){
+ } else if ((objc == 2) || (objc == 3)) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){
return TCL_ERROR;
}
nsPtr = (Namespace *) namespacePtr;
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?name? ?pattern?");
return TCL_ERROR;
}
@@ -2976,8 +2900,8 @@ NamespaceChildrenCmd(
*/
Tcl_DStringInit(&buffer);
- if (objc == 4) {
- const char *name = TclGetString(objv[3]);
+ if (objc == 3) {
+ const char *name = TclGetString(objv[2]);
if ((*name == ':') && (*(name+1) == ':')) {
pattern = name;
@@ -3080,8 +3004,8 @@ NamespaceCodeCmd(
register const char *arg, *p;
int length;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "arg");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arg");
return TCL_ERROR;
}
@@ -3089,7 +3013,7 @@ NamespaceCodeCmd(
* If "arg" is already a scoped value, then return it directly.
*/
- arg = TclGetStringFromObj(objv[2], &length);
+ arg = TclGetStringFromObj(objv[1], &length);
while (*arg == ':') {
arg++;
length--;
@@ -3099,7 +3023,7 @@ NamespaceCodeCmd(
/* empty body: skip over whitespace */
}
if (*p=='i' && (p+7 <= arg+length) && strncmp(p, "inscope", 7)==0) {
- Tcl_SetObjResult(interp, objv[2]);
+ Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
}
@@ -3126,7 +3050,7 @@ NamespaceCodeCmd(
}
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
- Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
+ Tcl_ListObjAppendElement(interp, listPtr, objv[1]);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
@@ -3162,8 +3086,8 @@ NamespaceCurrentCmd(
{
register Namespace *currNsPtr;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -3227,8 +3151,8 @@ NamespaceDeleteCmd(
const char *name;
register int i;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
return TCL_ERROR;
}
@@ -3238,7 +3162,7 @@ NamespaceDeleteCmd(
* command line are valid, and report any errors.
*/
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
if ((namespacePtr == NULL)
@@ -3256,7 +3180,7 @@ NamespaceDeleteCmd(
* Okay, now delete each namespace.
*/
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
if (namespacePtr) {
@@ -3295,6 +3219,17 @@ NamespaceDeleteCmd(
static int
NamespaceEvalCmd(
+ ClientData clientData, /* Arbitrary value passed to cmd. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
+ objv);
+}
+
+static int
+NRNamespaceEvalCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -3308,8 +3243,8 @@ NamespaceEvalCmd(
Tcl_Obj *objPtr;
int result;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
return TCL_ERROR;
}
@@ -3318,14 +3253,14 @@ NamespaceEvalCmd(
* namespace object along the way.
*/
- result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+ result = GetNamespaceFromObj(interp, objv[1], &namespacePtr);
/*
* If the namespace wasn't found, try to create it.
*/
if (result == TCL_ERROR) {
- const char *name = TclGetString(objv[2]);
+ const char *name = TclGetString(objv[1]);
namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
if (namespacePtr == NULL) {
@@ -3346,15 +3281,21 @@ NamespaceEvalCmd(
return TCL_ERROR;
}
- framePtr->objc = objc;
- framePtr->objv = objv;
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ framePtr->objc = objc;
+ framePtr->objv = objv;
+ } else {
+ framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
+ }
- if (objc == 4) {
+ if (objc == 3) {
/*
* TIP #280: Make actual argument location available to eval'd script.
*/
- objPtr = objv[3];
+ objPtr = objv[2];
invoker = iPtr->cmdFramePtr;
word = 3;
TclArgumentGet(interp, objPtr, &invoker, &word);
@@ -3365,7 +3306,7 @@ NamespaceEvalCmd(
* object when it decrements its refcount after eval'ing it.
*/
- objPtr = Tcl_ConcatObj(objc-3, objv+3);
+ objPtr = Tcl_ConcatObj(objc-2, objv+2);
invoker = NULL;
word = 0;
}
@@ -3438,13 +3379,13 @@ NamespaceExistsCmd(
{
Tcl_Namespace *namespacePtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- GetNamespaceFromObj(interp, objv[2], &namespacePtr) == TCL_OK));
+ GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
return TCL_OK;
}
@@ -3496,8 +3437,8 @@ NamespaceExportCmd(
int resetListFirst = 0;
int firstArg, patternCt, i, result;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
return TCL_ERROR;
}
@@ -3505,7 +3446,7 @@ NamespaceExportCmd(
* Process the optional "-clear" argument.
*/
- firstArg = 2;
+ firstArg = 1;
if (firstArg < objc) {
string = TclGetString(objv[firstArg]);
if (strcmp(string, "-clear") == 0) {
@@ -3519,9 +3460,9 @@ NamespaceExportCmd(
* the namespace's current export pattern list.
*/
- patternCt = (objc - firstArg);
+ patternCt = objc - firstArg;
if (patternCt == 0) {
- if (firstArg > 2) {
+ if (firstArg > 1) {
return TCL_OK;
} else {
/*
@@ -3595,12 +3536,12 @@ NamespaceForgetCmd(
const char *pattern;
register int i, result;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
return TCL_ERROR;
}
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
pattern = TclGetString(objv[i]);
result = Tcl_ForgetImport(interp, NULL, pattern);
if (result != TCL_OK) {
@@ -3662,8 +3603,8 @@ NamespaceImportCmd(
register int i, result;
int firstArg;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
return TCL_ERROR;
}
@@ -3671,7 +3612,7 @@ NamespaceImportCmd(
* Skip over the optional "-force" as the first argument.
*/
- firstArg = 2;
+ firstArg = 1;
if (firstArg < objc) {
string = TclGetString(objv[firstArg]);
if ((*string == '-') && (strcmp(string, "-force") == 0)) {
@@ -3680,7 +3621,7 @@ NamespaceImportCmd(
}
} else {
/*
- * When objc == 2, command is just [namespace import]. Introspection
+ * When objc == 1, command is just [namespace import]. Introspection
* form to return list of imported commands.
*/
@@ -3756,6 +3697,17 @@ NamespaceImportCmd(
static int
NamespaceInscopeCmd(
+ ClientData clientData, /* Arbitrary value passed to cmd. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
+ objv);
+}
+
+static int
+NRNamespaceInscopeCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -3763,11 +3715,12 @@ NamespaceInscopeCmd(
{
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
+ register Interp *iPtr = (Interp *) interp;
int i, result;
Tcl_Obj *cmdObjPtr;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
return TCL_ERROR;
}
@@ -3775,7 +3728,7 @@ NamespaceInscopeCmd(
* Resolve the namespace reference.
*/
- if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) {
return TCL_ERROR;
}
@@ -3791,8 +3744,14 @@ NamespaceInscopeCmd(
return result;
}
- framePtr->objc = objc;
- framePtr->objv = objv;
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ framePtr->objc = objc;
+ framePtr->objv = objv;
+ } else {
+ framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
+ }
/*
* Execute the command. If there is just one argument, just treat it as a
@@ -3801,21 +3760,21 @@ NamespaceInscopeCmd(
* of extra arguments to form the command to evaluate.
*/
- if (objc == 4) {
- cmdObjPtr = objv[3];
+ if (objc == 3) {
+ cmdObjPtr = objv[2];
} else {
Tcl_Obj *concatObjv[2];
register Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
- for (i = 4; i < objc; i++) {
+ for (i = 3; i < objc; i++) {
if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){
Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */
return TCL_ERROR;
}
}
- concatObjv[0] = objv[3];
+ concatObjv[0] = objv[2];
concatObjv[1] = listPtr;
cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
Tcl_DecrRefCount(listPtr); /* We're done with the list object. */
@@ -3865,17 +3824,17 @@ NamespaceOriginCmd(
Tcl_Command command, origCommand;
Tcl_Obj *resultPtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
- command = Tcl_GetCommandFromObj(interp, objv[2]);
+ command = Tcl_GetCommandFromObj(interp, objv[1]);
if (command == NULL) {
Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[2]), "\"", NULL);
+ TclGetString(objv[1]), "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
origCommand = TclGetOriginalCommand(command);
@@ -3925,14 +3884,14 @@ NamespaceParentCmd(
{
Tcl_Namespace *nsPtr;
- if (objc == 2) {
+ if (objc == 1) {
nsPtr = TclGetCurrentNamespace(interp);
- } else if (objc == 3) {
- if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+ } else if (objc == 2) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
return TCL_ERROR;
}
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?name?");
return TCL_ERROR;
}
@@ -3986,8 +3945,8 @@ NamespacePathCmd(
Tcl_Obj **nsObjv;
Tcl_Namespace **namespaceList = NULL;
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
return TCL_ERROR;
}
@@ -3995,7 +3954,7 @@ NamespacePathCmd(
* If no path is given, return the current path.
*/
- if (objc == 2) {
+ if (objc == 1) {
/*
* Not a very fast way to compute this, but easy to get right.
*/
@@ -4013,7 +3972,7 @@ NamespacePathCmd(
* There is a path given, so parse it into an array of namespace pointers.
*/
- if (TclListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) {
+ if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
goto badNamespace;
}
if (nsObjc != 0) {
@@ -4210,8 +4169,8 @@ NamespaceQualifiersCmd(
register const char *name, *p;
int length;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
@@ -4220,7 +4179,7 @@ NamespaceQualifiersCmd(
* the last "::" qualifier.
*/
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
@@ -4279,14 +4238,14 @@ NamespaceUnknownCmd(
Tcl_Obj *resultPtr;
int rc;
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?script?");
return TCL_ERROR;
}
currNsPtr = TclGetCurrentNamespace(interp);
- if (objc == 2) {
+ if (objc == 1) {
/*
* Introspection - return the current namespace handler.
*/
@@ -4297,9 +4256,9 @@ NamespaceUnknownCmd(
}
Tcl_SetObjResult(interp, resultPtr);
} else {
- rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[2]);
+ rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[1]);
if (rc == TCL_OK) {
- Tcl_SetObjResult(interp, objv[2]);
+ Tcl_SetObjResult(interp, objv[1]);
}
return rc;
}
@@ -4464,8 +4423,8 @@ NamespaceTailCmd(
{
register const char *name, *p;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
@@ -4474,7 +4433,7 @@ NamespaceTailCmd(
* qualifier.
*/
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
@@ -4525,17 +4484,17 @@ NamespaceUpvarCmd(
Var *otherPtr, *arrayPtr;
const char *myName;
- if (objc < 3 || !(objc & 1)) {
- Tcl_WrongNumArgs(interp, 2, objv, "ns ?otherVar myVar ...?");
+ if (objc < 2 || (objc & 1)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
return TCL_ERROR;
}
- if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
return TCL_ERROR;
}
- objc -= 3;
- objv += 3;
+ objc -= 2;
+ objv += 2;
for (; objc>0 ; objc-=2, objv+=2) {
/*
@@ -4600,16 +4559,16 @@ NamespaceWhichCmd(
int lookupType = 0;
Tcl_Obj *resultPtr;
- if (objc < 3 || objc > 4) {
+ if (objc < 2 || objc > 3) {
badArgs:
- Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
return TCL_ERROR;
- } else if (objc == 4) {
+ } else if (objc == 3) {
/*
* Look for a flag controlling the lookup.
*/
- if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
&lookupType) != TCL_OK) {
/*
* Preserve old style of error message!