path: root/tests/event.test

# This file is a Tcl script to test the code in tkEvent.c.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# XXX This test file is woefully incomplete.  Right now it only tests
# a few of the procedures in tkEvent.c.  Please add more tests whenever
# possible.

# Setup table used to query key events.

proc _init_keypress_lookup {} {
    global keypress_lookup

    scan A %c start
    scan Z %c finish

    for {set i $start} {$i <= $finish} {incr i} {
        set l [format %c $i]
        set keypress_lookup($l) $l
    }

    scan a %c start
    scan z %c finish

    for {set i $start} {$i <= $finish} {incr i} {
        set l [format %c $i]
        set keypress_lookup($l) $l
    }

    scan 0 %c start
    scan 9 %c finish

    for {set i $start} {$i <= $finish} {incr i} {
        set l [format %c $i]
        set keypress_lookup($l) $l
    }

    # Most punctuation
    array set keypress_lookup {
        ! exclam
        % percent
        & ampersand
        ( parenleft
        ) parenright
        * asterisk
        + plus
        , comma
        - minus
        . period
        / slash
        : colon
        < less
        = equal
        > greater
        ? question
        @ at
        ^ asciicircum
        _ underscore
        | bar
        ~ asciitilde
        ' apostrophe
    }
    # Characters with meaning to Tcl...
    array set keypress_lookup [list \
	    \"   quotedbl \
	    \#   numbersign \
	    \$   dollar \
	    \;   semicolon \
	    \[   bracketleft \
	    \\   backslash \
	    \]   bracketright \
	    \{   braceleft \
	    \}   braceright \
	    " "  space \
	    "\n" Return \
	    "\t" Tab]
}

# Lookup an event in the keypress table.
# For example:
# Q -> Q
# . -> period
# / -> slash
# Delete -> Delete
# Escape -> Escape

proc _keypress_lookup {char} {
    global keypress_lookup

    if {! [info exists keypress_lookup]} {
        _init_keypress_lookup
    }

    if {$char == ""} {
        error "empty char"
    }

    if {[info exists keypress_lookup($char)]} {
        return $keypress_lookup($char)
    } else {
        return $char
    }
}

# Lookup and generate a pair of KeyPress and KeyRelease events

proc _keypress {win key} {
    set keysym [_keypress_lookup $key]

    # Force focus to the window before delivering
    # each event so that a window manager using
    # a focus follows mouse will not steal away
    # the focus if the mouse is moved around.

    if {[focus] != $win} {
        focus -force $win
    }
    event generate $win <KeyPress-$keysym>
    _pause 50
    if {[focus] != $win} {
        focus -force $win
    }
    event generate $win <KeyRelease-$keysym>
    _pause 50
}

# Call _keypress for each character in the given string

proc _keypress_string {win string} {
    foreach letter [split $string ""] {
        _keypress $win $letter
    }
}

# Delay script execution for a given amount of time

proc _pause {{msecs 1000}} {
    global _pause

    if {! [info exists _pause(number)]} {
        set _pause(number) 0
    }

    set num [incr _pause(number)]
    set _pause($num) 0

    after $msecs "set _pause($num) 1"
    vwait _pause($num)
    unset _pause($num)
}

# Helper proc to convert index to x y position

proc _text_ind_to_x_y {text ind} {
    set bbox [$text bbox $ind]
    if {[llength $bbox] != 4} {
        error "got bbox \{$bbox\} from $text, index $ind"
    }
    foreach {x1 y1 width height} $bbox break
    set middle_y [expr {$y1 + ($height / 2)}]
    return [list $x1 $middle_y]
}

# Return selection only if owned by the given widget

proc _get_selection {widget} {
    if {[string compare $widget [selection own]] != 0} {
        return ""
    }
    if {[catch {selection get} sel]} {
        return ""
    }
    return $sel
}

# Begining of the actual tests

test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup {
	deleteWindows
    set x {}
} -body {
    button .b -text Test
    pack .b
    bindtags .b .b
    update
    bind .b <Destroy> {
	    lappend x destroy
	    event generate .b <1>
	    event generate .b <ButtonRelease-1>
    }
    bind .b <1> {
	    lappend x button
    }

    destroy .b
    return $x
} -cleanup {
    deleteWindows
} -result {destroy}
test event-1.2 {event generate <Alt-z>} -setup {
	deleteWindows
    catch {unset ::event12result}
} -body {
	set ::event12result 0
	pack [entry .e]
	update
	bind .e <Alt-z> {set ::event12result "1"}

	focus -force .e
     event generate .e <Alt-z>
	destroy .e
	set ::event12result
} -cleanup {
    deleteWindows
} -result 1


test event-2.1(keypress) {type into entry widget and hit Return} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    set return_binding 0
    bind $e <Return> {set return_binding 1}
    tkwait visibility $e
    _keypress_string $e HELLO\n
    list [$e get] $return_binding
} -cleanup {
    deleteWindows
} -result {HELLO 1}
test event-2.2(keypress) {type into entry widget and then delete some text} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    tkwait visibility $e
    # Avoid a hang when macOS puts the mouse pointer on the green button
    wm geometry .t +200+100
    _keypress_string $e MELLO
    _keypress $e BackSpace
    _keypress $e BackSpace
    $e get
} -cleanup {
    deleteWindows
} -result {MEL}
test event-2.3(keypress) {type into entry widget, triple click, hit Delete key,
        and then type some more} -setup {
    deleteWindows
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e JUMP

    set result [$e get]

    event generate $e <Enter>
    for {set i 0} {$i < 3} {incr i} {
        _pause 100
        event generate $e <ButtonPress-1>
        _pause 100
        event generate $e <ButtonRelease-1>
    }

    _keypress $e Delete
    _keypress_string $e UP
    lappend result [$e get]
} -cleanup {
    deleteWindows
} -result {JUMP UP}
test event-2.4(keypress) {type into text widget and hit Return} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    set return_binding 0
    bind $e <Return> {set return_binding 1}
    tkwait visibility $e
    _keypress_string $e HELLO\n
    list [$e get 1.0 end] $return_binding
} -cleanup {
    deleteWindows
} -result [list "HELLO\n\n" 1]
test event-2.5(keypress) {type into text widget and then delete some text} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e MELLO
    _keypress $e BackSpace
    _keypress $e BackSpace
    $e get 1.0 1.end
} -cleanup {
    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
    _keypress_string $e JUMP

    set result [$e get 1.0 1.end]

    event generate $e <Enter>
    for {set i 0} {$i < 3} {incr i} {
        _pause 100
        event generate $e <ButtonPress-1>
        _pause 100
        event generate $e <ButtonRelease-1>
    }

    _keypress $e Delete
    _keypress_string $e UP
    lappend result [$e get 1.0 1.end]
} -cleanup {
    deleteWindows
} -result {JUMP UP}

