C++ (Cpp) TclSetPreInitScript Examples

Example #1

File: kitInit.c Project: SASfit/SASfit

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;
}

Example #2

File: kitInit.c Project: ghoest/kitgen

__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;
}