Expose function to efficiently return current name of an object.

4 files changed, 44 insertions, 8 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index c1e8678..4233020 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOO.c,v 1.23 2009/07/12 14:51:30 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.24 2009/07/19 11:46:53 dkf Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -2439,7 +2439,7 @@ TclOOIsReachable(
 /*
  * ----------------------------------------------------------------------
  *
- * TclOOObjectName --
+ * TclOOObjectName, Tcl_GetObjectName --
  *
  *	Utility function that returns the name of the object. Note that this
  *	simplifies cache management by keeping the code to do it in one place
@@ -2465,6 +2465,14 @@ TclOOObjectName(
     oPtr->cachedNameObj = namePtr;
     return namePtr;
 }
+
+Tcl_Obj *
+Tcl_GetObjectName(
+    Tcl_Interp *interp,
+    Tcl_Object object)
+{
+    return TclOOObjectName(interp, (Object *) object);
+}
 
 /*
  * ----------------------------------------------------------------------
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index dd33f14..f06dd6b 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,8 +1,11 @@
-# -*- tcl -*-
-# $Id: tclOO.decls,v 1.4 2008/10/17 18:42:12 nijtmans Exp $
+# $Id: tclOO.decls,v 1.5 2009/07/19 11:46:53 dkf Exp $
 
-# public API
 library tclOO
+
+######################################################################
+# public API
+#
+
 interface tclOO
 hooks tclOOInt
 
@@ -109,9 +112,16 @@ declare 27 generic {
     void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
 	    Tcl_Method method)
 }
-
+declare 28 generic {
+    Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
+}
+
+######################################################################
 # private API, exposed to support advanced OO systems that plug in on top
+#
+
 interface tclOOInt
+
 declare 0 generic {
     Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
 }
@@ -187,3 +197,9 @@ declare 15 generic {
     void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
 	    int numMixins, Class *const *mixins)
 }
+
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 1a0c262..c42c02f 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -1,5 +1,5 @@
 /*
- * $Id: tclOODecls.h,v 1.11 2009/01/29 14:53:36 dkf Exp $
+ * $Id: tclOODecls.h,v 1.12 2009/07/19 11:46:53 dkf Exp $
  *
  * This file is (mostly) automatically generated from tclOO.decls.
  */
@@ -207,6 +207,12 @@ EXTERN void		Tcl_ClassSetConstructor (Tcl_Interp * interp,
 EXTERN void		Tcl_ClassSetDestructor (Tcl_Interp * interp,
 				Tcl_Class clazz, Tcl_Method method);
 #endif
+#ifndef Tcl_GetObjectName_TCL_DECLARED
+#define Tcl_GetObjectName_TCL_DECLARED
+/* 28 */
+EXTERN Tcl_Obj *	Tcl_GetObjectName (Tcl_Interp * interp,
+				Tcl_Object object);
+#endif
 
 typedef struct TclOOStubHooks {
     const struct TclOOIntStubs *tclOOIntStubs;
@@ -244,6 +250,7 @@ typedef struct TclOOStubs {
     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 */
 } TclOOStubs;
 
 #if defined(USE_TCLOO_STUBS) && !defined(USE_TCLOO_STUB_PROCS)
@@ -368,6 +375,10 @@ extern const TclOOStubs *tclOOStubsPtr;
 #define Tcl_ClassSetDestructor \
 	(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
 #endif
+#ifndef Tcl_GetObjectName
+#define Tcl_GetObjectName \
+	(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
+#endif
 
 #endif /* defined(USE_TCLOO_STUBS) && !defined(USE_TCLOO_STUB_PROCS) */
 
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
index 400eeef..4ec3992 100644
--- a/generic/tclOOStubInit.c
+++ b/generic/tclOOStubInit.c
@@ -1,5 +1,5 @@
 /*
- * $Id: tclOOStubInit.c,v 1.6 2008/07/22 23:01:39 das Exp $
+ * $Id: tclOOStubInit.c,v 1.7 2009/07/19 11:46:53 dkf Exp $
  *
  * This file is (mostly) automatically generated from tclOO.decls.
  * It is compiled and linked in with the tclOO package proper.
@@ -69,6 +69,7 @@ static const TclOOStubs tclOOStubs = {
     Tcl_ObjectSetMethodNameMapper, /* 25 */
     Tcl_ClassSetConstructor, /* 26 */
     Tcl_ClassSetDestructor, /* 27 */
+    Tcl_GetObjectName, /* 28 */
 };
 
 /* !END!: Do not edit above this line. */