Turn code snippets in TIP into a branch.

4 files changed, 39 insertions, 0 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 405d5d0..bdceec4 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -3144,6 +3144,26 @@ Tcl_ObjectSetMethodNameMapper(
 {
     ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
 }
+
+Tcl_Class
+Tcl_GetClassOfObject(
+    Tcl_Object object)
+{
+    return (Tcl_Class) ((Object *) object)->selfCls;
+}
+
+Tcl_Obj *
+Tcl_GetObjectClassName(
+    Tcl_Interp *interp,
+    Tcl_Object object)
+{
+    Tcl_Object classObj = (Tcl_Object) (((Object *) object)->selfCls)->thisPtr;
+
+    if (classObj == NULL) {
+	return NULL;
+    }
+    return Tcl_GetObjectName(interp, classObj);
+}
 
 /*
  * Local Variables:
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 4602460..e4063c7 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -129,6 +129,12 @@ declare 28 {
 declare 29 {
     int Tcl_MethodIsPrivate(Tcl_Method method)
 }
+declare 30 {
+    Tcl_Class Tcl_GetClassOfObject(Tcl_Object object)
+}
+declare 31 {
+    Tcl_Obj *Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object)
+}
 
 ######################################################################
 # Private API, exposed to support advanced OO systems that plug in on top of
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 928d07e..3be1e3d 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -118,6 +118,11 @@ TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
 				Tcl_Object object);
 /* 29 */
 TCLAPI int		Tcl_MethodIsPrivate(Tcl_Method method);
+/* 30 */
+TCLAPI Tcl_Class	Tcl_GetClassOfObject(Tcl_Object object);
+/* 31 */
+TCLAPI Tcl_Obj *	Tcl_GetObjectClassName(Tcl_Interp *interp,
+				Tcl_Object object);
 
 typedef struct {
     const struct TclOOIntStubs *tclOOIntStubs;
@@ -157,6 +162,8 @@ typedef struct TclOOStubs {
     void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
     Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
     int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
+    Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */
+    Tcl_Obj * (*tcl_GetObjectClassName) (Tcl_Interp *interp, Tcl_Object object); /* 31 */
 } TclOOStubs;
 
 extern const TclOOStubs *tclOOStubsPtr;
@@ -231,6 +238,10 @@ extern const TclOOStubs *tclOOStubsPtr;
 	(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
 #define Tcl_MethodIsPrivate \
 	(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */
+#define Tcl_GetClassOfObject \
+	(tclOOStubsPtr->tcl_GetClassOfObject) /* 30 */
+#define Tcl_GetObjectClassName \
+	(tclOOStubsPtr->tcl_GetObjectClassName) /* 31 */
 
 #endif /* defined(USE_TCLOO_STUBS) */
 
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
index 5e235f4..b9034f0 100644
--- a/generic/tclOOStubInit.c
+++ b/generic/tclOOStubInit.c
@@ -74,6 +74,8 @@ const TclOOStubs tclOOStubs = {
     Tcl_ClassSetDestructor, /* 27 */
     Tcl_GetObjectName, /* 28 */
     Tcl_MethodIsPrivate, /* 29 */
+    Tcl_GetClassOfObject, /* 30 */
+    Tcl_GetObjectClassName, /* 31 */
 };
 
 /* !END!: Do not edit above this line. */