From 5a38f01421e93db2cf5b5c05afe84fb73eb89425 Mon Sep 17 00:00:00 2001 From: mescalinum Date: Sun, 2 Oct 2011 16:34:46 +0000 Subject: mv *.cxx *.c svn path=/trunk/externals/loaders/tclpd/; revision=15442 --- tcl_loader.c | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) create mode 100644 tcl_loader.c (limited to 'tcl_loader.c') diff --git a/tcl_loader.c b/tcl_loader.c new file mode 100644 index 0000000..2dad0d1 --- /dev/null +++ b/tcl_loader.c @@ -0,0 +1,64 @@ +#include "tcl_extras.h" +#include +#include + +extern "C" int tclpd_do_load_lib(t_canvas *canvas, char *objectname) { +#ifdef DEBUG + post("Tcl loader: registering tcl class loader mechanism"); +#endif + char filename[MAXPDSTRING], dirbuf[MAXPDSTRING], + *classname, *nameptr; + int fd; + + if ((classname = strrchr(objectname, '/')) != NULL) + classname++; + else + classname = objectname; + + if(sys_onloadlist(objectname)) { + post("%s: already loaded", objectname); + return (1); + } + + /* try looking in the path for (objectname).(tcl) ... */ + if ((fd = canvas_open(canvas, objectname, ".tcl", + dirbuf, &nameptr, MAXPDSTRING, 1)) >= 0) + goto gotone; + + /* next try (objectname)/(classname).(tcl) ... */ + strncpy(filename, objectname, MAXPDSTRING); + filename[MAXPDSTRING-2] = 0; + strcat(filename, "/"); + strncat(filename, classname, MAXPDSTRING-strlen(filename)); + filename[MAXPDSTRING-1] = 0; + if ((fd = canvas_open(canvas, filename, ".tcl", + dirbuf, &nameptr, MAXPDSTRING, 1)) >= 0) + goto gotone; + + return 0; + +gotone: + close(fd); + class_set_extern_dir(gensym(dirbuf)); + /* rebuild the absolute pathname */ + strncpy(filename, dirbuf, MAXPDSTRING); + filename[MAXPDSTRING-2] = 0; + strcat(filename, "/"); + strncat(filename, nameptr, MAXPDSTRING-strlen(filename)); + filename[MAXPDSTRING-1] = 0; + + // load tcl external: + int result = Tcl_EvalFile(tcl_for_pd, filename); + if(result == TCL_OK) { + post("Tcl loader: loaded %s", filename); + } else { + post("Tcl loader: error trying to load %s", filename); + tclpd_interp_error(result); + return 0; + } + + class_set_extern_dir(&s_); + sys_putonloadlist(objectname); + return 1; +} + -- cgit v1.2.1