summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog24
-rw-r--r--generic/tkBind.c10
-rw-r--r--generic/tkCanvas.c6
-rw-r--r--generic/tkEntry.c21
-rw-r--r--generic/tkImgBmap.c8
-rw-r--r--generic/tkListbox.c6
-rw-r--r--generic/tkSelect.c8
-rw-r--r--generic/tkTextDisp.c6
-rw-r--r--generic/tkTextWind.c4
-rw-r--r--macosx/tkMacOSXHLEvents.c38
-rw-r--r--macosx/tkMacOSXMenu.c6
-rw-r--r--macosx/tkMacOSXMenus.c20
-rw-r--r--macosx/tkMacOSXScale.c4
-rw-r--r--macosx/tkMacOSXWindowEvent.c4
-rw-r--r--unix/tkUnixScale.c4
-rw-r--r--unix/tkUnixWm.c11
-rw-r--r--win/tkWinButton.c4
-rw-r--r--win/tkWinMenu.c6
-rw-r--r--win/tkWinScrlbr.c4
-rw-r--r--win/tkWinWm.c10
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);
generated by cgit v0.12 at 2024-11-02 23:11:19 (GMT)