added support for pd_bind/pd_unbind; added destructor call in tclpd_free

svn path=/trunk/externals/tclpd/; revision=12330

6 files changed, 95 insertions, 23 deletions

diff --git a/ChangeLog b/ChangeLog
index d40cca6..3089a49 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 Version 0.2.1:
 	- Added support for properties function.
+	- Added support for pd_bind/unbind.
+	- Added destructor call in pd_free.
 
 Version 0.2:
 	- Added support for GUI externals (widgetbehavior).
diff --git a/TODO b/TODO
index ebd69a4..e1cc55c 100644
--- a/TODO
+++ b/TODO
@@ -1,5 +1,4 @@
 TODO-list for tclpd (most important things first)
 =================================================
-- add support for send/receive symbols (pd_bind?)
-- add support for properties function
 - add (or check) GOP
+- signal externals? (really?)
diff --git a/pdlib.tcl b/pdlib.tcl
index a854e04..e2cd347 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -18,13 +18,17 @@ namespace eval ::pd {
         tclpd_add_proxyinlet [tclpd_get_instance $self]
     }
 
-    proc add_outlet {self sel} {
+    proc add_outlet {self {sel {}}} {
         if $::verbose {post [info level 0]}
-        if {[lsearch -exact {bang float list symbol} $sel] == -1} {
+        variable _
+        if {$sel == {}} {
+            set o [outlet_new [tclpd_get_object $self] [null_symbol]]
+        } else {
+            if {[lsearch -exact {bang float list symbol} $sel] == -1} {
                 return -code error [error_msg "unsupported selector: $sel"]
+            }
+            set o [outlet_new [tclpd_get_object $self] [gensym $sel]]
         }
-        variable _
-        set o [outlet_new [tclpd_get_object $self] [gensym $sel]]
         lappend _($self:x_outlet) $o
         return $o
     }
@@ -57,7 +61,14 @@ namespace eval ::pd {
                 outlet_bang $outlet
             }
             default {
-                return -code error [error_msg "unknown selector: $sel"]
+                set v [lindex $args 0]
+                set sz [llength $v]
+                set aa [new_atom_array $sz]
+                for {set i 0} {$i < $sz} {incr i} {
+                    set_atom_array $aa $i [lindex $v $i]
+                }
+                outlet_anything $outlet [gensym $sel] $sz $aa
+                delete_atom_array $aa $sz
             }
         }
     }
diff --git a/tcl.i b/tcl.i
index ba941a5..0c3d37a 100644
--- a/tcl.i
+++ b/tcl.i
@@ -38,9 +38,26 @@
 %ignore post;
 %ignore class_new;
 
+/* functions that we can't auto-wrap, because <insert reason here> */
+%ignore glist_new;
+%ignore canvas_zapallfortemplate;
+%ignore canvas_fattenforscalars;
+%ignore canvas_visforscalars;
+%ignore canvas_clicksub;
+%ignore text_xcoord;
+%ignore text_ycoord;
+%ignore canvas_getglistonsuper;
+%ignore canvas_getfont;
+%ignore canvas_setusedastemplate;
+%ignore canvas_vistext;
+%ignore rtext_remove;
+%ignore canvas_recurapply;
+%ignore gobj_properties;
+
 /* end of ignore-list */
 
 %include "m_pd.h"
+%include "g_canvas.h"
 %include "tcl_extras.h"
 
 %{
@@ -54,8 +71,9 @@
 %}
 
 /* this does the trick of solving
- TypeError in method 'outlet_list', argument 4 of type 't_atom *' */
+ TypeError in method 'xyz', argument 4 of type 't_atom *' */
 %name(outlet_list) EXTERN void outlet_list(t_outlet *x, t_symbol *s, int argc, t_atom_array *argv);
+%name(outlet_anything) EXTERN void outlet_anything(t_outlet *x, t_symbol *s, int argc, t_atom_array *argv);
 
 %pointer_class(t_float, t_float)
 %pointer_class(t_symbol, t_symbol)
diff --git a/tcl_class.cxx b/tcl_class.cxx
index 7525e77..81d5c98 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -70,22 +70,27 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) {
     const char* name = classsym->s_name;
     t_class* qlass = class_table[string(name)];
 
-    t_tcl* self = (t_tcl*)pd_new(qlass);
-    self->ninlets = 1 /* qlass->c_firstin ??? */;
+    t_tcl* x = (t_tcl*)pd_new(qlass);
+    x->ninlets = 1 /* qlass->c_firstin ??? */;
+
+    x->classname = Tcl_NewStringObj(name, -1);
+    Tcl_IncrRefCount(x->classname);
 
     char s[64];
     snprintf(s, 64, "tclpd:%s:x%lx", name, objectSequentialId++);
-    self->self = Tcl_NewStringObj(s, -1);
-    Tcl_IncrRefCount(self->self);
+    x->self = Tcl_NewStringObj(s, -1);
+    Tcl_IncrRefCount(x->self);
+
+    x->x_glist = (t_glist*)canvas_getcurrent();
 
     // store in object table (for later lookup)
-    object_table[string(s)] = (t_pd*)self;
+    object_table[string(s)] = (t_pd*)x;
 
     // build constructor command
     Tcl_Obj *av[ac+2]; InitArray(av, ac+2, NULL);
-    av[0] = Tcl_NewStringObj(name, -1);
+    av[0] = x->classname;
     Tcl_IncrRefCount(av[0]);
-    av[1] = self->self;
+    av[1] = x->self;
     Tcl_IncrRefCount(av[1]);
     for(int i=0; i<ac; i++) {
         if(pd_to_tcl(&at[i], &av[2+i]) == TCL_ERROR) {
@@ -95,6 +100,7 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) {
             goto error;
         }
     }
+    // call constructor
     if(Tcl_EvalObjv(tcl_for_pd, ac+2, av, 0) != TCL_OK) {
         goto error;
     }
@@ -102,7 +108,7 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) {
     for(int i = 0; i < (ac+2); i++)
         Tcl_DecrRefCount(av[i]);
 
-    return self;
+    return x;
 
 error:
     tclpd_interp_error(TCL_ERROR);
@@ -110,27 +116,45 @@ error:
         if(!av[i]) break;
         Tcl_DecrRefCount(av[i]);
     }
