From 8dbcb4b276318e6b06a7f576e0f5c87875a52a67 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 9 Dec 2008 21:22:55 +0000 Subject: 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: --- ChangeLog | 24 ++++++++++++++++++++++++ generic/tkBind.c | 10 ++++++---- generic/tkCanvas.c | 6 +++--- generic/tkEntry.c | 21 +++++++++++---------- generic/tkImgBmap.c | 8 ++++---- generic/tkListbox.c | 6 +++--- generic/tkSelect.c | 8 +++++--- generic/tkTextDisp.c | 6 +++--- generic/tkTextWind.c | 4 ++-- macosx/tkMacOSXHLEvents.c | 38 +++++++++++++++++++++++--------------- macosx/tkMacOSXMenu.c | 6 +++--- macosx/tkMacOSXMenus.c | 20 ++++++++++++-------- macosx/tkMacOSXScale.c | 4 ++-- macosx/tkMacOSXWindowEvent.c | 4 ++-- unix/tkUnixScale.c | 4 ++-- unix/tkUnixWm.c | 11 +++++------ win/tkWinButton.c | 4 ++-- win/tkWinMenu.c | 6 +++--- win/tkWinScrlbr.c | 4 ++-- win/tkWinWm.c | 10 +++++----- 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 + + 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 * 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); -- cgit v0.12