test event-3.1(click-drag) {click and drag in a text widget, this tests
    tkTextSelectTo in text.tcl} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e "A Tcl/Tk selection test!"
    set anchor 1.6
    set selend 1.18

    set result [list]
    lappend result [$e get 1.0 1.end]

    # Get the x,y coords of the second T in "Tcl/Tk"
    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break

    # Click down to set the insert cursor position
    event generate $e <Enter>
    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y

    # Save the position of the insert cursor
    lappend result [$e index insert]

    # Now drag until selend is highlighted, then click up

    set current $anchor
    while {[$e compare $current <= $selend]} {
        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
        event generate $e <B1-Motion> -x $current_x -y $current_y
        set current [$e index [list $current + 1 char]]
        _pause 50
    }

    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
    _pause 200

    # Save the position of the insert cursor
    lappend result [$e index insert]

    # Save the highlighted text
    lappend result [_get_selection $e]

    # Now click and click and drag to the left, over "Tcl/Tk selection"

    event generate $e <ButtonPress-1> -x $current_x -y $current_y

    while {[$e compare $current >= [list $anchor - 4 char]]} {
        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
        event generate $e <B1-Motion> -x $current_x -y $current_y
        set current [$e index [list $current - 1 char]]
        _pause 50
    }

    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
    _pause 200

    # Save the position of the insert cursor
    lappend result [$e index insert]

    # Save the highlighted text
    lappend result [_get_selection $e]

} -cleanup {
    deleteWindows
} -result {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}}
 test event-3.2(click-drag) {click and drag in an entry widget, this
    tests tkEntryMouseSelect in entry.tcl} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e "A Tcl/Tk selection!"
    set anchor 6
    set selend 18

    set result [list]
    lappend result [$e get]

    # Get the x,y coords of the second T in "Tcl/Tk"
    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break

    # Click down to set the insert cursor position
    event generate $e <Enter>
    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y

    # Save the position of the insert cursor
    lappend result [$e index insert]

    # Now drag until selend is highlighted, then click up

    set current $anchor
    while {$current <= $selend} {
        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
        event generate $e <B1-Motion> -x $current_x -y $current_y
        incr current
        _pause 50
    }

    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
    _pause 200

    # Save the position of the insert cursor
    lappend result [$e index insert]

    # Save the highlighted text
    lappend result [_get_selection $e]

    # Now click and click and drag to the left, over "Tcl/Tk selection"

    event generate $e <ButtonPress-1> -x $current_x -y $current_y

    while {$current >= ($anchor - 4)} {
        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
        event generate $e <B1-Motion> -x $current_x -y $current_y
        incr current -1
        _pause 50
    }

    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
    _pause 200

    # Save the position of the insert cursor
    lappend result [$e index insert]

    # Save the highlighted text
    lappend result [_get_selection $e]

} -cleanup {
    deleteWindows
} -result {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}}


