From d5e7bdcdc2200b4a3a52846c1ab19dd0232dc7a3 Mon Sep 17 00:00:00 2001 From: culler Date: Sat, 22 Jun 2024 19:13:38 +0000 Subject: Try to ensure that clipping regions are ready before filling a frame; clean up unixWm.test --- generic/tkFrame.c | 2 ++ macosx/tkMacOSXWm.c | 12 +++++------- tests/unixWm.test | 54 +++++++++++++++++------------------------------------ 3 files changed, 24 insertions(+), 44 deletions(-) diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 32f89f2..c0d45e8 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -1474,6 +1474,8 @@ DisplayFrame( Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); #else pixmap = Tk_WindowId(tkwin); + Tk_ClipDrawableToRect(Tk_Display(tkwin), pixmap, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin)); #endif /* TK_NO_DOUBLE_BUFFERING */ if (framePtr->type != TYPE_LABELFRAME) { diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index dfa5701..48e8d1a 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -819,28 +819,26 @@ FrontWindowAtPoint( int y) { NSPoint p = NSMakePoint(x, TkMacOSXZeroScreenHeight() - y); - NSArray *windows = [NSApp orderedWindows]; - TkWindow *winPtr = NULL; - for (NSWindow *w in windows) { - winPtr = TkMacOSXGetTkWindow(w); + for (NSWindow *w in [NSApp orderedWindows]) { + TkWindow *winPtr = TkMacOSXGetTkWindow(w); if (winPtr) { NSRect windowFrame = [w frame]; - NSRect contentFrame = [w frame]; + NSRect contentFrame = windowFrame; - contentFrame.size.height = [[w contentView] frame].size.height; /* * For consistency with other platforms, points in the * title bar are not considered to be contained in the * window. */ + contentFrame.size.height = [[w contentView] frame].size.height; 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 + * containing it, and therefore it should not be considered * to be contained in any Tk window. */ return NULL; diff --git a/tests/unixWm.test b/tests/unixWm.test index 4d2dad5..b5cafa1 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -16,18 +16,6 @@ namespace import -force ::tk::test:loadTkCommand testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] -# Starting with macOS Ventura it became necessary to wait for windows to be restacked -# or to be raised after creation. - -if {[tk windowingsystem] eq "aqua"} { - proc restackDelay {} { - after 200; - update idletasks - } -} else { - proc restackDelay {} {} -} - proc sleep ms { global x after $ms {set x 1} @@ -1839,14 +1827,12 @@ test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and tkwait visibility .t wm geom .t +100+100 update - restackDelay toplevel .t2 -width 200 -height 100 -bg blue wm overrideredirect .t2 1 tkwait visibility .t2 wm geom .t2 +200+200 update raise .t2 - restackDelay set x [winfo rootx .t] set y [winfo rooty .t] set y2 [winfo rooty .t2] @@ -1860,11 +1846,10 @@ test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and [winfo containing [expr $x +200] [expr $y + 450]] } {{} {} .t .t .t2 .t2 .t {}} test unixWm-50.3 { - Tk_CoordsToWindow procedure, finding a toplevel with embedding + Tk_CoordsToWindow procedure, finding a toplevel with embedding } tempNotWin { deleteWindows catch {interp delete child} - toplevel .t -width 300 -height 400 -bg blue wm geom .t +100+100 frame .t.f -container 1 -bg red @@ -1893,7 +1878,6 @@ test unixWm-50.3 { } {{} .x .t .t.f} test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix { destroy .t - catch {interp delete child} toplevel .t -width 200 -height 200 -bg green tkwait visibility .t @@ -1902,9 +1886,8 @@ test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix interp create child load {} Tk child child eval {wm geometry . 200x200+100+100; update} - restackDelay set result [list [winfo containing 200 200] \ - [child eval {winfo containing 200 200}]] + [child eval {winfo containing 200 200}]] interp delete child set result } {{} .} @@ -1984,22 +1967,24 @@ test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} unix { test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {unix failsOnUbuntu failsOnXQuarz} { destroy .t destroy .t2 + update toplevel .t -width 200 -height 200 -bg green tkwait visibility .t - update - wm geometry .t +0+0 + wm geometry .t +20+20 update toplevel .t2 -width 200 -height 200 -bg red tkwait visibility .t2 update - wm geometry .t2 +0+0 + wm geometry .t2 +20+20 update - restackDelay - set result [list [winfo containing 100 100]] - wm iconify .t2 +# set temp [winfo containing 120 120] +# unset temp + set result [list [winfo containing 120 120]] + destroy .t2 update - restackDelay - lappend result [winfo containing 100 100] +# set temp [winfo containing 120 120] +# unset temp + lappend result [winfo containing 120 120] } {.t2 .t} test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { destroy .t @@ -2077,7 +2062,6 @@ test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapp tkwait visibility .t wm geometry .t +0+0 update - restackDelay destroy .t2 toplevel .t2 -width 200 -height 200 -bg red # This test assumes that .t2 is not mapped yet, but that is not really guaranteed. @@ -2094,12 +2078,10 @@ test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {uni } update raise .t .t2 - restackDelay update set result [list [winfo containing 200 200]] lower .t3 - restackDelay - sleep 10 + update lappend result [winfo containing 200 200] } {.t3 .t} test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix { @@ -2113,8 +2095,7 @@ test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix wm overrideredirect .t2 1 wm geometry .t2 +0+0 tkwait visibility .t2 - restackDelay - + # Need to use vrootx and vrooty to make tests work correctly with # virtual root window measures managers: overrideredirect windows # come up at (0,0) in display coordinates, not virtual root @@ -2124,15 +2105,14 @@ test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix set y [expr 100-[winfo vrooty .]] set result [list [winfo containing $x $y]] raise .t - restackDelay lappend result [winfo containing $x $y] raise .t2 - restackDelay lappend result [winfo containing $x $y] } {.t2 .t .t2} # The mac won't put an overrideredirect window above the root, if {[tk windowingsystem] eq "aqua"} { wm withdraw . + update } test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix { foreach w {.t .t2 .t3} { @@ -2145,7 +2125,6 @@ test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} update } lower .t3 .t2 - restackDelay update # Need to use vrootx and vrooty to make tests work correctly with @@ -2157,11 +2136,12 @@ test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} set y [expr 100-[winfo vrooty .]] set result [list [winfo containing $x $y]] lower .t2 - restackDelay + update lappend result [winfo containing $x $y] } {.t2 .t3} if {[tk windowingsystem] eq "aqua"} { wm deiconify . + update } test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { makeToplevels -- cgit v0.12