static int SetupMainInterp( Tcl_Interp *interp) { /* * Initialize the console only if we are running as an interactive * application. */ TkMacInitAppleEvents(interp); TkMacInitMenus(interp); if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1") == 0) { if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) { goto error; } SetupSIOUX(); TclMacInstallExitToShellPatch(NoMoreOutput); } /* * Attach the global interpreter to tk's expected global console */ gStdoutInterp = interp; return TCL_OK; error: panic(Tcl_GetStringResult(interp)); return TCL_ERROR; }
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; }
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; }
int tcl_createconsole(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { Tk_CreateConsoleWindow(interp); 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) { 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; }
/* ** 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; }