test event-4.1(double-click-drag) {click down, click up, click down again,
    then drag in a text widget} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e "Word select test"
    set anchor 1.8

    # Get the x,y coords of the second e in "select"
    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break

    # Click down, release, then click down again
    event generate $e <Enter>
    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
    _pause 50
    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50

    # Save the highlighted text
    set result [list]
    lappend result [_get_selection $e]

    # Insert cursor should be at beginning of "select"
    lappend result [$e index insert]

    # Move mouse one character to the left
    set current [$e index [list $anchor - 1 char]]
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    # Insert cursor should be before the l in "select"
    lappend result [$e index insert]

    # Selection should still be the word "select"
    lappend result [_get_selection $e]

    # Move mouse to the space before the word "select"
    set current [$e index [list $current - 3 char]]

    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 200

    lappend result [$e index insert]
    lappend result [_get_selection $e]

    # Move mouse to the r in "Word"
    set current 1.2
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    # Selection should now be "Word select"
    lappend result [_get_selection $e]

    # Insert cursor should be before the r in "Word"
    lappend result [$e index insert]

    return $result
} -cleanup {
    deleteWindows
} -result {select 1.5 1.7 select 1.4 { select} {Word select} 1.2}
test event-4.2(double-click-drag) {click down, click up, click down again,
    then drag in an entry widget} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e "Word select test"

    set anchor 8

    # Get the x,y coords of the second e in "select"
    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break

    # Click down, release, then click down again
    event generate $e <Enter>
    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
    _pause 50
    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50

    set result [list]
    lappend result [_get_selection $e]

    # Insert cursor should be at the end of "select"
    lappend result [$e index insert]

    # Move mouse one character to the left
    set current [expr {$anchor - 1}]
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    # Insert cursor should be before the l in "select"
    lappend result [$e index insert]

    # Selection should still be the word "select"
    lappend result [_get_selection $e]

    # Move mouse to the space before the word "select"
    set current [expr {$current - 3}]
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    lappend result [$e index insert]
    lappend result [_get_selection $e]

    # Move mouse to the r in "Word"
    set current [expr {$current - 2}]
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    # Selection should now be "Word select"
    lappend result [_get_selection $e]

    # Insert cursor should be before the r in "Word"
    lappend result [$e index insert]

    return $result
} -cleanup {
    deleteWindows
} -result {select 11 7 select 4 { select} {Word select} 2}

