summaryrefslogtreecommitdiffstats
path: root/win/tclAppInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclAppInit.c')
-rw-r--r--win/tclAppInit.c80
1 files changed, 79 insertions, 1 deletions
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 5ddc93f..414e4d8 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAppInit.c,v 1.8 2002/02/21 21:20:08 davygrvy Exp $
+ * RCS: @(#) $Id: tclAppInit.c,v 1.9 2002/09/30 00:08:01 davygrvy Exp $
*/
#include "tcl.h"
@@ -29,6 +29,11 @@ extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
#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,6 +140,12 @@ Tcl_AppInit(interp)
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,3 +310,70 @@ setargv(argcPtr, argvPtr)
*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;
+}