/*
* Tcl_AppInit - Called by TCL to perform application-specific initialization.
*/
int Tcl_AppInit(Tcl_Interp *interp)
{
/* Tell TCL about the name of the simulator so it can */
/* use it as the title of the main window */
Tcl_SetVar(interp, "simname", simname, TCL_GLOBAL_ONLY);
if (Tcl_Init(interp) == TCL_ERROR)
return TCL_ERROR;
if (Tk_Init(interp) == TCL_ERROR)
return TCL_ERROR;
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
/* Call procedure to add new commands */
addAppCommands(interp);
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
kit::kit()
{
created++;
if(interp != NULL) // already initialized?
return;
interp = Tcl_CreateInterp();
if (Tcl_Init(interp) == TCL_ERROR)
{
cerr << "Tcl_Init(interp) failed: " << interp->result << endl;
exit(1);
}
if (Tk_Init(interp) == TCL_ERROR)
{
cerr << "Tk_Init(interp) failed: " << interp->result << endl;
exit(1);
}
if (Tix_Init(interp) == TCL_ERROR)
{
cerr << "Tix_Init(interp) failed: " << interp->result << endl;
exit(1);
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
/*
* We need more X event information that tk can provide, so install
* a handler for *each* event, to store a pointer to the Xevent
* structure, which has the information we need
*/
Tk_CreateGenericHandler(dispatchX, NULL);
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef BWISH
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif
Cad_AppInit(interp);
/*
* Specify a user-specific startup file to invoke if the application is
* run interactively. Typically the startup file is "~/.apprc" where "app"
* is the name of the application. If this line is deleted then no user-
* -specific startup file will be run under any conditions.
*/
#ifdef BWISH
Tcl_SetVar(interp, "tcl_rcFileName", "~/.bwishrc", TCL_GLOBAL_ONLY);
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.btclshrc", TCL_GLOBAL_ONLY);
#endif
return TCL_OK;
}
int Tcl_AppInit( Tcl_Interp *interp)
{
// Tcl_Eval (interp, "set tcl_library \"C:/Tcl/lib/tcl8.5\"" );
try
{
if ( TCL_OK != Tcl_Init(interp) )
throw std::logic_error ( Tcl_GetStringResult ( interp ));
if ( TCL_OK != Tk_Init(interp) )
throw std::logic_error ( Tcl_GetStringResult ( interp ));
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
Tk_InitConsoleChannels(interp);
if ( TCL_OK != Tk_CreateConsoleWindow(interp) )
throw std::logic_error ( Tcl_GetStringResult ( interp ));
if ( TCL_OK != Tcl_Eval (interp, "wm withdraw ." ) )
throw std::logic_error ( Tcl_GetStringResult ( interp ));
if ( TCL_OK != Tcl_Eval (interp, "console show" ) )
throw std::logic_error ( Tcl_GetStringResult ( interp ));
register_tclcmds ( interp );
Tcl_SetVar(interp, "tcl_rcFileName", "./.rc", TCL_GLOBAL_ONLY);
}
catch ( std::exception& ex )
{
const char* errinfo = ex.what();
return TCL_ERROR;
}
return TCL_OK;
}
/* ui admin functions */
int
ui_init(struct queue_s *channels)
{
interp = Tcl_CreateInterp();
priv_c = channels;
if (Tcl_Init(interp) == TCL_ERROR) {
printf("Failed to initialise Tcl interpreter:\n%s\n",
(interp)->result);
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
printf("Failed to initialise Tk package:\n%s\n",
(interp)->result);
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
Tcl_CreateCommand(interp, "get_ports", get_ports, NULL, NULL);
Tcl_CreateCommand(interp, "update_engine", update_engine, NULL, NULL);
Tcl_CreateCommand(interp, "query_engine", query_engine, NULL, NULL);
Tcl_CreateCommand(interp, "ui_exit", ui_exit, NULL, NULL);
if (Tcl_Eval(interp, &tclscript[0]) != TCL_OK) {
printf("Failed to run tcl command, error: %s\n", (interp)->result);
return 0;
}
return 1;
}
/*
* Called by Tk_Main() to let me initialize the modules (Togl) I will need.
*/
int my_init( Tcl_Interp *interp )
{
/*
* Initialize Tcl, Tk, and the Togl widget module.
*/
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef WIN32
/*
* Set up a console window. Delete the following statement if you do not need that.
*/
if (TkConsoleInit(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* WIN32 */
if (Togl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Specify the C callback functions for widget creation, display,
* and reshape.
*/
Togl_CreateFunc( create_cb );
Togl_DisplayFunc( display_cb );
Togl_ReshapeFunc( reshape_cb );
Togl_TimerFunc( timer_cb );
/*
* Make a new Togl widget command so the Tcl code can set a C variable.
*/
/* NONE */
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
/*NOTHING*/
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
#if (TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION) >= 705
Tcl_SetVar( interp, "tcl_rcFileName", "./index.tcl", TCL_GLOBAL_ONLY );
#else
tcl_RcFileName = "./index.tcl";
#endif
return TCL_OK;
}
int
init (Tcl_Interp *interp)
{
if (Tcl_Init (interp) == TCL_ERROR)
return TCL_ERROR;
if (Tk_Init (interp) == TCL_ERROR)
return TCL_ERROR;
return TCL_OK;
}
dfsch_object_t* dfsch_tcl_create_interpreter(){
Tcl_Interp* i = Tcl_CreateInterp();
if (Tcl_Init(i) == TCL_ERROR){
dfsch_tcl_error(i);
}
if (Tk_Init(i) == TCL_ERROR){
dfsch_tcl_error(i);
}
return dfsch_tcl_make_interpreter(i);
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
(Tcl_PackageInitProc *) NULL);
#endif /* TK_TEST */
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would look like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
SetupMainInterp(interp);
/*
* Specify a user-specific startup script to invoke if the application
* is run interactively. On the Mac we can specifiy either a TEXT resource
* which contains the script or the more UNIX like file location
* may also used. (I highly recommend using the resource method.)
*/
Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
return TCL_OK;
}
static int AppInit(Tcl_Interp *interp)
{
#include "bitmaps/back.xbm"
#include "bitmaps/fwrd.xbm"
#include "bitmaps/next.xbm"
#include "bitmaps/pause.xbm"
#include "bitmaps/play.xbm"
#include "bitmaps/prev.xbm"
#include "bitmaps/quit.xbm"
#include "bitmaps/stop.xbm"
#include "bitmaps/timidity.xbm"
#define DefineBitmap(Bitmap) do { \
Tk_DefineBitmap (interp, Tk_GetUid(#Bitmap), Bitmap##_bits, \
Bitmap##_width, Bitmap##_height); \
} while(0)
my_interp = interp;
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_CreateCommand(interp, "TraceCreate", (Tcl_CmdProc*) TraceCreate,
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
Tcl_CreateCommand(interp, "TraceUpdate", (Tcl_CmdProc*) TraceUpdate,
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
Tcl_CreateCommand(interp, "TraceReset", (Tcl_CmdProc*) TraceReset,
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
Tcl_CreateCommand(interp, "ExitAll", (Tcl_CmdProc*) ExitAll,
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
Tcl_CreateCommand(interp, "TraceUpdate", (Tcl_CmdProc*) TraceUpdate,
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
DefineBitmap(back);
DefineBitmap(fwrd);
DefineBitmap(next);
DefineBitmap(pause);
DefineBitmap(play);
DefineBitmap(prev);
DefineBitmap(quit);
DefineBitmap(stop);
DefineBitmap(timidity);
return TCL_OK;
#undef DefineBitmap
}
int Tcl_AppInit(Tcl_Interp *pintrp)
{
if (Tcl_InitStubs(pintrp, TCL_VERSION, 1) == NULL)
Panic (pintrp,"Tcl stub's initialisation failed!");
if (Tcl_Init(pintrp) == TCL_ERROR)
Panic (pintrp,"Tcl's initialisation failed!");
if (Tk_Init(pintrp) == TCL_ERROR)
Panic (pintrp,"Tk's initialisation failed!");
return TCL_OK;
}
static int
elWishAppInit(Tcl_Interp *interp)
{
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
/* change the rc file */
Tcl_SetVar(interp, "tcl_rcFileName", "~/.elwishrc", TCL_GLOBAL_ONLY);
/* I hate that stupid empty window you get after Tk_Init() */
Tcl_Eval(interp, "wm withdraw .");
return TCL_OK;
}
int appinit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR)
return (TCL_ERROR);
Tcl_CreateExitHandler(exitHandler, 0);
#ifdef TK
if (Tk_Init(interp) == TCL_ERROR)
return (TCL_ERROR);
#endif
if (on_program_start(interp) == TCL_ERROR)
return (TCL_ERROR);
return (TCL_OK);
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
Tk_Window main;
main = Tk_MainWindow(interp);
if (Tcl_Init(interp) == TCL_ERROR) {
PySys_WriteStderr("Tcl_Init error: %s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
PySys_WriteStderr("Tk_Init error: %s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
return TCL_OK;
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if ((Tcl_Init)(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 0);
#endif /* TK_TEST */
/*
* Call the init procedures for included packages. Each call should look
* like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module. (Dynamically-loadable packages
* should have the same entry-point name.)
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if they
* weren't already created by the init procedures called above.
*/
/*
* Specify a user-specific startup file to invoke if the application is
* run interactively. Typically the startup file is "~/.apprc" where "app"
* is the name of the application. If this line is deleted then no user-
* specific startup file will be run under any conditions.
*/
(Tcl_SetVar)(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
int appinit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR)
return TCL_ERROR;
#ifdef TK
if (Tk_Init(interp) == TCL_ERROR)
return TCL_ERROR;
#endif
/*
installation of tcl commands
*/
register_tcl_commands(interp);
register_global_variables(interp);
/* evaluate the Tcl initialization script */
char *scriptdir = getenv("ESPRESSO_SCRIPTS");
if (!scriptdir)
scriptdir = get_default_scriptsdir();
/* fprintf(stderr,"Script directory: %s\n", scriptdir);*/
char cwd[1024];
if ((getcwd(cwd, 1024) == NULL) || (chdir(scriptdir) != 0)) {
fprintf(stderr,
"\n\ncould not change to script dir %s, please check ESPRESSO_SCRIPTS.\n\n\n",
scriptdir);
exit(1);
}
if (Tcl_EvalFile(interp, "init.tcl") == TCL_ERROR) {
fprintf(stderr, "\n\nerror in initialization script: %s\n\n\n",
Tcl_GetStringResult(interp));
exit(1);
}
if (chdir(cwd) != 0) {
fprintf(stderr,
"\n\ncould not change back to execution dir %s ????\n\n\n",
cwd);
exit(1);
}
return (TCL_OK);
}
/*--------------------------------------------------------------------------*/
int sci_opentk(char *fname, unsigned long l)
{
Tcl_Interp *TCLinterpLocal = NULL;
CheckRhs(0, 0);
CheckLhs(1, 1);
TCLinterpLocal = Tcl_CreateInterp();
Tcl_Init(TCLinterpLocal);
Tk_Init(TCLinterpLocal);
TKmainWindow = Tk_MainWindow(TCLinterpLocal);
Tk_GeometryRequest(TKmainWindow, 200, 200);
Tk_SetWindowBackground(TKmainWindow, WhitePixelOfScreen(Tk_Screen(TKmainWindow)));
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
static bool tk_start(char **result)
{
static bool first_init = false;
Tk_Window mainw;
if (!first_init) {
first_init = true;
/* this works around a bug in some Tcl/Tk versions */
Tcl_FindExecutable(NULL);
/* finalize Tcl at program exit */
atexit(Tcl_Finalize);
}
*result = NULL;
if (interp) return true;
/* start up a new interpreter */
if (!(interp = Tcl_CreateInterp())) return false;
if (Tcl_Init(interp) != TCL_OK) {
if (check_result(interp))
set_result(result, get_result(interp));
else
set_result(result, "error initializing Tcl");
tk_stop();
return false;
}
/* create a command to invoke Pure callbacks from Tcl */
Tcl_CreateCommand(interp, "pure", (Tcl_CmdProc*)tk_pure,
(ClientData)0, NULL);
/* oddly, there are no `env' variables passed, and this one is needed */
Tcl_SetVar2(interp, "env", "DISPLAY", getenv("DISPLAY"), TCL_GLOBAL_ONLY);
if (Tk_Init(interp) != TCL_OK) {
if (check_result(interp))
set_result(result, get_result(interp));
else
set_result(result, "error initializing Tk");
tk_stop();
return false;
}
/* set up an X error handler */
mainw = Tk_MainWindow(interp);
Tk_CreateErrorHandler(Tk_Display(mainw), -1, -1, -1,
XErrorProc, (ClientData)mainw);
return true;
}
int
TkWin_init(void)
{
interp = Tcl_CreateInterp();
if (Tcl_Init(interp) == TCL_ERROR) { return 0; }
if (Tk_Init(interp) == TCL_ERROR) { return 0; }
TkWin_createCommands();
TkSpooler_init(interp);
TkTape_init(interp);
if (Tcl_EvalFile(interp, "src/canace.tcl") == TCL_ERROR ) {
fprintf(stderr, "Error: Can't eval src/canace.tcl\n");
return 0;
}
TkWin_displayWindow();
return 1;
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
if (OpenSeesAppInit(interp) < 0)
return TCL_ERROR;
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR) {
goto error;
}
if (Tk_Init(interp) == TCL_ERROR) {
goto error;
}
/*
* Initialize the console only if we are running as an interactive
* application.
*/
if (consoleRequired) {
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
goto error;
}
}
Cad_AppInit(interp);
Tcl_SetVar(interp, "tcl_rcFileName", "~/bwishrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
error:
MessageBeep(MB_ICONEXCLAMATION);
MessageBox(NULL, (LPCSTR)Tcl_GetStringResult(interp), (LPCSTR)"Error in bwish",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
ExitProcess(1);
/*
* We won't reach this, but we need the return.
*/
return TCL_ERROR;
}
// Tcl_AppInit:
// application-specific initialization
int animTcl::Tcl_AppInit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR) return TCL_ERROR;
// Set the interpreter variable immediately
// because it is used in outputMessage()
m_interpreter = interp;
LinkUserVariables(interp) ;
InitUserTclCommands(interp);
char filename[256];
if (UsingTk == TRUE)
{
if (Tk_Init(interp) == TCL_ERROR)
return TCL_ERROR;
//sprintf(filename,"%s/shell.tcl",getenv("ANIM_DIR"));
sprintf(filename,"./shell.tcl");
if (TCL_OK != Tcl_EvalFile(interp,filename))
animTcl::OutputMessage("error in script: %s", filename);
}
// read the start up file
sprintf(filename,"start.tcl");
if (TCL_OK != Tcl_EvalFile(interp,filename) )
animTcl::OutputMessage("error in script: %s", filename);
// now start mainLoop
mainLoop() ;
return TCL_OK;
}
int Tcl_AppInit(Tcl_Interp *interp)
{
if(Tcl_Init(interp) == TCL_ERROR)
return TCL_ERROR;
if(Tk_Init(interp) == TCL_ERROR)
return TCL_ERROR;
if(TB_Init(interp) == TCL_ERROR)
return TCL_ERROR;
#ifdef USE_TIDE
if(Tide_Init(interp) == TCL_ERROR)
return TCL_ERROR;
#endif
if(script) {
if(Tcl_EvalFile(interp, script) != TCL_OK) {
handle_error(interp, interp->result);
}
}
return TCL_OK;
}
int
init_tk()
{
char val[20];
int code;
interp = Tcl_CreateInterp();
code = Tcl_Init(interp);
if (code != TCL_OK) {
fprintf(stderr, "in Tcl_Init: %s\n", interp->result);
return code;
}
code = Tk_Init(interp);
if (code != TCL_OK) {
fprintf(stderr, "in Tk_Init: %s\n", interp->result);
return code;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
sprintf(val, "%d", maxstep);
if (Tcl_SetVar(interp, "maxstep", val, TCL_LEAVE_ERR_MSG) == NULL) {
fprintf(stderr, "in Tcl_SetVar: %s\n", interp->result);
return code;
}
code = Tcl_Eval(interp, "source $env(EMBED_LIB)/tkembed.tcl");
if (code != TCL_OK) {
fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
return code;
}
return TCL_OK;
}
int
TclKit_AppInit(Tcl_Interp *interp)
{
char *oldCmd;
KITDEBUG("Initializing static packages")
%DQKIT_INIT_CODE%
Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
Tcl_StaticPackage(0, "dqkitpwb", Pwb_Init, NULL);
Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
#ifdef _WIN32
Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
#endif
#ifdef KIT_INCLUDES_TK
Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
#endif
/* the tcl_rcFileName variable only exists in the initial interpreter */
#ifdef _WIN32
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
#ifdef MAC_TCL
Tcl_SetVar(interp, "tcl_rcRsrcName", "tclkitrc", TCL_GLOBAL_ONLY);
#endif
#endif
KITDEBUG("TclSetPreInitScript()")
oldCmd = TclSetPreInitScript(preInitCmd);
KITDEBUG("Tcl_Init()")
if (Tcl_Init(interp) == TCL_ERROR)
goto error;
KITDEBUG("Tcl_Init2()")
TclSetPreInitScript(preInitCmd2);
#ifdef KIT_INCLUDES_TK
KITDEBUG("Initializing Tk")
#if defined(_WIN32) || defined(MAC_TCL)
if (Tk_Init(interp) == TCL_ERROR)
goto error;
#ifdef _WIN32
KITDEBUG("Initializing Tk console window")
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR)
goto error;
#else
KITDEBUG("Setting up main Tcl interp")
SetupMainInterp(interp);
#endif
#endif
#endif
KITDEBUG("Tcl_Eval(initScript)")
/* messy because TclSetStartupScriptPath is called slightly too late */
if (Tcl_Eval(interp, initScript) == TCL_OK) {
Tcl_Obj* path = TclGetStartupScriptPath();
TclSetStartupScriptPath(Tcl_GetObjResult(interp));
if (path == NULL)
Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
}
KITDEBUG("returning")
Tcl_SetVar(interp, "errorInfo", "", TCL_GLOBAL_ONLY);
Tcl_ResetResult(interp);
return TCL_OK;
error:
#ifdef KIT_INCLUDES_TK
#ifdef _WIN32
MessageBeep(MB_ICONEXCLAMATION);
MessageBox(NULL, Tcl_GetStringResult(interp), "Error in TclKit",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
ExitProcess(1);
/* we won't reach this, but we need the return */
#endif
#endif
return TCL_ERROR;
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
Tk_Window main_window;
const char * _tkinter_skip_tk_init;
#ifdef TK_AQUA
#ifndef MAX_PATH_LEN
#define MAX_PATH_LEN 1024
#endif
char tclLibPath[MAX_PATH_LEN], tkLibPath[MAX_PATH_LEN];
Tcl_Obj* pathPtr;
/* pre- Tcl_Init code copied from tkMacOSXAppInit.c */
Tk_MacOSXOpenBundleResources (interp, "com.tcltk.tcllibrary",
tclLibPath, MAX_PATH_LEN, 0);
if (tclLibPath[0] != '\0') {
Tcl_SetVar(interp, "tcl_library", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
}
if (tclLibPath[0] != '\0') {
Tcl_SetVar(interp, "tcl_library", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
}
#endif
if (Tcl_Init (interp) == TCL_ERROR)
return TCL_ERROR;
#ifdef TK_AQUA
/* pre- Tk_Init code copied from tkMacOSXAppInit.c */
Tk_MacOSXOpenBundleResources (interp, "com.tcltk.tklibrary",
tkLibPath, MAX_PATH_LEN, 1);
if (tclLibPath[0] != '\0') {
pathPtr = Tcl_NewStringObj(tclLibPath, -1);
} else {
Tcl_Obj *pathPtr = TclGetLibraryPath();
}
if (tkLibPath[0] != '\0') {
Tcl_Obj *objPtr;
Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY);
objPtr = Tcl_NewStringObj(tkLibPath, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
}
TclSetLibraryPath(pathPtr);
#endif
#ifdef WITH_XXX
// Initialize modules that don't require Tk
#endif
_tkinter_skip_tk_init = Tcl_GetVar(interp, "_tkinter_skip_tk_init", TCL_GLOBAL_ONLY);
if (_tkinter_skip_tk_init != NULL && strcmp(_tkinter_skip_tk_init, "1") == 0) {
return TCL_OK;
}
if (Tk_Init(interp) == TCL_ERROR)
return TCL_ERROR;
main_window = Tk_MainWindow(interp);
#ifdef TK_AQUA
TkMacOSXInitAppleEvents(interp);
TkMacOSXInitMenus(interp);
#endif
#ifdef WITH_MOREBUTTONS
{
extern Tcl_CmdProc studButtonCmd;
extern Tcl_CmdProc triButtonCmd;
Tcl_CreateCommand(interp, "studbutton", studButtonCmd,
(ClientData) main_window, NULL);
Tcl_CreateCommand(interp, "tributton", triButtonCmd,
(ClientData) main_window, NULL);
}
#endif
#ifdef WITH_PIL /* 0.2b5 and later -- not yet released as of May 14 */
{
extern void TkImaging_Init(Tcl_Interp *);
TkImaging_Init(interp);
/* XXX TkImaging_Init() doesn't have the right return type */
/*Tcl_StaticPackage(interp, "Imaging", TkImaging_Init, NULL);*/
}
#endif
#ifdef WITH_PIL_OLD /* 0.2b4 and earlier */
{
extern void TkImaging_Init(void);
/* XXX TkImaging_Init() doesn't have the right prototype */
/*Tcl_StaticPackage(interp, "Imaging", TkImaging_Init, NULL);*/
}
#endif
#ifdef WITH_TIX
{
extern int Tix_Init(Tcl_Interp *interp);
extern int Tix_SafeInit(Tcl_Interp *interp);
Tcl_StaticPackage(NULL, "Tix", Tix_Init, Tix_SafeInit);
}
#endif
#ifdef WITH_BLT
{
extern int Blt_Init(Tcl_Interp *);
extern int Blt_SafeInit(Tcl_Interp *);
Tcl_StaticPackage(NULL, "Blt", Blt_Init, Blt_SafeInit);
}
#endif
#ifdef WITH_TOGL
{
/* XXX I've heard rumors that this doesn't work */
extern int Togl_Init(Tcl_Interp *);
/* XXX Is there no Togl_SafeInit? */
Tcl_StaticPackage(NULL, "Togl", Togl_Init, NULL);
}
#endif
#ifdef WITH_XXX
#endif
return TCL_OK;
}
int
Tk_CreateConsoleWindow(
Tcl_Interp *interp) /* Interpreter to use for prompting. */
{
Tcl_Channel chan;
ConsoleInfo *info;
Tk_Window mainWindow;
Tcl_Command token;
int result = TCL_OK;
int haveConsoleChannel = 1;
/* Init an interp with Tcl and Tk */
Tcl_Interp *consoleInterp = Tcl_CreateInterp();
if (Tcl_Init(consoleInterp) != TCL_OK) {
goto error;
}
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
/*
* Fetch the instance data from whatever std channel is a
* console channel. If none, create fresh instance data.
*/
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
} else {
haveConsoleChannel = 0;
}
if (haveConsoleChannel) {
ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
info = data->info;
if (info->consoleInterp) {
/* New ConsoleInfo for a new console window */
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
/* Update any console channels to make use of the new console */
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
}
} else {
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
}
info->consoleInterp = consoleInterp;
info->interp = interp;
Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
info->refCount++;
Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
/*
* Add console commands to the interp
*/
token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
ConsoleDeleteProc);
info->refCount++;
/*
* We don't have to count the ref held by the [consoleinterp] command
* in the consoleInterp. The ref held by the consoleInterp delete
* handler takes care of us.
*/
Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
info, NULL);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
info->refCount++;
}
Tcl_Preserve(consoleInterp);
result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
if (result == TCL_ERROR) {
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
}
Tcl_Release(consoleInterp);
if (result == TCL_ERROR) {
Tcl_DeleteCommandFromToken(interp, token);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
goto error;
}
return TCL_OK;
error:
Tcl_AddErrorInfo(interp, "\n (creating console window)");
if (!Tcl_InterpDeleted(consoleInterp)) {
Tcl_DeleteInterp(consoleInterp);
}
return TCL_ERROR;
}
void tcltk_init(int *TkUp)
{
int code;
*TkUp = 0;
/* Absence of the following line is said to be an error with
* tcl >= 8.4 on all platforms, and is known to cause crashes under
* Windows */
Tcl_FindExecutable(NULL);
RTcl_interp = Tcl_CreateInterp();
code = Tcl_Init(RTcl_interp);
if (code != TCL_OK) error(Tcl_GetStringResult(RTcl_interp));
/* HAVE_AQUA is not really right here.
On Mac OS X we might be using Aqua Tcl/Tk or X11 Tcl/Tk, and that
is in principle independent of whether we want quartz() built.
*/
#if !defined(Win32) && !defined(HAVE_AQUA)
char *p= getenv("DISPLAY");
if(p && p[0]) /* exclude DISPLAY = "" */
#endif
{
code = Tk_Init(RTcl_interp); /* Load Tk into interpreter */
if (code != TCL_OK) {
warning(Tcl_GetStringResult(RTcl_interp));
} else {
Tcl_StaticPackage(RTcl_interp, "Tk", Tk_Init, Tk_SafeInit);
code = Tcl_Eval(RTcl_interp, "wm withdraw ."); /* Hide window */
if (code != TCL_OK) error(Tcl_GetStringResult(RTcl_interp));
*TkUp = 1;
}
}
#if !defined(Win32) && !defined(HAVE_AQUA)
else
warningcall(R_NilValue, _("no DISPLAY variable so Tk is not available"));
#endif
Tcl_CreateCommand(RTcl_interp,
"R_eval",
R_eval,
(ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(RTcl_interp,
"R_call",
R_call,
(ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(RTcl_interp,
"R_call_lang",
R_call_lang,
(ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
#ifndef Win32
Tcl_unix_setup();
#endif
Tcl_SetServiceMode(TCL_SERVICE_ALL);
/*** We may want to revive this at some point ***/
#if 0
code = Tcl_EvalFile(RTcl_interp, "init.tcl");
if (code != TCL_OK)
error("%s\n", Tcl_GetStringResult(RTcl_interp));
#endif
}
/* Initialisation, based on tkMain.c */
value camltk_opentk(value argv) /* ML */
{
/* argv must contain argv[0], the application command name */
value tmp = Val_unit;
char *argv0;
Begin_root(tmp);
if ( argv == Val_int(0) ){
failwith("camltk_opentk: argv is empty");
}
argv0 = String_val( Field( argv, 0 ) );
if (!cltk_slave_mode) {
/* Create an interpreter, dies if error */
#if TCL_MAJOR_VERSION >= 8
Tcl_FindExecutable(String_val(argv0));
#endif
cltclinterp = Tcl_CreateInterp();
if (Tcl_Init(cltclinterp) != TCL_OK)
tk_error(cltclinterp->result);
Tcl_SetVar(cltclinterp, "argv0", String_val (argv0), TCL_GLOBAL_ONLY);
{ /* Sets argv if needed */
int argc = 0;
tmp = Field(argv, 1); /* starts from argv[1] */
while ( tmp != Val_int(0) ) {
argc++;
tmp = Field(tmp, 1);
}
if( argc != 0 ){
int i;
char *args;
char **tkargv;
char argcstr[256];
tkargv = malloc( sizeof( char* ) * argc );
tmp = Field(argv, 1); /* starts from argv[1] */
i = 0;
while ( tmp != Val_int(0) ) {
tkargv[i] = String_val(Field(tmp, 0));
tmp = Field(tmp, 1);
i++;
}
sprintf( argcstr, "%d", argc );
Tcl_SetVar(cltclinterp, "argc", argcstr, TCL_GLOBAL_ONLY);
args = Tcl_Merge(argc, tkargv); /* args must be freed by Tcl_Free */
Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
Tcl_Free(args);
free( tkargv );
}
}
if (Tk_Init(cltclinterp) != TCL_OK)
tk_error(cltclinterp->result);
/* Retrieve the main window */
cltk_mainWindow = Tk_MainWindow(cltclinterp);
if (NULL == cltk_mainWindow)
tk_error(cltclinterp->result);
Tk_GeometryRequest(cltk_mainWindow,200,200);
}
/* Create the camlcallback command */
Tcl_CreateCommand(cltclinterp,
CAMLCB, CamlCBCmd,
(ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
/* This is required by "unknown" and thus autoload */
Tcl_SetVar(cltclinterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* Our hack for implementing break in callbacks */
Tcl_SetVar(cltclinterp, "BreakBindingsSequence", "0", TCL_GLOBAL_ONLY);
/* Load the traditional rc file */
{
char *home = getenv("HOME");
if (home != NULL) {
char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
f[0]='\0';
strcat(f, home);
strcat(f, "/");
strcat(f, RCNAME);
if (0 == access(f,R_OK))
if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
stat_free(f);
tk_error(cltclinterp->result);
};
stat_free(f);
}
}
End_roots();
return Val_unit;
}
/********************************************************************************************
* InitTcl
* purpose : Initialize the TCL part of the test application
* input : executable - Program executable
* versionString - Stack version string
* output : reason - Reason of failure on failure
* return : Tcl_Interp interpreter for tcl commands
* NULL on failure
********************************************************************************************/
Tcl_Interp* InitTcl(const char* executable, char* versionString, char** reason)
{
static char strBuf[1024];
int retCode;
/* Find TCL executable and create an interpreter */
Tcl_FindExecutable(executable);
interp = Tcl_CreateInterp();
if (interp == NULL)
{
*reason = (char*)"Failed to create Tcl interpreter";
return NULL;
}
/* Overload file and source commands */
TclExecute("rename file fileOverloaded");
CREATE_COMMAND("file", test_File);
CREATE_COMMAND("source", test_Source);
/* Reroute tcl libraries - we'll need this one later */
/*TclSetVariable("tcl_library", TCL_LIBPATH);
TclSetVariable("env(TCL_LIBRARY)", TCL_LIBPATH);
TclSetVariable("tk_library", TK_LIBPATH);
TclSetVariable("env(TK_LIBRARY)", TK_LIBPATH);*/
/* Initialize TCL */
retCode = Tcl_Init(interp);
if (retCode != TCL_OK)
{
sprintf(strBuf, "Error in Tcl_Init: %s", Tcl_GetStringResult(interp));
*reason = strBuf;
Tcl_DeleteInterp(interp);
return NULL;
}
/* Initialize TK */
retCode = Tk_Init(interp);
if (retCode != TCL_OK)
{
sprintf(strBuf, "Error in Tk_Init: %s", Tcl_GetStringResult(interp));
*reason = strBuf;
Tcl_DeleteInterp(interp);
return NULL;
}
/* Set argc and argv parameters for the script.
This allows us to work with C in the scripts. */
retCode = TclExecute("set tmp(version) {Test Application: %s }", versionString);
if (retCode != TCL_OK)
{
*reason = (char*)"Error setting stack's version for test application";
return interp;
}
/* Create new commands that are used in the tcl script */
CreateTclCommands(interp);
Tcl_LinkVar(interp, (char *)"scriptLogs", (char *)&LogWrappers, TCL_LINK_BOOLEAN);
/* Evaluate the Tcl script of the test application */
retCode = Tcl_Eval(interp, (char*)"source " TCL_FILENAME);
if (retCode != TCL_OK)
{
sprintf(strBuf, "Error reading testapp script (line %d): %s\n", interp->errorLine, Tcl_GetStringResult(interp));
*reason = strBuf;
return NULL;
}
/* Return the created interpreter */
*reason = NULL;
return interp;
}