From f7dd0d906c42c7f0e0e5d5fecc8d987b35901d75 Mon Sep 17 00:00:00 2001
From: mescalinum <mescalinum@users.sourceforge.net>
Date: Sat, 15 Oct 2011 15:52:13 +0000
Subject: fix save function

svn path=/trunk/externals/loaders/tclpd/; revision=15603
---
 pdlib.tcl   |  1 -
 tcl_class.c | 39 +++++++++++++++------------------------
 2 files changed, 15 insertions(+), 25 deletions(-)

diff --git a/pdlib.tcl b/pdlib.tcl
index 777162d..0766ae4 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -130,7 +130,6 @@ namespace eval ::pd {
 
 	# some dummy function to suppress eventual errors if they are not deifned:
 	proc ::${classname}::0_loadbang {self} {}
-        proc ::${classname}::save {self args} {return ""}
 
         # TODO: c->c_gobj = (typeflag >= CLASS_GOBJ)
         set flag [expr {
diff --git a/tcl_class.c b/tcl_class.c
index 03350a2..08fe2e6 100644
--- a/tcl_class.c
+++ b/tcl_class.c
@@ -32,37 +32,28 @@ t_class* tclpd_class_new(const char* name, int flags) {
     // is this really necessary given that there is already a 'anything' handler?
     class_addmethod(c, (t_method)tclpd_loadbang, gensym("loadbang"), A_NULL);
     
-    // always set save function. it will call the default if
-    // none exists in tcl space.
-    class_setsavefn(c, tclpd_save);
-
-    // check if properties function exists in tcl space.
     char buf[80];
+    Tcl_Obj* res;
     int res_i;
+
+    // use properties function if exists in tcl space.
     snprintf(buf, 80, "llength [info procs ::%s::properties]", name);
     if(Tcl_Eval(tcl_for_pd, buf) == TCL_OK) {
-        Tcl_Obj* res = Tcl_GetObjResult(tcl_for_pd);
-        if(Tcl_GetIntFromObj(tcl_for_pd, res, &res_i) == TCL_OK) {
-            if(res_i) {
-                class_setpropertiesfn(c, tclpd_properties);
-            }
-#ifdef DEBUG
-            else {
-                post("tclpd_class_new: propertiesfn does not exist", buf);
-            }
-#endif
-        }
-#ifdef DEBUG
-        else {
-            post("tclpd_class_new: Tcl_GetIntFromObj returned an error");
+        res = Tcl_GetObjResult(tcl_for_pd);
+        if(Tcl_GetIntFromObj(tcl_for_pd, res, &res_i) == TCL_OK && res_i > 0) {
+            class_setpropertiesfn(c, tclpd_properties);
         }
-#endif
     }
-#ifdef DEBUG
-    else {
-        post("tclpd_class_new: [info procs] returned an error");
+
+    // use save function if exists in tcl space.
+    snprintf(buf, 80, "llength [info procs ::%s::save]", name);
+    if(Tcl_Eval(tcl_for_pd, buf) == TCL_OK) {
+        res = Tcl_GetObjResult(tcl_for_pd);
+        if(Tcl_GetIntFromObj(tcl_for_pd, res, &res_i) == TCL_OK && res_i > 0) {
+            class_setsavefn(c, tclpd_save);
+        }
     }
-#endif
+
     return c;
 }
 
-- 
cgit v1.2.1