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