Index: .github/workflows/linux-build.yml ================================================================== --- .github/workflows/linux-build.yml +++ .github/workflows/linux-build.yml @@ -3,10 +3,11 @@ push: branches: - "main" - "core-8-branch" - "core-8-6-branch" + - "bug-22349fc78a-v2" tags: - "core-**" permissions: contents: read defaults: Index: .github/workflows/mac-build.yml ================================================================== --- .github/workflows/mac-build.yml +++ .github/workflows/mac-build.yml @@ -3,10 +3,11 @@ push: branches: - "main" - "core-8-branch" - "core-8-6-branch" + - "bug-22349fc78a-v2" tags: - "core-**" permissions: contents: read env: @@ -55,11 +56,11 @@ echo "::error::Failure during Test" exit 1 fi timeout-minutes: 30 clang: - runs-on: macos-11 + runs-on: macos-12 strategy: matrix: symbols: - 'no' - 'mem' Index: .github/workflows/win-build.yml ================================================================== --- .github/workflows/win-build.yml +++ .github/workflows/win-build.yml @@ -3,10 +3,11 @@ push: branches: - "main" - "core-8-branch" - "core-8-6-branch" + - "bug-22349fc78a-v2" tags: - "core-**" permissions: contents: read env: Index: generic/tkTest.c ================================================================== --- generic/tkTest.c +++ generic/tkTest.c @@ -144,10 +144,13 @@ * Forward declarations for functions defined later in this file: */ static int ImageObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); +static int TestProcessEventsObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); static int TestbitmapObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); static int TestborderObjCmd(ClientData dummy, @@ -245,10 +248,11 @@ if (Tcl_PkgProvideEx(interp, "Tktest", TK_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } + Tcl_CreateObjCommand(interp, "testprocessevents", TestProcessEventsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd, (ClientData) Tk_MainWindow(interp), NULL); @@ -1676,10 +1680,82 @@ Tcl_DeleteCommand(timPtr->interp, timPtr->imageName); ckfree(timPtr->imageName); ckfree(timPtr->varName); ckfree(timPtr); } + +/* + *---------------------------------------------------------------------- + * + * TestProcessEventsObjCmd -- + * + * This function implements the "testprocessevents" command which processes + * all queued events of a type specified by one of the arguments to the + * command. Currently the supported arguments are leave, enter, motion, + * and expose. Others could be added if needed. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Events are processed + * + *---------------------------------------------------------------------- + */ + +static Tk_RestrictAction +CrossingRestrictProc( + ClientData arg, + XEvent *eventPtr) +{ + int *eventTypes = (int *) arg; + for (int *t = eventTypes; *t != 0; t++) { + if (eventPtr->type == *t) { + return TK_PROCESS_EVENT; + } + } + return TK_DEFER_EVENT; +} + +static int TestProcessEventsObjCmd( + TCL_UNUSED(ClientData), /* Main window for application. */ + Tcl_Interp* interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj* const objv[]) /* Argument objects. */ +{ + ClientData oldArg; + Tk_RestrictProc *oldProc; + int index; + static const char *const eventTypeNames[] = { + "leave", "enter", "motion", "expose", NULL}; + static const int eventTypes[] = { + LeaveNotify, EnterNotify, MotionNotify, Expose}; +#define NUM_TYPES (sizeof(eventTypes)/sizeof(int)) + int whichEvents[1 + NUM_TYPES]; + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "eventtype ?eventtype ...?"); + return TCL_ERROR; + } + if (objc > NUM_TYPES + 1) { + Tcl_WrongNumArgs(interp, 1, objv, "too many event types"); + return TCL_ERROR; + } +#undef NUM_TYPES + for (int n = 1; n < objc; n++) { + if (Tcl_GetIndexFromObj(interp, objv[n], eventTypeNames, "eventtype", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + whichEvents[n - 1] = eventTypes[index]; + } + whichEvents[objc - 1] = 0; + oldProc = Tk_RestrictEvents(CrossingRestrictProc, (void *) whichEvents, + &oldArg); + while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT)) {}; + Tk_RestrictEvents(oldProc, oldArg, &oldArg); + return TCL_OK; +} /* *---------------------------------------------------------------------- * * TestmakeexistObjCmd -- Index: generic/tkWindow.c ================================================================== --- generic/tkWindow.c +++ generic/tkWindow.c @@ -213,10 +213,21 @@ int *screenPtr); static int Initialize(Tcl_Interp *interp); static int NameWindow(Tcl_Interp *interp, TkWindow *winPtr, TkWindow *parentPtr, const char *name); static void UnlinkWindow(TkWindow *winPtr); + +/* + * This static variable only makes sense for macOS and Windows, which never + * have more than one display. It is set by TkCloseDisplay, and when set + * prevents sending Enter and Leave events when all of the windows in the + * display are being destroyed. Tk does not send those events on X11; that + * job is handled by the X server. + */ + +static int displayBeingClosed = 0; + /* *---------------------------------------------------------------------- * * TkCloseDisplay -- @@ -237,10 +248,11 @@ static void TkCloseDisplay( TkDisplay *dispPtr) { + displayBeingClosed = 1; TkClipCleanup(dispPtr); TkpCancelWarp(dispPtr); if (dispPtr->name != NULL) { @@ -1320,10 +1332,43 @@ * callback functions are invoked. * *-------------------------------------------------------------- */ +#if defined(MAC_OSX_TK) || defined(_WIN32) +static void SendEnterLeaveForDestroy( + Tk_Window tkwin) +{ + int x, y; + unsigned int state; + Tk_Window pointerWin; + TkWindow *containerPtr; + + if (displayBeingClosed) { + return; + } + XQueryPointer(Tk_Display(tkwin), None, NULL, NULL, &x, &y, + NULL, NULL, &state); + pointerWin = Tk_CoordsToWindow(x, y, tkwin); + if (pointerWin == tkwin) { + if (!Tk_IsTopLevel(tkwin)) { + containerPtr = TkGetContainer((TkWindow *)pointerWin); + Tk_UpdatePointer((Tk_Window) containerPtr, x, y, state); + } + } + + if (pointerWin && (tkwin == Tk_Parent(pointerWin))) { + Tk_UpdatePointer(Tk_Parent(tkwin), x, y, state); + } +} +#else +static void SendEnterLeaveForDestroy( + TCL_UNUSED(Tk_Window)) +{ +} +#endif + void Tk_DestroyWindow( Tk_Window tkwin) /* Window to destroy. */ { TkWindow *winPtr = (TkWindow *) tkwin; @@ -1339,10 +1384,14 @@ * Ignore the request. */ return; } + if ((winPtr->flags & TK_DONT_DESTROY_WINDOW) == 0) { + SendEnterLeaveForDestroy(tkwin); + } + winPtr->flags |= TK_ALREADY_DEAD; /* * Unless we are cleaning up a half dead window from * DeleteWindowsExitProc, add this window to the half dead list. @@ -1509,11 +1558,11 @@ /* * Cleanup the data structures associated with this window. */ - if (winPtr->flags & TK_WIN_MANAGED) { + if (winPtr->wmInfoPtr && (winPtr->flags & TK_WIN_MANAGED)) { TkWmDeadWindow(winPtr); } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) { TkWmRemoveFromColormapWindows(winPtr); } if (winPtr->window != None) { @@ -2595,11 +2644,11 @@ { TkWindow *winPtr = (TkWindow *) tkwin; TkWindow *otherPtr = (TkWindow *) other; /* - * Special case: if winPtr is a top-level window then just find the + * Special case: if winPtr is a toplevel window then just find the * top-level ancestor of otherPtr and restack winPtr above otherPtr * without changing any of Tk's childLists. */ if (winPtr->flags & TK_WIN_MANAGED) { Index: macosx/tkMacOSXInit.c ================================================================== --- macosx/tkMacOSXInit.c +++ macosx/tkMacOSXInit.c @@ -421,10 +421,22 @@ Bool doCleanup = doCleanupFromExit; if (doCleanupFromExit) { doCleanupFromExit = NO; /* prevent possible recursive call. */ closePanels(); } + + /* + * At this point it is too late to be looking up the Tk window associated + * to any NSWindows, but it can happen. This makes sure the answer is None + * if such a query is attempted. + */ + + for (TKWindow *w in [NSApp orderedWindows]) { + if ([w respondsToSelector: @selector (tkWindow)]) { + [w setTkWindow: None]; + } + } /* * Tcl_Exit does not call Tcl_Finalize if there is an exit proc installed. */ Index: macosx/tkMacOSXMouseEvent.c ================================================================== --- macosx/tkMacOSXMouseEvent.c +++ macosx/tkMacOSXMouseEvent.c @@ -498,12 +498,13 @@ */ state |= TkGetButtonMask(Button1); } if (eventType == NSMouseEntered) { - Tk_UpdatePointer((Tk_Window) [NSApp tkPointerWindow], - global.x, global.y, state); + Tk_Window new_win = Tk_CoordsToWindow(global.x, global.y, + (Tk_Window) [NSApp tkPointerWindow]); + Tk_UpdatePointer(new_win, global.x, global.y, state); } else if (eventType == NSMouseExited) { if ([NSApp tkDragTarget]) { Tk_UpdatePointer((Tk_Window) [NSApp tkDragTarget], global.x, global.y, state); } else { Index: macosx/tkMacOSXSubwindows.c ================================================================== --- macosx/tkMacOSXSubwindows.c +++ macosx/tkMacOSXSubwindows.c @@ -60,12 +60,12 @@ /* * Remove any dangling pointers that may exist if the window we are * deleting is being tracked by the grab code. */ - TkPointerDeadWindow(macWin->winPtr); TkMacOSXSelDeadWindow(macWin->winPtr); + TkPointerDeadWindow(macWin->winPtr); macWin->toplevel->referenceCount--; if (!Tk_IsTopLevel(macWin->winPtr)) { TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW); if (macWin->winPtr->parentPtr != NULL) { Index: macosx/tkMacOSXWindowEvent.c ================================================================== --- macosx/tkMacOSXWindowEvent.c +++ macosx/tkMacOSXWindowEvent.c @@ -254,11 +254,11 @@ { NSWindow *w = [notification object]; TkWindow *winPtr = TkMacOSXGetTkWindow(w); if (winPtr) { - while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {} + while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {} } } - (void) windowLiveResize: (NSNotification *) notification { @@ -282,13 +282,15 @@ { TKLog(@"-[%@(%p) %s] %@", [self class], self, sel_getName(_cmd), notification); NSWindow *w = [notification object]; TkWindow *winPtr = TkMacOSXGetTkWindow(w); +#if 0 if (winPtr) { - //Tk_UnmapWindow((Tk_Window)winPtr); + Tk_UnmapWindow((Tk_Window)winPtr); } +#endif } #endif /* TK_MAC_DEBUG_NOTIFICATIONS */ - (void) _setupWindowNotifications Index: macosx/tkMacOSXWm.c ================================================================== --- macosx/tkMacOSXWm.c +++ macosx/tkMacOSXWm.c @@ -621,11 +621,10 @@ TkWindow *winPtr = NULL; for (NSWindow *w in windows) { winPtr = TkMacOSXGetTkWindow(w); if (winPtr) { - WmInfo *wmPtr = winPtr->wmInfoPtr; NSRect windowFrame = [w frame]; NSRect contentFrame = [w frame]; contentFrame.size.height = [[w contentView] frame].size.height; /* @@ -632,17 +631,19 @@ * For consistency with other platforms, points in the * title bar are not considered to be contained in the * window. */ - if ((wmPtr->hints.initial_state == NormalState || - wmPtr->hints.initial_state == ZoomState)) { - if (NSMouseInRect(p, contentFrame, NO)) { - return winPtr; - } else if (NSMouseInRect(p, windowFrame, NO)) { - return NULL; - } + if (NSMouseInRect(p, contentFrame, NO)) { + return winPtr; + } else if (NSMouseInRect(p, windowFrame, NO)) { + /* + * The pointer is in the title bar of the highest NSWindow + * containing it, and therefore is should not be considered + * to be contained in any Tk window. + */ + return NULL; } } } return NULL; } @@ -895,31 +896,34 @@ * * TkWmDeadWindow -- * * This procedure is invoked when a top-level window is about to be * deleted. It cleans up the wm-related data structures for the window. + * If the dead window contains the pointer, TkUpdatePointer is called + * to tell Tk which window will be the new pointer window. * * Results: * None. * * Side effects: - * The WmInfo structure for winPtr gets freed up. + * The WmInfo structure for winPtr gets freed. Tk's cached pointer + * window may change. * *---------------------------------------------------------------------- */ void TkWmDeadWindow( TkWindow *winPtr) /* Top-level window that's being deleted. */ { + TkWindow *winPtr2; WmInfo *wmPtr = winPtr->wmInfoPtr, *wmPtr2; - TKWindow *deadNSWindow; - - if (wmPtr == NULL) { + TKWindow *deadNSWindow = (TKWindow *)TkMacOSXGetNSWindowForDrawable( + Tk_WindowId(winPtr)); + if (deadNSWindow == NULL) { return; } - /* *If the dead window is a transient, remove it from the container's list. */ RemoveTransient(winPtr); @@ -983,33 +987,53 @@ wmPtr->transientPtr = transientPtr->nextPtr; ckfree(transientPtr); } - deadNSWindow = (TKWindow *)wmPtr->window; - /* * Remove references to the Tk window from the mouse event processing - * state which is recorded in the NSApplication object. + * state which is recorded in the NSApplication object and notify Tk + * of the new pointer window. */ - if (winPtr == [NSApp tkPointerWindow]) { - NSWindow *w; - NSPoint mouse = [NSEvent mouseLocation]; - [NSApp setTkPointerWindow:nil]; - for (w in [NSApp orderedWindows]) { - if (w == deadNSWindow) { - continue; - } - if (NSPointInRect(mouse, [w frame])) { - TkWindow *winPtr2 = TkMacOSXGetTkWindow(w); - int x = mouse.x, y = TkMacOSXZeroScreenHeight() - mouse.y; - [NSApp setTkPointerWindow:winPtr2]; - Tk_UpdatePointer((Tk_Window) winPtr2, x, y, - [NSApp tkButtonState]); - break; - } + NSPoint mouse = [NSEvent mouseLocation]; + NSWindow *w; + [NSApp setTkPointerWindow:nil]; + winPtr2 = NULL; + + for (w in [NSApp orderedWindows]) { + if (w == deadNSWindow || w == NULL) { + continue; + } + winPtr2 = TkMacOSXGetTkWindow(w); + if (winPtr2 == NULL) { + continue; + } + if (NSPointInRect(mouse, [w frame])) { + [NSApp setTkPointerWindow: winPtr2]; + break; + } + } + if (winPtr2) { + /* + * We now know which toplevel will contain the pointer when the window + * is destroyed. We need to know which Tk window within the + * toplevel will contain the pointer. + */ + NSPoint local = [w tkConvertPointFromScreen: mouse]; + int top_x = floor(local.x), + top_y = floor(w.frame.size.height - local.y); + int root_x = floor(mouse.x), + root_y = floor(TkMacOSXZeroScreenHeight() - mouse.y); + int win_x, win_y; + Tk_Window target = Tk_TopCoordsToWindow((Tk_Window) winPtr2, top_x, top_y, &win_x, &win_y); + /* + * A non-toplevel window can have a NULL parent while it is in the process of + * being destroyed. We should not call Tk_UpdatePointer in that case. + */ + if (Tk_Parent(target) != NULL || Tk_IsTopLevel(target)) { + Tk_UpdatePointer(target, root_x, root_y, [NSApp tkButtonState]); } } /* * Unregister the NSWindow and remove all references to it from the Tk @@ -1057,13 +1081,14 @@ /* * Fix bug 5692042764: * set tkEventTarget to NULL when there is no window to send Tk events to. */ TkWindow *newTkEventTarget = NULL; + winPtr2 = NULL; for (NSWindow *w in [NSApp orderedWindows]) { - TkWindow *winPtr2 = TkMacOSXGetTkWindow(w); + winPtr2 = TkMacOSXGetTkWindow(w); BOOL isOnScreen; if (!winPtr2 || !winPtr2->wmInfoPtr) { continue; } @@ -2017,11 +2042,10 @@ macWin->toplevel->referenceCount--; macWin->toplevel = winPtr->parentPtr->privatePtr->toplevel; macWin->toplevel->referenceCount++; macWin->flags &= ~TK_HOST_EXISTS; - TkWmDeadWindow(winPtr); RemapWindows(winPtr, (MacDrawable *)winPtr->parentPtr->window); /* * Make sure wm no longer manages this window */ @@ -2896,10 +2920,11 @@ TkMapTopFrame(frameWin); TkWmMapWindow(winPtr); } else if (Tk_IsTopLevel(frameWin)) { /* Already managed by wm - ignore it */ } + Tk_ManageGeometry((Tk_Window)winPtr, &wmMgrType, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- Index: tests/event.test ================================================================== --- tests/event.test +++ tests/event.test @@ -309,10 +309,11 @@ deleteWindows } -result {MEL} test event-2.6(keypress) {type into text widget, triple click, hit Delete key, and then type some more} -setup { deleteWindows + update idletasks } -body { set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e @@ -859,64 +860,331 @@ } } -cleanup { deleteWindows } -result {OK} -test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup { - set EnterBind [bind . ] -} -body { - wm geometry . 200x200+300+300 - wm deiconify . - _pause 200 - toplevel .top2 -width 200 -height 200 - wm geometry .top2 +[expr {[winfo rootx .]+50}]+[expr {[winfo rooty .]+50}] - wm deiconify .top2 - raise .top2 - _pause 400 - event generate .top2 -warp 1 -x 50 -y 50 - _pause 100 - bind . {lappend res %W} - set res [list ] - destroy .top2 - _pause 200 - set res -} -cleanup { - deleteWindows - bind . $EnterBind -} -result {.} -test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} -setup { - set iconified false - if {[winfo ismapped .]} { - wm iconify . - update - set iconified true - } -} -body { - toplevel .top1 - wm geometry .top1 200x200+300+300 - wm deiconify .top1 - _pause 200 - toplevel .top2 -width 200 -height 200 - wm geometry .top2 +[expr {[winfo rootx .top1]+50}]+[expr {[winfo rooty .top1]+50}] - _pause 200 - wm deiconify .top2 - raise .top2 - _pause 400 - event generate .top2 -warp 1 -x 50 -y 50 - _pause 100 - bind .top1 {lappend res %W} - set res [list ] - destroy .top2 - _pause 200 - set res -} -cleanup { - deleteWindows ; # destroy all children of ".", this already includes .top1 - if {$iconified} { - wm deiconify . - update - } -} -result {.top1} +proc waitForWindowEvent {w event {timeout 1000}} { +# This proc is intended to overcome latency of windowing system +# notifications when toplevel windows are involved. These latencies vary +# considerably with the window manager in use, with the system load, +# with configured scheduling priorities for processes, etc ... +# Waiting for the corresponding window events evades the trouble that is +# associated with the alternative: waiting or halting the Tk process for a +# fixed amount of time (using "after ms"). With the latter strategy it's +# always a gamble how much waiting time is enough on an end user's system. +# It also leads to long fixed waiting times in order to be on the safe side. + + variable _windowEvent + + # Use counter as a unique ID to prevent subsequent waits + # from interfering with each other. + set counter [incr _windowEvent(counter)] + set _windowEvent($counter) 1 + set savedBinding [bind $w $event] + bind $w $event [list +waitForWindowEvent.signal $counter] + set afterID [after $timeout [list set _windowEvent($counter) -1]] + vwait _windowEvent($counter) + set late [expr {$_windowEvent($counter) == -1}] + bind $w $event $savedBinding + unset _windowEvent($counter) + if {$late} { + puts stderr "wait for $event event on $w timed out (> $timeout ms)" + } else { + after cancel $afterID + } +} +proc waitForWindowEvent.signal {counter} { +# Helper proc that records the triggering of a window event. + incr ::_windowEvent($counter) +} + +proc create_and_pack_frames {{w {}}} { + frame $w.f1 -bg blue -width 200 -height 200 + pack propagate $w.f1 0 + frame $w.f1.f2 -bg yellow -width 100 -height 100 + pack $w.f1.f2 $w.f1 -side bottom -anchor se + update idletasks +} + +proc setup_win_mousepointer {w} { +# Position the window and the mouse pointer as an initial state for some tests. +# The so-called "pointer window" is the $w window that will now contain the mouse pointer. + wm geometry . +700+400; # root window out of our way - must not cover windows from event-9.1* + toplevel $w + pack propagate $w 0 + wm geometry $w 300x300+100+100 + tkwait visibility $w + update; # service remaining screen drawing events (e.g. ) + set pointerWin [winfo containing [winfo pointerx $w] [winfo pointery $w]] + event generate $w -warp 1 -x 250 -y 250 + if {($pointerWin ne $w) && ([tk windowingsystem] ne "aqua")} { + waitForWindowEvent $w + } else { + controlPointerWarpTiming + } +} + +test event-9.11 {pointer window container = parent} -setup { + setup_win_mousepointer .one + wm withdraw .one + create_and_pack_frames .one + wm deiconify .one + tkwait visibility .one.f1.f2 + _pause 200; # needed for Windows + update idletasks; # finish display of window + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .one.f1.f2 + if {[tk windowingsystem] ne "x11"} { + testprocessevents enter leave + } else { + update + } + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyInferior .one.f1|} + +test event-9.12 {pointer window container != parent} -setup { + setup_win_mousepointer .one + wm withdraw .one + create_and_pack_frames .one + pack propagate .one.f1.f2 0 + pack [frame .one.g -bg orange -width 80 -height 80] -anchor se -side bottom -in .one.f1.f2 + wm deiconify .one + tkwait visibility .one.g + event generate .one -warp 1 -x 250 -y 250 + _pause 200; # needed for Windows + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .one.g + if {[tk windowingsystem] ne "x11"} { + testprocessevents enter leave + } else { + update + } + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyNonlinearVirtual .one.f1| NotifyNonlinear .one.f1.f2|} + +test event-9.13 {pointer window is a toplevel, toplevel destination} -setup { + setup_win_mousepointer .one + toplevel .two + wm geometry .two 300x300+150+150 + wm withdraw .two + wm deiconify .two + waitForWindowEvent .two + update idletasks; # finish displaying windows + set result | +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .two + waitForWindowEvent .one + if {[tk windowingsystem] ne "x11"} { + testprocessevents enter leave + } else { + update + } + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyNonlinear .one|} + +test event-9.14 {pointer window is a toplevel, tk internal destination} -setup { + setup_win_mousepointer .one + wm withdraw .one + create_and_pack_frames .one + toplevel .two + wm geometry .two 300x300+150+150 + wm withdraw .two + wm deiconify .one + wm deiconify .two + waitForWindowEvent .two + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .two + waitForWindowEvent .one.f1.f2 + testprocessevents enter leave + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyNonlinearVirtual .one| NotifyNonlinearVirtual .one.f1| NotifyNonlinear .one.f1.f2|} + +test event-9.15 {pointer window is a toplevel, destination is screen root} -setup { + setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test) +# destroy .one + toplevel .two + wm geometry .two 300x300+150+150 + wm deiconify .two + waitForWindowEvent .two + update idletasks; # finish displaying .two + event generate .two -warp 1 -x 275 -y 275 + controlPointerWarpTiming + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .two + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {|} + +test event-9.16 {Successive destructions (pointer window + parent), single generation of crossing events} -setup { + # Tests correctness of overwriting the dead window struct in + # TkPointerDeadWindow() and subsequent reading in GenerateEnterLeave(). + setup_win_mousepointer .one + wm withdraw .one + create_and_pack_frames .one + wm deiconify .one + tkwait visibility .one.f1.f2 + update idletasks; # finish displaying window + _pause 200; # needed for Windows + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .one.f1 + if {[tk windowingsystem] ne "x11"} { + testprocessevents enter leave + } else { + update + } + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyInferior .one|} + +test event-9.17 {Successive destructions (pointer window + parent), separate crossing events} -setup { + # Tests correctness of overwriting the dead window struct in + # TkPointerDeadWindow() and subsequent reading in GenerateEnterLeave(). + setup_win_mousepointer .one + wm withdraw .one + create_and_pack_frames .one + wm deiconify .one + tkwait visibility .one.f1.f2 + update idletasks; # finish displaying window + _pause 200; # needed for Windows + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .one.f1.f2 + update; # make sure window is gone + destroy .one.f1 + update; # make sure window is gone + if {[tk windowingsystem] ne "x11"} {testprocessevents enter leave} + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyInferior .one.f1| NotifyInferior .one|} + +test event-9.18 {Successive destructions (pointer window + ancestors including its toplevel), destination is non-root toplevel} -setup { + setup_win_mousepointer .one + toplevel .two + pack propagate .two 0 + wm geometry .two 300x300+100+100 + create_and_pack_frames .two + wm deiconify .two + waitForWindowEvent .two.f1.f2 + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .two + waitForWindowEvent .one + if {[tk windowingsystem] ne "x11"} {testprocessevents enter leave} + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + unset result +} -result {| NotifyNonlinear .one|} + +test event-9.19 {Successive destructions (pointer window + ancestors including its toplevel), destination is internal window, bypass root win} -setup { + setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test) +# destroy .one + toplevel .two + pack propagate .two 0 + wm geometry .two 300x300+100+100 + create_and_pack_frames .two + wm deiconify .two + toplevel .three + pack propagate .three 0 + wm geometry .three 300x300+110+110 + create_and_pack_frames .three + wm deiconify .three + waitForWindowEvent .three.f1.f2 + update idletasks; # finish displaying windows + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .three + waitForWindowEvent .two.f1.f2 + update idletasks; #finish destroying .two + if {[tk windowingsystem] ne "x11"} {testprocessevents enter leave} + set result +} -cleanup { + bind all {} + bind all {} + destroy .one + destroy .two + unset result +} -result {| NotifyNonlinearVirtual .two| NotifyNonlinearVirtual .two.f1| NotifyNonlinear .two.f1.f2|} + +test event-9.20 {Successive destructions (pointer window + ancestors including its toplevel), destination is screen root} -setup { + setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test) + destroy .one + toplevel .two + pack propagate .two 0 + wm geometry .two 300x300+100+100 + create_and_pack_frames .two + wm deiconify .two + waitForWindowEvent .two.f1.f2 + set result "|" +} -body { + bind all {append result " %d %W|"} + bind all {append result " %d %W|"} + destroy .two + update idletasks; #finish destroying .two + set result +} -cleanup { + bind all {} + bind all {} + unset result +} -result {|} # cleanup update unset -nocomplain keypress_lookup rename _init_keypress_lookup {} @@ -923,10 +1191,12 @@ rename _keypress_lookup {} rename _keypress {} rename _pause {} rename _text_ind_to_x_y {} rename _get_selection {} +rename create_and_pack_frames {} +rename setup_win_mousepointer {} cleanupTests return Index: tests/font.test ================================================================== --- tests/font.test +++ tests/font.test @@ -2432,19 +2432,19 @@ set c [canvas .t.c] set textid [$c create text 20 20 -font MyFont -text $text -anchor nw] set twidth [font measure MyFont $text] set theight [font metrics MyFont -linespace] set circid [$c create polygon \ - 15 15 \ - [expr {15 + $twidth}] 15 \ - [expr {15 + $twidth}] [expr {15 + $theight}] \ - 15 [expr {15 + $theight}] \ - -width 1 -joinstyle round -smooth true -fill {} -outline blue] + 15 15 \ + [expr {15 + $twidth}] 15 \ + [expr {15 + $twidth}] [expr {15 + $theight}] \ + 15 [expr {15 + $theight}] \ + -width 1 -joinstyle round -smooth true -fill {} -outline blue] pack $c -fill both -expand 1 -side top update - # Lamda test functions + # Lambda test functions set circle_text {{w user_data text circ} { if {[winfo class $w] ne "Canvas"} { puts "Wrong widget type: $w" return } @@ -2466,10 +2466,11 @@ set results {} apply $circle_text $c FontChanged $textid $circid update bind $c <> [list apply $circle_text %W %d $textid $circid] + update idletasks # Begin test: set results {} lappend results [apply $enclosed $c $circid] font configure MyFont -size 26 Index: tests/unixWm.test ================================================================== --- tests/unixWm.test +++ tests/unixWm.test @@ -103,10 +103,11 @@ } set i 1 foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { test unixWm-3.$i {moving window while iconified} unix { + update wm iconify .t update idletasks wm geom .t $geom update idletasks wm deiconify .t @@ -639,10 +640,12 @@ list [catch {wm deiconify .t 12} msg] $msg } {1 {wrong # args: should be "wm deiconify window"}} test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix { destroy .icon toplevel .icon -width 50 -height 50 -bg red + # calling update here prevents a crash in 16.3 on macOS + update wm iconwindow .t .icon set result [list [catch {wm deiconify .icon} msg] $msg] destroy .icon set result } {1 {can't deiconify .icon: it is an icon for .t}} @@ -1350,12 +1353,16 @@ set result } {1 {can't withdraw .t2: it is an icon for .t}} test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix { set result {} wm withdraw .t + #added to avoid a crash on macOS + update idletasks lappend result [wm state .t] [winfo ismapped .t] wm deiconify .t + #added to avoid a crash on macOS + update idletasks lappend result [wm state .t] [winfo ismapped .t] } {withdrawn 0 normal 1} test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix { list [catch {wm unknown .t} msg] $msg @@ -1371,11 +1378,13 @@ pack .t.l -fill both -expand 1 update wm geometry .t } {30x10+0+0} test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix { + update destroy .t + update toplevel .t wm geometry .t 200x100+100+$Y0 listbox .t.l -height 20 -width 20 pack .t.l -fill both -expand 1 update @@ -1796,10 +1805,12 @@ list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \ [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] } {52 7 12 62} deleteWindows +# Make sure that the root window is out of the way! +wm geom . +700+700 wm withdraw . if {[tk windowingsystem] eq "aqua"} { # Modern mac windows have no border. set result_50_1 {{} {} .t .t .t2 {} .t2 .t .t} } else { Index: tests/winfo.test ================================================================== --- tests/winfo.test +++ tests/winfo.test @@ -439,12 +439,14 @@ } -result {child 0 parent 0} test winfo-13.4 {[winfo containing] with embedded windows} -setup { deleteWindows } -body { + wm geometry . +100+100 frame .con -container 1 pack .con -expand yes -fill both + update toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update Index: tests/wm.test ================================================================== --- tests/wm.test +++ tests/wm.test @@ -942,10 +942,12 @@ } -returnCodes error -cleanup { destroy .t2 .icon } -result {.icon is already an icon for .t2} test wm-iconwindow-2.1 {setting and reading values} -setup { + # without this macOS crashes for unknown reasons + wm iconwindow .t {} destroy .icon set result {} } -body { lappend result [wm iconwindow .t] toplevel .icon -width 50 -height 50 -bg green Index: tests/xmfbox.test ================================================================== --- tests/xmfbox.test +++ tests/xmfbox.test @@ -52,10 +52,11 @@ if {$err0 || $err1 || $err2 || $err3 || $err4} { error [list $msg0 $msg1 $msg2 $msg3 $msg4] } catch {unset foo} destroy .foo + update } # ---------------------------------------------------------------------- test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} -constraints { @@ -74,10 +75,11 @@ catch {unset foo} deleteWindows } -body { toplevel .bar wm geometry .bar +0+0 + update set x [tk::MotifFDialog_Create foo open {-parent .bar}] } -cleanup { destroy $x destroy .bar } -result {.bar.foo} @@ -87,10 +89,11 @@ unix } -body { cleanup file mkdir ./~nosuchuser1 set x [tk::MotifFDialog_Create foo open {}] + update $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 set kk [tk::MotifFDialog_InterpFilter $x] } -result "$testPWD/~nosuchuser1 *" @@ -98,10 +101,11 @@ unix } -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] + update $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 set kk [tk::MotifFDialog_InterpFilter $x] } -result "$testPWD ./~nosuchuser1" @@ -109,10 +113,11 @@ unix } -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] + update $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 tk::MotifFDialog_InterpFilter $x tk::MotifFDialog_Update $x $::tk::dialog::file::foo(fList) get end @@ -122,10 +127,11 @@ unix } -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] + update set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1] expr {$i >= 0} } -result 1 test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} -constraints { @@ -132,10 +138,11 @@ unix } -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] + update set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1] $::tk::dialog::file::foo(fList) selection clear 0 end $::tk::dialog::file::foo(fList) selection set $i tk::MotifFDialog_BrowseFList $x $::tk::dialog::file::foo(sEnt) get Index: win/tkWinWm.c ================================================================== --- win/tkWinWm.c +++ win/tkWinWm.c @@ -2574,10 +2574,37 @@ * Side effects: * The WmInfo structure for winPtr gets freed up. * *-------------------------------------------------------------- */ + +static void CheckForPointer(TkWindow *winPtr) +{ + POINT mouse; + int x, y; + unsigned int state = TkWinGetModifierState(); + TkWindow **windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); + TkWindow **w; + TkGetPointerCoords(NULL, &x, &y); + mouse.x = x; + mouse.y = y; + if (windows != NULL) { + for (w = windows; *w ; w++) { + RECT windowRect; + HWND hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) *w)); + if (GetWindowRect(hwnd, &windowRect) == 0) { + continue; + } + if (winPtr != *w && PtInRect(&windowRect, mouse)) { + Tk_Window target = Tk_CoordsToWindow(x, y, (Tk_Window) *w); + Tk_UpdatePointer((Tk_Window) target, x, y, state); + break; + } + } + ckfree(windows); + } +} void TkWmDeadWindow( TkWindow *winPtr) /* Top-level window that's being deleted. */ { @@ -2713,10 +2740,17 @@ */ DecrIconRefCount(wmPtr->iconPtr); } + /* + * Check if the dead window is a toplevel containing the pointer. If so, + * find the window which will inherit the pointer and call + * TkUpdatePointer. + */ + + CheckForPointer(winPtr); ckfree(wmPtr); winPtr->wmInfoPtr = NULL; } /* @@ -6669,12 +6703,10 @@ TkWindow *childWinPtr; TkWmStackorderToplevelPair *pair = (TkWmStackorderToplevelPair *) lParam; - /*fprintf(stderr, "Looking up HWND %d\n", hwnd);*/ - hPtr = Tcl_FindHashEntry(pair->table, (char *) hwnd); if (hPtr != NULL) { childWinPtr = (TkWindow *)Tcl_GetHashValue(hPtr); /*