From adb7dc9f4414e23bad1815fe592f74cfe7ff956e Mon Sep 17 00:00:00 2001 From: mescalinum Date: Wed, 12 Oct 2011 10:13:10 +0000 Subject: some fixes svn path=/trunk/externals/loaders/tclpd/; revision=15573 --- Makefile | 6 ++++-- pdlib.tcl | 5 ++++- tcl_class.c | 10 +++++----- tcl_extras.h | 2 +- tcl_loader.c | 2 +- tcl_widgetbehavior.c | 26 +++++++++++++------------- tclpd.c | 11 +++++------ 7 files changed, 33 insertions(+), 29 deletions(-) diff --git a/Makefile b/Makefile index beec508..2c000a7 100644 --- a/Makefile +++ b/Makefile @@ -35,7 +35,9 @@ EXTRA_DIST = tcl.i tcl_extras.h pdlib.tcl $(TCLPD_SOURCES) ChangeLog.txt AUTHORS # #------------------------------------------------------------------------------# -ALL_CFLAGS = $(PD_INCLUDES) -std=c99 -I/usr/include/tcl8.5 +ALL_CFLAGS = $(PD_INCLUDES) -std=c99 -I/usr/include/tcl8.5 \ + -fno-strict-aliasing \ + -Wall -W -Wno-unused-parameter ALL_LDFLAGS = SHARED_LDFLAGS = ALL_LIBS = @@ -52,7 +54,7 @@ LIBS_windows = -ltcl85 "$(LIBRARY_NAME).def" # these can be set from outside without (usually) breaking the build DEBUG = 0 -CFLAGS = -Wall -W +CFLAGS = LDFLAGS = LIBS = diff --git a/pdlib.tcl b/pdlib.tcl index b50479b..f490289 100644 --- a/pdlib.tcl +++ b/pdlib.tcl @@ -84,7 +84,10 @@ namespace eval ::pd { if {[llength [info commands $m_any]] > 0} { return [$m_any $self [list symbol $sel] {*}$args] } - post "Tcl class $classname: inlet $inlet: no such method: $sel" + # don't notify if a loadbang method does not exists + if {$sel != "loadbang"} { + post "Tcl class $classname: inlet $inlet: no such method: $sel" + } } proc read_class_definition {classname def} { diff --git a/tcl_class.c b/tcl_class.c index b5d98d9..4e17bc7 100644 --- a/tcl_class.c +++ b/tcl_class.c @@ -233,7 +233,7 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) { return x; error: - tclpd_interp_error(TCL_ERROR); + tclpd_interp_error(NULL, TCL_ERROR); for(int i = 0; i < (ac+2); i++) { if(!av[i]) break; Tcl_DecrRefCount(av[i]); @@ -302,7 +302,7 @@ void tclpd_inlet_anything(t_tcl* x, int inlet, t_symbol* s, int ac, t_atom* at) return; error: - tclpd_interp_error(TCL_ERROR); + tclpd_interp_error(x, TCL_ERROR); for(int i=0; i < (ac+3); i++) { if(!av[i]) break; Tcl_DecrRefCount(av[i]); @@ -399,12 +399,12 @@ void tclpd_save(t_gobj* z, t_binbuf* b) { } } else { pd_error(x, "Tcl: object save: failed"); - tclpd_interp_error(result); + tclpd_interp_error(x, result); } Tcl_DecrRefCount(res); } else { pd_error(x, "Tcl: object save: failed"); - tclpd_interp_error(result); + tclpd_interp_error(x, result); } Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); @@ -427,7 +427,7 @@ void tclpd_properties(t_gobj* z, t_glist* owner) { if(result != TCL_OK) { //res = Tcl_GetObjResult(tcl_for_pd); pd_error(x, "Tcl: object properties: failed"); - tclpd_interp_error(result); + tclpd_interp_error(x, result); } Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); diff --git a/tcl_extras.h b/tcl_extras.h index a07c2d3..d209b8e 100644 --- a/tcl_extras.h +++ b/tcl_extras.h @@ -51,7 +51,7 @@ int tcl_to_pd(Tcl_Obj* input, t_atom* output); /* tcl_setup.cxx */ extern Tcl_Interp* tcl_for_pd; extern void tclpd_setup(void); -void tclpd_interp_error(int result); +void tclpd_interp_error(t_tcl* x, int result); /* tcl_class.cxx */ t_class* tclpd_class_new(const char* name, int flags); diff --git a/tcl_loader.c b/tcl_loader.c index 184eb20..95d0232 100644 --- a/tcl_loader.c +++ b/tcl_loader.c @@ -53,7 +53,7 @@ gotone: post("Tcl loader: loaded %s", filename); } else { post("Tcl loader: error trying to load %s", filename); - tclpd_interp_error(result); + tclpd_interp_error(NULL, result); return 0; } diff --git a/tcl_widgetbehavior.c b/tcl_widgetbehavior.c index 818e9a4..56e21dc 100644 --- a/tcl_widgetbehavior.c +++ b/tcl_widgetbehavior.c @@ -16,7 +16,7 @@ void tclpd_guiclass_motion(t_tcl* x, t_floatarg dx, t_floatarg dy) { Tcl_IncrRefCount(av[4]); int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } goto cleanup; @@ -72,7 +72,7 @@ int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shif goto cleanup; error: - tclpd_interp_error(result); + tclpd_interp_error(x, result); cleanup: if(o) Tcl_DecrRefCount(o); @@ -108,7 +108,7 @@ void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* Tcl_IncrRefCount(av[4]); int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } theList = Tcl_GetObjResult(tcl_for_pd); @@ -117,7 +117,7 @@ void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* //result = Tcl_ListObjGetElements(tcl_for_pd, theList, @, @); result = Tcl_ListObjLength(tcl_for_pd, theList, &length); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } if(length != 4) { @@ -128,12 +128,12 @@ void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* for(i = 0; i < 4; i++) { result = Tcl_ListObjIndex(tcl_for_pd, theList, i, &o); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } result = Tcl_GetIntFromObj(tcl_for_pd, o, &tmp[i]); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } } @@ -167,7 +167,7 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { Tcl_IncrRefCount(av[4]); int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } theList = Tcl_GetObjResult(tcl_for_pd); @@ -176,7 +176,7 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { //result = Tcl_ListObjGetElements(tcl_for_pd, theList, @, @); result = Tcl_ListObjLength(tcl_for_pd, theList, &length); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } if(length != 2) { @@ -187,12 +187,12 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { for(i = 0; i < 2; i++) { result = Tcl_ListObjIndex(tcl_for_pd, theList, i, &o); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } result = Tcl_GetIntFromObj(tcl_for_pd, o, &tmp[i]); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } } @@ -223,7 +223,7 @@ void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected) { Tcl_IncrRefCount(av[3]); int result = Tcl_EvalObjv(tcl_for_pd, 4, av, 0); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } goto cleanup; @@ -248,7 +248,7 @@ void tclpd_guiclass_activate(t_gobj* z, t_glist* glist, int state) { Tcl_IncrRefCount(av[3]); int result = Tcl_EvalObjv(tcl_for_pd, 4, av, 0); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } goto cleanup; @@ -286,7 +286,7 @@ void tclpd_guiclass_vis(t_gobj* z, t_glist* glist, int vis) { Tcl_IncrRefCount(av[6]); int result = Tcl_EvalObjv(tcl_for_pd, 7, av, 0); if(result != TCL_OK) { - tclpd_interp_error(result); + tclpd_interp_error(x, result); goto error; } goto cleanup; diff --git a/tclpd.c b/tclpd.c index 27e49d7..4bc0b5a 100644 --- a/tclpd.c +++ b/tclpd.c @@ -33,11 +33,10 @@ void tclpd_setup(void) { sys_register_loader(tclpd_do_load_lib); } -void tclpd_interp_error(int result) { +void tclpd_interp_error(t_tcl* x, int result) { error("tclpd error: %s", Tcl_GetStringResult(tcl_for_pd)); - post(" (see stderr for details)"); - fprintf(stderr, "------------------- Tcl error: -------------------\n"); + logpost(x, 3, "------------------- Tcl error: -------------------\n"); // Tcl_GetReturnOptions and Tcl_DictObjGet only available in Tcl >= 8.5 @@ -48,10 +47,10 @@ void tclpd_interp_error(int result) { Tcl_IncrRefCount(errorInfoK); Tcl_DictObjGet(tcl_for_pd, dict, errorInfoK, &errorInfo); Tcl_DecrRefCount(errorInfoK); - fprintf(stderr, "%s\n", Tcl_GetStringFromObj(errorInfo, 0)); + logpost(x, 3, "%s\n", Tcl_GetStringFromObj(errorInfo, 0)); #else - fprintf(stderr, "Backtrace not available in Tcl < 8.5. Please upgrade Tcl.\n"); + logpost(x, 3, "Backtrace not available in Tcl < 8.5. Please upgrade Tcl.\n"); #endif - fprintf(stderr, "--------------------------------------------------\n"); + logpost(x, 3, "--------------------------------------------------\n"); } -- cgit v1.2.1