diff options
Diffstat (limited to 'tests/scrollbar.test')
| -rw-r--r-- | tests/scrollbar.test | 86 |
1 files changed, 57 insertions, 29 deletions
diff --git a/tests/scrollbar.test b/tests/scrollbar.test index ae938dc..ea34f1d 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -23,7 +23,7 @@ proc getTroughSize {w} { return [expr {[winfo height $w] - 2*[testmetrics cyvscroll $w]}] } else { return [expr {[winfo width $w] - 2*[testmetrics cxhscroll $w]}] - } + } } else { if {[tk windowingsystem] eq "x11"} { # Calculations here assume that the arrow area is a square. @@ -60,7 +60,7 @@ proc getTroughSize {w} { foreach {width height} [wm minsize .] { set height [expr {($height < 200) ? 200 : $height}] set width [expr {($width < 1) ? 1 : $width}] -} +} frame .f -height $height -width $width pack .f -side left @@ -197,7 +197,7 @@ test scrollbar-3.14.1 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { destroy .s2 test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} { llength [.s configure] -} {20} +} 20 test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} { list [catch {.s configure -bad} msg] $msg } {1 {unknown option "-bad"}} @@ -230,7 +230,7 @@ test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} { } {1 {expected integer but got "xxyz"}} test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} { format {%.6g} [.s delta 20 0] -} {0} +} 0 test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} { format {%.6g} [.s delta 0 20] } [format %.6g [expr {20.0/([getTroughSize .s]-1)}]] @@ -262,20 +262,20 @@ test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} { } {1 {expected integer but got "bogus"}} test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.s fraction 0 0] -} {0} +} 0 test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.s fraction 0 1000] -} {1} +} 1 test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.s fraction 4 21] } [format %.6g [expr {(21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \ /([getTroughSize .s] - 1)}]] test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} x11 { format {%.6g} [.s fraction 4 179] -} {1} +} 1 test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} { format {%.6g} [.s fraction 4 [expr {200 - [testmetrics cyvscroll .s]}]] -} {1} +} 1 test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} x11 { format {%.6g} [.s fraction 4 178] } {0.993711} @@ -309,7 +309,7 @@ if {[testConstraint testmetrics]} { update test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.t.s fraction 100 0] -} {0} +} 0 destroy .t test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} { list [catch {.s get a} msg] $msg @@ -380,15 +380,15 @@ test scrollbar-3.59 {ScrollbarWidgetCmd procedure, "set" option} { set result } {0.0 0.3} test scrollbar-3.60 {ScrollbarWidgetCmd procedure, "set" option} { - .s set 1.1 .4 + .s set 1.1 .4 .s get } {1.0 1.0} test scrollbar-3.61 {ScrollbarWidgetCmd procedure, "set" option} { - .s set .5 -.3 + .s set .5 -.3 .s get } {0.5 0.5} test scrollbar-3.62 {ScrollbarWidgetCmd procedure, "set" option} { - .s set .5 87 + .s set .5 87 .s get } {0.5 1.0} test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} { @@ -412,23 +412,23 @@ test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} { list [catch {.s set 1 2 3 jkl} msg] $msg } {1 {expected integer but got "jkl"}} test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} { - .s set -10 50 20 30 + .s set -10 50 20 30 .s get } {0 50 0 0} test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} { - .s set 100 -10 20 30 + .s set 100 -10 20 30 .s get } {100 0 20 30} test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} { - .s set 100 50 30 20 + .s set 100 50 30 20 .s get } {100 50 30 30} test scrollbar-3.71 {ScrollbarWidgetCmd procedure, "set" option} { list [catch {.s set 1 2 3} msg] $msg -} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}} +} {1 {wrong # args: should be ".s set firstFraction lastFraction"}} test scrollbar-3.72 {ScrollbarWidgetCmd procedure, "set" option} { list [catch {.s set 1 2 3 4 5} msg] $msg -} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}} +} {1 {wrong # args: should be ".s set firstFraction lastFraction"}} test scrollbar-3.73 {ScrollbarWidgetCmd procedure} { list [catch {.s bogus} msg] $msg } {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}} @@ -499,7 +499,7 @@ test scrollbar-6.12.2 {ScrollbarPosition procedure} aqua { .s identify 8 19 } {trough1} test scrollbar-6.14 {ScrollbarPosition procedure} win { - .s identify [expr {[winfo width .s] / 2}] 0 + .s identify [expr {[winfo width .s] / 2}] 0 } {arrow1} test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr {[winfo width .s] / 2}] [expr {[testmetrics cyvscroll .s] - 1}] @@ -610,7 +610,7 @@ test scrollbar-6.41.2 {ScrollbarPosition procedure} aqua { } {trough2} test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} { .t.s identify [expr {int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] - - 1}] [expr {[winfo height .t.s] / 2}] + - 1}] [expr {[winfo height .t.s] / 2}] } {slider} test scrollbar-6.44 {ScrollbarPosition procedure} unix { .t.s identify 100 18 @@ -645,7 +645,7 @@ test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} notAqua { .t.f.s set 0 .5 update set result [winfo exists .t.f.s] - event generate .t.f.s <ButtonPress> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 + event generate .t.f.s <Button> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 event generate .t <ButtonRelease> -button 1 update lappend result [winfo exists .t.f.s] [winfo exists .t.f] @@ -666,7 +666,7 @@ test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} notAqua { .t.f.s set 0 .5 update set result [winfo exists .t.f.s] - event generate .t.f.s <ButtonPress> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 + event generate .t.f.s <Button> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 event generate .t.f <ButtonRelease> -button 1 update lappend result [winfo exists .t.f.s] [winfo exists .t.f] @@ -714,7 +714,7 @@ test scrollbar-10.1.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -set destroy .t .s } -result {5.0} -test scrollbar-10.2.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -728,7 +728,7 @@ test scrollbar-10.2.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} - } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup { +test scrollbar-10.2.2 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -742,6 +742,34 @@ test scrollbar-10.2.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -set } -cleanup { destroy .t .s } -result {1.4} +test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup { + destroy .t .s +} -body { + pack [text .t -xscrollcommand {.s set} -wrap none] -side top + for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} + pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top + update + focus -force .s + event generate .s <MouseWheel> -delta -120 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {1.4} +test scrollbar-10.2.4 {<MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup { + destroy .t .s +} -body { + pack [text .t -xscrollcommand {.s set} -wrap none] -side top + for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} + pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top + update + focus -force .s + event generate .s <MouseWheel> -delta -4 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {1.4} test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body { proc destroy_scrollbar {} { @@ -751,15 +779,15 @@ test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destructi } toplevel .top scrollbar .top.s - bind .top.s <2> {destroy_scrollbar} + bind .top.s <Button-2> {destroy_scrollbar} pack .top.s focus -force .top.s update - event generate .top.s <2> + event generate .top.s <Button-2> update ; # shall not trigger error invalid command name ".top.s" } -cleanup { destroy .top.s .top -} -result {} +} -result {} test scrollbar-11.2 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body { proc destroy_scrollbar {{y 0}} { if {[winfo exists .top.s]} { @@ -770,15 +798,15 @@ test scrollbar-11.2 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destructi wm minsize .top 50 400 update scrollbar .top.s - bind .top.s <2> {after idle destroy_scrollbar} + bind .top.s <Button-2> {after idle destroy_scrollbar} pack .top.s -expand true -fill y focus -force .top.s update - event generate .top.s <2> -x 2 -y [expr {[winfo height .top.s] / 2}] + event generate .top.s <Button-2> -x 2 -y [expr {[winfo height .top.s] / 2}] update ; # shall not trigger error invalid command name ".top.s" } -cleanup { destroy .top.s .top -} -result {} +} -result {} catch {destroy .s} catch {destroy .t} |