diff options
| -rw-r--r-- | doc/Class.3 | 15 | ||||
| -rw-r--r-- | generic/tclOO.c | 20 | ||||
| -rw-r--r-- | generic/tclOO.decls | 6 | ||||
| -rw-r--r-- | generic/tclOODecls.h | 11 | ||||
| -rw-r--r-- | generic/tclOOStubInit.c | 2 |
5 files changed, 54 insertions, 0 deletions
diff --git a/doc/Class.3 b/doc/Class.3 index 5f8e061..c89c5f4 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -55,6 +55,14 @@ 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 @@ -114,6 +122,13 @@ 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 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. */ |