add support for save function (savefn)

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

3 files changed, 59 insertions, 3 deletions

diff --git a/pdlib.tcl b/pdlib.tcl
index 2d15d89..4c3a63e 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -77,11 +77,12 @@ namespace eval ::pd {
     }
 
     proc read_class_definition {classname def} {
-        # strip comments:
-        set def2 [regsub -all -line {#.*$} $def {}]
         set patchable_flag 1
         set noinlet_flag 0
-        foreach {id arg} $def2 {
+
+        proc ::${classname}_object_save {self args} {return ""}
+
+        foreach {id arg} $def {
             switch -- $id {
                 patchable {
                     if {$arg != 0 && $arg != 1} {
diff --git a/tcl_class.cxx b/tcl_class.cxx
index 94c56ba..bd583a9 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -13,8 +13,12 @@ map<string,t_pd*> object_table;
 t_class* tclpd_class_new(const char* name, int flags) {
     t_class* c = class_new(gensym(name), (t_newmethod)tclpd_new,
         (t_method)tclpd_free, sizeof(t_tcl), flags, A_GIMME, A_NULL);
+
     class_table[string(name)] = c;
     class_addanything(c, tclpd_anything);
+
+    class_setsavefn(c, tclpd_save);
+
     return c;
 }
 
@@ -123,4 +127,51 @@ void poststring2 (const char *s) {
 }
 
 void tclpd_save(t_gobj* z, t_binbuf* b) {
+    Tcl_Obj* av[3], *res;
+    t_tcl* x = (t_tcl*)z;
+    av[0] = x->self;
+    av[1] = Tcl_NewStringObj("object", -1);
+    Tcl_IncrRefCount(av[1]);
+    av[2] = Tcl_NewStringObj("save", -1);
+    Tcl_IncrRefCount(av[2]);
+    int result = Tcl_EvalObjv(tcl_for_pd, 3, av, 0);
+    if(result == TCL_OK) {
+        res = Tcl_GetObjResult(tcl_for_pd);
+        Tcl_IncrRefCount(res);
+        int objc;
+        Tcl_Obj** objv;
+        result = Tcl_ListObjGetElements(tcl_for_pd, res, &objc, &objv);
+        if(result == TCL_OK) {
+            if(objc == 0 && objv == NULL) {
+                // call default savefn
+                text_save(z, b);
+            } else {
+                // do custom savefn
+                int i;
+                double tmp;
+                for(i = 0; i < objc; i++) {
+                    result = Tcl_GetDoubleFromObj(tcl_for_pd, objv[i], &tmp);
+                    if(result == TCL_OK) {
+                        binbuf_addv(b, "f", (t_float)tmp);
+                    } else {
+                        char* tmps = Tcl_GetStringFromObj(objv[i], NULL);
+                        if(!strcmp(tmps, ";")) {
+                            binbuf_addv(b, ";");
+                        } else {
+                            binbuf_addv(b, "s", gensym(tmps));
+                        }
+                    }
+                }
+            }
+        } else {
+            pd_error(x, "Tcl: object save: failed");
+            tclpd_interp_error(result);
+        }
+        Tcl_DecrRefCount(res);
+    } else {
+        pd_error(x, "Tcl: object save: failed");
+        tclpd_interp_error(result);
+    }
+    Tcl_DecrRefCount(av[1]);
+    Tcl_DecrRefCount(av[2]);
 }
diff --git a/tcl_extras.h b/tcl_extras.h
index 602ceef..ca396ac 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -59,6 +59,10 @@ t_tcl* tclpd_get_instance(const char* objectSequentialId);
 t_object* tclpd_get_object(const char* objectSequentialId);
 t_pd* tclpd_get_object_pd(const char* objectSequentialId);
 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);
+
+/* tcl_widgetbehavior.cxx */
 void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* xp2, int* yp2);
 void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy);
 void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected);