Attachment "noBoom.c" to
ticket [219355ffff]
added by
davygrvy
2001-05-18 06:23:41.
/*
* free-form code mods by David Gravereaux <[email protected]>
* May 17, 01
*/
#define TCL_THREADS 1
#include <tcl.h>
#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 <windows.h>
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 <EOF>
* 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;
}
