From 9ea4e9fc1b4775a0e6b1c387a2a0965686c1c20e Mon Sep 17 00:00:00 2001 From: mescalinum Date: Fri, 14 Oct 2011 21:32:49 +0000 Subject: reorder tcl land into namespaces and streamline and standardize syntax svn path=/trunk/externals/loaders/tclpd/; revision=15600 --- tcl_class.c | 99 +++++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 64 insertions(+), 35 deletions(-) (limited to 'tcl_class.c') diff --git a/tcl_class.c b/tcl_class.c index c0c7485..6e700c2 100644 --- a/tcl_class.c +++ b/tcl_class.c @@ -136,6 +136,8 @@ t_class* tclpd_class_new(const char* name, int flags) { class_table_add(name, c); class_addanything(c, tclpd_anything); + + // 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 @@ -145,7 +147,7 @@ t_class* tclpd_class_new(const char* name, int flags) { // check if properties function exists in tcl space. char buf[80]; int res_i; - snprintf(buf, 80, "llength [info procs ::%s_object_properties]", name); + 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) { @@ -196,31 +198,37 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) { x->x_glist = (t_glist*)canvas_getcurrent(); x->classname = Tcl_NewStringObj(name, -1); - char s[64]; - snprintf(s, 64, "tclpd:%s:x%lx", name, objectSequentialId++); - x->self = Tcl_NewStringObj(s, -1); - - // the lifetime of x->classname and x->self is greater than this + char so[64]; + snprintf(so, 64, "tclpd.%s.x%lx", name, objectSequentialId++); + x->self = Tcl_NewStringObj(so, -1); + char sd[64]; + snprintf(sd, 64, "::%s::dispatcher", name); + x->dispatcher = Tcl_NewStringObj(sd, -1); + + // the lifetime of x->{classname,self,dispatcher} is greater than this // function, hence they get an extra Tcl_IncrRefCount here: // (see tclpd_free()) Tcl_IncrRefCount(x->classname); Tcl_IncrRefCount(x->self); + Tcl_IncrRefCount(x->dispatcher); // store in object table (for later lookup) - if(!object_table_get(s)) - object_table_add(s, x); + if(!object_table_get(so)) + object_table_add(so, x); // build constructor command - Tcl_Obj *av[ac+2]; InitArray(av, ac+2, NULL); - av[0] = x->classname; + Tcl_Obj *av[ac+3]; InitArray(av, ac+3, NULL); + av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("constructor", -1); + Tcl_IncrRefCount(av[2]); for(int i=0; iclassname, NULL), -1); - Tcl_AppendToObj(sym, "_destructor", -1); - Tcl_Obj *av[2]; InitArray(av, 2, NULL); - av[0] = sym; + Tcl_Obj *av[3]; InitArray(av, 3, NULL); + av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("destructor", -1); + Tcl_IncrRefCount(av[2]); + // call destructor - if(Tcl_EvalObjv(tcl_for_pd, 2, av, 0) != TCL_OK) { + if(Tcl_EvalObjv(tcl_for_pd, 3, av, 0) != TCL_OK) { #ifdef DEBUG - post("tclpd_free: failed"); + post("tclpd_free: failed to call destructor"); #endif } + + // decrement reference counter Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); + Tcl_DecrRefCount(av[2]); // here ends the lifetime of x->classname and x->self Tcl_DecrRefCount(x->self); Tcl_DecrRefCount(x->classname); + Tcl_DecrRefCount(x->dispatcher); #ifdef DEBUG post("tclpd_free called"); #endif @@ -280,30 +293,34 @@ void tclpd_anything(t_tcl* x, t_symbol* s, int ac, t_atom* at) { } void tclpd_inlet_anything(t_tcl* x, int inlet, t_symbol* s, int ac, t_atom* at) { - // proxy method - format: ... - Tcl_Obj* av[ac+3]; InitArray(av, ac+3, NULL); + // proxy method - format: method args... + Tcl_Obj* av[ac+5]; InitArray(av, ac+5, NULL); int result; - av[0] = x->self; + av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); - av[1] = Tcl_NewIntObj(inlet); + av[1] = x->self; Tcl_IncrRefCount(av[1]); - av[2] = Tcl_NewStringObj(s->s_name, -1); + av[2] = Tcl_NewStringObj("method", -1); Tcl_IncrRefCount(av[2]); + av[3] = Tcl_NewIntObj(inlet); + Tcl_IncrRefCount(av[3]); + av[4] = Tcl_NewStringObj(s->s_name, -1); + Tcl_IncrRefCount(av[4]); for(int i=0; iself; + av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); - av[1] = Tcl_NewStringObj("object", -1); + av[1] = x->self; 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); @@ -429,6 +447,7 @@ void tclpd_save(t_gobj* z, t_binbuf* b) { pd_error(x, "Tcl: object save: failed"); tclpd_interp_error(x, result); } + Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); Tcl_DecrRefCount(av[2]); @@ -436,23 +455,33 @@ void tclpd_save(t_gobj* z, t_binbuf* b) { void tclpd_properties(t_gobj* z, t_glist* owner) { Tcl_Obj* av[3]; InitArray(av, 3, NULL); - Tcl_Obj* res; t_tcl* x = (t_tcl*)z; - av[0] = x->self; + av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); - av[1] = Tcl_NewStringObj("object", -1); + av[1] = x->self; Tcl_IncrRefCount(av[1]); av[2] = Tcl_NewStringObj("properties", -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); pd_error(x, "Tcl: object properties: failed"); tclpd_interp_error(x, result); } + Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); Tcl_DecrRefCount(av[2]); } + +void tclpd_class_namespace_init(const char* classname) { + char cmd[256]; + snprintf(cmd, 256, "if [namespace exists ::%s] " + "{namespace delete ::%s}; " + "namespace eval ::%s {}", + classname, classname, classname); + Tcl_Eval(tcl_for_pd, cmd); +} -- cgit v1.2.1