Tk Source Code

Artifact 345c61790c4fbe80ef56041a5ceb5326de257adc220fa4b3e483b502efb752d1:

Attachment "exercise.tcl" to ticket [e2418ce5] added by erikleunissen 2026-02-09 12:43:45.

---

#!/usr/bin/tclsh

package require Tk
wm geometry . 200x200+100+100
wm deiconify .
after 10; update

# Arbitrary initial position
event generate {} <Motion> -warp 1 -x 340 -y 100
after 10; update; after 1000

puts -nonewline "Move mouse pointer while root win mapped: "
flush stdout
event generate {} <Motion> -warp 1 -x 350 -y 200
after 10; update; after 1000
if {([winfo pointerx .] == 350) && ([winfo pointery .] == 200)} {
    puts OK
} else {
    puts FAILED
}

puts -nonewline "Move mouse pointer while root win unmapped: "
flush stdout
wm withdraw .
after 10; update
event generate {} <Motion> -warp 1 -x 360 -y 300
after 10; update; after 1000
if {([winfo pointerx .] == 360) && ([winfo pointery .] == 300)} {
    puts OK
} else {
    puts FAILED
}

#
# The code above is meant for visual inspection
# ----------------------------------------------
# The code below is proposed for inclusion in the Tk test suite
#
if {0} {

test bug-xxxxxx0 {pointer warp relative to the root window of the screen when the Tk root window is unmapped} -setup {
    deleteWindows
    if {! [winfo ismapped .]} {
	wm deiconify .
	wm geometry . 200x200+100+100
	after 10; update
    }
    event generate {} <Motion> -warp 1 -x 350 -y 200
    controlPointerWarpTiming
    wm withdraw .
    assert {([winfo ismapped .] == 0) && ([winfo pointerx .] == 350) && ([winfo pointery .] == 200)}
} -body {
    event generate {} <Motion> -warp 1 -x 360 -y 250
    controlPointerWarpTiming
    winfo pointerxy .
} -cleanup {
    wm deiconify .
} -result {360 250}

test bug-xxxxxx1 {pointer warp relative to an arbitrary toplevel when the Tk root window is unmapped} -setup {
    deleteWindows
    if {! [winfo ismapped .]} {
	wm deiconify .
	wm geometry . 200x200+100+100
	after 10; update
    }
    event generate {} <Motion> -warp 1 -x 350 -y 200
    controlPointerWarpTiming
    toplevel .one
    wm geometry .one 200x200+100+350
    after 10; update
    wm withdraw .
    assert {([winfo ismapped .] == 0) && ([winfo pointerx .] == 350) && ([winfo pointery .] == 200)}
} -body {
    event generate .one <Motion> -warp 1 -x 250 -y 100
    after 10; update
    list [expr {[winfo pointerx .one] - [winfo rootx .one]}] [expr {[winfo pointery .one] - [winfo rooty .one]}]
} -cleanup {
    wm deiconify .
} -result {250 100}

}; # if {0}

exit