1# This file is a Tcl script to test out scrollbar widgets and 2# the "scrollbar" command of Tk. It is organized in the standard 3# fashion for Tcl tests. 4# 5# Copyright (c) 1994 The Regents of the University of California. 6# Copyright (c) 1994-1997 Sun Microsystems, Inc. 7# Copyright (c) 1998-1999 by Scriptics Corporation. 8# All rights reserved. 9# 10# RCS: @(#) $Id$ 11 12package require tcltest 2.1 13eval tcltest::configure $argv 14tcltest::loadTestedCommands 15 16proc scroll args { 17 global scrollInfo 18 set scrollInfo $args 19} 20 21proc getTroughSize {w} { 22 if {[testConstraint testmetrics]} { 23 if [string match v* [$w cget -orient]] { 24 return [expr [winfo height $w] - 2*[testmetrics cyvscroll $w]] 25 } else { 26 return [expr [winfo width $w] - 2*[testmetrics cxhscroll $w]] 27 } 28 } else { 29 if [string match v* [$w cget -orient]] { 30 return [expr [winfo height $w] \ 31 - ([winfo width $w] \ 32 - [$w cget -highlightthickness] \ 33 - [$w cget -bd] + 1)*2] 34 } else { 35 return [expr [winfo width $w] \ 36 - ([winfo height $w] \ 37 - [$w cget -highlightthickness] \ 38 - [$w cget -bd] + 1)*2] 39 } 40 } 41} 42 43# XXX Note: this test file is woefully incomplete. Right now there are 44# only bits and pieces of tests. Please make this file more complete 45# as you fix bugs and add features. 46 47foreach {width height} [wm minsize .] { 48 set height [expr ($height < 200) ? 200 : $height] 49 set width [expr ($width < 1) ? 1 : $width] 50} 51 52frame .f -height $height -width $width 53pack .f -side left 54scrollbar .s 55pack .s -side right -fill y 56update 57set i 1 58foreach test { 59 {-activebackground #ff0000 #ff0000 non-existent 60 {unknown color name "non-existent"}} 61 {-activerelief sunken sunken non-existent 62 {bad relief type "non-existent": must be flat, groove, raised, ridge, solid, or sunken}} 63 {-background #ff0000 #ff0000 non-existent 64 {unknown color name "non-existent"}} 65 {-bd 4 4 badValue {bad screen distance "badValue"}} 66 {-bg #ff0000 #ff0000 non-existent 67 {unknown color name "non-existent"}} 68 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} 69 {-command "set x" {set x} {} {}} 70 {-elementborderwidth 4 4 badValue {bad screen distance "badValue"}} 71 {-cursor arrow arrow badValue {bad cursor spec "badValue"}} 72 {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} 73 {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} 74 {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} 75 {-highlightthickness -2 0 {} {}} 76 {-jump true 1 silly {expected boolean value but got "silly"}} 77 {-orient horizontal horizontal badValue 78 {bad orientation "badValue": must be vertical or horizontal}} 79 {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}} 80 {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}} 81 {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}} 82 {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}} 83 {-takefocus "any string" "any string" {} {}} 84 {-troughcolor #432 #432 lousy {unknown color name "lousy"}} 85 {-width 32 32 badValue {bad screen distance "badValue"}} 86} { 87 lassign $test name value okResult badValue badResult 88 # Assume $name is plain; true of all our in-use options! 89 test scrollbar-1.$i {configuration options} \ 90 ".s configure $name [list $value]; .s cget $name" $okResult 91 incr i 92 if {$badValue ne ""} { 93 test scrollbar-1.$i {configuration options} \ 94 -body [list .s configure $name $badValue] \ 95 -returnCodes error -result $badResult 96 incr i 97 } 98 .s configure $name [lindex [.s configure $name] 3] 99} 100 101destroy .s 102test scrollbar-2.1 {Tk_ScrollbarCmd procedure} -returnCodes error -body { 103 scrollbar 104} -result {wrong # args: should be "scrollbar pathName ?options?"} 105test scrollbar-2.2 {Tk_ScrollbarCmd procedure} -body { 106 scrollbar gorp 107} -returnCodes error -result {bad window path name "gorp"} 108test scrollbar-2.3 {Tk_ScrollbarCmd procedure} -setup { 109 scrollbar .s 110} -body { 111 list [winfo class .s] [info command .s] 112} -cleanup { 113 destroy .s 114} -result {Scrollbar .s} 115test scrollbar-2.4 {Tk_ScrollbarCmd procedure} { 116 list [catch {scrollbar .s -gorp blah} msg] $msg [winfo exists .s] \ 117 [info command .s] 118} {1 {unknown option "-gorp"} 0 {}} 119test scrollbar-2.5 {Tk_ScrollbarCmd procedure} -setup { 120 catch {destroy .s} 121} -body { 122 scrollbar .s 123} -cleanup { 124 destroy .s 125} -result .s 126 127scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2 128pack .s -side right -fill y 129update 130test scrollbar-3.1 {ScrollbarWidgetCmd procedure} { 131 list [catch {.s} msg] $msg 132} {1 {wrong # args: should be ".s option ?arg arg ...?"}} 133test scrollbar-3.2 {ScrollbarWidgetCmd procedure, "cget" option} { 134 list [catch {.s cget} msg] $msg 135} {1 {wrong # args: should be ".s cget option"}} 136test scrollbar-3.3 {ScrollbarWidgetCmd procedure, "cget" option} { 137 list [catch {.s cget -gorp} msg] $msg 138} {1 {unknown option "-gorp"}} 139test scrollbar-3.4 {ScrollbarWidgetCmd procedure, "activate" option} { 140 list [catch {.s activate a b} msg] $msg 141} {1 {wrong # args: should be ".s activate element"}} 142test scrollbar-3.5 {ScrollbarWidgetCmd procedure, "activate" option} { 143 .s activate arrow1 144 .s activate 145} {arrow1} 146test scrollbar-3.6 {ScrollbarWidgetCmd procedure, "activate" option} { 147 .s activate slider 148 .s activate 149} {slider} 150test scrollbar-3.7 {ScrollbarWidgetCmd procedure, "activate" option} { 151 .s activate arrow2 152 .s activate 153} {arrow2} 154test scrollbar-3.8 {ScrollbarWidgetCmd procedure, "activate" option} { 155 .s activate s 156 .s activate {} 157 .s activate 158} {} 159test scrollbar-3.9 {ScrollbarWidgetCmd procedure, "activate" option} { 160 list [catch {.s activate trough1} msg] $msg 161} {0 {}} 162test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} { 163 list [catch {.s cget -orient} msg] $msg 164} {0 vertical} 165scrollbar .s2 166test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} { 167 expr {[.s2 cget -bd] == [lindex [.s2 configure -bd] 3]} 168} 1 169test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { 170 # empty test; duplicated scrollbar-3.11 171} {} 172test scrollbar-3.12.1 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { 173 # empty test; duplicated scrollbar-3.11 174} {} 175test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} { 176 expr {[.s2 cget -highlightthickness] == [lindex [.s2 configure -highlightthickness] 3]} 177} 1 178test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { 179 # empty test; duplicated scrollbar-3.13 180} {} 181test scrollbar-3.14.1 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { 182 # empty test; duplicated scrollbar-3.13 183} {} 184destroy .s2 185test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} { 186 llength [.s configure] 187} {20} 188test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} { 189 list [catch {.s configure -bad} msg] $msg 190} {1 {unknown option "-bad"}} 191test scrollbar-3.17 {ScrollbarWidgetCmd procedure, "configure" option} { 192 .s configure -orient 193} {-orient orient Orient vertical vertical} 194test scrollbar-3.18 {ScrollbarWidgetCmd procedure, "configure" option} { 195 .s configure -orient horizontal 196 set x [.s cget -orient] 197 .s configure -orient vertical 198 set x 199} {horizontal} 200test scrollbar-3.19 {ScrollbarWidgetCmd procedure, "configure" option} { 201 list [catch {.s configure -bad worse} msg] $msg 202} {1 {unknown option "-bad"}} 203test scrollbar-3.20 {ScrollbarWidgetCmd procedure, "delta" option} { 204 list [catch {.s delta 24} msg] $msg 205} {1 {wrong # args: should be ".s delta xDelta yDelta"}} 206test scrollbar-3.21 {ScrollbarWidgetCmd procedure, "delta" option} { 207 list [catch {.s delta 24 35 42} msg] $msg 208} {1 {wrong # args: should be ".s delta xDelta yDelta"}} 209test scrollbar-3.22 {ScrollbarWidgetCmd procedure, "delta" option} { 210 list [catch {.s delta silly 24} msg] $msg 211} {1 {expected integer but got "silly"}} 212test scrollbar-3.23 {ScrollbarWidgetCmd procedure, "delta" option} { 213 list [catch {.s delta 18 xxyz} msg] $msg 214} {1 {expected integer but got "xxyz"}} 215test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} { 216 list [catch {.s delta 18 xxyz} msg] $msg 217} {1 {expected integer but got "xxyz"}} 218test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} { 219 format {%.6g} [.s delta 20 0] 220} {0} 221test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} { 222 format {%.6g} [.s delta 0 20] 223} [format %.6g [expr 20.0/([getTroughSize .s]-1)]] 224test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} { 225 format {%.6g} [.s delta 0 -20] 226} [format %.6g [expr -20.0/([getTroughSize .s]-1)]] 227test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} { 228 toplevel .t -width 250 -height 100 229 wm geom .t +0+0 230 scrollbar .t.s -orient horizontal -borderwidth 2 231 place .t.s -width 201 232 update 233 set result [list [format {%.6g} [.t.s delta 0 20]] \ 234 [format {%.6g} [.t.s delta [expr [getTroughSize .t.s] - 1] 0]]] 235 destroy .t 236 set result 237} {0 1} 238test scrollbar-3.29 {ScrollbarWidgetCmd procedure, "fraction" option} { 239 list [catch {.s fraction 24} msg] $msg 240} {1 {wrong # args: should be ".s fraction x y"}} 241test scrollbar-3.30 {ScrollbarWidgetCmd procedure, "fraction" option} { 242 list [catch {.s fraction 24 30 32} msg] $msg 243} {1 {wrong # args: should be ".s fraction x y"}} 244test scrollbar-3.31 {ScrollbarWidgetCmd procedure, "fraction" option} { 245 list [catch {.s fraction silly 24} msg] $msg 246} {1 {expected integer but got "silly"}} 247test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} { 248 list [catch {.s fraction 24 bogus} msg] $msg 249} {1 {expected integer but got "bogus"}} 250test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} { 251 format {%.6g} [.s fraction 0 0] 252} {0} 253test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} { 254 format {%.6g} [.s fraction 0 1000] 255} {1} 256test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} { 257 format {%.6g} [.s fraction 4 21] 258} [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \ 259 /([getTroughSize .s] - 1)]] 260test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} unix { 261 format {%.6g} [.s fraction 4 179] 262} {1} 263test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} { 264 format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]] 265} {1} 266test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} unix { 267 format {%.6g} [.s fraction 4 178] 268} {0.993711} 269test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics win} { 270 expr \ 271 [format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]]] \ 272 == [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \ 273 / ($height - 1 - [testmetrics cyvscroll .s]*2)]] 274} 1 275 276toplevel .t -width 250 -height 100 277wm geom .t +0+0 278scrollbar .t.s -orient horizontal -borderwidth 2 279place .t.s -width 201 280update 281 282test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} { 283 format {%.6g} [.t.s fraction 100 0] 284} {0.5} 285if {[testConstraint testmetrics]} { 286 place configure .t.s -width [expr 2*[testmetrics cxhscroll .t.s]+1] 287} else { 288 place configure .t.s -width [expr [winfo reqwidth .t.s] - 4] 289} 290update 291test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} { 292 format {%.6g} [.t.s fraction 100 0] 293} {0} 294destroy .t 295test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} { 296 list [catch {.s get a} msg] $msg 297} {1 {wrong # args: should be ".s get"}} 298test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} { 299 .s set 100 10 13 14 300 .s get 301} {100 10 13 14} 302test scrollbar-3.45 {ScrollbarWidgetCmd procedure, "get" option} { 303 .s set 0.6 0.8 304 set result {} 305 foreach element [.s get] { 306 lappend result [format %.1f $element] 307 } 308 set result 309} {0.6 0.8} 310test scrollbar-3.46 {ScrollbarWidgetCmd procedure, "identify" option} { 311 list [catch {.s identify 0} msg] $msg 312} {1 {wrong # args: should be ".s identify x y"}} 313test scrollbar-3.47 {ScrollbarWidgetCmd procedure, "identify" option} { 314 list [catch {.s identify 0 0 1} msg] $msg 315} {1 {wrong # args: should be ".s identify x y"}} 316test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} { 317 list [catch {.s identify bogus 2} msg] $msg 318} {1 {expected integer but got "bogus"}} 319test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} { 320 list [catch {.s identify -1 bogus} msg] $msg 321} {1 {expected integer but got "bogus"}} 322test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} { 323 .s identify 5 5 324} {arrow1} 325test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} { 326 .s identify 5 35 327} {trough1} 328test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} { 329 .s set .3 .6 330 .s identify 5 80 331} {slider} 332test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} { 333 .s identify 5 145 334} {trough2} 335test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} { 336 .s identify 5 195 337} {arrow2} 338test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} unix { 339 .s identify 0 0 340} {} 341test scrollbar-3.57 {ScrollbarWidgetCmd procedure, "set" option} { 342 list [catch {.s set abc def} msg] $msg 343} {1 {expected floating-point number but got "abc"}} 344test scrollbar-3.58 {ScrollbarWidgetCmd procedure, "set" option} { 345 list [catch {.s set 0.6 def} msg] $msg 346} {1 {expected floating-point number but got "def"}} 347test scrollbar-3.59 {ScrollbarWidgetCmd procedure, "set" option} { 348 .s set -.2 .3 349 set result {} 350 foreach element [.s get] { 351 lappend result [format %.1f $element] 352 } 353 set result 354} {0.0 0.3} 355test scrollbar-3.60 {ScrollbarWidgetCmd procedure, "set" option} { 356 .s set 1.1 .4 357 .s get 358} {1.0 1.0} 359test scrollbar-3.61 {ScrollbarWidgetCmd procedure, "set" option} { 360 .s set .5 -.3 361 .s get 362} {0.5 0.5} 363test scrollbar-3.62 {ScrollbarWidgetCmd procedure, "set" option} { 364 .s set .5 87 365 .s get 366} {0.5 1.0} 367test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} { 368 .s set .4 .3 369 set result {} 370 foreach element [.s get] { 371 lappend result [format %.1f $element] 372 } 373 set result 374} {0.4 0.4} 375test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} { 376 list [catch {.s set abc def ghi jkl} msg] $msg 377} {1 {expected integer but got "abc"}} 378test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} { 379 list [catch {.s set 1 def ghi jkl} msg] $msg 380} {1 {expected integer but got "def"}} 381test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} { 382 list [catch {.s set 1 2 ghi jkl} msg] $msg 383} {1 {expected integer but got "ghi"}} 384test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} { 385 list [catch {.s set 1 2 3 jkl} msg] $msg 386} {1 {expected integer but got "jkl"}} 387test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} { 388 .s set -10 50 20 30 389 .s get 390} {0 50 0 0} 391test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} { 392 .s set 100 -10 20 30 393 .s get 394} {100 0 20 30} 395test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} { 396 .s set 100 50 30 20 397 .s get 398} {100 50 30 30} 399test scrollbar-3.71 {ScrollbarWidgetCmd procedure, "set" option} { 400 list [catch {.s set 1 2 3} msg] $msg 401} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}} 402test scrollbar-3.72 {ScrollbarWidgetCmd procedure, "set" option} { 403 list [catch {.s set 1 2 3 4 5} msg] $msg 404} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}} 405test scrollbar-3.73 {ScrollbarWidgetCmd procedure} { 406 list [catch {.s bogus} msg] $msg 407} {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}} 408test scrollbar-3.74 {ScrollbarWidgetCmd procedure} { 409 list [catch {.s c} msg] $msg 410} {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}} 411 412test scrollbar-4.1 {ScrollbarEventProc procedure} { 413 catch {destroy .s1} 414 scrollbar .s1 -bg #543210 415 rename .s1 .s2 416 set x {} 417 lappend x [winfo exists .s1] 418 lappend x [.s2 cget -bg] 419 destroy .s1 420 lappend x [info command .s?] [winfo exists .s1] [winfo exists .s2] 421} {1 #543210 {} 0 0} 422 423test scrollbar-5.1 {ScrollbarCmdDeletedProc procedure} { 424 catch {destroy .s1} 425 scrollbar .s1 426 rename .s1 {} 427 list [info command .s?] [winfo exists .s1] 428} {{} 0} 429 430catch {destroy .s} 431scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2 432pack .s -side left -fill y 433.s set .2 .4 434update 435 436test scrollbar-6.1 {ScrollbarPosition procedure} unix { 437 .s identify 8 3 438} {} 439test scrollbar-6.3 {ScrollbarPosition procedure} unix { 440 .s identify 8 196 441} {} 442test scrollbar-6.4 {ScrollbarPosition procedure} unix { 443 .s identify 3 100 444} {} 445test scrollbar-6.6 {ScrollbarPosition procedure} unix { 446 .s identify 19 100 447} {} 448test scrollbar-6.7 {ScrollbarPosition procedure} { 449 .s identify [expr [winfo width .s] / 2] -1 450} {} 451test scrollbar-6.8 {ScrollbarPosition procedure} { 452 .s identify [expr [winfo width .s] / 2] [expr [winfo height .s]] 453} {} 454test scrollbar-6.9 {ScrollbarPosition procedure} { 455 .s identify -1 [expr [winfo height .s] / 2] 456} {} 457test scrollbar-6.10 {ScrollbarPosition procedure} { 458 .s identify [winfo width .s] [expr [winfo height .s] / 2] 459} {} 460test scrollbar-6.11 {ScrollbarPosition procedure} unix { 461 .s identify 8 4 462} {arrow1} 463test scrollbar-6.12 {ScrollbarPosition procedure} unix { 464 .s identify 8 19 465} {arrow1} 466test scrollbar-6.14 {ScrollbarPosition procedure} win { 467 .s identify [expr [winfo width .s] / 2] 0 468} {arrow1} 469test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics win} { 470 .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll .s] - 1] 471} {arrow1} 472test scrollbar-6.16 {ScrollbarPosition procedure} unix { 473 .s identify 8 20 474} {trough1} 475test scrollbar-6.17 {ScrollbarPosition procedure} {unix nonPortable} { 476 # Don't know why this is non-portable, but it doesn't work on 477 # some platforms. 478 .s identify 8 51 479} {trough1} 480test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics win} { 481 .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll .s] 482} {trough1} 483test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics win} { 484 .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \ 485 + [testmetrics cyvscroll .s] - 1] 486} {trough1} 487test scrollbar-6.20 {ScrollbarPosition procedure} unix { 488 .s identify 8 52 489} {slider} 490test scrollbar-6.21 {ScrollbarPosition procedure} {unix nonPortable} { 491 # Don't know why this is non-portable, but it doesn't work on 492 # some platforms. 493 .s identify 8 83 494} {slider} 495test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics win} { 496 .s identify [expr [winfo width .s] / 2] \ 497 [expr int(.2 / [.s delta 0 1] + 0.5) + [testmetrics cyvscroll .s]] 498} {slider} 499test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics win} { 500 .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ 501 + [testmetrics cyvscroll .s] - 1] 502} {slider} 503test scrollbar-6.24 {ScrollbarPosition procedure} unix { 504 .s identify 8 84 505} {trough2} 506test scrollbar-6.25 {ScrollbarPosition procedure} unix { 507 .s identify 8 179 508} {trough2} 509test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics win knownBug} { 510 # This asks for 8,21, which is actually the slider, but there is a 511 # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value 512 # that is larger than the thumb displayed, skewing the ability to 513 # calculate the trough2 area correctly (Win2k). -- hobbs 514 .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ 515 + [testmetrics cyvscroll .s]] 516} {trough2} 517test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} { 518 .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ 519 - [testmetrics cyvscroll .s] - 1] 520} {trough2} 521test scrollbar-6.29 {ScrollbarPosition procedure} unix { 522 .s identify 8 180 523} {arrow2} 524test scrollbar-6.30 {ScrollbarPosition procedure} unix { 525 .s identify 8 195 526} {arrow2} 527test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics win} { 528 .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ 529 - [testmetrics cyvscroll .s]] 530} {arrow2} 531test scrollbar-6.33 {ScrollbarPosition procedure} win { 532 .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1] 533} {arrow2} 534test scrollbar-6.34 {ScrollbarPosition procedure} unix { 535 .s identify 4 100 536} {trough2} 537test scrollbar-6.35 {ScrollbarPosition procedure} unix { 538 .s identify 18 100 539} {trough2} 540test scrollbar-6.37 {ScrollbarPosition procedure} win { 541 .s identify 0 100 542} {trough2} 543test scrollbar-6.38 {ScrollbarPosition procedure} win { 544 .s identify [expr [winfo width .s] - 1] 100 545} {trough2} 546 547catch {destroy .t} 548toplevel .t -width 250 -height 150 549wm geometry .t +0+0 550scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2 551place .t.s -width 200 552.t.s set .2 .4 553update 554 555test scrollbar-6.39 {ScrollbarPosition procedure} unix { 556 .t.s identify 4 8 557} {arrow1} 558test scrollbar-6.40 {ScrollbarPosition procedure} win { 559 .t.s identify 0 [expr [winfo height .t.s] / 2] 560} {arrow1} 561test scrollbar-6.41 {ScrollbarPosition procedure} unix { 562 .t.s identify 82 8 563} {slider} 564test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} { 565 .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] \ 566 - 1] [expr [winfo height .t.s] / 2] 567} {slider} 568test scrollbar-6.44 {ScrollbarPosition procedure} unix { 569 .t.s identify 100 18 570} {trough2} 571test scrollbar-6.46 {ScrollbarPosition procedure} win { 572 .t.s identify 100 [expr [winfo height .t.s] - 1] 573} {trough2} 574 575test scrollbar-7.1 {EventuallyRedraw} { 576 .s configure -orient horizontal 577 update 578 set result [.s cget -orient] 579 .s configure -orient vertical 580 update 581 lappend result [.s cget -orient] 582} {horizontal vertical} 583 584catch {destroy .t} 585toplevel .t 586wm geometry .t +0+0 587test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { 588 proc doit {args} { destroy .t.f } 589 proc bgerror {args} {} 590 destroy .t.f 591 frame .t.f 592 scrollbar .t.f.s -command doit 593 pack .t.f -fill both -expand 1 594 pack .t.f.s -fill y -expand 1 -side right 595 wm geometry .t 100x100 596 .t.f.s set 0 .5 597 update 598 set result [winfo exists .t.f.s] 599 event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5 600 event generate .t <ButtonRelease> -button 1 601 update 602 lappend result [winfo exists .t.f.s] [winfo exists .t.f] 603 rename bgerror {} 604 set result 605} {1 0 0} 606test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} { 607 proc doit {args} { destroy .t.f.s } 608 proc bgerror {args} {} 609 destroy .t.f 610 frame .t.f 611 scrollbar .t.f.s -command doit 612 pack .t.f -fill both -expand 1 613 pack .t.f.s -fill y -expand 1 -side right 614 wm geometry .t 100x100 615 .t.f.s set 0 .5 616 update 617 set result [winfo exists .t.f.s] 618 event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5 619 event generate .t.f <ButtonRelease> -button 1 620 update 621 lappend result [winfo exists .t.f.s] [winfo exists .t.f] 622 rename bgerror {} 623 set result 624} {1 0 1} 625 626set l [interp hidden] 627deleteWindows 628 629test scrollbar-9.1 {scrollbar widget vs hidden commands} { 630 catch {destroy .s} 631 scrollbar .s 632 interp hide {} .s 633 destroy .s 634 list [winfo children .] [interp hidden] 635} [list {} $l] 636 637catch {destroy .s} 638catch {destroy .t} 639 640# cleanup 641cleanupTests 642return 643