Index: doc/define.n ================================================================== --- doc/define.n +++ doc/define.n @@ -140,19 +140,28 @@ be afterwards. .TP \fBself\fI subcommand arg ...\fR .TP \fBself\fI script\fR +.TP +\fBself\fR . This command is equivalent to calling \fBoo::objdefine\fR on the class being defined (see \fBCONFIGURING OBJECTS\fR below for a description of the supported values of \fIsubcommand\fR). It follows the same general pattern of argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands, and .QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR" operates identically to .QW "\fBoo::objdefine \fIcls subcommand ...\fR" . +.RS +.PP +.VS TIP470 +If no arguments at all are used, this gives the name of the class currently +being configured. +.VE TIP470 +.RE .TP \fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? .VS This slot (see \fBSLOTTED DEFINITIONS\fR below) .VE @@ -262,10 +271,16 @@ This renames the method called \fIfromName\fR in an object to \fItoName\fR. The method must have previously existed in the object, and \fItoName\fR must not previously refer to a method in that object. Does not affect the classes that the object is an instance of. Does not change the export status of the method; if it was exported before, it will be afterwards. +.TP +\fBself \fR +. +.VS TIP470 +This gives the name of the object currently being configured. +.VE TIP470 .TP \fBunexport\fI name \fR?\fIname ...\fR? . This arranges for each of the named methods, \fIname\fR, to be not exported (i.e. not usable outside the object through the object's command, but instead Index: generic/tclOO.c ================================================================== --- generic/tclOO.c +++ generic/tclOO.c @@ -39,10 +39,11 @@ {"deletemethod", TclOODefineDeleteMethodObjCmd, 1}, {"export", TclOODefineExportObjCmd, 1}, {"forward", TclOODefineForwardObjCmd, 1}, {"method", TclOODefineMethodObjCmd, 1}, {"renamemethod", TclOODefineRenameMethodObjCmd, 1}, + {"self", TclOODefineObjSelfObjCmd, 0}, {"unexport", TclOODefineUnexportObjCmd, 1}, {NULL, NULL, 0} }; /* Index: generic/tclOODefineCmds.c ================================================================== --- generic/tclOODefineCmds.c +++ generic/tclOODefineCmds.c @@ -1012,19 +1012,19 @@ Tcl_Obj *const *objv) { Foundation *fPtr = TclOOGetFoundation(interp); Object *oPtr; int result; + + oPtr = (Object *) TclOOGetDefineCmdContext(interp); + if (oPtr == NULL) { + return TCL_ERROR; + } if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); - return TCL_ERROR; - } - - oPtr = (Object *) TclOOGetDefineCmdContext(interp); - if (oPtr == NULL) { - return TCL_ERROR; + Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr)); + return TCL_OK; } /* * Make the oo::objdefine namespace the current namespace and evaluate the * command(s). @@ -1055,10 +1055,43 @@ */ TclPopStackFrame(interp); return result; } + +/* + * ---------------------------------------------------------------------- + * + * TclOODefineObjSelfObjCmd -- + * Implementation of the "self" subcommand of the "oo::objdefine" + * command. + * + * ---------------------------------------------------------------------- + */ + +int +TclOODefineObjSelfObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + Object *oPtr; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + oPtr = (Object *) TclOOGetDefineCmdContext(interp); + if (oPtr == NULL) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr)); + return TCL_OK; +} /* * ---------------------------------------------------------------------- * * TclOODefineClassObjCmd -- Index: generic/tclOOInt.h ================================================================== --- generic/tclOOInt.h +++ generic/tclOOInt.h @@ -428,10 +428,13 @@ MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData, Index: tests/oo.test ================================================================== --- tests/oo.test +++ tests/oo.test @@ -3764,10 +3764,117 @@ oo::class create B {} oo::class create D {mixin B} namespace eval [info object namespace D] [list [namespace which B] destroy] } {} +test oo-36.1 {TIP #470: introspection within oo::define} { + oo::define oo::object self +} ::oo::object +test oo-36.2 {TIP #470: introspection within oo::define} -setup { + oo::class create Cls +} -body { + oo::define Cls self +} -cleanup { + Cls destroy +} -result ::Cls +test oo-36.3 {TIP #470: introspection within oo::define} -setup { + oo::class create Super + set result uncalled +} -body { + oo::class create Sub { + superclass Super + ::set ::result [self] + } + return $result +} -cleanup { + Super destroy +} -result ::Sub +test oo-36.4 {TIP #470: introspection within oo::define} -setup { + oo::class create Super + set result uncalled +} -body { + oo::class create Sub { + superclass Super + ::set ::result [self {}] + } + return $result +} -cleanup { + Super destroy +} -result {} +test oo-36.5 {TIP #470: introspection within oo::define} -setup { + oo::class create Super + set result uncalled +} -body { + oo::class create Sub { + superclass Super + ::set ::result [self self] + } +} -cleanup { + Super destroy +} -result ::Sub +test oo-36.6 {TIP #470: introspection within oo::objdefine} -setup { + oo::class create Cls + set result uncalled +} -body { + Cls create obj + oo::objdefine obj { + ::set ::result [self] + } +} -cleanup { + Cls destroy +} -result ::obj +test oo-36.7 {TIP #470: introspection within oo::objdefine} -setup { + oo::class create Cls +} -body { + Cls create obj + oo::objdefine obj { + self + } +} -cleanup { + Cls destroy +} -result ::obj +test oo-36.8 {TIP #470: introspection within oo::objdefine} -setup { + oo::class create Cls +} -body { + Cls create obj + oo::objdefine obj { + self anything + } +} -returnCodes error -cleanup { + Cls destroy +} -result {wrong # args: should be "self"} +test oo-36.9 {TIP #470: introspection within oo::define} -setup { + oo::class create Cls + set result uncalled +} -body { + proc oo::define::testself {} { + global result + set result [list [catch {self} msg] $msg \ + [catch {uplevel 1 self} msg] $msg] + return + } + list [oo::define Cls testself] $result +} -cleanup { + Cls destroy + catch {rename oo::define::testself {}} +} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::Cls}} +test oo-36.10 {TIP #470: introspection within oo::define} -setup { + oo::class create Cls + set result uncalled +} -body { + proc oo::objdefine::testself {} { + global result + set result [list [catch {self} msg] $msg \ + [catch {uplevel 1 self} msg] $msg] + return + } + Cls create obj + list [oo::objdefine obj testself] $result +} -cleanup { + Cls destroy + catch {rename oo::objdefine::testself {}} +} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::obj}} cleanupTests return # Local Variables: