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:

8 files changed, 37 insertions, 32 deletions

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);