static TkappObject *
Tkapp_New(char *screenName, char *baseName, char *className, int interactive)
{
TkappObject *v;
char *argv0;
v = PyObject_New(TkappObject, &Tkapp_Type);
if (v == NULL)
return NULL;
v->interp = Tcl_CreateInterp();
#if defined(macintosh)
/* This seems to be needed */
ClearMenuBar();
TkMacInitMenus(v->interp);
#endif
/* Delete the 'exit' command, which can screw things up */
Tcl_DeleteCommand(v->interp, "exit");
if (screenName != NULL)
Tcl_SetVar2(v->interp, "env", "DISPLAY",
screenName, TCL_GLOBAL_ONLY);
if (interactive)
Tcl_SetVar(v->interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
else
Tcl_SetVar(v->interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* This is used to get the application class for Tk 4.1 and up */
argv0 = (char*)ckalloc(strlen(className) + 1);
if (!argv0) {
PyErr_NoMemory();
Py_DECREF(v);
return NULL;
}
strcpy(argv0, className);
if (isupper((int)(argv0[0])))
argv0[0] = tolower(argv0[0]);
Tcl_SetVar(v->interp, "argv0", argv0, TCL_GLOBAL_ONLY);
ckfree(argv0);
if (Tcl_AppInit(v->interp) != TCL_OK)
return (TkappObject *)Tkinter_Error((PyObject *)v);
EnableEventHook();
return v;
}
test() {
Tcl_Interp *interp;
int code;
int i=123;
double d=3.14;
interp = Tcl_CreateInterp();
Tcl_AppInit(interp);
// cinttk_init();
// Link C/C++ variable and Tcl variable
Tcl_LinkVar(interp,"i",(char*)(&i),TCL_LINK_INT);
Tcl_LinkVar(interp,"d",(char*)(&d),TCL_LINK_DOUBLE);
printf("i=%s\n",Tcl_GetVar(interp,"i",0));
printf("d=%s\n",Tcl_GetVar(interp,"d",0));
Tcl_SetVar(interp,"i","456",0);
Tcl_SetVar(interp,"d","1.41421356",0);
printf("i=%d\n",i);
printf("d=%g\n",d);
code=Tcl_Eval(interp,"set i 789");
code=Tcl_Eval(interp,"set d 0.71");
printf("i=%d\n",i);
printf("d=%g\n",d);
i=3229;
d=1.6e-19;
code=Tcl_Eval(interp,"expr $i");
if(*interp->result!=0) printf("%s\n",interp->result);
code=Tcl_Eval(interp,"expr $d");
if(*interp->result!=0) printf("%s\n",interp->result);
printf("tcl source code insertion test\n");
#pragma tcl interp
set i 512
set d 299.793
#pragma endtcl
printf("i=%d\n",i);
printf("d=%g\n",d);
if(code!=TCL_OK) exit(1);
exit(0);
}
int main(int argc, char** argv)
{
int err;
Tcl_Interp *interp;
err = 0;
print_head();
interp = Tcl_CreateInterp();
if (interp == NULL)
{
fprintf(stderr, "can't create interpreter\n");
return ERRCODE_TCL;
}
/* get device name from environment */
{
char *denv;
denv = getenv(ENV_DPORT_TTY);
if (denv != NULL)
strcpy(dev, denv);
}
/* check existance of default startup script */
{
struct stat statbuf;
if (stat(DEFAULT_SCRIPT, &statbuf) == 0)
strcpy(script, DEFAULT_SCRIPT);
}
/* parse cmd line */
get_args(argc, argv, interp);
if (strlen(dev) == 0)
{
fprintf(stderr, "communication port not specified, see --dev option\n");
return ERRCODE_DEVSTR;
}
/* print miscellaneous variables */
{
if (strlen(script))
printf("SCRIPT %s\n", script);
printf( "TTY %s\n", dev);
printf("\n");
}
/* initialize communication port */
commdev_init();
commdev_open(&commdev, dev);
/* initialize some debug structures */
debug.commdev = &commdev;
debug.interp = interp;
debug.run = 1;
debug.cont = 0;
/*
* Target's buffer size should be determined
* befor we can execute some commands
*/
if (debug_cmd_get_bufsize(&debug) < 0)
{
err = ERRCODE_BUFSIZE;
goto err_getbufsize;
}
if (Tcl_AppInit(interp) != TCL_OK)
{
err = ERRCODE_TCL;
goto err_tcl;
}
err = debug_loop();
err_getbufsize:
err_tcl:
commdev_close(&commdev);
commdev_exit();
return err;
}
void Init(CCore* Root) {
const char * const *argv;
CModuleImplementation::Init(Root);
g_Bouncer = Root;
const char *ConfigFile = g_Bouncer->BuildPathConfig("sbnc.tcl");
struct stat statbuf;
if (stat(ConfigFile, &statbuf) < 0) {
FILE *ConfigFd = fopen(ConfigFile, "wb");
if (ConfigFd == NULL) {
g_Bouncer->Log("Could not create 'sbnc.tcl' file.");
g_Bouncer->Fatal();
}
const char *ConfigDistFile = g_Bouncer->BuildPathShared("scripts/sbnc.tcl.dist");
FILE *ConfigDistFd = fopen(ConfigDistFile, "rb");
if (ConfigDistFd == NULL) {
ConfigFile = g_Bouncer->BuildPathConfig("sbnc.tcl");
unlink(ConfigFile);
g_Bouncer->Log("Could not open 'sbnc.tcl.dist' file.");
g_Bouncer->Fatal();
}
while (!feof(ConfigDistFd) && !ferror(ConfigDistFd)) {
size_t Count;
char Buffer[1024];
Count = fread(Buffer, 1, sizeof(Buffer), ConfigDistFd);
if (fwrite(Buffer, 1, Count, ConfigFd) < Count) {
g_Bouncer->Log("Could not write to 'sbnc.tcl' file.");
g_Bouncer->Fatal();
}
}
fclose(ConfigDistFd);
fclose(ConfigFd);
}
const char *ScriptsDir = g_Bouncer->BuildPathConfig("scripts");
if (mkdir(ScriptsDir) < 0 && errno != EEXIST) {
g_Bouncer->Log("Could not create 'scripts' directory.");
g_Bouncer->Fatal();
}
g_TclListeners = new CHashtable<CTclSocket*, false>();
g_TclClientSockets = new CHashtable<CTclClientSocket*, false>();
argv = GetCore()->GetArgV();
Tcl_FindExecutable(argv[0]);
Tcl_SetSystemEncoding(NULL, "ISO8859-1");
g_Encoding = Tcl_GetEncoding(g_Interp, "ISO8859-1");
g_Interp = Tcl_CreateInterp();
Tcl_InitMemory(g_Interp);
Tcl_SetVar(g_Interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
Tcl_AppInit(g_Interp);
Tcl_Preserve(g_Interp);
Tcl_Eval(g_Interp,
"rename source tcl_source\n"
"\n"
"# TODO: add support for -rsrc and -rsrcid\n"
"proc source {args} {\n"
" set file [lindex $args end]\n"
"\n"
" set has_shared_file [file isfile [file join [bncshareddir] $file]]\n"
" set has_user_file [file isfile [file join [bncconfigdir] $file]]\n"
"\n"
" if {!$has_user_file && $has_shared_file} {\n"
" set file [file join [bncshareddir] $file]\n"
" }\n"
"\n"
" uplevel 1 tcl_source [lreplace $args end end $file]\n"
"}");
Tcl_EvalFile(g_Interp, "./sbnc.tcl");
}
