From f3e255ddca6468b6adea0f10f30540c37cdde9ad Mon Sep 17 00:00:00 2001 From: "N.N." Date: Tue, 18 Sep 2007 17:19:03 +0000 Subject: first commit for tclpd external svn path=/trunk/externals/tclpd/; revision=8736 --- tcl_loader.cxx | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 tcl_loader.cxx (limited to 'tcl_loader.cxx') diff --git a/tcl_loader.cxx b/tcl_loader.cxx new file mode 100644 index 0000000..47d8cc0 --- /dev/null +++ b/tcl_loader.cxx @@ -0,0 +1,55 @@ +#include "tcl_extras.h" +#include +#include + +extern "C" int tclpd_do_load_lib(t_canvas *canvas, char *objectname) +{ + char filename[MAXPDSTRING], dirbuf[MAXPDSTRING], + *classname, *nameptr; + int fd; + if (classname = strrchr(objectname, '/')) + 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).(sys_dllextent) ... */ + 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; + //post("Tcl_loader: tried and failed"); + 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: + char b[MAXPDSTRING+10]; + snprintf(&b[0], MAXPDSTRING+10, "source %s", filename); + if (Tcl_Eval(tcl_for_pd,b) == TCL_OK) + post("Tcl_loader: loaded %s", b); + else + post("Tcl_loader: error trying to load %s", b); + + class_set_extern_dir(&s_); + sys_putonloadlist(objectname); + return (1); +} + -- cgit v1.2.1