add proxy inlet. still some unresolved TypeError, will continue the work tomorrow

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

7 files changed, 69 insertions, 29 deletions

diff --git a/Makefile b/Makefile
index 4c40052..a32339d 100644
--- a/Makefile
+++ b/Makefile
@@ -37,7 +37,7 @@ clean::
 
 .SUFFIXES: .cxx .o
 
-SRCS = tcl_wrap.cxx tcl_typemap.cxx tcl_class.cxx tcl_setup.cxx tcl_loader.cxx
+SRCS = tcl_wrap.cxx tcl_typemap.cxx tcl_class.cxx tcl_proxyinlet.cxx tcl_setup.cxx tcl_loader.cxx
 OBJS = ${SRCS:.cxx=.o}
 
 tcl_wrap.cxx:: tcl.i tcl_extras.h Makefile
@@ -46,5 +46,10 @@ tcl_wrap.cxx:: tcl.i tcl_extras.h Makefile
 .cxx.o:: tcl_extras.h Makefile
 	$(CXX) $(CFLAGS) $(INCLUDES) -xc++ -c $<
 
-$(LIBNAME)$(PDSUF):: tcl_extras.h Makefile $(OBJS)
+$(LIBNAME)$(PDSUF):: tcl_extras.h Makefile $(OBJS) pdlib_tcl_syntax
 	$(LDSHARED) $(CFLAGS) -o $(LIBNAME)$(PDSUF) $(OBJS) $(LDSOFLAGS)
+
+pdlib_tcl_syntax: pdlib.tcl
+	@echo -n "checking pdlib.tcl for syntax..."
+	@tclsh pdlib.tcl >/dev/null 2>&1
+	@echo " OK"
diff --git a/pdlib.tcl b/pdlib.tcl
index e61b7c7..904be91 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -30,9 +30,10 @@ namespace eval ::pd {
                 #lappend _($self:x_inlet) [symbolinlet_new [tclpd_get_object $self] $ptr]
             }
             list {
-                set ptr [new_t_alist]
-                alist_init $ptr
-                alist_list $ptr 0 3 {some test args}
+                set ptr [new_t_proxyinlet]
+                proxyinlet_init $ptr
+                #proxyinlet_list $ptr [gensym list] 2 {{symbol foo} {symbol bar}}
+                inlet_new [tclpd_get_object $self] [$ptr cget -pd] 0 {}
                 lappend _($self:p_inlet) $ptr
                 lappend _($self:t_inlet) "list"
             }
@@ -60,7 +61,7 @@ namespace eval ::pd {
         variable _
         set p_inlet [lindex $_($self:p_inlet) [expr $n-1]]
         if {$_($self:t_inlet) == {list}} {
-            return [$p_inlet value]
+            return [$p_inlet argv]
         } else {
             return [$p_inlet value]
         }
diff --git a/tcl.i b/tcl.i
index 8cb5763..e3015ad 100644
--- a/tcl.i
+++ b/tcl.i
@@ -60,8 +60,12 @@
 
 %typemap(in) t_atom * {
     t_atom *a = (t_atom*)getbytes(sizeof(t_atom));
-    if(tcl_to_pd($input, a) == TCL_ERROR)
+    if(tcl_to_pd($input, a) == TCL_ERROR) {
+#ifdef DEBUG
+        post("Tcl SWIG: typemap(in) error");
+#endif
         return TCL_ERROR;
+    }
     $1 = a;
 }
 
@@ -71,8 +75,12 @@
 
 %typemap(out) t_atom* {
     Tcl_Obj* res_obj;
-    if(pd_to_tcl($1, &res_obj) == TCL_ERROR)
+    if(pd_to_tcl($1, &res_obj) == TCL_ERROR) {
+#ifdef DEBUG
+        post("Tcl SWIG: typemap(out) error");
+#endif
         return TCL_ERROR;
+    }
     Tcl_SetObjResult(tcl_for_pd, res_obj);
 }
 
diff --git a/tcl_class.cxx b/tcl_class.cxx
index a95bf5c..bb070f9 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -33,20 +33,22 @@ 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));
+            //post("tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
+            tclpd_interp_error(TCL_ERROR);
             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) {
+        //post("tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
+        tclpd_interp_error(TCL_ERROR);
         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
@@ -62,14 +64,17 @@ void tclpd_anything(t_tcl *self, t_symbol *s, int ac, t_atom *at) {
     Tcl_IncrRefCount(av[1]);
     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));
+            //post("Tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
+            tclpd_interp_error(TCL_ERROR);
             return;
         }
     }
     int result = Tcl_EvalObjv(tcl_for_pd,ac+2,av,0);
     Tcl_DecrRefCount(av[1]);
