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