-    pd_free((t_pd*)self);
+    pd_free((t_pd*)x);
     return 0;
 }
 
-void tclpd_free(t_tcl* self) {
-    Tcl_DecrRefCount(self->self);
+void tclpd_free(t_tcl* x) {
+    // build destructor command
+    Tcl_Obj *sym = Tcl_NewStringObj(Tcl_GetStringFromObj(x->classname, NULL), -1);
+    Tcl_AppendToObj(sym, "_destructor", -1);
+    Tcl_Obj *av[2]; InitArray(av, 2, NULL);
+    av[0] = sym;
+    Tcl_IncrRefCount(av[0]);
+    av[1] = x->self;
+    Tcl_IncrRefCount(av[1]);
+    // call destructor
+    if(Tcl_EvalObjv(tcl_for_pd, 2, av, 0) != TCL_OK) {
+#ifdef DEBUG
+        post("tclpd_free: failed");
+#endif
+    }
+    Tcl_DecrRefCount(av[0]);
+    Tcl_DecrRefCount(av[1]);
+
+    Tcl_DecrRefCount(x->self);
+    Tcl_DecrRefCount(x->classname);
 #ifdef DEBUG
     post("tclpd_free called");
 #endif
 }
 
-void tclpd_anything(t_tcl* self, t_symbol* s, int ac, t_atom* at) {
-    tclpd_inlet_anything(self, 0, s, ac, at);
+void tclpd_anything(t_tcl* x, t_symbol* s, int ac, t_atom* at) {
+    tclpd_inlet_anything(x, 0, s, ac, at);
 }
 
-void tclpd_inlet_anything(t_tcl* self, int inlet, t_symbol* s, int ac, t_atom* at) {
+void tclpd_inlet_anything(t_tcl* x, int inlet, t_symbol* s, int ac, t_atom* at) {
     // proxy method - format: <self> <inlet#> <selector> ...
     Tcl_Obj* av[ac+3]; InitArray(av, ac+3, NULL);
     int result;
 
-    av[0] = self->self;
+    av[0] = x->self;
     Tcl_IncrRefCount(av[0]);
     av[1] = Tcl_NewIntObj(inlet);
     Tcl_IncrRefCount(av[1]);
@@ -179,6 +203,10 @@ t_tcl* tclpd_get_instance(const char* objectSequentialId) {
     return (t_tcl*)object_table[objectSequentialId];
 }
 
+t_pd* tclpd_get_instance_pd(const char* objectSequentialId) {
+    return (t_pd*)object_table[objectSequentialId];
+}
+
 t_object* tclpd_get_object(const char* objectSequentialId) {
     t_tcl* x = tclpd_get_instance(objectSequentialId);
     return &x->o;
@@ -189,6 +217,15 @@ t_pd* tclpd_get_object_pd(const char* objectSequentialId) {
     return &o->ob_pd;
 }
 
+t_glist* tclpd_get_glist(const char* objectSequentialId) {
+    t_tcl* x = tclpd_get_instance(objectSequentialId);
+    return x->x_glist;
+}
+
+t_symbol* null_symbol() {
+    return (t_symbol*)0;
+}
+
 void poststring2 (const char *s) {
     post("%s", s);
 }
diff --git a/tcl_extras.h b/tcl_extras.h
index 9c38f58..ccbec4c 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -16,7 +16,9 @@
 
 typedef struct _t_tcl {
     t_object o;
+    t_glist* x_glist;
     Tcl_Obj* self;
+    Tcl_Obj* classname;
     int ninlets;
 } t_tcl;
 
@@ -60,8 +62,11 @@ void tclpd_anything(t_tcl* self, t_symbol* s, int ac, t_atom* at);
 void tclpd_inlet_anything(t_tcl *self, int inlet, t_symbol *s, int ac, t_atom *at);
 t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x);
 t_tcl* tclpd_get_instance(const char* objectSequentialId);
+t_pd* tclpd_get_instance_pd(const char* objectSequentialId);
 t_object* tclpd_get_object(const char* objectSequentialId);
 t_pd* tclpd_get_object_pd(const char* objectSequentialId);
+t_glist* tclpd_get_glist(const char* objectSequentialId);
+t_symbol* null_symbol();
 void poststring2(const char* s);
 extern "C" void text_save(t_gobj *z, t_binbuf *b);
 void tclpd_save(t_gobj* z, t_binbuf* b);