diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclOOInfo.c | 37 |
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] |