Pulling changes from trunkcore_zip_vfs

1 files changed, 77 insertions, 10 deletions

diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index c6a5a90..6d811dc 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -22,7 +22,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 [string match v* [$w cget -orient]] {
 	    return [expr [winfo height $w] \
@@ -45,7 +45,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
@@ -351,15 +351,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} {
@@ -383,15 +383,15 @@ 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} {
@@ -462,7 +462,7 @@ test scrollbar-6.12 {ScrollbarPosition procedure} unix {
     .s identify 8 19
 } {arrow1}
 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]
@@ -561,7 +561,7 @@ test scrollbar-6.41 {ScrollbarPosition procedure} unix {
 } {slider}
 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
@@ -632,6 +632,73 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} {
     list [winfo children .] [interp hidden]
 } [list {} $l]
 
+test scrollbar-10.1 {<MouseWheel> event on scrollbar} -constraints {win|unix} -setup {
+    destroy .t .s
+} -body {
+    pack [text .t -yscrollcommand {.s set}] -side left
+    for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
+    pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
+    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 {5.0}
+
+test scrollbar-10.2 {<MouseWheel> event on scrollbar} -constraints {win|unix} -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 <Shift-MouseWheel> -delta -120
+    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 {} {
+        if {[winfo exists .top.s]} {
+            destroy .top.s
+        }
+    }
+    toplevel .top
+    scrollbar .top.s
+    bind .top.s <2> {destroy_scrollbar}
+    pack .top.s
+    focus -force .top.s
+    update
+    event generate .top.s <2>
+    update  ; # shall not trigger error  invalid command name ".top.s"
+} -cleanup {
+    destroy .top.s .top
+} -result {}
+test scrollbar-11.2 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body {
+    proc destroy_scrollbar {{y 0}} {
+        if {[winfo exists .top.s]} {
+            destroy .top.s
+        }
+    }
+    toplevel .top
+    wm minsize .top 50 400
+    update
+    scrollbar .top.s
+    bind .top.s <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}]
+    update  ; # shall not trigger error  invalid command name ".top.s"
+} -cleanup {
+    destroy .top.s .top
+} -result {}
+
 catch {destroy .s}
 catch {destroy .t}