Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.94
diff -b -u -r1.94 tcl.decls
--- generic/tcl.decls	31 Aug 2002 06:09:45 -0000	1.94
+++ generic/tcl.decls	21 Mar 2003 21:06:42 -0000
@@ -1754,6 +1754,11 @@
 	    Tcl_ChannelType *chanTypePtr)
 }

+# New export for custom app exit handling
+declare 494 generic {
+    Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
+}
+
 ##############################################################################

 # Define the platform specific public Tcl interface.  These functions are
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.93
diff -b -u -r1.93 tclDecls.h
--- generic/tclDecls.h	5 Aug 2002 15:01:04 -0000	1.93
+++ generic/tclDecls.h	21 Mar 2003 21:06:48 -0000
@@ -1564,6 +1564,9 @@
 /* 493 */
 EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
 				Tcl_ChannelType * chanTypePtr));
+/* 494 */
+EXTERN Tcl_ExitProc *  Tcl_SetExitProc _ANSI_ARGS_((
+        Tcl_ExitProc *proc));

 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -2117,6 +2120,7 @@
     Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */
     Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */
     Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */
+    Tcl_ExitProc * (*Tcl_SetExitProc) _ANSI_ARGS_((Tcl_ExitProc *proc)); /* 494 */
 } TclStubs;

 #ifdef __cplusplus
@@ -4132,6 +4136,10 @@
 #ifndef Tcl_ChannelWideSeekProc
 #define Tcl_ChannelWideSeekProc \
 	(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
+#endif
+#ifndef Tcl_SetExitProc
+#define Tcl_SetExitProc \
+	(tclStubsPtr->Tcl_SetExitProc) /* 494 */
 #endif

 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclEvent.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEvent.c,v
retrieving revision 1.28
diff -b -u -r1.28 tclEvent.c
--- generic/tclEvent.c	22 Feb 2003 09:23:16 -0000	1.28
+++ generic/tclEvent.c	21 Mar 2003 21:06:49 -0000
@@ -88,6 +88,14 @@
 static int inFinalize = 0;
 static int subsystemsInitialized = 0;

+/*
+ * This variable contains the application wide exit handler.  It will be
+ * called by Tcl_Exit instead of the C-runtime exit if this variable is set
+ * to a non-NULL value.
+ */
+
+static Tcl_ExitProc *appExitPtr = NULL;
+
 typedef struct ThreadSpecificData {
     ExitHandler *firstExitPtr;  /* First in list of all exit handlers for
 				 * this thread. */
@@ -542,6 +550,38 @@
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_SetExitProc --
+ *
+ *	This procedure sets the application wide exit handler that will be
+ *  called by Tcl_Exit in place of the C-runtime exit.  If the
+ *  application wide exit handler is NULL, the C-runtime exit will be
+ *  used instead.
+ *
+ * Results:
+ *	The previously set application wide exit handler.
+ *
+ * Side effects:
+ *	Sets the application wide exit handler to the specified value.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_ExitProc *
+Tcl_SetExitProc(proc)
+    Tcl_ExitProc *proc; /* new exit handler for app or NULL */
+{
+    Tcl_ExitProc *prevExitProc; /* return prev exit handler to caller */
+
+    Tcl_MutexLock(&exitMutex);
+    prevExitProc = appExitPtr; /* get old app exit ptr */
+    appExitPtr = proc; /* set new app exit ptr */
+    Tcl_MutexUnlock(&exitMutex);
+
+    return prevExitProc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Exit --
  *
  *	This procedure is called to terminate the application.
@@ -561,8 +601,25 @@
     int status;			/* Exit status for application;  typically
 				 * 0 for normal return, 1 for error return. */
 {
+    Tcl_ExitProc *currentAppExitPtr;
+
+    Tcl_MutexLock(&exitMutex);
+    currentAppExitPtr = appExitPtr;
+    Tcl_MutexUnlock(&exitMutex);
+
+    if (currentAppExitPtr) {
+      /***********************************************************/
+      /* WARNING: This code SHOULD NOT return, as there is code  */
+      /*          that depends on Tcl_Exit never returning.      */
+      /***********************************************************/
+      currentAppExitPtr((ClientData) status);
+    } else {
+      /* use default handling */
     Tcl_Finalize();
     TclpExit(status);
+    }
+
+    Tcl_Panic ("exitProc returned!");
 }
 
 /*
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.80
diff -b -u -r1.80 tclStubInit.c
--- generic/tclStubInit.c	21 Mar 2003 03:23:24 -0000	1.80
+++ generic/tclStubInit.c	21 Mar 2003 21:06:50 -0000
@@ -925,6 +925,7 @@
     Tcl_Seek, /* 491 */
     Tcl_Tell, /* 492 */
     Tcl_ChannelWideSeekProc, /* 493 */
+    Tcl_SetExitProc, /* 494 */
 };

 /* !END!: Do not edit above this line. */
