From be9d4efe7ba6f645e1cd3e8c93dfa13f634eb972 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 27 Mar 2013 11:54:48 +0000 Subject: Same change as [9bc120ced2] for UNIX, but for Windows as well. --- win/Makefile.in | 1 - win/configure | 19 +++++++++++++++++++ win/configure.in | 11 +++++++++++ win/makefile.bc | 1 - win/makefile.vc | 1 - 5 files changed, 30 insertions(+), 3 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index 550e6ae..2952e03 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -350,7 +350,6 @@ TK_OBJS = \ tkUtil.$(OBJEXT) \ tkVisual.$(OBJEXT) \ tkStubInit.$(OBJEXT) \ - tkStubLib.$(OBJEXT) \ tkWindow.$(OBJEXT) \ $(TTK_OBJS) diff --git a/win/configure b/win/configure index bd3acf4..9e6acbd 100755 --- a/win/configure +++ b/win/configure @@ -3284,6 +3284,25 @@ echo "${ECHO_T}could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6 +if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then + { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 +echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} + { (exit 1); exit 1; }; } +fi +if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then + { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 +echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} + { (exit 1); exit 1; }; } +fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called diff --git a/win/configure.in b/win/configure.in index ef517e6..87826fb 100644 --- a/win/configure.in +++ b/win/configure.in @@ -81,6 +81,17 @@ SC_ENABLE_SHARED SC_PATH_TCLCONFIG($TK_PATCH_LEVEL) SC_LOAD_TCLCONFIG +if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then + AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) +fi +if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then + AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) +fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called diff --git a/win/makefile.bc b/win/makefile.bc index 12fd5b8..295ed23 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -225,7 +225,6 @@ TKOBJS = \ $(TMPDIR)\tkUtil.obj \ $(TMPDIR)\tkVisual.obj \ $(TMPDIR)\tkStubInit.obj \ - $(TMPDIR)\tkStubLib.obj \ $(TMPDIR)\tkWindow.obj # Maintenance hint: Please have multiple members of TKSTUBOBJS be separated diff --git a/win/makefile.vc b/win/makefile.vc index 68df470..a7b0c0a 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -360,7 +360,6 @@ TKOBJS = \ $(TMP_DIR)\tkUtil.obj \ $(TMP_DIR)\tkVisual.obj \ $(TMP_DIR)\tkStubInit.obj \ - $(TMP_DIR)\tkStubLib.obj \ $(TMP_DIR)\tkWindow.obj \ $(TTK_OBJS) \ !if !$(STATIC_BUILD) -- cgit v0.12 From cb35a015bca66fd1c76097082f0498ef1d007745 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 27 Mar 2013 13:07:29 +0000 Subject: Make compiling/running Tk8.5 against 8.6 headers work on Windows as well. In dynamic builds, Tcl_FindExecutable should always be taken from the stub table, even though the 8.6 headers tell otherwise. That's why in Tcl 8.6, the Tcl_FindExecutable() call moved from Tk_MainEx to the Tk_Main() macro. --- generic/tkMain.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/generic/tkMain.c b/generic/tkMain.c index 5d58932..cb1fb5e 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -171,6 +171,12 @@ Tk_MainEx( tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); +#if !defined(STATIC_BUILD) +# undef Tcl_FindExecutable +# define Tcl_FindExecutable \ + (tclStubsPtr->tcl_FindExecutable) /* 144 */ +#endif + Tcl_FindExecutable(argv[0]); tsdPtr->interp = interp; Tcl_Preserve((ClientData) interp); -- cgit v0.12 From d2775095f0bf50afa0506eca7153d42d0667806a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 27 Mar 2013 14:06:11 +0000 Subject: Properly clean up, when a (Tcl 8.6) thread is canceled. (Backported from Tk 8.6) --- generic/tkCmds.c | 73 +++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file 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; } /* -- cgit v0.12 From 0198f40eb58a938f901dac686a48e9635c8d1156 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Mar 2013 07:36:44 +0000 Subject: Easier solution, with proper protection and configure warnings. --- generic/tkCmds.c | 7 +------ generic/tkMain.c | 2 +- generic/tkWindow.c | 2 +- unix/configure | 6 ++++++ unix/configure.in | 4 ++++ win/configure | 6 ++++++ win/configure.in | 4 ++++ 7 files changed, 23 insertions(+), 8 deletions(-) diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 09c1d67..a655341 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -23,12 +23,7 @@ #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 +# define Tcl_Canceled(interp, flags) (TCL_OK) #endif /* diff --git a/generic/tkMain.c b/generic/tkMain.c index cb1fb5e..8bebb3d 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -135,7 +135,7 @@ Tk_MainEx( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION ".0", 0) == NULL) { if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { abort(); } else { diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 2901256..d40e7de 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -3024,7 +3024,7 @@ Initialize( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION ".0", 0) == NULL) { return TCL_ERROR; } diff --git a/unix/configure b/unix/configure index 93c2451..01274fe 100755 --- a/unix/configure +++ b/unix/configure @@ -1603,6 +1603,12 @@ Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} { (exit 1); exit 1; }; } fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + { echo "$as_me:$LINENO: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&5 +echo "$as_me: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&2;} +fi #------------------------------------------------------------------------ # Handle the --prefix=... option diff --git a/unix/configure.in b/unix/configure.in index 0e7db3c..6c6e68b 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -49,6 +49,10 @@ if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + AC_MSG_WARN([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}]) +fi #------------------------------------------------------------------------ # Handle the --prefix=... option diff --git a/win/configure b/win/configure index 9e6acbd..33030b9 100755 --- a/win/configure +++ b/win/configure @@ -3302,6 +3302,12 @@ Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} { (exit 1); exit 1; }; } fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + { echo "$as_me:$LINENO: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&5 +echo "$as_me: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&2;} +fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This diff --git a/win/configure.in b/win/configure.in index 87826fb..c5f09cc 100644 --- a/win/configure.in +++ b/win/configure.in @@ -91,6 +91,10 @@ if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + AC_MSG_WARN([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}]) +fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This -- cgit v0.12 From b8f8082aad49088238582658c22248f9469ad055 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Mar 2013 08:46:17 +0000 Subject: One last review of tkCmds.c, making sure that there is no single mistake in it. Found one unnecessary IncrRefCount/DecrRefcount, some unneeded type cast and a few more cleanups, all already fixed in Tk 8.6. So better backport that too. --- generic/tkCmds.c | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/generic/tkCmds.c b/generic/tkCmds.c index a655341..acb7496 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -236,7 +236,7 @@ TkBindEventProc( ClientData objects[MAX_OBJS], *objPtr; TkWindow *topLevPtr; int i, count; - char *p; + const char *p; Tcl_HashEntry *hPtr; if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) { @@ -255,7 +255,7 @@ TkBindEventProc( (winPtr->numTags * sizeof(ClientData))); } for (i = 0; i < winPtr->numTags; i++) { - p = (char *) winPtr->tagPtr[i]; + p = winPtr->tagPtr[i]; if (*p == '.') { hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p); if (hPtr != NULL) { @@ -331,7 +331,6 @@ Tk_BindtagsObjCmd( } if (objc == 2) { listPtr = Tcl_NewObj(); - Tcl_IncrRefCount(listPtr); if (winPtr->numTags == 0) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); @@ -354,7 +353,6 @@ Tk_BindtagsObjCmd( } } Tcl_SetObjResult(interp, listPtr); - Tcl_DecrRefCount(listPtr); return TCL_OK; } if (winPtr->tagPtr != NULL) { @@ -415,10 +413,10 @@ TkFreeBindingTags( TkWindow *winPtr) /* Window whose tags are to be released. */ { int i; - char *p; + const char *p; for (i = 0; i < winPtr->numTags; i++) { - p = (char *) (winPtr->tagPtr[i]); + p = winPtr->tagPtr[i]; if (*p == '.') { /* * Names starting with "." are malloced rather than Uids, so they @@ -1059,8 +1057,7 @@ WaitVisibilityProc( if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } - if (eventPtr->type == DestroyNotify) { + } else if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1555,9 +1552,7 @@ Tk_WinfoObjCmd( Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } break; - case WIN_INTERPS: { - int result; - + case WIN_INTERPS: skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); if (skip < 0) { return TCL_ERROR; @@ -1566,9 +1561,7 @@ Tk_WinfoObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?"); return TCL_ERROR; } - result = TkGetInterpNames(interp, tkwin); - return result; - } + return TkGetInterpNames(interp, tkwin); case WIN_PATHNAME: { Window id; -- cgit v0.12