Tk Source Code

     * cleared.
     */

    pixmap = Tk_GetPixmap(framePtr->display, Tk_WindowId(tkwin),
	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
#else
    pixmap = Tk_WindowId(tkwin);


#endif /* TK_NO_DOUBLE_BUFFERING */

    if (framePtr->type != TYPE_LABELFRAME) {
	/*
	 * Pass to platform specific draw function. In general, it just draws
	 * a simple rectangle, but it may "theme" the background.
	 */

static TkWindow*
FrontWindowAtPoint(
    int x,
    int y)
{
    NSPoint p = NSMakePoint(x, TkMacOSXZeroScreenHeight() - y);
    NSArray *windows = [NSApp orderedWindows];
    TkWindow *winPtr = NULL;

    for (NSWindow *w in windows) {
	winPtr = TkMacOSXGetTkWindow(w);
	if (winPtr) {
	    NSRect windowFrame = [w frame];
	    NSRect contentFrame = [w frame];

	    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.
	     */


	    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;

tcltest::loadTestedCommands

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}
    vwait x
}

# Procedure to set up a collection of top-level windows

} $result_50_1
test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} unix {
    deleteWindows
    toplevel .t -width 400 -height 300 -bg yellow
    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]
    list [winfo containing [expr $x +200] [expr $y - 30]] \
	 [winfo containing [expr $x +200] [expr $y - 1]] \
	 [winfo containing [expr $x +200] $y] \
	 [winfo containing [expr $x +200] [expr $y2 - 1]] \
	 [winfo containing [expr $x +200] $y2] \
	 [winfo containing [expr $x +200] [expr $y2 + 99]] \
	 [winfo containing [expr $x +200] [expr $y2 + 100]] \
	 [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
} 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
    place .t.f -x 150 -y 50
    tkwait visibility .t.f
    update
    interp create child

    set y [winfo rooty .t]
    lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \
	[winfo containing [expr $x + 200] [expr $y +50]]
    set result
} {{} .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
    wm geometry .t +100+100
    update
    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}]]
    interp delete child
    set result
} {{} .}
test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} {
    deleteWindows
    toplevel .t -width 300 -height 400 -bd 2 -relief raised
    frame .t.f -width 150 -height 120 -bg green

	    [winfo containing [expr $x + 250] $y] \
	    [winfo containing [expr $x + 350] $y] \
	    [winfo containing [expr $x + 450] $y]
} {.t .t.f .t.f.f .t {}}
test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {unix failsOnUbuntu failsOnXQuarz} {
    destroy .t
    destroy .t2

    toplevel .t -width 200 -height 200 -bg green
    tkwait visibility .t
    update
    wm geometry .t +0+0
    update
    toplevel .t2 -width 200 -height 200 -bg red
    tkwait visibility .t2
    update
    wm geometry .t2 +0+0
    update
    restackDelay

    set result [list [winfo containing 100 100]]
    wm iconify .t2
    update
    restackDelay


    lappend result [winfo containing 100 100]
} {.t2 .t}
test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix {
    destroy .t
    toplevel .t -width 200 -height 200 -bg green
    wm geometry .t +0+0
    frame .t.f -width 150 -height 150 -bd 2 -relief raised
    place .t.f -x 25 -y 25

    wm geometry . +300+300
    destroy .t
    update idletasks
    toplevel .t -width 200 -height 200 -bg green
    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.
    winfo containing 100 100
} {.t}
test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {unix failsOnXQuarz} {
    foreach w {.t .t2 .t3} {
	destroy $w
	update
	toplevel $w -width 200 -height 200 -bg green
	tkwait visibility $w
	wm geometry $w +100+100
	update
    }
    update
    raise .t .t2
    restackDelay
    update
    set result [list [winfo containing 200 200]]
    lower .t3
    restackDelay
    sleep 10
    lappend result [winfo containing 200 200]
} {.t3 .t}
test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix {
    destroy .t
    toplevel .t -width 200 -height 200 -bg green
    wm overrideredirect .t 1
    wm geometry .t +0+0
    tkwait visibility .t
    destroy .t2
    toplevel .t2 -width 200 -height 200 -bg red
    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
    # coordinates.

    set x [expr 100-[winfo vrootx .]]
    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 .

}
test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix {
    foreach w {.t .t2 .t3} {
	destroy $w
	update
	toplevel $w -width 200 -height 200 -bg green
	wm overrideredirect $w 1
	wm geometry $w +0+0
	tkwait visibility $w
	update
    }
    lower .t3 .t2
    restackDelay
    update

    # 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
    # coordinates.

    set x [expr 100-[winfo vrootx .]]
    set y [expr 100-[winfo vrooty .]]
    set result [list [winfo containing $x $y]]
    lower .t2
    restackDelay
    lappend result [winfo containing $x $y]
} {.t2 .t3}
if {[tk windowingsystem] eq "aqua"} {
    wm deiconify .

}
test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix {
    makeToplevels
    raise .raise1
    set time [lindex [time {raise .raise1}] 0]
    expr {$time < 2000000}
} 1