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