From 728c64fc037b7b9cbad80e040b2c58317d78271a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 27 Apr 2017 12:38:21 +0000
Subject: Start of implementation of TIP #470.

---
 generic/tclOO.c           |  1 +
 generic/tclOODefineCmds.c | 43 ++++++++++++++++++++++++++++++++++++++-----
 generic/tclOOInt.h        |  3 +++
 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);
-- 
cgit v0.12