add support for properties function

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

2 files changed, 53 insertions, 0 deletions

diff --git a/tcl_class.cxx b/tcl_class.cxx
index 01aebaf..7525e77 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -17,8 +17,37 @@ t_class* tclpd_class_new(const char* name, int flags) {
     class_table[string(name)] = c;
     class_addanything(c, tclpd_anything);
 
+    // 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];
+    int res_i;
+    snprintf(buf, 80, "llength [info procs ::%s_object_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");
+        }
+#endif
+    }
+#ifdef DEBUG
+    else {
+        post("tclpd_class_new: [info procs] returned an error");
+    }
+#endif
     return c;
 }
 
@@ -218,3 +247,26 @@ void tclpd_save(t_gobj* z, t_binbuf* b) {
     Tcl_DecrRefCount(av[1]);
     Tcl_DecrRefCount(av[2]);
 }
+
+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;
+    Tcl_IncrRefCount(av[0]);
+    av[1] = Tcl_NewStringObj("object", -1);
+    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(result);
+    }
+    Tcl_DecrRefCount(av[0]);
+    Tcl_DecrRefCount(av[1]);
+    Tcl_DecrRefCount(av[2]);
+}
diff --git a/tcl_extras.h b/tcl_extras.h
index ad95dc1..9c38f58 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -65,6 +65,7 @@ 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);
+void tclpd_properties(t_gobj* z, t_glist* owner);
 
 /* tcl_widgetbehavior.cxx */
 void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* xp2, int* yp2);