TIP #337 IMPLEMENTATION

        * doc/BackgdErr.3:      Converted internal routine
        * doc/interp.n:         TclBackgroundException() into public routine
        * generic/tcl.decls:    Tcl_BackgroundException().
        * generic/tclEvent.c:
        * generic/tclInt.decls:

        * generic/tclDecls.h:   make genstubs
        * generic/tclIntDecls.h:
        * generic/tclStubInit.c:

        * generic/tclIO.c:      Update callers.
        * generic/tclIOCmd.c:
        * generic/tclInterp.c:
        * generic/tclTimer.c:
        *** POTENTIAL INCOMPATIBILITY only for extensions using the converted
        internal routine ***

10 files changed, 44 insertions, 34 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index bdfe02c..9bf31ff 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tcl.decls,v 1.157 2008/12/05 21:38:47 dkf Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.158 2008/12/09 20:16:29 dgp Exp $
 
 library tcl
 
@@ -2217,6 +2217,11 @@ declare 608 generic {
     int Tcl_InterpActive(Tcl_Interp *interp)
 }
 
+# TIP 337
+declare 609 generic {
+    void Tcl_BackgroundException(Tcl_Interp *interp, int code)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface. These functions are only
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 7e1c6fd..525b613 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.159 2008/12/05 21:40:38 dkf Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.160 2008/12/09 20:16:29 dgp Exp $
  */
 
 #ifndef _TCLDECLS
@@ -3681,6 +3681,12 @@ EXTERN void		Tcl_TransferResult (Tcl_Interp * sourceInterp,
 /* 608 */
 EXTERN int		Tcl_InterpActive (Tcl_Interp * interp);
 #endif
+#ifndef Tcl_BackgroundException_TCL_DECLARED
+#define Tcl_BackgroundException_TCL_DECLARED
+/* 609 */
+EXTERN void		Tcl_BackgroundException (Tcl_Interp * interp,
+				int code);
+#endif
 
 typedef struct TclStubHooks {
     const struct TclPlatStubs *tclPlatStubs;
@@ -4349,6 +4355,7 @@ typedef struct TclStubs {
     void (*tcl_SetErrorLine) (Tcl_Interp * interp, int value); /* 606 */
     void (*tcl_TransferResult) (Tcl_Interp * sourceInterp, int result, Tcl_Interp * targetInterp); /* 607 */
     int (*tcl_InterpActive) (Tcl_Interp * interp); /* 608 */
+    void (*tcl_BackgroundException) (Tcl_Interp * interp, int code); /* 609 */
 } TclStubs;
 
 #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6857,6 +6864,10 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_InterpActive \
 	(tclStubsPtr->tcl_InterpActive) /* 608 */
 #endif
+#ifndef Tcl_BackgroundException
+#define Tcl_BackgroundException \
+	(tclStubsPtr->tcl_BackgroundException) /* 609 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 203dc5a..cbb0aad 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEvent.c,v 1.85 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.86 2008/12/09 20:16:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -140,10 +140,10 @@ Tcl_BackgroundError(
     Tcl_Interp *interp)		/* Interpreter in which an error has
 				 * occurred. */
 {
-    TclBackgroundException(interp, TCL_ERROR);
+    Tcl_BackgroundException(interp, TCL_ERROR);
 }
 void
-TclBackgroundException(
+Tcl_BackgroundException(
     Tcl_Interp *interp,		/* Interpreter in which an exception has
 				 * occurred. */
     int code)			/* The exception code value */
@@ -353,7 +353,7 @@ TclDefaultBgErrorHandlerObjCmd(
     if (code == TCL_OK) {
 	/*
 	 * Somehow we got to exception handling with no exception.
-	 * (Pass TCL_OK to TclBackgroundException()?)
+	 * (Pass TCL_OK to Tcl_BackgroundException()?)
 	 * Just return without doing anything.
 	 */
 	return TCL_OK;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1a2bbfb..09ca6fa 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.152 2008/12/09 14:09:14 dkf Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.153 2008/12/09 20:16:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -8307,7 +8307,7 @@ TclChannelEventScriptInvoker(
 	if (chanPtr->typePtr != NULL) {
 	    DeleteScriptRecord(interp, chanPtr, mask);
 	}
-	TclBackgroundException(interp, result);
+	Tcl_BackgroundException(interp, result);
     }
     Tcl_Release(interp);
 }
@@ -8812,7 +8812,7 @@ CopyData(
 	}
 	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
 	if (code != TCL_OK) {
-	    TclBackgroundException(interp, code);
+	    Tcl_BackgroundException(interp, code);
 	    result = TCL_ERROR;
 	}
 	TclDecrRefCount(cmdPtr);
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index dbc9bb1..dbf6b2c 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.59 2008/10/16 22:34:19 nijtmans Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.60 2008/12/09 20:16:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1334,7 +1334,7 @@ AcceptCallbackProc(
 	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
 		" ", address, " ", portBuf, NULL);
 	if (result != TCL_OK) {
-	    TclBackgroundException(interp, result);
+	    Tcl_BackgroundException(interp, result);
 	    Tcl_UnregisterChannel(interp, chan);
 	}
 
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 221fb34..1853c5c 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tclInt.decls,v 1.129 2008/10/22 20:23:59 nijtmans Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.130 2008/12/09 20:16:29 dgp Exp $
 
 library tcl
 
@@ -933,9 +933,10 @@ declare 235 generic {
 }
 
 
-declare 236 generic {
-    void TclBackgroundException(Tcl_Interp *interp, int code)
-}
+# TIP 337 made this one public
+#declare 236 generic {
+#    void TclBackgroundException(Tcl_Interp *interp, int code)
+#}
 
 # TIP #285: Script cancellation support.
 declare 237 generic {
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index ab08e3b..a511988 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -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: tclIntDecls.h,v 1.125 2008/10/22 20:23:59 nijtmans Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.126 2008/12/09 20:16:30 dgp Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -1059,12 +1059,7 @@ EXTERN Var *		TclVarHashCreateVar (TclVarHashTable * tablePtr,
 EXTERN void		TclInitVarHashTable (TclVarHashTable * tablePtr,
 				Namespace * nsPtr);
 #endif
-#ifndef TclBackgroundException_TCL_DECLARED
-#define TclBackgroundException_TCL_DECLARED
-/* 236 */
-EXTERN void		TclBackgroundException (Tcl_Interp * interp,
-				int code);
-#endif
+/* Slot 236 is reserved */
 #ifndef TclResetCancellation_TCL_DECLARED
 #define TclResetCancellation_TCL_DECLARED
 /* 237 */
@@ -1369,7 +1364,7 @@ typedef struct TclIntStubs {
     void (*tclGetSrcInfoForPc) (CmdFrame * contextPtr); /* 233 */
     Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */
     void (*tclInitVarHashTable) (TclVarHashTable * tablePtr, Namespace * nsPtr); /* 235 */
-    void (*tclBackgroundException) (Tcl_Interp * interp, int code); /* 236 */
+    void *reserved236;
     int (*tclResetCancellation) (Tcl_Interp * interp, int force); /* 237 */
     int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *const objv[]); /* 238 */
     int (*tclNRInterpProcCore) (Tcl_Interp * interp, Tcl_Obj * procNameObj, int skip, ProcErrorProc errorProc); /* 239 */
@@ -2110,10 +2105,7 @@ extern const TclIntStubs *tclIntStubsPtr;
 #define TclInitVarHashTable \
 	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
 #endif
-#ifndef TclBackgroundException
-#define TclBackgroundException \
-	(tclIntStubsPtr->tclBackgroundException) /* 236 */
-#endif
+/* Slot 236 is reserved */
 #ifndef TclResetCancellation
 #define TclResetCancellation \
 	(tclIntStubsPtr->tclResetCancellation) /* 237 */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 939d3a0..ac8cbb9 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInterp.c,v 1.98 2008/12/05 14:27:36 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.99 2008/12/09 20:16:30 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3765,7 +3765,7 @@ TimeLimitCallback(
     code = Tcl_LimitCheck(interp);
     if (code != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
-	TclBackgroundException(interp, code);
+	Tcl_BackgroundException(interp, code);
     }
     Tcl_Release(interp);
 }
@@ -3933,7 +3933,7 @@ CallScriptLimitCallback(
     code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
 	    TCL_EVAL_GLOBAL);
     if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
-	TclBackgroundException(limitCBPtr->interp, code);
+	Tcl_BackgroundException(limitCBPtr->interp, code);
     }
     Tcl_Release(limitCBPtr->interp);
 }
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 6fdbc0d..f858b14 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.170 2008/12/05 21:40:38 dkf Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.171 2008/12/09 20:16:30 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -305,7 +305,7 @@ static const TclIntStubs tclIntStubs = {
     TclGetSrcInfoForPc, /* 233 */
     TclVarHashCreateVar, /* 234 */
     TclInitVarHashTable, /* 235 */
-    TclBackgroundException, /* 236 */
+    NULL, /* 236 */
     TclResetCancellation, /* 237 */
     TclNRInterpProc, /* 238 */
     TclNRInterpProcCore, /* 239 */
@@ -1134,6 +1134,7 @@ static const TclStubs tclStubs = {
     Tcl_SetErrorLine, /* 606 */
     Tcl_TransferResult, /* 607 */
     Tcl_InterpActive, /* 608 */
+    Tcl_BackgroundException, /* 609 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index e254830..03e01fa 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTimer.c,v 1.36 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.37 2008/12/09 20:16:30 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1177,7 +1177,7 @@ AfterProc(
     result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
-	TclBackgroundException(interp, result);
+	Tcl_BackgroundException(interp, result);
     }
     Tcl_Release((ClientData) interp);