From 2f5abe3d9fdc42d3b2f2d50c1d7621487348ac10 Mon Sep 17 00:00:00 2001
From: mescalinum <mescalinum@users.sourceforge.net>
Date: Tue, 1 Sep 2009 19:53:32 +0000
Subject: pass inlet number around instead of binding it to the selector

svn path=/trunk/externals/tclpd/; revision=12169
---
 pdlib.tcl     | 19 ++++++++++++-------
 tcl_class.cxx | 26 ++++++++++++--------------
 tcl_extras.h  |  6 +++++-
 3 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/pdlib.tcl b/pdlib.tcl
index c349dfd..0a22957 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -63,12 +63,17 @@ namespace eval ::pd {
     }
 
     # add a class method (that is: a proc named <class>_<sel>)
-    proc call_classmethod {classname self sel args} {
+    proc call_classmethod {classname self inlet sel args} {
         if $::verbose {post [info level 0]}
-        set m "${classname}_${sel}"
-        if {[llength [info commands "::$m"]] > 0} {
-            return [$m $self {*}$args]
+        set m_sel "::${classname}_${inlet}_${sel}"
+        if {[llength [info commands $m_sel]] > 0} {
+            return [$m_sel $self {*}$args]
         }
+        set m_any "::${classname}_${inlet}_anything"
+        if {[llength [info commands $m_any]] > 0} {
+            return [$m_any $self $sel {*}$args]
+        }
+        post "class $classname: inlet $inlet: no such selector: $sel"
     }
 
     # this handles the pd::class definition
@@ -105,11 +110,11 @@ namespace eval ::pd {
         # class level dispatcher (sort of class constructor)
         proc ::$classname {self args} "
             if \$::verbose {::pd::post \[info level 0\]}
-            ::pd::call_classmethod $classname \$self constructor {*}\$args
+            ::pd::call_classmethod $classname \$self 0 constructor {*}\$args
             # object dispatcher
-            proc ::\$self {selector args} \"
+            proc ::\$self {inlet selector args} \"
              if \\\$::verbose {::pd::post \\\[info level 0\\\]}
-             ::pd::call_classmethod $classname \$self \\\$selector {*}\\\$args
+             ::pd::call_classmethod $classname \$self \\\$inlet \\\$selector {*}\\\$args
             \"
             return \$self
         "
diff --git a/tcl_class.cxx b/tcl_class.cxx
index 8b21139..fb7131e 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -37,7 +37,7 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) {
     t_tcl* self = (t_tcl*)pd_new(qlass);
     self->ninlets = 1 /* qlass->c_firstin ??? */;
     char s[32];
-    sprintf(s, "pd%06lx", objectSequentialId++);
+    sprintf(s, "tclpd:%s:x%x", name, objectSequentialId++);
     self->self = Tcl_NewStringObj(s, -1);
     Tcl_IncrRefCount(self->self);
     object_table[string(s)] = (t_pd*)self;
@@ -47,46 +47,44 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) {
     av[1] = self->self;
     for(int i=0; i<ac; i++) {
         if(pd_to_tcl(&at[i], &av[2+i]) == TCL_ERROR) {
-            //post("tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
             tclpd_interp_error(TCL_ERROR);
-            pd_free((t_pd *)self);
+            pd_free((t_pd*)self);
             return 0;
         }
     }
-    if(Tcl_EvalObjv(tcl_for_pd,ac+2,av,0) != TCL_OK) {
-        //post("tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
+    if(Tcl_EvalObjv(tcl_for_pd, ac+2, av, 0) != TCL_OK) {
         tclpd_interp_error(TCL_ERROR);
-        pd_free((t_pd *)self);
+        pd_free((t_pd*)self);
         return 0;
     }
     return self;
 }
 
-void tclpd_free(t_tcl *self) {
+void tclpd_free(t_tcl* self) {
 #ifdef DEBUG
     post("tclpd_free called");
 #endif
 }
 
-void tclpd_anything(t_tcl *self, t_symbol *s, int ac, t_atom *at) {
+void tclpd_anything(t_tcl* self, t_symbol* s, int ac, t_atom* at) {
     tclpd_inlet_anything(self, 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* self, int inlet, t_symbol* s, int ac, t_atom* at) {
 /* proxy method */
-    Tcl_Obj *av[ac+2];
+    Tcl_Obj* av[ac+3];
     av[0] = self->self;
     av[1] = Tcl_NewIntObj(inlet);
-    Tcl_AppendToObj(av[1],"_",1);
-    Tcl_AppendToObj(av[1],s->s_name,strlen(s->s_name)); // selector
     Tcl_IncrRefCount(av[1]);
+    av[2] = Tcl_NewStringObj(s->s_name, -1);
+    Tcl_IncrRefCount(av[2]);
     for(int i=0; i<ac; i++) {
-        if(pd_to_tcl(&at[i], &av[2+i]) == TCL_ERROR) {
+        if(pd_to_tcl(&at[i], &av[3+i]) == TCL_ERROR) {
             tclpd_interp_error(TCL_ERROR);
             return;
         }
     }
-    int result = Tcl_EvalObjv(tcl_for_pd,ac+2,av,0);
+    int result = Tcl_EvalObjv(tcl_for_pd, ac+3, av, 0);
     Tcl_DecrRefCount(av[1]);
     if (result != TCL_OK) {
         tclpd_interp_error(TCL_ERROR);
diff --git a/tcl_extras.h b/tcl_extras.h
index cdfc2e5..3400b7e 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -1,4 +1,8 @@
 #include "m_pd.h"
+#include "m_imp.h"
+#include "g_canvas.h"
+#include "s_stuff.h"
+
 #include <tcl.h>
 
 /* PATH_MAX is not defined in limits.h on some platforms */
@@ -67,7 +71,7 @@ int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shif
 extern "C" int tclpd_do_load_lib(t_canvas* canvas, char* objectname);
 /* pd loader private stuff: */
 typedef int (*loader_t)(t_canvas *canvas, char* classname);
-extern "C" void sys_register_loader(loader_t loader);
+//extern "C" void sys_register_loader(loader_t loader);
 extern "C" int sys_onloadlist(char* classname);
 extern "C" void sys_putonloadlist(char* classname);
 extern "C" void class_set_extern_dir(t_symbol* s);
-- 
cgit v1.2.1