Index: doc/Class.3 ================================================================== --- doc/Class.3 +++ doc/Class.3 @@ -53,10 +53,18 @@ .sp Tcl_ObjectMapMethodNameProc \fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR) .sp \fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR) +.sp +.VS "TIP 605" +Tcl_Class +\fBTcl_GetClassOfObject\fR(\fIobject\fR) +.sp +Tcl_Obj * +\fBTcl_GetObjectClassName\fR(\fIinterp\fR, \fIobject\fR) +.VE "TIP 605" .SH ARGUMENTS .AS ClientData metadata in/out .AP Tcl_Interp *interp in/out Interpreter providing the context for looking up or creating an object, and into whose result error messages will be written on failure. @@ -112,10 +120,17 @@ and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR is a shared reference. You can also get whether the object has been marked for deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the object has begun); this can be useful during the processing of methods. +.VS "TIP 605" +The class of an object can be retrieved with \fBTcl_GetClassOfObject\fR, and +the name of the class of an object with \fBTcl_GetObjectClassName\fR; note +that these two \fImay\fR return NULL during deletion of an object (this is +transient, and only occurs when the object is a long way through being +deleted). +.VE "TIP 605" .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to Index: generic/tclOO.c ================================================================== --- generic/tclOO.c +++ generic/tclOO.c @@ -3142,10 +3142,30 @@ Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc) { ((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: * mode: c * c-basic-offset: 4 Index: generic/tclOO.decls ================================================================== --- generic/tclOO.decls +++ generic/tclOO.decls @@ -127,10 +127,16 @@ Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object) } 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 # TclOO; not intended for general use and does not have any commitment to # long-term support. Index: generic/tclOODecls.h ================================================================== --- generic/tclOODecls.h +++ generic/tclOODecls.h @@ -116,10 +116,15 @@ /* 28 */ 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; } TclOOStubHooks; @@ -155,10 +160,12 @@ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ 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; #ifdef __cplusplus @@ -229,11 +236,15 @@ (tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */ #define Tcl_GetObjectName \ (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) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOODECLS */ Index: generic/tclOOStubInit.c ================================================================== --- generic/tclOOStubInit.c +++ generic/tclOOStubInit.c @@ -72,8 +72,10 @@ Tcl_ObjectSetMethodNameMapper, /* 25 */ Tcl_ClassSetConstructor, /* 26 */ Tcl_ClassSetDestructor, /* 27 */ Tcl_GetObjectName, /* 28 */ Tcl_MethodIsPrivate, /* 29 */ + Tcl_GetClassOfObject, /* 30 */ + Tcl_GetObjectClassName, /* 31 */ }; /* !END!: Do not edit above this line. */