summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoe Mistachkin <joe@mistachkin.com>2008-06-13 05:46:08 (GMT)
committerJoe Mistachkin <joe@mistachkin.com>2008-06-13 05:46:08 (GMT)
commitee10365fe5ddffde317320b6ac35d36b86b21dc4 (patch)
tree53dd4c32ceb799030ada10f68625bfe0e4c015e0
parentf12c70da2d6208293f2afb3d2181b40adb47ec67 (diff)
downloadtk-ee10365fe5ddffde317320b6ac35d36b86b21dc4.zip
tk-ee10365fe5ddffde317320b6ac35d36b86b21dc4.tar.gz
tk-ee10365fe5ddffde317320b6ac35d36b86b21dc4.tar.bz2
TIP 285 Implementation
-rw-r--r--ChangeLog9
-rw-r--r--generic/tkCmds.c67
-rw-r--r--win/makefile.vc8
-rw-r--r--win/rules.vc8
4 files changed, 81 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index 309884e..406e74d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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