Tk Source Code

    # 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 <Key-$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

    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 <Button-1>
	_pause 100
	event generate $e <ButtonRelease-1>
    }

    _keypress $e Delete
    _keypress_string $e UP
    lappend result [$e get]
} -cleanup {

    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 <Button-1>
	_pause 100
	event generate $e <ButtonRelease-1>
    }

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

    # 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 <Button-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]

    # 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 <Button-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]

    # 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 <Button-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 <Button-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]

    # 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 <Button-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 <Button-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]

    # 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 <Button-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 <Button-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 <Button-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" \

    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 <Button-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 <Button-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 <Button-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 <Button-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 <Button-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

    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 <Button-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 <Button-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 <Button-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 <Button-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 <Button-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

} -result {OK}

test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup {
    set EnterBind [bind . <Enter>]
} -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}]
    update idletasks
    wm deiconify .top2
    update idletasks
    raise .top2
    _pause 400
    event generate .top2 <Motion> -warp 1 -x 50 -y 50
    _pause 100
    bind . <Enter> {lappend res %W}
    set res [list ]
    destroy .top2
    update idletasks
    _pause 200
    set res
} -cleanup {
    deleteWindows
    bind . <Enter> $EnterBind
} -result {.}

# This test fails sporadically when run on the macOS CI runner. It does

	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
    update idletasks
    raise .top2
    _pause 400
    event generate .top2 <Motion> -warp 1 -x 50 -y 50
    _pause 100
    bind .top1 <Enter> {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
    }

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 <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.f1.f2
    update

    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; # needed for Windows
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.g
    update
    set result

    # 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 <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.f1
    update
    set result

    # 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 <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.f1.f2
    update; # make sure window is gone
    destroy .one.f1

    bind all <Enter> {}
    unset result
} -result {|}

# cleanup
# macOS sometimes has trouble deleting the test window,
# causing a failure in focus.test.
_pause 200;
deleteWindows
update
unset -nocomplain keypress_lookup
rename _init_keypress_lookup {}
rename _keypress_lookup {}
rename _keypress {}
rename _text_ind_to_x_y {}

    }

    # Suspend script execution for a given amount of time, but continue
    # processing events.
    proc _pause {{msecs 1000}} {
	variable _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)
    }

    # On macOS windows are not allowed to overlap the menubar at the top of the
    # screen or the dock.  So tests which move a window and then check whether it
    # got moved to the requested location should use a y coordinate larger than the
    # height of the menubar (normally 23 pixels) and an x coordinate larger than the
    # width of the dock, if it happens to be on the left.

    incr i
}

set i 1
foreach geom "+$X+80 +$X+40 +$X+$Y0" {
    test unixWm-4.$i {moving window while withdrawn} unix {
	wm withdraw .t
	_pause 10
	wm geom .t $geom
	update idletasks
	wm deiconify .t
	_pause 10
	wm geom .t
    } 100x150$geom
    incr i
}

test unixWm-5.1 {compounded state changes} {unix nonPortable} {
    destroy .t

    focus -force .
    toplevel .t
    lower .t
    update
    lappend results [focus]

    wm attributes .t -fullscreen 1
    _pause 200
    lappend results [focus]

    wm attributes .t -fullscreen 0
    _pause 200
    lappend results [focus]
} -cleanup {
    deleteWindows
} -result {. . .}
test wm-attributes-1.4.1 {setting fullscreen does not generate FocusIn on wrapper create} -setup {
    catch {unset focusin}
} -constraints win -body {
    focus -force .
    toplevel .t
    pack [entry .t.e]
    lower .t
    bind .t <FocusIn> {lappend focusin %W}
    _pause 200

    lappend focusin 1
    focus -force .t.e
    _pause 200

    lappend focusin 2
    wm attributes .t -fullscreen 1
    _pause 200

    lappend focusin 3
    wm attributes .t -fullscreen 0
    _pause 200

    lappend focusin final [focus]
} -cleanup {
    bind . <FocusIn> {}
    bind .t <FocusIn> {}
    deleteWindows
} -result {1 .t .t.e 2 3 final .t.e}

test wm-attributes-1.5.0 {fullscreen stackorder} -setup {
    set results [list]
} -constraints win -body {
    toplevel .t
    lappend results [wm stackorder .]
    _pause 200
    lappend results [wm stackorder .]

    # Default stacking is on top of other windows on the display. Setting the
    # fullscreen attribute does not change this.
    wm attributes .t -fullscreen 1
    _pause 200
    lappend results [wm stackorder .]
} -cleanup {
    deleteWindows
} -result {. {. .t} {. .t}}
test wm-attributes-1.5.1 {fullscreen stackorder} -setup {
    set results [list]
} -constraints win -body {
    toplevel .t
    lower .t
    _pause 200
    lappend results [wm stackorder .]

    # If stacking order is explicitly set, then setting the fullscreen
    # attribute should not change it.
    wm attributes .t -fullscreen 1
    _pause 200
    lappend results [wm stackorder .]
} -cleanup {
    deleteWindows
} -result {{.t .} {.t .}}
test wm-attributes-1.5.2 {fullscreen stackorder} -setup {
    set results [list]
} -constraints win -body {
    toplevel .t
    # lower forces the window to be mapped, it would not be otherwise
    lower .t
    lappend results [wm stackorder .]

    # If stacking order is explicitly set for an unmapped window, then setting
    # the fullscreen attribute should not change it.
    wm attributes .t -fullscreen 1
    _pause 200
    lappend results [wm stackorder .]
} -cleanup {
    deleteWindows
} -result {{.t .} {.t .}}
test wm-attributes-1.5.3 {fullscreen stackorder} -setup {
    set results [list]
} -constraints win -body {
    toplevel .t
    _pause 200
    lappend results [wm stackorder .]

    wm attributes .t -fullscreen 1
    _pause 200
    lappend results [wm stackorder .]

    # Unsetting the fullscreen attribute should not change the stackorder.
    wm attributes .t -fullscreen 0
    _pause 200
    lappend results [wm stackorder .]
} -cleanup {
    deleteWindows
} -result {{. .t} {. .t} {. .t}}
test wm-attributes-1.5.4 {fullscreen stackorder} -setup {
    set results [list]
} -constraints win -body {
    toplevel .t
    lower .t
    _pause 200
    lappend results [wm stackorder .]

    wm attributes .t -fullscreen 1
    _pause 200
    lappend results [wm stackorder .]

    # Unsetting the fullscreen attribute should not change the stackorder.
    wm attributes .t -fullscreen 0
    _pause 200
    lappend results [wm stackorder .]
} -cleanup {
    deleteWindows
} -result {{.t .} {.t .} {.t .}}
test wm-attributes-1.5.5 {fullscreen stackorder} -setup {
    set results [list]
} -constraints win -body {
    toplevel .a
    toplevel .b
    toplevel .c
    raise .a
    raise .b
    raise .c
    _pause 200
    lappend results [wm stackorder .]

    wm attributes .b -fullscreen 1
    _pause 200
    lappend results [wm stackorder .]

    # Unsetting the fullscreen attribute should not change the stackorder.
    wm attributes .b -fullscreen 0
    _pause 200
    lappend results [wm stackorder .]
} -cleanup {
    deleteWindows
} -result {{. .a .b .c} {. .a .b .c} {. .a .b .c}}


stdWindow