TIP 337

        * generic/tkBind.c:     Updated callers of Tcl_BackgroundError()
        * generic/tkCanvas.c:   to use the new routine
        * generic/tkEntry.c:    Tcl_BackgroundException() as appropriate.
        * generic/tkImgBmap.c:
        * generic/tkListbox.c:
        * generic/tkSelect.c:
        * generic/tkTextDisp.c:
        * generic/tkTextWind.c:
        * macosx/tkMacOSXHLEvents.c:
        * macosx/tkMacOSXMenu.c:
        * macosx/tkMacOSXMenus.c:
        * macosx/tkMacOSXScale.c:
        * macosx/tkMacOSXWindowEvent.c:
        * unix/tkUnixScale.c:
        * unix/tkUnixWm.c:
        * win/tkWinButton.c:
        * win/tkWinMenu.c:
        * win/tkWinScrlbr.c:
        * win/tkWinWm.c:


FossilOrigin-Name: 8390c9df2a3de24d02b3414ba3ef502bc1349814

20 files changed, 122 insertions, 82 deletions

diff --git a/ChangeLog b/ChangeLog
index 91421ea..5f5bbed 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2008-12-09  Don Porter	<dgp@users.sourceforge.net>
+
+	TIP 337
+
+	* generic/tkBind.c:	Updated callers of Tcl_BackgroundError()
+	* generic/tkCanvas.c:	to use the new routine
+	* generic/tkEntry.c:	Tcl_BackgroundException() as appropriate.
+	* generic/tkImgBmap.c:
+	* generic/tkListbox.c:
+	* generic/tkSelect.c:
+	* generic/tkTextDisp.c:
+	* generic/tkTextWind.c:
+	* macosx/tkMacOSXHLEvents.c:
+	* macosx/tkMacOSXMenu.c:
+	* macosx/tkMacOSXMenus.c:
+	* macosx/tkMacOSXScale.c:
+	* macosx/tkMacOSXWindowEvent.c:
+	* unix/tkUnixScale.c:
+	* unix/tkUnixWm.c:
+	* win/tkWinButton.c:
+	* win/tkWinMenu.c:
+	* win/tkWinScrlbr.c:
+	* win/tkWinWm.c:
+
 2008-12-07  Joe English  <jenglish@users.sourceforge.net>
 
 	* macosx/ttkMacOSXTheme.c: Add native aqua elements for
diff --git a/generic/tkBind.c b/generic/tkBind.c
index dffb926..a3312db 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.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: tkBind.c,v 1.50 2008/11/25 11:19:03 dkf Exp $
+ * RCS: @(#) $Id: tkBind.c,v 1.51 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -1775,7 +1775,7 @@ Tk_BindEvent(
 		break;
 	    } else {
 		Tcl_AddErrorInfo(interp, "\n    (command bound to event)");
-		Tcl_BackgroundError(interp);
+		Tcl_BackgroundException(interp, code);
 		break;
 	    }
 	}
@@ -2663,12 +2663,14 @@ ChangeScreen(
 {
     Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d",
 	    dispName, screenIndex);
+    int code;
 
     Tcl_IncrRefCount(cmdObj);
-    if (Tcl_GlobalEvalObj(interp, cmdObj) != TCL_OK) {
+    code = Tcl_GlobalEvalObj(interp, cmdObj);
+    if (code != TCL_OK) {
 	Tcl_AddErrorInfo(interp,
 		"\n    (changing screen in event binding)");
-	Tcl_BackgroundError(interp);
+	Tcl_BackgroundException(interp, code);
     }
     Tcl_DecrRefCount(cmdObj);
 }
diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c
index a3a2bd9..f1d7421 100644
--- a/generic/tkCanvas.c
+++ b/generic/tkCanvas.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: tkCanvas.c,v 1.57 2008/11/09 20:51:28 nijtmans Exp $
+ * RCS: @(#) $Id: tkCanvas.c,v 1.58 2008/12/09 21:22:56 dgp Exp $
  */
 
 /* #define USE_OLD_TAG_SEARCH 1 */
@@ -5501,7 +5501,7 @@ CanvasUpdateScrollbars(
 		NULL);
 	Tcl_DecrRefCount(fractions);
 	if (result != TCL_OK) {
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, result);
 	}
 	Tcl_ResetResult(interp);
 	Tcl_Release(xScrollCmd);
@@ -5515,7 +5515,7 @@ CanvasUpdateScrollbars(
 		NULL);
 	Tcl_DecrRefCount(fractions);
 	if (result != TCL_OK) {
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, result);
 	}
 	Tcl_ResetResult(interp);
 	Tcl_Release(yScrollCmd);
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index aae87dc..44ea933 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkEntry.c,v 1.56 2008/11/27 23:26:05 nijtmans Exp $
+ * RCS: @(#) $Id: tkEntry.c,v 1.57 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -2940,7 +2940,7 @@ EntryUpdateScrollbar(
 		"\n    (horizontal scrolling command executed by ");
 	Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin));
 	Tcl_AddErrorInfo(interp, ")");
