1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#include "tclpd.h"
#include <string.h>
#include <unistd.h>
/* from tcl_class.c: */
//void source_table_remove(const char *object_name);
void source_table_add(const char *object_name, const char *source_path);
extern int tclpd_do_load_lib(t_canvas *canvas, char *objectname) {
char filename[MAXPDSTRING], dirbuf[MAXPDSTRING], buf[MAXPDSTRING],
*classname, *nameptr;
int fd;
if ((classname = strrchr(objectname, '/')) != NULL)
classname++;
else
classname = objectname;
if(sys_onloadlist(objectname)) {
verbose(-1, "tclpd loader: already loaded: %s", objectname);
return 1;
}
/* try looking in the path for (objectname).(tcl) ... */
verbose(-1, "tclpd loader: searching for %s in path...", objectname);
if ((fd = canvas_open(canvas, objectname, ".tcl",
dirbuf, &nameptr, MAXPDSTRING, 1)) >= 0)
goto found;
/* 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;
verbose(-1, "tclpd loader: searching for %s in path...", filename);
if ((fd = canvas_open(canvas, filename, ".tcl",
dirbuf, &nameptr, MAXPDSTRING, 1)) >= 0)
goto found;
verbose(-1, "tclpd loader: found nothing!");
return 0;
found:
verbose(-1, "tclpd loader: found!");
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;
verbose(-1, "tclpd loader: absolute path is %s", filename);
int result;
// create the required tcl namespace for the class
verbose(-1, "tclpd loader: init namespace for class %s", classname);
tclpd_class_namespace_init(classname);
// add current dir to the Tcl auto_path so objects can use local packages
Tcl_Eval(tclpd_interp, "set current_auto_path $auto_path");
snprintf(buf, MAXPDSTRING, "set auto_path \"{%s} $auto_path\"", dirbuf);
Tcl_Eval(tclpd_interp, buf);
verbose(0, buf);
// load tcl external:
verbose(-1, "tclpd loader: loading tcl file %s", filename);
result = Tcl_EvalFile(tclpd_interp, filename);
if(result == TCL_OK) {
source_table_add(classname, filename);
verbose(0, "tclpd loader: loaded %s", filename);
} else {
error("tclpd loader: error trying to load %s", filename);
tclpd_interp_error(NULL, result);
return 0;
}
// reset auto_path
Tcl_Eval(tclpd_interp, "set auto_path $current_auto_path");
#ifdef TCLPD_CALL_SETUP
// call the setup method:
char cmd[64];
snprintf(cmd, 64, "::%s::setup", classname);
verbose(-1, "tclpd loader: calling setup function for %s", classname);
result = Tcl_Eval(tclpd_interp, cmd);
if(result == TCL_OK) {
} else {
error("tclpd loader: error in %s %s::setup", filename, classname);
tclpd_interp_error(NULL, result);
return 0;
}
#endif // TCLPD_CALL_SETUP
class_set_extern_dir(&s_);
sys_putonloadlist(objectname);
return 1;
}
|
