/* * free-form code mods by David Gravereaux * May 17, 01 */ #define TCL_THREADS 1 #include #ifdef _MSC_VER # ifdef _DEBUG # pragma comment (lib, "tcl" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) "dt.lib") # else # pragma comment (lib, "tcl" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) "t.lib") # endif #endif #include BOOL __stdcall sigHandler (DWORD fdwCtrlType); Tcl_AsyncHandler exitToken; Tcl_AsyncProc asyncExit; int main( int argc, char* argv[] ) { Tcl_Interp* m_pInterp; printf( "start!\n"); Tcl_FindExecutable(argv[0]); exitToken = Tcl_AsyncCreate(asyncExit, NULL); SetConsoleCtrlHandler(sigHandler, TRUE); m_pInterp = Tcl_CreateInterp(); Tcl_Init(m_pInterp); //no init errors! /* do work here */ Tcl_DeleteInterp(m_pInterp); Tcl_Finalize(); printf( "close the window!\n"); getchar(); //at this pause we click the 'x' on the console. return 0; } /* *---------------------------------------------------------------------- * * asyncExit -- * * The AsyncProc for the exitToken. * * Results: * doesn't actually return. * * Side effects: * tclsh cleanly exits. * *---------------------------------------------------------------------- */ int asyncExit (ClientData clientData, Tcl_Interp *interp, int code) { Tcl_Exit(-1); /* NOTREACHED */ return code; } /* *---------------------------------------------------------------------- * * sigHandler -- * * Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and * other exits. This is needed so tclsh can do it's real clean-up * and not an unclean crash terminate. * * Results: * TRUE. * * Side effects: * effects the way the app exits from a signal. This is an * operating system supplied thread and unsafe to call ANY * Tcl commands except for Tcl_AsyncMark. * *---------------------------------------------------------------------- */ BOOL __stdcall sigHandler (DWORD fdwCtrlType) { /* * If Tcl is currently executing some bytecode or in the eventloop, * this will cause Tcl to enter asyncExit at the next command * boundry. This is protected in Win32 SEH to ensure mutex access * will not cause an exception should Tcl_Finalize() have already * cleaned-up the async subsystem. */ __try { Tcl_AsyncMark(exitToken); } __except (EXCEPTION_EXECUTE_HANDLER) { /* ignore exceptions */ } /* * This will cause Tcl_Gets in Tcl_Main() to drop-out with an * should it be blocked on input and our Tcl_AsyncMark didn't grab * the attention of the interpreter. */ CloseHandle(GetStdHandle(STD_INPUT_HANDLE)); /* indicate to the OS not to call the default terminator */ return TRUE; }