test event-5.1(triple-click-drag) {Triple click and drag across lines in a
        text widget, this should extend the selection to the new line} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e "LINE ONE\nLINE TWO\nLINE THREE"

    set anchor 3.2

    # Triple click one third line leaving mouse down

    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break

    event generate $e <Enter>

    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
    _pause 50

    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
    _pause 50

    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
    _pause 50

    set result [list]
    lappend result [_get_selection $e]

    # Drag up to second line

    set current [$e index [list $anchor - 1 line]]
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    lappend result [_get_selection $e]

    # Drag up to first line

    set current [$e index [list $current - 1 line]]
    foreach {current_x current_y} [_text_ind_to_x_y $e $current] break

    event generate $e <B1-Motion> -x $current_x -y $current_y
    _pause 50

    lappend result [_get_selection $e]

    return $result
} -cleanup {
    deleteWindows
} -result [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \
        "LINE ONE\nLINE TWO\nLINE THREE\n"]

test event-6.1(button-state) {button press in a window that is then
        destroyed, when the mouse is moved into another window it
        should not generate a <B1-motion> event since the mouse
        was not pressed down in that window} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]

    event generate $t <ButtonPress-1>
    destroy $t
    set t [toplevel .t]
    set motion nomotion
    bind $t <B1-Motion> {set motion inmotion}
    event generate $t <Motion>
    return $motion
} -cleanup {
    deleteWindows
} -result {nomotion}

test event-7.1(double-click) {A double click on a lone character
    in a text widget should select that character} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    tkwait visibility $e
    focus -force $e
    _keypress_string $e "On A letter"

    set anchor 1.3

    # Get x,y coords just inside the left
    # and right hand side of the letter A
    foreach {x1 y1 width height} [$e bbox $anchor] break

    set middle_y [expr {$y1 + ($height / 2)}]

    set left_x [expr {$x1 + 2}]
    set left_y $middle_y

    set right_x [expr {($x1 + $width) - 2}]
    set right_y $middle_y

    # Double click near left hand egde of the letter A

    event generate $e <Enter>
    event generate $e <ButtonPress-1> -x $left_x -y $left_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $left_x -y $left_y
    _pause 50
    event generate $e <ButtonPress-1> -x $left_x -y $left_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $left_x -y $left_y
    _pause 50

    set result [list]
    lappend result [$e index insert]
    lappend result [_get_selection $e]

    # Clear selection by clicking at 0,0

    event generate $e <ButtonPress-1> -x 0 -y 0
    _pause 50
    event generate $e <ButtonRelease-1> -x 0 -y 0
    _pause 50

    # Double click near right hand edge of the letter A

    event generate $e <ButtonPress-1> -x $right_x -y $right_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $right_x -y $right_y
    _pause 50
    event generate $e <ButtonPress-1> -x $right_x -y $right_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $right_x -y $right_y
    _pause 50

    lappend result [$e index insert]
    lappend result [_get_selection $e]

    return $result
} -cleanup {
    deleteWindows
    unset x1 y1 width height middle_y left_x left_y right_x right_y
} -result {1.3 A 1.3 A}
test event-7.2(double-click) {A double click on a lone character
    in an entry widget should select that character} -setup {
	deleteWindows
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    tkwait visibility $e
    focus -force $e
    _keypress_string $e "On A letter"

    set anchor 3

    # Get x,y coords just inside the left
    # and right hand side of the letter A
    foreach {x1 y1 width height} [$e bbox $anchor] break

    set middle_y [expr {$y1 + ($height / 2)}]

    set left_x [expr {$x1 + 2}]
    set left_y $middle_y

    set right_x [expr {($x1 + $width) - 2}]
    set right_y $middle_y

    # Double click near left hand egde of the letter A

    event generate $e <Enter>
    event generate $e <ButtonPress-1> -x $left_x -y $left_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $left_x -y $left_y
    _pause 50
    event generate $e <ButtonPress-1> -x $left_x -y $left_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $left_x -y $left_y
    _pause 50

    set result [list]
    lappend result [$e index insert]
    lappend result [_get_selection $e]

    # Clear selection by clicking at 0,0

    event generate $e <ButtonPress-1> -x 0 -y 0
    _pause 50
    event generate $e <ButtonRelease-1> -x 0 -y 0
    _pause 50

    # Double click near right hand edge of the letter A

    event generate $e <ButtonPress-1> -x $right_x -y $right_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $right_x -y $right_y
    _pause 50
    event generate $e <ButtonPress-1> -x $right_x -y $right_y
    _pause 50
    event generate $e <ButtonRelease-1> -x $right_x -y $right_y
    _pause 50

    lappend result [$e index insert]
    lappend result [_get_selection $e]

    return $result
} -cleanup {
    deleteWindows
    unset x1 y1 width height middle_y left_x left_y right_x right_y
} -result {4 A 4 A}

