diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-03-27 14:06:11 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-03-27 14:06:11 (GMT) |
commit | d2775095f0bf50afa0506eca7153d42d0667806a (patch) | |
tree | 045a97aa039ad078fee924d4f40551f8d0415715 /generic | |
parent | cb35a015bca66fd1c76097082f0498ef1d007745 (diff) | |
download | tk-d2775095f0bf50afa0506eca7153d42d0667806a.zip tk-d2775095f0bf50afa0506eca7153d42d0667806a.tar.gz tk-d2775095f0bf50afa0506eca7153d42d0667806a.tar.bz2 |
Properly clean up, when a (Tcl 8.6) thread is canceled.
(Backported from Tk 8.6)
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tkCmds.c | 73 |
1 files changed, 65 insertions, 8 deletions
diff --git a/generic/tkCmds.c b/generic/tkCmds.c index a86ef84..09c1d67 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -22,6 +22,15 @@ #include "tkUnixInt.h" #endif +#if (TCL_MAJOR_VERSION==8) && (TCL_MINOR_VERSION<6) +# if defined(STATIC_BUILD) +# define Tcl_Canceled(interp, flags) (TCL_OK) +# else +# define Tcl_Canceled \ + (tclStubsPtr->tclCanceled) /* 581 */ +# endif +#endif + /* * Forward declarations for functions defined later in this file: */ @@ -913,6 +922,7 @@ Tk_TkwaitObjCmd( { Tk_Window tkwin = (Tk_Window) clientData; int done, index; + int code = TCL_OK; static const char *optionStrings[] = { "variable", "visibility", "window", NULL }; @@ -939,6 +949,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]), @@ -958,9 +972,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. @@ -988,25 +1006,37 @@ 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, &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 */ @@ -1080,6 +1110,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; @@ -1104,12 +1135,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; } @@ -1117,11 +1171,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; } /* |