ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tk 8.6.11

Browse Source
This commit is contained in:
Steve Dower
2021-03-30 00:54:10 +01:00
parent 42c69189d9
commit 070b8750b0
403 changed files with 21608 additions and 16269 deletions
Download Patch File Download Diff File Expand all files Collapse all files

327
tests/bind.test
View File

@@ -36,12 +36,22 @@ proc unsetBindings {} {
# move the mouse pointer away of the testing area
# otherwise some spurious events may pollute the tests
toplevel .top
wm geometry .top 50x50-50-50
update
event generate .top <Button-1> -warp 1
update
destroy .top
# also, this will procure a known grab state at startup
# for tests mixing grabs and pointer warps
proc pointerAway {} {
toplevel .top
wm geometry .top 50x50-50-50
update
# On KDE/Plasma _with_the_Aurorae_theme_ (at least), setting up the toplevel
# will not be finished right after the above 'update'. The WM still
# needs some time before the window is fully ready. For me 50 ms is enough,
# but let's wait more (it depends on computer performance).
after 100 ; update
event generate .top <Button-1> -warp 1
update
destroy .top
}
pointerAway
test bind-1.1 {bind command} -body {
bind
@@ -6624,12 +6634,112 @@ test bind-33.15 {prefer last in case of homogeneous equal patterns} -setup {
# because both bindings are homogeneous equal, so the most recently defined
# must be preferred.
} -result {last}
test bind-33.16 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup {
pack [frame .t.f]
focus -force .t.f
update
set x {}
} -body {
bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" }
event generate .t.f <Escape>
event generate .t.f <Control_L>
event generate .t.f <Control_L>
event generate .t.f <Control_L>
event generate .t.f <Control-c>
set x
} -cleanup {
destroy .t.f
} -result {Esc_Control-c}
test bind-33.17 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup {
pack [frame .t.f]
focus -force .t.f
update
set x {}
} -body {
bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" }
bind .t.f <Escape><Control_L><Control-c> { lappend x "Esc_Ctrl_L_Control-c" }
event generate .t.f <Escape>
event generate .t.f <Control_L>
event generate .t.f <Control_L>
event generate .t.f <Control_L>
event generate .t.f <Control-c>
set x
} -cleanup {
destroy .t.f
} -result {Esc_Ctrl_L_Control-c}
test bind-33.18 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup {
pack [frame .t.f]
focus -force .t.f
update
set x {}
} -body {
bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" }
bind .t.f <Escape><Control_L><Control-c> { lappend x "Esc_Ctrl_L_Control-c" }
bind .t.f <Escape><Control_L><Control_L><Control-c> { lappend x "Esc_Ctrl_L(2)_Control-c" }
event generate .t.f <Escape>
event generate .t.f <Control_L>
event generate .t.f <Control_L>
event generate .t.f <Control_L>
event generate .t.f <Control-c>
set x
} -cleanup {
destroy .t.f
} -result {Esc_Ctrl_L(2)_Control-c}
test bind-33.19 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup {
pack [frame .t.f]
focus -force .t.f
update
set x {}
} -body {
bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" }
bind .t.f <Escape><KeyPress><KeyPress><Control-c> { lappend x "Esc_Key(2)_Control-c" }
event generate .t.f <Escape>
event generate .t.f <Alt_L>
event generate .t.f <Control_L>
event generate .t.f <Control-c>
set x
} -cleanup {
destroy .t.f
} -result {Esc_Key(2)_Control-c}
test bind-33.20 {simulate use of the keyboard to trigger a pattern sequence with mixed Key and Button types - bug [16ef161925]} -setup {
pack [frame .t.f]
focus -force .t.f
update
set x {}
} -body {
bind .t.f <Key-1><Button-1> { lappend x "1_Button1" }
event generate .t.f <Key-1>
event generate .t.f <KeyRelease-1>
event generate .t.f <Button-1>
set x
} -cleanup {
destroy .t.f
} -result {1_Button1}
test bind-33.21 {simulate use of the keyboard to trigger a pattern sequence with mixed Key and Button types - bug [16ef161925]} -setup {
pack [frame .t.f]
focus -force .t.f
update
set x {}
} -body {
bind .t.f <Key-1><Button-1> { lappend x "1_Button1" }
bind .t.f <Key-1><Button-1><Key-2> { lappend x "1_Button1_2" }
event generate .t.f <Key-1>
event generate .t.f <KeyRelease-1>
event generate .t.f <Button-1>
event generate .t.f <Key-2>
event generate .t.f <KeyRelease-2>
set x
} -cleanup {
destroy .t.f
} -result {1_Button1 1_Button1_2}
test bind-34.1 {-warp works relatively to a window} -setup {
toplevel .top
wm geometry .top +100+100
update
} -body {
# In order to avoid platform-dependent coordinate results due to
# decorations and borders, this test warps the pointer twice
# decorations and borders, this test warps the pointer twice
# relatively to a window that moved in the meantime, and checks
# how much the pointer moved
wm geometry .top +200+200
@@ -6637,13 +6747,13 @@ test bind-34.1 {-warp works relatively to a window} -setup {
event generate .top <Motion> -x 20 -y 20 -warp 1
update idletasks ; # DoWarp is an idle callback
after 50 ; # Win specific - wait for SendInput to be executed
set pointerPos1 [winfo pointerxy .t]
set pointerPos1 [winfo pointerxy .top]
wm geometry .top +600+600
update
event generate .top <Motion> -x 20 -y 20 -warp 1
update idletasks ; # DoWarp is an idle callback
after 50 ; # Win specific - wait for SendInput to be executed
set pointerPos2 [winfo pointerxy .t]
set pointerPos2 [winfo pointerxy .top]
# from the first warped position to the second one, the mouse
# pointer should have moved the same amount as the window moved
set res 1
@@ -6670,16 +6780,34 @@ test bind-34.2 {-warp works relatively to the screen} -setup {
} -cleanup {
} -result {20 20 200 200}
test bind-34.3 {-warp works with null or negative coordinates} -setup {
# On some OS/WM, at least Linux with KDE, the "Screen edges" feature
# provides hot spots that can be associated with some action.
# When activated, the WM will not allow warping to happen on top of
# a hot spot (which would trigger the corresponding action as an
# unwanted effect) but will warp the pointer to the hot spot limit only.
if {[tk windowingsystem] eq "x11"} {
set halo 1
} else {
set halo 0
}
set res {}
} -body {
event generate {} <Motion> -x 0 -y 0 -warp 1
update idletasks ; # DoWarp is an idle callback
after 50 ; # Win specific - wait for SendInput to be executed
set res [winfo pointerxy .]
event generate {} <Motion> -x -1 -y -1 -warp 1
update idletasks ; # DoWarp is an idle callback
after 50 ; # Win specific - wait for SendInput to be executed
foreach dim [winfo pointerxy .] {
if {$dim <= 0} {
if {$dim <= $halo} {
lappend res ok
} else {
lappend res $dim
}
}
event generate {} <Motion> -x 100 -y 100 -warp 1
update idletasks ; after 50
event generate {} <Motion> -x -1 -y -1 -warp 1
update idletasks ; after 50
foreach dim [winfo pointerxy .] {
if {$dim <= $halo} {
lappend res ok
} else {
lappend res $dim
@@ -6687,7 +6815,176 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup {
}
set res
} -cleanup {
} -result {0 0 ok ok}
} -result {ok ok ok ok}
set keyInfo {}
set numericKeysym {}
proc testKey {window event type mods} {
global keyInfo numericKeysym
set keyInfo {}
set numericKeysym {}
bind $window <KeyPress> {
set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k]
set numericKeysym %N
}
focus -force $window
update
event generate $window $event
if {$keyInfo == {}} {
vwait keyInfo
}
set save $keyInfo
set keyInfo {}
set injectcmd [list injectkeyevent $type $numericKeysym]
foreach {option} $mods {
lappend injectcmd $option
}
eval $injectcmd
if {$keyInfo == {}} {
vwait keyInfo
}
if {$save != $keyInfo} {
return "[format "0x%x" $numericKeysym] ($mods): $save != $keyInfo"
}
return pass
}
proc testKeyWithMods {window keysym type} {
set result [testKey $window "<$keysym>" $type {}]
if {$result != {pass}} {
return $result
}
set result [testKey $window "<Shift-$keysym>" $type {-shift}]
if {$result != {pass}} {
return $result
}
set result [testKey $window "<Option-$keysym>" $type {-option}]
if {$result != {pass}} {
return $result
}
set result [testKey $window "<Shift-Option-$keysym>" $type {-shift -option}]
if {$result != {pass}} {
return $result
}
return pass
}
test bind-35.0 {Generated and real key events agree} -constraints {aqua} -body {
foreach k {o O F2 Home Right Greek_sigma Greek_ALPHA} {
set result [testKeyWithMods . $k press]
if {$result != "pass"} {
return $result
}
}
return pass
} -cleanup {
} -result pass
test bind-35.1 {Key events agree for entry widgets} -constraints {aqua} -setup {
toplevel .new
entry .new.e
pack .new.e
} -body {
foreach k {o O F2 Home Right Greek_sigma Greek_ALPHA Menu} {
set result [testKeyWithMods .new.e $k press]
if {$result != "pass"} {
return $result
}
}
return pass
} -cleanup {
destroy .new.e
destroy .new
} -result pass
test bind-35.2 {Can bind to function keys} -constraints {aqua} -body {
global keyInfo numericKeysym
bind . <KeyPress> {}
bind . <KeyPress> {
lappend keyInfo %K
set numericKeysym %N
}
set keyInfo {}
set numericKeysym {}
focus -force .
event generate . <F2>
injectkeyevent press $numericKeysym -function
vwait keyInfo
return $keyInfo
} -cleanup {
} -result {F2 F2}
test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup {
} -body {
global keyInfo numericalKeysym
set result {}
bind . <KeyPress> {
set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k]
set numericalKeysym [format "0x%x" %N]
}
foreach event {
{<Control_L> -control}
{<Control_R> -control}
{<Alt_L> -option}
{<Alt_R> -option}
{<Meta_L> -command}
{<Meta_R> -command}
{<Shift_L> -shift}
{<Shift_R> -shift}
} {
set keyInfo {}
event generate . [lindex $event 0]
if {$keyInfo == {}} {
vwait keyInfo
}
set save $keyInfo
injectkeyevent flagschanged $numericKeysym [lindex $event 1]
if {$keyInfo == {}} {
vwait keyInfo
}
if {$save != $keyInfo} {
return "$save != $keyInfo"
}
}
return pass
} -cleanup {
} -result pass
test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup {
pointerAway
toplevel .top
grab release .top
wm geometry .top 200x200+300+300
label .top.l -height 5 -width 20 -highlightthickness 2 \
-highlightbackground black -bg yellow -text "My label"
pack .top.l -side bottom
update
# On KDE/Plasma _with_the_Aurorae_theme_ (at least), setting up the toplevel
# and the label will not be finished after the above 'update'. The WM still
# needs some time before the window is fully ready. For me 50 ms is enough,
# but let's wait more (it depends on computer performance).
after 100 ; update
} -body {
grab .top ; # this will queue events
after 50
update
event generate .top.l <Motion> -warp 1 -x 10 -y 10
update idletasks ; after 50
foreach {x1 y1} [winfo pointerxy .top.l] {}
event generate {} <Motion> -warp 1 -x 50 -y 50
update idletasks ; after 50
grab release .top ; # this will queue events
after 50
update
event generate .top.l <Motion> -warp 1 -x 10 -y 10
update idletasks ; after 50
foreach {x2 y2} [winfo pointerxy .top.l] {}
# success if the coords are the same with or without the grab, and if they
# are at (10,10) inside the label widget as requested by the warping
expr {$x1==$x2 && $y1==$y2 && $x1==[winfo rootx .top.l]+10 \
&& $y1==[winfo rooty .top.l]+10}
} -cleanup {
destroy .top
unset x1 y1 x2 y2
} -result {1}
# cleanup
cleanupTests