test event-8 {event generate with keysyms corresponding to
              multi-byte virtual keycodes - bug
              e36963bfe8df9f5e528134707a91b9c0051de723} -constraints nonPortable -setup {
    deleteWindows
    set res [list ]
} -body {
    set t [toplevel .t]
    set e [entry $t.e]
    pack $e
    tkwait visibility $e
    bind $e <KeyPress> {lappend res keycode: %k keysym: %K}
    focus -force $e
    update
    event generate $e <diaeresis>
    # The value now contained in $res depends on the actual
    # physical keyboard layout and keycode generated, from
    # the hardware on which the test suite happens to run.
    # We don't need (and we can't really) check correctness
    # of the (system-dependent) keycode received, however
    # Tk should be able to associate this keycode to a
    # (system-independent) known keysym, unless the system
    # running the test does not have a keyboard with a
    # diaeresis key.
    if {[expr {[lindex $res 3] ne "??"}]} {
        # keyboard has a physical diaeresis key and bug is fixed
        return "OK"
    } else  {
        return "Test failed, unless the keyboard tied to the system \
                on which this test is run does NOT have a diaeresis \
                physical key - in this case, test is actually void."
    }
} -cleanup {
    deleteWindows
} -result {OK}

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+700; # 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. <Expose>)
    set pointerWin [winfo containing [winfo pointerx $w] [winfo pointery $w]]
    event generate $w <Motion> -warp 1 -x 250 -y 250
    if {($pointerWin ne $w) && ([tk windowingsystem] ne "aqua")} {
        waitForWindowEvent $w <Enter>
    } 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
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.f1.f2
    _pause 200; # service crossing events
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> 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 <Motion> -warp 1 -x 250 -y 250
    _pause 200
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.g
    _pause 200; # service crossing events -- crashes without this
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> 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 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result |
} -body {
    destroy .two
    waitForWindowEvent .one <Enter>
    # destroying .one here instead of in cleanup makes the test pass
    destroy .one
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    unset result
} -result {|<Enter> 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 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .two
    waitForWindowEvent .one.f1.f2 <Enter>
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    set result
} -cleanup {
    unset result
} -result {|<Enter> NotifyNonlinearVirtual .one|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> 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)
    toplevel .two
    wm geometry .two 300x300+150+150
    wm deiconify .two
    waitForWindowEvent .two <Enter>
    event generate .two <Motion> -warp 1 -x 275 -y 275
    controlPointerWarpTiming
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    _pause 200; # ensure servicing of all scheduled events (only <Expose> events expected)
    destroy .two
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    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
    _pause 200
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.f1
    _pause 200; # service crossing events
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> 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
    _pause 200
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.f1.f2
    _pause 200; # service crossing events
    destroy .one.f1
    _pause 200; # service crossing events
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyInferior .one.f1|<Enter> 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 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .two
    waitForWindowEvent .one <Enter>
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    set result
} -cleanup {
    unset result
} -result {|<Enter> 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
    waitForWindowEvent .two.f1.f2 <Enter>
    toplevel .three
    pack propagate .three 0
    wm geometry .three 300x300+110+110
    create_and_pack_frames .three
    wm deiconify .three
    waitForWindowEvent .three.f1.f2 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .three
    waitForWindowEvent .two.f1.f2 <Enter>
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .two
    set result
} -cleanup {
    unset result
} -result {|<Enter> NotifyNonlinearVirtual .two|<Enter> NotifyNonlinearVirtual .two.f1|<Enter> 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 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .two
    _pause 200; # service events (only screen drawing events expected)
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    unset result
} -result {|}

# cleanup
update
unset -nocomplain keypress_lookup
rename _init_keypress_lookup {}
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