Attachment "patch.txt" to
ticket [219355ffff]
added by
davygrvy
2002-09-29 07:50:26.
*** win/tclAppInit.c 21 Feb 2002 21:20:08 -0000 1.8
--- win/tclAppInit.c 29 Sep 2002 00:43:00 -0000
***************
*** 29,34 ****
--- 29,39 ----
#endif /* TCL_TEST */
static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
+ static BOOL __stdcall sigHandler (DWORD fdwCtrlType);
+ static Tcl_AsyncProc asyncExit;
+
+ Tcl_AsyncHandler exitToken;
+ DWORD exitErrorCode;
/*
***************
*** 135,140 ****
--- 140,151 ----
return TCL_ERROR;
}
+ /*
+ * Install a signal handler to the win32 console tclsh is running in.
+ */
+ SetConsoleCtrlHandler(sigHandler, TRUE);
+ exitToken = Tcl_AsyncCreate(asyncExit, NULL);
+
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
***************
*** 299,301 ****
--- 310,379 ----
*argcPtr = argc;
*argvPtr = argv;
}
+
+ /*
+ *----------------------------------------------------------------------
+ *
+ * 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((int)exitErrorCode);
+
+ /* 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.
+ */
+ exitErrorCode = fdwCtrlType;
+ Tcl_AsyncMark(exitToken);
+
+ /*
+ * 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;
+ }
