From bb3429c7e76130165328180dd65451c64e7df9a1 Mon Sep 17 00:00:00 2001
From: mescalinum <mescalinum@users.sourceforge.net>
Date: Wed, 16 Nov 2011 11:02:02 +0000
Subject: add a obj-instance -> class-name mapping facility

svn path=/trunk/externals/loaders/tclpd/; revision=15754
---
 tcl_class.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/tcl_class.c b/tcl_class.c
index 46aec27..0ce39d2 100644
--- a/tcl_class.c
+++ b/tcl_class.c
@@ -127,6 +127,11 @@ t_tcl * tclpd_new(t_symbol *classsym, int ac, t_atom *at) {
     snprintf(sd, 64, "::%s::dispatcher", name);
     x->dispatcher = Tcl_NewStringObj(sd, -1);
 
+    // obj instance -> classname mapping
+    char addmapcmd[256];
+    snprintf(addmapcmd, 256, "array set ::pd::classname {{%s} {%s}}", so, name);
+    Tcl_Eval(tclpd_interp, addmapcmd);
+
     // the lifetime of x->{classname,self,dispatcher} is greater than this
     // function, hence they get an extra Tcl_IncrRefCount here:
     //      (see tclpd_free())
-- 
cgit v1.2.1