summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2017-04-27 12:38:21 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2017-04-27 12:38:21 (GMT)
commit728c64fc037b7b9cbad80e040b2c58317d78271a (patch)
tree5f096c75a9358203b13688e46c18639dbc124adf
parent08266ba63bcae218ba1c574d6128462468670b80 (diff)
downloadtcl-728c64fc037b7b9cbad80e040b2c58317d78271a.zip
tcl-728c64fc037b7b9cbad80e040b2c58317d78271a.tar.gz
tcl-728c64fc037b7b9cbad80e040b2c58317d78271a.tar.bz2
Start of implementation of TIP #470.
-rw-r--r--generic/tclOO.c1
-rw-r--r--generic/tclOODefineCmds.c43
-rw-r--r--generic/tclOOInt.h3
3 files changed, 42 insertions, 5 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index ef0c987..73acce8 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -41,6 +41,7 @@ static const struct {
{"forward", TclOODefineForwardObjCmd, 1},
{"method", TclOODefineMethodObjCmd, 1},
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
+ {"self", TclOODefineObjSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 1},
{NULL, NULL, 0}
};
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 5b0dfc3..d3ab1eb 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -1028,16 +1028,16 @@ TclOODefineSelfObjCmd(
int result;
Object *oPtr;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
- return TCL_ERROR;
- }
-
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
if (oPtr == NULL) {
return TCL_ERROR;
}
+ if (objc < 2) {
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
+ return TCL_OK;
+ }
+
/*
* Make the oo::objdefine namespace the current namespace and evaluate the
* command(s).
@@ -1113,6 +1113,39 @@ TclOODefineSelfObjCmd(
/*
* ----------------------------------------------------------------------
*
+ * 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 --
* Implementation of the "class" subcommand of the "oo::objdefine"
* command.
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index ae24dee..476446d 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -431,6 +431,9 @@ MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData,
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);