summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclOOInfo.c37
1 files changed, 36 insertions, 1 deletions
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index daacc02..9874864 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOInfo.c,v 1.12 2009/01/09 11:21:46 dkf Exp $
+ * RCS: @(#) $Id: tclOOInfo.c,v 1.13 2009/05/15 10:08:02 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -26,6 +26,7 @@ static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
+static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
@@ -54,6 +55,7 @@ static const struct NameProcMap infoObjectCmds[] = {
{"::oo::InfoObject::isa", InfoObjectIsACmd},
{"::oo::InfoObject::methods", InfoObjectMethodsCmd},
{"::oo::InfoObject::mixins", InfoObjectMixinsCmd},
+ {"::oo::InfoObject::namespace", InfoObjectNsCmd},
{"::oo::InfoObject::variables", InfoObjectVariablesCmd},
{"::oo::InfoObject::vars", InfoObjectVarsCmd},
{NULL, NULL}
@@ -643,6 +645,39 @@ InfoObjectMixinsCmd(
/*
* ----------------------------------------------------------------------
*
+ * InfoObjectNsCmd --
+ *
+ * Implements [info object namespace $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectNsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* InfoObjectVariablesCmd --
*
* Implements [info object variables $objName]