diff options
| -rw-r--r-- | pdlib.tcl | 1 | ||||
| -rw-r--r-- | tcl_class.c | 39 |
2 files changed, 15 insertions, 25 deletions
@@ -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; } |