-	Tcl_BackgroundError(interp);
+	Tcl_BackgroundException(interp, code);
     }
     Tcl_ResetResult(interp);
     Tcl_Release(interp);
@@ -3141,10 +3141,10 @@ EntryValidate(
      */
 
     if (code != TCL_OK && code != TCL_RETURN) {
-	Tcl_AddErrorInfo(interp, "\n\t(in validation command executed by ");
-	Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin));
-	Tcl_AddErrorInfo(interp, ")");
-	Tcl_BackgroundError(interp);
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n\t(in validation command executed by %s)",
+		Tk_PathName(entryPtr->tkwin)));
+	Tcl_BackgroundException(interp, code);
 	return TCL_ERROR;
     }
 
@@ -3275,11 +3275,12 @@ EntryValidateChange(
 		    change, newValue, index, type, &script);
 	    Tcl_DStringAppend(&script, "", 1);
 	    p = Tcl_DStringValue(&script);
-	    if (Tcl_EvalEx(entryPtr->interp, p, -1,
-		    TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) != TCL_OK) {
+	    code = Tcl_EvalEx(entryPtr->interp, p, -1,
+		    TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+	    if (code != TCL_OK) {
 		Tcl_AddErrorInfo(entryPtr->interp,
 			"\n\t(in invalidcommand executed by entry)");
-		Tcl_BackgroundError(entryPtr->interp);
+		Tcl_BackgroundException(entryPtr->interp, code);
 		code = TCL_ERROR;
 		entryPtr->validate = VALIDATE_NONE;
 	    }
@@ -4283,7 +4284,7 @@ SpinboxInvoke(
 
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)");
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, code);
 
 	    /*
 	     * Yes, it's an error, but a bg one, so we return OK
diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c
index b7de72a..167b252 100644
--- a/generic/tkImgBmap.c
+++ b/generic/tkImgBmap.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: tkImgBmap.c,v 1.27 2008/11/12 00:15:26 nijtmans Exp $
+ * RCS: @(#) $Id: tkImgBmap.c,v 1.28 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -443,9 +443,9 @@ ImgBmapConfigureInstance(
 	Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
     }
     instancePtr->gc = None;
-    Tcl_AddErrorInfo(masterPtr->interp, "\n    (while configuring image \"");
-    Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
-    Tcl_AddErrorInfo(masterPtr->interp, "\")");
+    Tcl_AppendObjToErrorInfo(masterPtr->interp, Tcl_ObjPrintf(
+	    "\n    (while configuring image \"%s\")", Tk_NameOfImage(
+	    masterPtr->tkMaster)));
     Tcl_BackgroundError(masterPtr->interp);
 }
 
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index d15246c..838751d 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.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: tkListbox.c,v 1.53 2008/12/07 16:34:12 das Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.54 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "default.h"
@@ -3276,7 +3276,7 @@ ListboxUpdateVScrollbar(
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp,
 		"\n    (vertical scrolling command executed by listbox)");
-	Tcl_BackgroundError(interp);
+	Tcl_BackgroundException(interp, result);
     }
     Tcl_Release(interp);
 }
@@ -3341,7 +3341,7 @@ ListboxUpdateHScrollbar(
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp,
 		"\n    (horizontal scrolling command executed by listbox)");
-	Tcl_BackgroundError(interp);
+	Tcl_BackgroundException(interp, result);
     }
     Tcl_Release(interp);
 }
diff --git a/generic/tkSelect.c b/generic/tkSelect.c
index bf31e5b..effd47b 100644
--- a/generic/tkSelect.c
+++ b/generic/tkSelect.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: tkSelect.c,v 1.26 2008/11/08 18:44:40 dkf Exp $
+ * RCS: @(#) $Id: tkSelect.c,v 1.27 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -1560,6 +1560,7 @@ LostSelection(
     LostCommand *lostPtr = clientData;
     Tcl_Obj *objPtr;
     Tcl_Interp *interp;
+    int code;
 
     interp = lostPtr->interp;
     Tcl_Preserve(interp);
@@ -1573,8 +1574,9 @@ LostSelection(
     Tcl_IncrRefCount(objPtr);
     Tcl_ResetResult(interp);
 
-    if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
-	Tcl_BackgroundError(interp);
+    code = TkCopyAndGlobalEval(interp, lostPtr->command);
+    if (code != TCL_OK) {
+	Tcl_BackgroundException(interp, code);
     }
 
     Tcl_SetObjResult(interp, objPtr);
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
index ac6f138..4d20b50 100644
--- a/generic/tkTextDisp.c
+++ b/generic/tkTextDisp.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: tkTextDisp.c,v 1.71 2008/11/08 18:44:40 dkf Exp $
+ * RCS: @(#) $Id: tkTextDisp.c,v 1.72 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -6063,7 +6063,7 @@ GetXView(
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (horizontal scrolling command executed by text)");
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, code);
 	}
     }
 }
@@ -6345,7 +6345,7 @@ GetYView(
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (vertical scrolling command executed by text)");
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, code);
 	}
     }
 }
diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c
index 0e97d92..7787cc6 100644
--- a/generic/tkTextWind.c
+++ b/generic/tkTextWind.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: tkTextWind.c,v 1.25 2008/10/17 23:18:37 nijtmans Exp $
+ * RCS: @(#) $Id: tkTextWind.c,v 1.26 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkPort.h"
@@ -911,7 +911,7 @@ EmbWinLayoutProc(
 	}
 	if (code != TCL_OK) {
 	createError:
-	    Tcl_BackgroundError(textPtr->interp);
+	    Tcl_BackgroundException(textPtr->interp, code);
 	    goto gotWindow;
 	}
 	Tcl_DStringInit(&name);
diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c
index 2f5a0b7..500faf5 100644
--- a/macosx/tkMacOSXHLEvents.c
+++ b/macosx/tkMacOSXHLEvents.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: tkMacOSXHLEvents.c,v 1.18 2008/09/02 16:10:55 das Exp $
+ * RCS: @(#) $Id: tkMacOSXHLEvents.c,v 1.19 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -208,8 +208,9 @@ OappHandler(
 
     if (interp &&
 	    Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){
-	if (Tcl_GlobalEval(interp, "::tk::mac::OpenApplication") != TCL_OK) {
-	    Tcl_BackgroundError(interp);
+	int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication");
+	if (code != TCL_OK) {
+	    Tcl_BackgroundException(interp, code);
 	}
     }
     return noErr;
@@ -244,8 +245,9 @@ RappHandler(
 
     if (interp && Tcl_GetCommandInfo(interp,
 	    "::tk::mac::ReopenApplication", &dummy)) {
-	if (Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication") != TCL_OK){
-	    Tcl_BackgroundError(interp);
+	int code = Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication");
+	if (code != TCL_OK){
+	    Tcl_BackgroundException(interp, code);
 	}
     }
     return err;
@@ -279,8 +281,9 @@ PrefsHandler(
 
     if (interp &&
 	    Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
-	if (Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences") != TCL_OK) {
-	    Tcl_BackgroundError(interp);
+	int code = Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences");
+	if (code != TCL_OK) {
+	    Tcl_BackgroundException(interp, code);
 	}
     }
     return noErr;
@@ -317,6 +320,7 @@ OdocHandler(
     AEKeyword keyword;
     Tcl_DString command, pathName;
     Tcl_CmdInfo dummy;
+    int code;
 
     /*
      * Don't bother if we don't have an interp or the open document procedure
@@ -367,9 +371,10 @@ OdocHandler(
      * Now handle the event by evaluating a script.
      */
 
-    if (Tcl_EvalEx(interp, Tcl_DStringValue(&command),
-	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL) != TCL_OK) {
-	Tcl_BackgroundError(interp);
+    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
+	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
+    if (code != TCL_OK) {
+	Tcl_BackgroundException(interp, code);
     }
     Tcl_DStringFree(&command);
     return noErr;
@@ -406,6 +411,7 @@ PrintHandler(
     AEKeyword keyword;
     Tcl_DString command, pathName;
     Tcl_CmdInfo dummy;
+    int code;
 
     /*
      * Don't bother if we don't have an interp or the print document procedure
@@ -451,9 +457,10 @@ PrintHandler(
      * Now handle the event by evaluating a script.
      */
 
-    if (Tcl_EvalEx(interp, Tcl_DStringValue(&command),
-	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL) != TCL_OK) {
-	Tcl_BackgroundError(interp);
+    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
+	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
+    if (code != TCL_OK) {
+	Tcl_BackgroundException(interp, code);
     }
     Tcl_DStringFree(&command);
     return noErr;
@@ -620,13 +627,14 @@ ReallyKillMe(
     Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
     Tcl_CmdInfo dummy;
     int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
+    int code = Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit");
 
-    if (Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit") != TCL_OK) {
+    if (code != TCL_OK) {
 	/*
 	 * Should be never reached...
 	 */
 
-	Tcl_BackgroundError(interp);
+	Tcl_BackgroundException(interp, code);
     }
     return 1;
 }
diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c
index 73ccbae..331befa 100644
--- a/macosx/tkMacOSXMenu.c
+++ b/macosx/tkMacOSXMenu.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: tkMacOSXMenu.c,v 1.48 2008/12/07 16:36:26 das Exp $
+ * RCS: @(#) $Id: tkMacOSXMenu.c,v 1.49 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -2189,7 +2189,7 @@ EventuallyInvokeMenu (
 
     if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
 	Tcl_AddErrorInfo(realData->menuPtr->interp, "\n    (menu invoke)");
-	Tcl_BackgroundError(realData->menuPtr->interp);
+	Tcl_BackgroundException(realData->menuPtr->interp, code);
     }
 
     if (realData->menuPtr->tkwin) {
@@ -4076,7 +4076,7 @@ TkMacOSXPreprocessMenu(void)
 		    && (code != TCL_BREAK)) {
 		Tcl_AddErrorInfo(currentMenuBarInterp,
 			"\n    (menu preprocess)");
-		Tcl_BackgroundError(currentMenuBarInterp);
+		Tcl_BackgroundException(currentMenuBarInterp, code);
 	    }
 	    Tcl_Release(currentMenuBarInterp);
 	}
diff --git a/macosx/tkMacOSXMenus.c b/macosx/tkMacOSXMenus.c
index 89867fe..7bfcca5 100644
--- a/macosx/tkMacOSXMenus.c
+++ b/macosx/tkMacOSXMenus.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: tkMacOSXMenus.c,v 1.23 2008/12/07 16:36:26 das Exp $
+ * RCS: @(#) $Id: tkMacOSXMenus.c,v 1.24 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -102,6 +102,7 @@ TkMacOSXHandleMenuSelect(
     Window window;
     TkDisplay *dispPtr;
     Tcl_CmdInfo dummy;
+    int code;
 
     if (theItem == 0) {
 	TkMacOSXClearMenubarActive();
@@ -116,9 +117,10 @@ TkMacOSXHandleMenuSelect(
 		Tcl_GetCommandInfo(gInterp, "tkAboutDialog", &dummy) == 0) {
 		TkAboutDlg();
 	    } else {
-		if (Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
-			TCL_EVAL_GLOBAL) != TCL_OK) {
-		    Tcl_BackgroundError(gInterp);
+		code = Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
+			TCL_EVAL_GLOBAL);
+		if (code != TCL_OK) {
+		    Tcl_BackgroundException(gInterp, code);
 		}
 		Tcl_ResetResult(gInterp);
 	    }
@@ -138,8 +140,9 @@ TkMacOSXHandleMenuSelect(
 		    Tcl_GetStringFromObj(path, &len);
 		    if (len) {
 			Tcl_IncrRefCount(path);
-			if (Tcl_FSEvalFile(gInterp, path) == TCL_ERROR) {
-			    Tcl_BackgroundError(gInterp);
+			code = Tcl_FSEvalFile(gInterp, path);
+			if (code != TCL_OK) {
+			    Tcl_BackgroundException(gInterp, code);
 			}
 			Tcl_DecrRefCount(path);
 		    }
@@ -153,8 +156,9 @@ TkMacOSXHandleMenuSelect(
 
 		if (path) {
 		    Tcl_IncrRefCount(path);
-		    if (Tcl_FSEvalFile(gInterp, path) == TCL_ERROR) {
-			Tcl_BackgroundError(gInterp);
+		    code = Tcl_FSEvalFile(gInterp, path);
+		    if (code != TCL_OK) {
+			Tcl_BackgroundException(gInterp, code);
 		    }
 		    Tcl_DecrRefCount(path);
 		    Tcl_ResetResult(gInterp);
diff --git a/macosx/tkMacOSXScale.c b/macosx/tkMacOSXScale.c
index dc5d06d..7de157d 100644
--- a/macosx/tkMacOSXScale.c
+++ b/macosx/tkMacOSXScale.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: tkMacOSXScale.c,v 1.15 2007/12/13 15:27:10 dgp Exp $
+ * RCS: @(#) $Id: tkMacOSXScale.c,v 1.16 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -174,7 +174,7 @@ TkpDisplayScale(
 	result = Tcl_VarEval(interp, scalePtr->command, " ", string, NULL);
 	if (result != TCL_OK) {
 	    Tcl_AddErrorInfo(interp, "\n    (command executed by scale)");
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, result);
 	}
 	Tcl_Release((ClientData) interp);
     }
diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c
index 093e842..28658c9 100644
--- a/macosx/tkMacOSXWindowEvent.c
+++ b/macosx/tkMacOSXWindowEvent.c
@@ -48,7 +48,7 @@
  *	permission to use and distribute the software in accordance with the
  *	terms specified in this license.
  *
- * RCS: @(#) $Id: tkMacOSXWindowEvent.c,v 1.33 2008/10/05 21:26:11 dkf Exp $
+ * RCS: @(#) $Id: tkMacOSXWindowEvent.c,v 1.34 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -891,7 +891,7 @@ TkWmProtocolEventProc(
 		Tcl_AddErrorInfo(interp,
 			Tk_GetAtomName((Tk_Window) winPtr, protocol));
 		Tcl_AddErrorInfo(interp, "\" window manager protocol)");
-		Tk_BackgroundError(interp);
+		Tk_BackgroundException(interp, result);
 	    }
 	    Tcl_Release(interp);
 	    Tcl_Release(protPtr);
diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c
index 4c925b7..fd249ba 100644
--- a/unix/tkUnixScale.c
+++ b/unix/tkUnixScale.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: tkUnixScale.c,v 1.13 2007/12/13 15:28:51 dgp Exp $
+ * RCS: @(#) $Id: tkUnixScale.c,v 1.14 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -557,7 +557,7 @@ TkpDisplayScale(
 		(char *) NULL);
 	if (result != TCL_OK) {
 	    Tcl_AddErrorInfo(interp, "\n    (command executed by scale)");
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, result);
 	}
 	Tcl_Release((ClientData) interp);
     }
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index 1b9cbdf..0e0ceea 100644
--- a/unix/tkUnixWm.c
+++ b/unix/tkUnixWm.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: tkUnixWm.c,v 1.66 2008/11/18 23:49:43 nijtmans Exp $
+ * RCS: @(#) $Id: tkUnixWm.c,v 1.67 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkUnixInt.h"
@@ -6086,11 +6086,10 @@ TkWmProtocolEventProc(
 	    Tcl_Preserve((ClientData) interp);
 	    result = Tcl_GlobalEval(interp, protPtr->command);
 	    if (result != TCL_OK) {
-		Tcl_AddErrorInfo(interp, "\n    (command for \"");
-		Tcl_AddErrorInfo(interp, protocolName);
-		Tcl_AddErrorInfo(interp,
-			"\" window manager protocol)");
-		Tcl_BackgroundError(interp);
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (command for \"%s\" window manager protocol)",
+			protocolName));
+		Tcl_BackgroundException(interp, result);
 	    }
 	    Tcl_Release((ClientData) interp);
 	    Tcl_Release((ClientData) protPtr);
diff --git a/win/tkWinButton.c b/win/tkWinButton.c
index 41f8b84..8aafd7b 100644
--- a/win/tkWinButton.c
+++ b/win/tkWinButton.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: tkWinButton.c,v 1.35 2008/10/17 23:18:38 nijtmans Exp $
+ * RCS: @(#) $Id: tkWinButton.c,v 1.36 2008/12/09 21:22:56 dgp Exp $
  */
 
 #define OEMRESOURCE
@@ -1287,7 +1287,7 @@ ButtonProc(
 	    if (code != TCL_OK && code != TCL_CONTINUE
 		    && code != TCL_BREAK) {
 		Tcl_AddErrorInfo(interp, "\n    (button invoke)");
-		Tcl_BackgroundError(interp);
+		Tcl_BackgroundException(interp, code);
 	    }
 	    Tcl_Release((ClientData)interp);
 	}
diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c
index 2d38ae1..ac92b44 100644
--- a/win/tkWinMenu.c
+++ b/win/tkWinMenu.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: tkWinMenu.c,v 1.61 2008/11/08 18:44:40 dkf Exp $
+ * RCS: @(#) $Id: tkWinMenu.c,v 1.62 2008/12/09 21:22:56 dgp Exp $
  */
 
 #define OEMRESOURCE
@@ -1032,7 +1032,7 @@ TkWinHandleMenuEvent(
 		if ((code != TCL_OK) && (code != TCL_CONTINUE)
 			&& (code != TCL_BREAK)) {
 		    Tcl_AddErrorInfo(interp, "\n    (menu preprocess)");
-		    Tcl_BackgroundError(interp);
+		    Tcl_BackgroundException(interp, code);
 		}
 		Tcl_Release((ClientData)interp);
 	    }
@@ -1091,7 +1091,7 @@ TkWinHandleMenuEvent(
 	    code = TkInvokeMenu(interp, menuPtr, mePtr->index);
 	    if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
 		Tcl_AddErrorInfo(interp, "\n    (menu invoke)");
-		Tcl_BackgroundError(interp);
+		Tcl_BackgroundException(interp, code);
 	    }
 	    Tcl_Release((ClientData)interp);
 	    *plResult = 0;
diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c
index 0060a9f..eb9fcea 100644
--- a/win/tkWinScrlbr.c
+++ b/win/tkWinScrlbr.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: tkWinScrlbr.c,v 1.16 2008/10/03 13:13:31 dkf Exp $
+ * RCS: @(#) $Id: tkWinScrlbr.c,v 1.17 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkWinInt.h"
@@ -572,7 +572,7 @@ ScrollbarProc(
 	code = Tcl_GlobalEval(interp, cmdString.string);
 	if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
 	    Tcl_AddErrorInfo(interp, "\n    (scrollbar command)");
-	    Tcl_BackgroundError(interp);
+	    Tcl_BackgroundException(interp, code);
 	}
 	Tcl_DStringFree(&cmdString);
 
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index 8ffc4d5..89fe23e 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.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: tkWinWm.c,v 1.133 2008/11/18 23:49:42 nijtmans Exp $
+ * RCS: @(#) $Id: tkWinWm.c,v 1.134 2008/12/09 21:22:56 dgp Exp $
  */
 
 #include "tkWinInt.h"
@@ -6523,10 +6523,10 @@ TkWmProtocolEventProc(
 	    Tcl_Preserve(interp);
 	    result = Tcl_GlobalEval(interp, protPtr->command);
 	    if (result != TCL_OK) {
-		Tcl_AddErrorInfo(interp, "\n    (command for \"");
-		Tcl_AddErrorInfo(interp, name);
-		Tcl_AddErrorInfo(interp, "\" window manager protocol)");
-		Tcl_BackgroundError(interp);
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (command for \"%s\" window manager protocol)",
+			name));
+		Tcl_BackgroundException(interp, result);
 	    }
 	    Tcl_Release(interp);
 	    Tcl_Release(protPtr);