aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormescalinum <mescalinum@users.sourceforge.net>2011-10-15 15:52:13 +0000
committermescalinum <mescalinum@users.sourceforge.net>2011-10-15 15:52:13 +0000
commitf7dd0d906c42c7f0e0e5d5fecc8d987b35901d75 (patch)
tree4e90fcfbcb4b7fbd93485475b2e687043d26c176
parent61ab39873f66649129872485ed721911999060b1 (diff)
fix save function
svn path=/trunk/externals/loaders/tclpd/; revision=15603
-rw-r--r--pdlib.tcl1
-rw-r--r--tcl_class.c39
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;
}