summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
authorhobbs <hobbs>2000-05-11 00:17:29 (GMT)
committerhobbs <hobbs>2000-05-11 00:17:29 (GMT)
commit18a7211a6c01bc759bfa2dd32b7155206b356885 (patch)
treefd6e521dcdcb8b122084bd5461cc4ab5faff7a31 /generic/tclNamesp.c
parent49819cda899108c1cfefcbbbc112bfb30ba8a065 (diff)
downloadtcl-18a7211a6c01bc759bfa2dd32b7155206b356885.zip
tcl-18a7211a6c01bc759bfa2dd32b7155206b356885.tar.gz
tcl-18a7211a6c01bc759bfa2dd32b7155206b356885.tar.bz2
* doc/namespace.n:
* tests/namespace.test: * generic/tclNamesp.c (Tcl_NamespaceObjCmd): added 'namespace exists' command. [Bug: 4665]
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c73
1 files changed, 64 insertions, 9 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 43b074c..e4454e6 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,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.17 2000/03/27 22:18:56 hobbs Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.18 2000/05/11 00:17:29 hobbs Exp $
*/
#include "tclInt.h"
@@ -104,6 +104,9 @@ static int NamespaceDeleteCmd _ANSI_ARGS_((
static int NamespaceEvalCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
+static int NamespaceExistsCmd _ANSI_ARGS_((
+ ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
static int NamespaceExportCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
@@ -2409,6 +2412,7 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
* namespace current
* namespace delete ?name name...?
* namespace eval name arg ?arg...?
+ * namespace exists name
* namespace export ?-clear? ?pattern pattern...?
* namespace forget ?pattern pattern...?
* namespace import ?-force? ?pattern pattern...?
@@ -2443,15 +2447,16 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
register Tcl_Obj *CONST objv[]; /* Argument objects. */
{
static char *subCmds[] = {
- "children", "code", "current", "delete",
- "eval", "export", "forget", "import",
- "inscope", "origin", "parent", "qualifiers",
- "tail", "which", (char *) NULL};
+ "children", "code", "current", "delete",
+ "eval", "exists", "export", "forget", "import",
+ "inscope", "origin", "parent", "qualifiers",
+ "tail", "which", (char *) NULL
+ };
enum NSSubCmdIdx {
- NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
- NSEvalIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
- NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
- NSTailIdx, NSWhichIdx
+ NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+ NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
+ NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
+ NSTailIdx, NSWhichIdx
};
int index, result;
@@ -2486,6 +2491,9 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
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;
@@ -2951,6 +2959,53 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * NamespaceExistsCmd --
+ *
+ * Invoked to implement the "namespace exists" command that returns
+ * true if the given namespace currently exists, and false otherwise.
+ * Handles the following syntax:
+ *
+ * namespace exists name
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ * Returns a result in the interpreter's result object. If anything
+ * goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceExistsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tcl_Namespace *namespacePtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check whether the given namespace exists
+ */
+
+ if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NamespaceExportCmd --
*
* Invoked to implement the "namespace export" command that specifies