int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if ((Tcl_Init)(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
#endif
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
#endif /* TCL_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_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
return TCL_OK;
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
Procbodytest_SafeInit);
#endif /* TCL_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.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* 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;
}
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;
}
/*-----------------------------------------------------------------------------
* TclX_AppInit --
*
* This procedure performs application-specific initialization. Most
* applications, especially those that incorporate additional packages, will
* have their own version of this procedure.
*
* Results:
* Returns a standard Tcl completion code, and leaves an error message in
* interp result if an error occurs.
*-----------------------------------------------------------------------------
*/
int
TclX_AppInit (Tcl_Interp *interp)
{
if (Tcl_Init (interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tclx_Init (interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage (interp, "Tclx", Tclx_Init, Tclx_SafeInit);
/*
* 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", "~/.tclrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
/*
* 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);
}
/* 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;
}
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;
}
initdobj( void )
{
PyObject* m;
m = Py_InitModule( "dobj", OpenGLMethods );
printf( "-- slsoggy_init1\n" );
Tcl_StaticPackage( NULL, "Slsoggy", Slsoggy_Init, Slsoggy_Init );
}
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){
// Tcl_Init(interp);
// Tcl_SourceRCFile(interp);
//Tcl_SetStartupScript("/remote/us01home19/szhang/scratch/disk.dc/dc2nwtn/misc/tcltrace.tcl",NULL);
// parse_tcl_command(interp);
// Tcl_AllowExceptions(interp);
Parsetcl_Init(interp);
Tcl_StaticPackage(interp, "Parsetcl", Parsetcl_Init, NULL);
/*
if(TCL_OK != Tcl_Eval(interp,"load {} Parsetcl")){
printf("Error: load error\n");
}
*/
char buf[512];
const char *name = Tcl_GetNameOfExecutable();
sprintf(buf, "%s.lib.tcl", name);
Tcl_EvalFile(interp, buf);
//Tcl_Obj *startup = Tcl_GetStartupScript(NULL);
//parse_tcl_file(interp,"dcp558_gif_fp.cstr.tcl");
/*
int level = 0;
int flags = 0; // TCL_ALLOW_INLINE_COMPILATION
Tcl_CmdObjTraceProc *objProc = Tcl_CmdObjTraceProc_impl;
ClientData clientData = 0;
Tcl_CmdObjTraceDeleteProc *deleteProc=NULL;
Tcl_CreateObjTrace(interp, level, flags, objProc, clientData, deleteProc);
*/
// Tcl_Eval(interp,"exit");
return TCL_OK;
}
int Libsqlite_Init( Tcl_Interp *interp) {
#ifdef TCL_THREADS
if (Thread_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif
Sqlite_Init(interp);
#ifdef SQLITE_TEST
{
extern int Sqlitetest1_Init(Tcl_Interp*);
extern int Sqlitetest2_Init(Tcl_Interp*);
extern int Sqlitetest3_Init(Tcl_Interp*);
extern int Md5_Init(Tcl_Interp*);
Sqlitetest1_Init(interp);
Sqlitetest2_Init(interp);
Sqlitetest3_Init(interp);
Md5_Init(interp);
Tcl_StaticPackage(interp, "sqlite", Libsqlite_Init, Libsqlite_Init);
}
#endif
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) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* TCL_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.
*/
if (Itcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
/*
* This is itclsh, so import all [incr Tcl] commands by
* default into the global namespace. Fix up the autoloader
* to do the same.
*/
if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
"::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
return TCL_ERROR;
}
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* 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", "itclshrc", TCL_GLOBAL_ONLY);
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.itclshrc", TCL_GLOBAL_ONLY); */
return TCL_OK;
}
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;
}
static AP_Result tk_new(AP_World *w, AP_Obj interp_name)
{
AP_Result result;
Tcl_Interp *interp;
result = built_interp(w, &interp, &interp_name);
// Similar to 2009 note above, this cause Tk_Init to fail (tk.tcl not found)
#if 0
{
Tcl_DString path;
const char *elements[3];
Tcl_DStringInit(&path);
elements[0] = library_dir;
#ifdef macintosh
elements[1] = "Tool Command Language";
#else
elements[1] = "lib";
#endif
elements[2] = "tk" TK_VERSION;
Tcl_JoinPath(3, elements, &path);
Tcl_SetVar(interp, (char *)"tk_library", path.string, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
}
#endif
if (result == AP_SUCCESS) {
int r = Tk_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
#ifdef ITCL
r = Itk_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
Tcl_StaticPackage(interp, (char *)"Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
r = Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
(char *)"::itk::*", /* allowOverwrite */ 1);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
r = Tcl_Eval(interp, (char *)"auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }");
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
#endif
/*Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);*/
#ifdef macintosh
//TkMacInitAppleEvents(interp);
//TkMacInitMenus(interp);
//Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
#endif
}
return result;
}
int Tcl_AppInit(Tcl_Interp *interp)
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
#ifdef TCL_XT_TEST
if (Tclxttest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_THREADS
if (TclThread_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
Procbodytest_SafeInit);
#endif /* TCL_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.
*/
/*
* 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", "~/.tclshrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
#ifdef TCL_XT_TEST
if (Tclxttest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
Procbodytest_SafeInit);
#endif /* TCL_TEST */
/*
* Call the init functions 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 functions 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.
*/
#ifdef DJGPP
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif
return TCL_OK;
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
Procbodytest_SafeInit);
#endif /* TCL_TEST */
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
{
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
}
#endif
/*
* Call the init functions 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 functions 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", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
}
/*
** This routine runs first.
*/
int main(int argc, char **argv){
Tcl_Interp *interp;
char *args;
char buf[100];
int tty;
char TCLdir[20];
char TKdir[20];
char autopath[20];
char sourceCmd[80];
#ifdef WITHOUT_TK
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
char buffer[1000];
int code, gotPartial, length;
Tcl_Channel inChannel, outChannel, errChannel;
#endif
/* Create a Tcl interpreter
*/
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
if( Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1)==0 ){
return 1;
}
args = Tcl_Merge(argc-1, (CONST84 char * CONST *)argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
sprintf(buf, "%d", argc-1);
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* We have to initialize the virtual filesystem before calling
** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find
** its startup script files.
*/
Zvfs_Init(interp);
Tcl_SetVar(interp, "extname", "", TCL_GLOBAL_ONLY);
Zvfs_Mount(interp, (char *)Tcl_GetNameOfExecutable(), "/");
sprintf(TCLdir, "%s/tcl", mountPt);
Tcl_SetVar2(interp, "env", "TCL_LIBRARY", TCLdir, TCL_GLOBAL_ONLY);
sprintf(TKdir, "%s/tk", mountPt);
Tcl_SetVar2(interp, "env", "TK_LIBRARY", TKdir, TCL_GLOBAL_ONLY);
/* Initialize Tcl and Tk
*/
if( Tcl_Init(interp) ) return TCL_ERROR;
sprintf(autopath, " %s", TCLdir);
Tcl_SetVar(interp, "auto_path", autopath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_libPath", TCLdir, TCL_GLOBAL_ONLY);
#ifdef WITHOUT_TK
Tcl_SetVar(interp, "extname", "tclsh", TCL_GLOBAL_ONLY);
#else
Tk_InitConsoleChannels(interp);
if ( Tk_Init(interp) ) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
Tk_CreateConsoleWindow(interp);
#endif
/* Start up all extensions.
*/
#if defined(__WIN32__)
/* DRL - Do the standard Windows extentions */
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Registry", Registry_Init, 0);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Dde", Dde_Init, 0);
#endif
#ifndef WITHOUT_TDOM
if (Tdom_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tdom", Tdom_Init, Tdom_SafeInit);
#endif
#ifndef WITHOUT_TLS
if (Tls_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tls", Tls_Init, Tls_SafeInit);
#endif
/*
#ifndef WITHOUT_MKZIPLIB
if (Mkziplib_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Mkziplib", Mkziplib_Init, Mkziplib_SafeInit);
#endif
*/
#ifndef WITHOUT_XOTCL
if (Xotcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Xotcl", Xotcl_Init, Xotcl_SafeInit);
/*
if (Xotclexpat_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "xotclexpat", Xotclexpat_Init, 0);
*/
/*
if (Xotclsdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclsdbm", Xotclsdbm_Init, Xotclsdbm_SafeInit);
/*
if (Xotclgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclgdbm", Xotclgdbm_Init, Xotclgdbm_SafeInit);
#endif
#ifndef WITHOUT_TGDBM
if (Tgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tgdbm", Tgdbm_Init, 0);
#endif
#ifndef WITHOUT_THREAD
if (Thread_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Thread", Thread_Init, 0);
#endif
#if !defined(WITHOUT_TK) && !defined(WITHOUT_WINICO) && (defined(__WIN32__) || defined(_WIN32))
if (Winico_Init(interp) == TCL_ERROR) return TCL_ERROR;
Tcl_StaticPackage(interp, "Winico", Winico_Init, Winico_SafeInit);
#endif
/* Add some freeWrap commands */
if (Freewrap_Init(interp) == TCL_ERROR) return TCL_ERROR;
/* After all extensions are registered, start up the
** program by running freewrapCmds.tcl.
*/
sprintf(sourceCmd, "source %s/freewrapCmds.tcl", mountPt);
Tcl_Eval(interp, sourceCmd);
#ifndef WITHOUT_TK
/*
* Loop infinitely, waiting for commands to execute. When there
* are no windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
#else
/*
* Process commands from stdin until there's an end-of-file. Note
* that we need to fetch the standard channels again after every
* eval, since they may have been changed.
*/
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
while (1) {
if (tty) {
Tcl_Obj *promptCmdPtr;
promptCmdPtr = Tcl_GetVar2Ex(interp,
(gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
Tcl_WriteChars(outChannel, "% ", 2);
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
goto defaultPrompt;
}
}
if (outChannel) {
Tcl_Flush(outChannel);
}
}
if (!inChannel) {
goto done;
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
goto done;
}
if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
goto done;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string.
*/
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
}
}
/*
* Rather than calling exit, invoke the "exit" command so that
* users can replace "exit" with some other command to do additional
* cleanup on exit. The Tcl_Eval call should never return.
*/
done:
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
sprintf(buffer, "exit %d", 0);
Tcl_Eval(interp, buffer);
#endif
return TCL_OK;
}
__declspec(dllexport) int
#else
extern int
#endif
TclKit_AppInit(Tcl_Interp *interp)
{
/*
* Ensure that std channels exist (creating them if necessary)
*/
TclKit_InitStdChannels();
#ifdef KIT_INCLUDES_ITCL
Tcl_StaticPackage(0, "Itcl", Itcl_Init, NULL);
#endif
#ifdef KIT_LITE
Tcl_StaticPackage(0, "vlerq", Vlerq_Init, Vlerq_SafeInit);
#else
Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
#endif
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);
#endif
Tcl_StaticPackage(0, "tclkitpath", TclKitPath_Init, NULL);
Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
#if KIT_INCLUDES_ZLIB
Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
#endif
#ifdef TCL_THREADS
Tcl_StaticPackage(0, "Thread", Thread_Init, Thread_SafeInit);
#endif
#ifdef _WIN32
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
Tcl_StaticPackage(0, "dde", Dde_Init, Dde_SafeInit);
#else
Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
#endif
Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
#endif
#ifdef KIT_INCLUDES_TK
Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
#endif
/* insert custom packages here */
/* 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);
#endif
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
{
Tcl_DString encodingName;
Tcl_GetEncodingNameFromEnvironment(&encodingName);
if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
/* fails, so we set a variable and do it in the boot.tcl script */
Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
}
Tcl_SetVar(interp, "tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
Tcl_DStringFree(&encodingName);
}
#endif
TclSetPreInitScript(preInitCmd);
if (Tcl_Init(interp) == TCL_ERROR)
goto error;
#if defined(KIT_INCLUDES_TK) && defined(_WIN32)
if (Tk_Init(interp) == TCL_ERROR)
goto error;
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR)
goto error;
#endif
/* messy because TclSetStartupScriptPath is called slightly too late */
if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) == TCL_OK) {
const char *encoding = NULL;
Tcl_Obj* path = Tcl_GetStartupScript(&encoding);
Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
if (path == NULL) {
Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
}
}
Tcl_SetVar(interp, "errorInfo", "", TCL_GLOBAL_ONLY);
Tcl_ResetResult(interp);
return TCL_OK;
error:
#if defined(KIT_INCLUDES_TK) && defined(_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
return TCL_ERROR;
}
TclTextInterp::TclTextInterp(VMDApp *vmdapp, int guienabled, int mpienabled)
: app(vmdapp) {
interp = Tcl_CreateInterp();
#if 0
Tcl_InitMemory(interp); // enable Tcl memory debugging features
// when compiled with TCL_MEM_DEBUG
#endif
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
consoleisatty = vmd_isatty(0); // whether we're interactive or not
ignorestdin = 0;
gotPartial = 0;
needPrompt = 1;
callLevel = 0;
starttime = delay = 0;
#if defined(VMDMPI)
//
// MPI builds of VMD cannot try to read any command input from the
// console because it creates shutdown problems, at least with MPICH.
// File-based command input is fine however.
//
// don't check for interactive console input if running in parallel
if (mpienabled)
ignorestdin = 1;
#endif
#if defined(ANDROIDARMV7A)
//
// For the time being, the Android builds won't attempt to get any
// console input. Any input we're going to get is going to come via
// some means other than stdin, such as a network socket, text box, etc.
//
// Don't check for interactive console input if compiled for Android
ignorestdin = 1;
#endif
// set tcl_interactive, lets us run unix commands as from a shell
#if !defined(VMD_NANOHUB)
Tcl_SetVar(interp, "tcl_interactive", "1", 0);
#else
Tcl_SetVar(interp, "tcl_interactive", "0", 0);
Tcl_Channel channel;
#define CLIENT_READ (3)
#define CLIENT_WRITE (4)
channel = Tcl_MakeFileChannel((ClientData)CLIENT_READ, TCL_READABLE);
if (channel != NULL) {
const char *result;
Tcl_RegisterChannel(interp, channel);
result = Tcl_SetVar2(interp, "vmd_client", "read",
Tcl_GetChannelName(channel),
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
if (result == NULL) {
fprintf(stderr, "can't create variable for client read channel\n");
}
}
channel = Tcl_MakeFileChannel((ClientData)CLIENT_WRITE, TCL_WRITABLE);
if (channel != NULL) {
const char *result;
Tcl_RegisterChannel(interp, channel);
result = Tcl_SetVar2(interp, "vmd_client", "write",
Tcl_GetChannelName(channel),
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
if (result == NULL) {
fprintf(stderr, "can't create variable for client write channel\n");
}
}
write(CLIENT_WRITE, "vmd 1.0\n", 8);
#endif
// pass our instance of VMDApp to a hash table assoc. with the interpreter
Tcl_SetAssocData(interp, "VMDApp", NULL, app);
// Set up argc, argv0, and argv variables
{
char argcbuf[20];
sprintf(argcbuf, "%d", app->argc_m);
Tcl_SetVar(interp, "argc", argcbuf, TCL_GLOBAL_ONLY);
// it might be better to use the same thing that was passed to
// Tcl_FindExecutable, but this is now
Tcl_SetVar(interp, "argv0", app->argv_m[0], TCL_GLOBAL_ONLY);
char *args = Tcl_Merge(app->argc_m-1, app->argv_m+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
Tcl_Free(args);
}
#if defined(_MSC_VER) && TCL_MINOR_VERSION >= 4
// The Windows versions of Tcl 8.5.x have trouble finding
// the Tcl library subdirectory for unknown reasons.
// We force the appropriate env variables to be set in Tcl,
// despite Windows.
{
char vmdinitscript[4096];
char * tcl_library = getenv("TCL_LIBRARY");
char * tk_library = getenv("TK_LIBRARY");
if (tcl_library) {
sprintf(vmdinitscript, "set env(TCL_LIBRARY) {%s}", tcl_library);
if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
msgErr << Tcl_GetStringResult(interp) << sendmsg;
}
}
if (tk_library) {
sprintf(vmdinitscript, "set env(TK_LIBRARY) {%s}", tk_library);
if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
msgErr << Tcl_GetStringResult(interp) << sendmsg;
}
}
}
#endif
if (Tcl_Init(interp) == TCL_ERROR) { // new with 7.6
msgErr << "Tcl startup error: " << Tcl_GetStringResult(interp) << sendmsg;
}
#ifdef VMDTK
// and the Tk commands (but only if a GUI is available!)
if (guienabled) {
if (Tk_Init(interp) == TCL_ERROR) {
msgErr << "Tk startup error: " << Tcl_GetStringResult(interp) << sendmsg;
} else {
Tcl_StaticPackage(interp, "Tk",
(Tcl_PackageInitProc *) Tk_Init,
(Tcl_PackageInitProc *) NULL);
}
} // end of check that GUI is allowed
#endif
add_commands();
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
goto error;
}
if (Tk_Init(interp) == TCL_ERROR) {
goto error;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
/*
* Initialize the console only if we are running as an interactive
* application.
*/
if (consoleRequired) {
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
goto error;
}
}
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
{
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
}
#endif
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
goto error;
}
Tcl_StaticPackage(interp, "Tktest", Tktest_Init, NULL);
#endif /* TK_TEST */
Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
error:
MessageBeep(MB_ICONEXCLAMATION);
MessageBox(NULL, Tcl_GetStringResult(interp), "Error in Wish",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
ExitProcess(1);
/*
* We won't reach this, but we need the return.
*/
return TCL_ERROR;
}
static AP_Result built_interp(AP_World *w, Tcl_Interp **interpretor, AP_Obj *interp_name)
{
Tcl_Interp *interp;
char name[128];
const char *namep;
Tcl_HashEntry *entry;
int is_new, pre_named;
AP_Type type;
int r;
type = AP_ObjType(w, *interp_name);
if (type != AP_VARIABLE && type != AP_ATOM) {
AP_SetStandardError(w, AP_TYPE_ERROR,
AP_NewSymbolFromStr(w, "atom_or_variable"), *interp_name);
goto error;
}
pre_named = (type == AP_ATOM);
#ifdef macintosh
// Tcl_MacSetEventProc(MyConvertEvent);
// SIOUXSetEventVector(MyHandleOneEvent);
#endif
interp = Tcl_CreateInterp();
if (!interp) {
AP_SetStandardError(w, AP_RESOURCE_ERROR, AP_NewSymbolFromStr(w, "tcl_memory"));
goto error;
}
/*
The following was causing a coredump on Mac OS X 10.5, and isn't necessary when
using the OS's Tcl/TK. Turned off for the moment.
TODO figure out why this is crashing on 10.5 - CEH 2009
*/
#if 0
{
Tcl_DString path;
const char *elements[3];
Tcl_DStringInit(&path);
elements[0] = library_dir;
#ifdef macintosh
elements[1] = "Tool Command Language";
#else
elements[1] = "lib";
#endif
elements[2] = "tcl" TCL_VERSION;
Tcl_JoinPath(3, (char **)elements, &path);
Tcl_SetVar(interp, (char *)"tcl_library", path.string, TCL_GLOBAL_ONLY);
Tcl_DStringSetLength(&path, 0);
Tcl_JoinPath(2, (char **)elements, &path);
Tcl_SetVar(interp, (char *)"tcl_pkgPath", path.string, TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
Tcl_SetVar(interp, (char *)"autopath", (char *)"", TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
}
#endif
r = Tcl_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
#ifdef ITCL
r = Itcl_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
Tcl_StaticPackage(interp, (char *)"Itcl", Itcl_Init, Itcl_SafeInit);
r = Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
(char *)"::itcl::*", /* allowOverwrite */ 1);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
r = Tcl_Eval(interp,
(char *)"auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }");
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
#endif
if (pre_named) {
namep = AP_GetAtomStr(w, *interp_name);
} else {
interp_count++;
sprintf(name, "tcl_interp%d", interp_count);
/* handle error */
namep = name;
}
entry = Tcl_CreateHashEntry(&tcl_interp_name_table, namep, &is_new);
if (!entry) {
AP_SetStandardError(w, AP_RESOURCE_ERROR, AP_NewSymbolFromStr(w, "tcl_memory"));
goto error_delete;
}
if (!is_new) {
AP_SetStandardError(w, AP_PERMISSION_ERROR,
AP_NewSymbolFromStr(w, "create"),
AP_NewSymbolFromStr(w, "tcl_interpreter"), *interp_name);
goto error_delete;
}
Tcl_SetHashValue(entry, interp);
if (ALSProlog_Package_Init(interp, w) != TCL_OK) {
AP_SetError(w, AP_NewSymbolFromStr(w, "tcl_create_command_error"));
goto error_delete;
}
*interpretor = interp;
return (pre_named) ? AP_SUCCESS : AP_Unify(w, *interp_name, AP_NewUIAFromStr(w, namep));
error_delete:
Tcl_DeleteInterp(interp);
error:
return AP_EXCEPTION;
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
Tk_Window main_window;
if (Tcl_Init (interp) == TCL_ERROR)
return TCL_ERROR;
if (Tk_Init (interp) == TCL_ERROR)
return TCL_ERROR;
main_window = Tk_MainWindow(interp);
#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);
if (Tix_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "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
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
Tcl_Channel tempChan;
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* TCL_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.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* 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); */
/*
* We have to support at least the quit Apple Event.
*/
TkMacInitAppleEvents(interp);
/*
* Open a file channel to put stderr, stdin, stdout...
*/
tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDIN);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDOUT);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDERR);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
return TCL_OK;
}
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
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
char *lib, buf[1025];
/*
* Redefine TCL_LIBRARY and TK_LIBRARY to the staden package versions
* in $STADLIB/{tcl,tk}.
*/
#ifndef _WIN32 /* 11/1/98 johnt - not required for WIN32 */
if (NULL != (lib = getenv("STADLIB"))) {
sprintf(buf, "TCL_LIBRARY=%s/tcl", lib);
Tcl_PutEnv(buf);
sprintf(buf, "TK_LIBRARY=%s/tk", lib);
Tcl_PutEnv(buf);
}
#endif
#ifdef TRAP_SIGNALS
/*
* Use the BSD signal() command to trap probable program crashes.
* This then adds a debug message to make sure that we tell people
* to email us.
*/
#if defined(SIGBUS) /* 11/1/99 johnt - SIGBUS not defined under WINNT */
signal(SIGBUS, error_sig);
#endif
signal(SIGSEGV, error_sig);
signal(SIGILL, error_sig);
signal(SIGFPE, error_sig);
#if defined(SIGSYS)
signal(SIGSYS, error_sig);
#endif /* SIGSYS */
#endif /* TRAP_SIGNALS */
if (Tcl_Init(interp) == TCL_ERROR) {
WishPanic(interp->result);
return TCL_ERROR;
}
#ifdef _WIN32
if( needConsole ){
/* running in Windows mode, so initialise TK, and Init console */
if (Tk_Init(interp) == TCL_ERROR) {
WishPanic(interp->result);
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
if (TkConsoleInit(interp) == TCL_ERROR) {
WishPanic(interp->result);
return TCL_ERROR;
}
}
/* modified Windows Save Dialog, to set save type, based on user selection and file extension */
Tcl_CreateCommand(interp,"sp_getSaveFile",Tk_CustomGetSaveFileCmd,(ClientData)NULL,NULL);
/* modified Windows Open Dialog, to allow multiple file opens */
Tcl_CreateCommand(interp,"sp_getOpenFile",Tk_CustomGetOpenFileCmd,(ClientData)NULL,NULL);
#endif
/*
Tcl_CreateCommand(interp, "tkinit", tkinit,
(ClientData)NULL, NULL);
*/
/*
* 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.
*/
/* Library init routines */
if (Tk_utils_Init(interp) == TCL_ERROR) {
WishPanic(interp->result);
return TCL_ERROR;
}
/*
* 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", "~/.stashrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