-    if (result != TCL_OK)
-        post("Tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
+    if (result != TCL_OK) {
+        //post("Tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
+        tclpd_interp_error(TCL_ERROR);
+    }
 }
 
 /* Tcl glue: */
diff --git a/tcl_extras.h b/tcl_extras.h
index e3546c6..a540dad 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -11,6 +11,20 @@ typedef struct _t_tcl {
     Tcl_Obj *self;
 } t_tcl;
 
+typedef struct _t_proxyinlet {
+    t_pd pd;
+    int argc;
+    t_atom* argv;
+} t_proxyinlet;
+
+/* tcl_proxyinlet.cxx */
+void proxyinlet_init(t_proxyinlet* x);
+void proxyinlet_clear(t_proxyinlet* x);
+void proxyinlet_list(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv);
+void proxyinlet_anything(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv);
+void proxyinlet_clone(t_proxyinlet* x, t_proxyinlet* y);
+void proxyinlet_setup(void);
+
 /* tcl_wrap.cxx */
 extern "C" int Tclpd_SafeInit(Tcl_Interp *interp);
 
@@ -21,6 +35,7 @@ int          tcl_to_pd            (Tcl_Obj* input, t_atom* output);
 /* tcl_setup.cxx */
 extern Tcl_Interp *tcl_for_pd;
 extern "C" void tclpd_setup(void);
+void tclpd_interp_error(int result);
 
 /* tcl_class.cxx */
 t_class* tclpd_class_new(char *name, int flags);
diff --git a/tcl_loader.cxx b/tcl_loader.cxx
index e7f22ff..5358ff5 100644
--- a/tcl_loader.cxx
+++ b/tcl_loader.cxx
@@ -52,21 +52,10 @@ gotone:
     snprintf(&b[0], MAXPDSTRING+10, "source %s", filename);
     int result = Tcl_Eval(tcl_for_pd, b);
     if(result == TCL_OK) {
-        post("Tcl_loader: loaded %s", filename);
+        post("Tcl loader: loaded %s", filename);
     } else {
-        post("Tcl_loader: error trying to load %s", filename);
-        post("Error: %s", Tcl_GetStringResult(tcl_for_pd));
-        post("(see stderr for details)");
-
-        fprintf(stderr, "------------------- Tcl error: -------------------\n");
-        Tcl_Obj* dict = Tcl_GetReturnOptions(tcl_for_pd, result);
-        Tcl_Obj* errorInfo = NULL;
-        Tcl_Obj* errorInfoK = Tcl_NewStringObj("-errorinfo", -1);
-        Tcl_IncrRefCount(errorInfoK);
-        Tcl_DictObjGet(tcl_for_pd, dict, errorInfoK, &errorInfo);
-        Tcl_DecrRefCount(errorInfoK);
-        fprintf(stderr, "%s\n", Tcl_GetStringFromObj(errorInfo, 0));
-        fprintf(stderr, "--------------------------------------------------\n");
+        post("Tcl loader: error trying to load %s", filename);
+        tclpd_interp_error(result);
         return 0;
     }
 
diff --git a/tcl_setup.cxx b/tcl_setup.cxx
index 28d6778..15eb3c3 100644
--- a/tcl_setup.cxx
+++ b/tcl_setup.cxx
@@ -15,6 +15,8 @@ void tclpd_setup(void) {
 
     post("Tcl loader v0.1.1 - 08.2009");
 
+    proxyinlet_setup();
+
     tcl_for_pd = Tcl_CreateInterp();
     Tcl_Init(tcl_for_pd);
     Tclpd_SafeInit(tcl_for_pd);
@@ -51,3 +53,18 @@ void tclpd_setup(void) {
 
     sys_register_loader(tclpd_do_load_lib);
 }
+
+void tclpd_interp_error(int result) {
+    post("Tcl error: %s", Tcl_GetStringResult(tcl_for_pd));
+    post("  (see stderr for details)");
+
+    fprintf(stderr, "------------------- Tcl error: -------------------\n");
+    Tcl_Obj* dict = Tcl_GetReturnOptions(tcl_for_pd, result);
+    Tcl_Obj* errorInfo = NULL;
+    Tcl_Obj* errorInfoK = Tcl_NewStringObj("-errorinfo", -1);
+    Tcl_IncrRefCount(errorInfoK);
+    Tcl_DictObjGet(tcl_for_pd, dict, errorInfoK, &errorInfo);
+    Tcl_DecrRefCount(errorInfoK);
+    fprintf(stderr, "%s\n", Tcl_GetStringFromObj(errorInfo, 0));
+    fprintf(stderr, "--------------------------------------------------\n");
+}