diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tkCmds.c | 67 | ||||
| -rw-r--r-- | win/makefile.vc | 8 | ||||
| -rw-r--r-- | win/rules.vc | 8 |
4 files changed, 81 insertions, 11 deletions
@@ -1,3 +1,12 @@ +2008-06-13 Joe Mistachkin <joe@mistachkin.com> + + TIP #285 IMPLEMENTATION + + * generic/tkCmds.c: During [tkwait] and [update], always cooperatively + check for script cancellation. + * win/makefile.vc: Added 'pdbs' option for Windows build rules to allow + * win/rules.vc: for non-debug builds with full symbols. + 2008-06-12 Daniel Steffen <das@users.sourceforge.net> * generic/tkPointer.c (Tk_UpdatePointer): fix failure to restore a diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 63d329c..8852ee8 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.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: tkCmds.c,v 1.41 2007/12/13 15:24:13 dgp Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.42 2008/06/13 05:46:09 mistachkin Exp $ */ #include "tkInt.h" @@ -915,6 +915,7 @@ Tk_TkwaitObjCmd( { Tk_Window tkwin = (Tk_Window) clientData; int done, index; + int code = TCL_OK; static const char *optionStrings[] = { "variable", "visibility", "window", NULL }; @@ -941,6 +942,10 @@ Tk_TkwaitObjCmd( } done = 0; while (!done) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } Tcl_DoOneEvent(0); } Tcl_UntraceVar(interp, Tcl_GetString(objv[2]), @@ -960,9 +965,13 @@ Tk_TkwaitObjCmd( WaitVisibilityProc, (ClientData) &done); done = 0; while (!done) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } Tcl_DoOneEvent(0); } - if (done != 1) { + if ((done != 0) && (done != 1)) { /* * Note that we do not delete the event handler because it was * deleted automatically when the window was destroyed. @@ -990,25 +999,38 @@ Tk_TkwaitObjCmd( WaitWindowProc, (ClientData) &done); done = 0; while (!done) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } Tcl_DoOneEvent(0); } /* - * Note: there's no need to delete the event handler. It was deleted - * automatically when the window was destroyed. + * Note: normally there's no need to delete the event handler. It was deleted + * automatically when the window was destroyed; however, if the wait operation + * was canceled, we need to delete it. */ + if (done == 0) { + Tk_DeleteEventHandler(window, + StructureNotifyMask, + WaitWindowProc, (ClientData) &done); + } break; } } /* * Clear out the interpreter's result, since it may have been set by event - * handlers. + * handlers. This is skipped if an error occurred above, such as the wait + * operation being canceled. */ + if (code == TCL_OK) Tcl_ResetResult(interp); - return TCL_OK; + + return code; } /* ARGSUSED */ @@ -1082,6 +1104,7 @@ Tk_UpdateObjCmd( static const char *updateOptions[] = {"idletasks", NULL}; int flags, index; TkDisplay *dispPtr; + int code = TCL_OK; if (objc == 1) { flags = TCL_DONT_WAIT; @@ -1106,12 +1129,35 @@ Tk_UpdateObjCmd( while (1) { while (Tcl_DoOneEvent(flags) != 0) { - /* Empty loop body */ + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } } + + /* + * If event processing was canceled proceed no further. + */ + + if (code == TCL_ERROR) + break; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XSync(dispPtr->display, False); } + + /* + * Check again if event processing has been canceled because the inner + * loop (above) may not have checked (i.e. no events were processed and + * the loop body was skipped). + */ + + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } + if (Tcl_DoOneEvent(flags) == 0) { break; } @@ -1119,11 +1165,14 @@ Tk_UpdateObjCmd( /* * Must clear the interpreter's result because event handlers could have - * executed commands. + * executed commands. This is skipped if an error occurred above, such as + * the wait operation being canceled. */ + if (code == TCL_OK) Tcl_ResetResult(interp); - return TCL_OK; + + return code; } /* diff --git a/win/makefile.vc b/win/makefile.vc index b8a790e..9c1509e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -13,7 +13,7 @@ # Copyright (c) 2003-2008 Pat Thoyts. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.122 2008/05/15 00:06:19 patthoyts Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.123 2008/06/13 05:46:09 mistachkin Exp $ #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) @@ -437,6 +437,9 @@ cdebug = $(OPTIMIZATIONS) !else cdebug = !endif +!if $(SYMBOLS) +cdebug = $(cdebug) -Zi +!endif !else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" ### Warnings are too many, can't support warnings into errors. cdebug = -Zi -Od $(DEBUGFLAGS) @@ -480,6 +483,9 @@ TK_CFLAGS = $(TK_CFLAGS) -DUSE_TCL_STUBS ldebug = -debug:full -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 +!if $(SYMBOLS) +ldebug = $(ldebug) -debug:full -debugtype:cv +!endif !endif ### Declarations common to all linker options diff --git a/win/rules.vc b/win/rules.vc index 73215e8..4626bc1 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -11,7 +11,7 @@ # Copyright (c) 2003-2007 Patrick Thoyts # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: rules.vc,v 1.22 2008/05/15 00:06:19 patthoyts Exp $ +# RCS: @(#) $Id: rules.vc,v 1.23 2008/06/13 05:46:09 mistachkin Exp $ #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -252,6 +252,12 @@ DEBUG = 1 !else DEBUG = 0 !endif +!if [nmakehlp -f $(OPTS) "pdbs"] +!message *** Doing pdbs +SYMBOLS = 1 +!else +SYMBOLS = 0 +!endif !if [nmakehlp -f $(OPTS) "profile"] !message *** Doing profile PROFILE = 1 |