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