OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [scrollbar.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# 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 
#
8 
# See the file "license.terms" for information on usage and redistribution
9 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 
#
11 
# RCS: @(#) $Id: scrollbar.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
12 
 
13 
if {[info procs test] != "test"} {
14 
    source defs
15 
}
16 
 
17 
foreach i [winfo children .] {
18 
    destroy $i
19 
}
20 
wm geometry . {}
21 
raise .
22 
update
23 
 
24 
proc scroll args {
25 
    global scrollInfo
26 
    set scrollInfo $args
27 
}
28 
 
29 
proc getTroughSize {w} {
30 
    global tcl_platform
31 
    if {$tcl_platform(platform) == "windows"} {
32 
        if [string match v* [$w cget -orient]] {
33 
            return [expr [winfo height $w] - 2*[testmetrics cyvscroll]]
34 
        } else {
35 
            return [expr [winfo width $w] - 2*[testmetrics cxhscroll]]
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 
 
56 
foreach {width height} [wm minsize .] {
57 
    set height [expr ($height < 200) ? 200 : $height]
58 
    set width [expr ($width < 1) ? 1 : $width]
59 
}
60 
 
61 
frame .f -height $height -width $width
62 
pack .f -side left
63 
scrollbar .s
64 
pack .s -side right -fill y
65 
update
66 
set i 1
67 
foreach 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 
    {-trough #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 
 
111 
destroy .s
112 
test scrollbar-2.1 {Tk_ScrollbarCmd procedure} {
113 
    list [catch {scrollbar} msg] $msg
114 
} {1 {wrong # args: should be "scrollbar pathName ?options?"}}
115 
test scrollbar-2.2 {Tk_ScrollbarCmd procedure} {
116 
    list [catch {scrollbar gorp} msg] $msg
117 
} {1 {bad window path name "gorp"}}
118 
test 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}
124 
test 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 {}}
128 
test scrollbar-2.5 {Tk_ScrollbarCmd procedure} {
129 
    set x [scrollbar .s]
130 
    destroy .s
131 
    set x
132 
} {.s}
133 
 
134 
scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2
135 
pack .s -side right -fill y
136 
update
137 
test scrollbar-3.1 {ScrollbarWidgetCmd procedure} {
138 
    list [catch {.s} msg] $msg
139 
} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
140 
test scrollbar-3.2 {ScrollbarWidgetCmd procedure, "cget" option} {
141 
    list [catch {.s cget} msg] $msg
142 
} {1 {wrong # args: should be ".s cget option"}}
143 
test scrollbar-3.3 {ScrollbarWidgetCmd procedure, "cget" option} {
144 
    list [catch {.s cget -gorp} msg] $msg
145 
} {1 {unknown option "-gorp"}}
146 
test 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"}}
149 
test scrollbar-3.5 {ScrollbarWidgetCmd procedure, "activate" option} {
150 
    .s activate arrow1
151 
    .s activate
152 
} {arrow1}
153 
test scrollbar-3.6 {ScrollbarWidgetCmd procedure, "activate" option} {
154 
    .s activate slider
155 
    .s activate
156 
} {slider}
157 
test scrollbar-3.7 {ScrollbarWidgetCmd procedure, "activate" option} {
158 
    .s activate arrow2
159 
    .s activate
160 
} {arrow2}
161 
test scrollbar-3.8 {ScrollbarWidgetCmd procedure, "activate" option} {
162 
    .s activate s
163 
    .s activate {}
164 
    .s activate
165 
} {}
166 
test scrollbar-3.9 {ScrollbarWidgetCmd procedure, "activate" option} {
167 
    list [catch {.s activate trough1} msg] $msg
168 
} {0 {}}
169 
test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
170 
    list [catch {.s cget -orient} msg] $msg
171 
} {0 vertical}
172 
scrollbar .s2
173 
test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
174 
    list [catch {.s2 cget -bd} msg] $msg
175 
} {0 0}
176 
test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
177 
    list [catch {.s2 cget -bd} msg] $msg
178 
} {0 2}
179 
test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
180 
    list [catch {.s2 cget -highlightthickness} msg] $msg
181 
} {0 0}
182 
test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
183 
    list [catch {.s2 cget -highlightthickness} msg] $msg
184 
} {0 1}
185 
destroy .s2
186 
test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
187 
    llength [.s configure]
188 
} {20}
189 
test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} {
190 
    list [catch {.s configure -bad} msg] $msg
191 
} {1 {unknown option "-bad"}}
192 
test scrollbar-3.17 {ScrollbarWidgetCmd procedure, "configure" option} {
193 
    .s configure -orient
194 
} {-orient orient Orient vertical vertical}
195 
test 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}
201 
test scrollbar-3.19 {ScrollbarWidgetCmd procedure, "configure" option} {
202 
    list [catch {.s configure -bad worse} msg] $msg
203 
} {1 {unknown option "-bad"}}
204 
test 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"}}
207 
test 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"}}
210 
test scrollbar-3.22 {ScrollbarWidgetCmd procedure, "delta" option} {
211 
    list [catch {.s delta silly 24} msg] $msg
212 
} {1 {expected integer but got "silly"}}
213 
test scrollbar-3.23 {ScrollbarWidgetCmd procedure, "delta" option} {
214 
    list [catch {.s delta 18 xxyz} msg] $msg
215 
} {1 {expected integer but got "xxyz"}}
216 
test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} {
217 
    list [catch {.s delta 18 xxyz} msg] $msg
218 
} {1 {expected integer but got "xxyz"}}
219 
test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} {
220 
    .s delta 20 0
221 
} {0}
222 
test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} {
223 
    .s delta 0 20
224 
} [format %.6g [expr 20.0/([getTroughSize .s]-1)]]
225 
test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} {
226 
    .s delta 0 -20
227 
} [format %.6g [expr -20.0/([getTroughSize .s]-1)]]
228 
test 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}
239 
test 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"}}
242 
test 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"}}
245 
test scrollbar-3.31 {ScrollbarWidgetCmd procedure, "fraction" option} {
246 
    list [catch {.s fraction silly 24} msg] $msg
247 
} {1 {expected integer but got "silly"}}
248 
test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} {
249 
    list [catch {.s fraction 24 bogus} msg] $msg
250 
} {1 {expected integer but got "bogus"}}
251 
test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} {
252 
    .s fraction 0 0
253 
} {0}
254 
test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} {
255 
    .s fraction 0 1000
256 
} {1}
257 
test 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)]]
261 
test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
262 
    .s fraction 4 179
263 
} {1}
264 
test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {macOrPc} {
265 
    .s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]
266 
} {1}
267 
test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
268 
    .s fraction 4 178
269 
} {0.993711}
270 
test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {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
275 
test scrollbar-3.40 {ScrollbarWidgetCmd procedure, "fraction" option} {macOnly} {
276 
    .s fraction 4 178
277 
} {0.97006}
278 
 
279 
toplevel .t -width 250 -height 100
280 
wm geom .t +0+0
281 
scrollbar .t.s -orient horizontal -borderwidth 2
282 
place .t.s -width 201
283 
update
284 
 
285 
test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} {
286 
    .t.s fraction 100 0
287 
} {0.5}
288 
if {$tcl_platform(platform) == "windows"} {
289 
    place configure .t.s -width [expr 2*[testmetrics cxhscroll]+1]
290 
} else {
291 
    place configure .t.s -width [expr [winfo reqwidth .t.s] - 4]
292 
}
293 
update
294 
test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} {
295 
    .t.s fraction 100 0
296 
} {0}
297 
destroy .t
298 
test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} {
299 
    list [catch {.s get a} msg] $msg
300 
} {1 {wrong # args: should be ".s get"}}
301 
test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} {
302 
    .s set 100 10 13 14
303 
    .s get
304 
} {100 10 13 14}
305 
test 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}
313 
test 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"}}
316 
test 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"}}
319 
test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} {
320 
    list [catch {.s identify bogus 2} msg] $msg
321 
} {1 {expected integer but got "bogus"}}
322 
test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} {
323 
    list [catch {.s identify -1 bogus} msg] $msg
324 
} {1 {expected integer but got "bogus"}}
325 
test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} {
326 
    .s identify 5 5
327 
} {arrow1}
328 
test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} {
329 
    .s identify 5 35
330 
} {trough1}
331 
test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} {
332 
    .s set .3 .6
333 
    .s identify 5 80
334 
} {slider}
335 
test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} {
336 
    .s identify 5 145
337 
} {trough2}
338 
test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} {
339 
    .s identify 5 195
340 
} {arrow2}
341 
test scrollbar-3.55 {ScrollbarWidgetCmd procedure, "identify" option} {macOnly} {
342 
    .s identify 5 195
343 
} {}
344 
test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} {unixOnly} {
345 
    .s identify 0 0
346 
} {}
347 
test 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"}}
350 
test 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"}}
353 
test 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}
361 
test scrollbar-3.60 {ScrollbarWidgetCmd procedure, "set" option} {
362 
    .s set 1.1 .4
363 
    .s get
364 
} {1.0 1.0}
365 
test scrollbar-3.61 {ScrollbarWidgetCmd procedure, "set" option} {
366 
    .s set .5 -.3
367 
    .s get
368 
} {0.5 0.5}
369 
test scrollbar-3.62 {ScrollbarWidgetCmd procedure, "set" option} {
370 
    .s set .5 87
371 
    .s get
372 
} {0.5 1.0}
373 
test 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}
381 
test 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"}}
384 
test 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"}}
387 
test 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"}}
390 
test 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"}}
393 
test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} {
394 
    .s set -10 50 20 30
395 
    .s get
396 
} {0 50 0 0}
397 
test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} {
398 
    .s set 100 -10 20 30
399 
    .s get
400 
} {100 0 20 30}
401 
test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} {
402 
    .s set 100 50 30 20
403 
    .s get
404 
} {100 50 30 30}
405 
test 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"}}
408 
test 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"}}
411 
test 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}}
414 
test 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 
 
418 
test 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 
 
429 
test 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 
 
436 
catch {destroy .s}
437 
scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2
438 
pack .s -side left -fill y
439 
.s set .2 .4
440 
update
441 
test scrollbar-6.1 {ScrollbarPosition procedure} {unixOnly} {
442 
    .s identify 8 3
443 
} {}
444 
test scrollbar-6.2 {ScrollbarPosition procedure} {macOnly} {
445 
    .s identify 8 3
446 
} {arrow1}
447 
test scrollbar-6.3 {ScrollbarPosition procedure} {macOrUnix} {
448 
    .s identify 8 196
449 
} {}
450 
test scrollbar-6.4 {ScrollbarPosition procedure} {unixOnly} {
451 
    .s identify 3 100
452 
} {}
453 
test scrollbar-6.5 {ScrollbarPosition procedure} {macOnly} {
454 
    .s identify 3 100
455 
} {trough2}
456 
test scrollbar-6.6 {ScrollbarPosition procedure} {macOrUnix} {
457 
    .s identify 19 100
458 
} {}
459 
test scrollbar-6.7 {ScrollbarPosition procedure} {
460 
    .s identify [expr [winfo width .s] / 2] -1
461 
} {}
462 
test scrollbar-6.8 {ScrollbarPosition procedure} {
463 
    .s identify [expr [winfo width .s] / 2] [expr [winfo height .s]]
464 
} {}
465 
test scrollbar-6.9 {ScrollbarPosition procedure} {
466 
    .s identify -1 [expr [winfo height .s] / 2]
467 
} {}
468 
test scrollbar-6.10 {ScrollbarPosition procedure} {
469 
    .s identify [winfo width .s] [expr [winfo height .s] / 2]
470 
} {}
471 
 
472 
test scrollbar-6.11 {ScrollbarPosition procedure} {macOrUnix} {
473 
    .s identify 8 4
474 
} {arrow1}
475 
test scrollbar-6.12 {ScrollbarPosition procedure} {unixOnly} {
476 
    .s identify 8 19
477 
} {arrow1}
478 
test scrollbar-6.13 {ScrollbarPosition procedure} {macOnly} {
479 
    .s identify 8 19
480 
} {trough1}
481 
test scrollbar-6.14 {ScrollbarPosition procedure} {pcOnly} {
482 
    .s identify [expr [winfo width .s] / 2] 0
483 
} {arrow1}
484 
test scrollbar-6.15 {ScrollbarPosition procedure} {pcOnly} {
485 
    .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll] - 1]
486 
} {arrow1}
487 
 
488 
test scrollbar-6.16 {ScrollbarPosition procedure} {macOrUnix} {
489 
    .s identify 8 20
490 
} {trough1}
491 
test 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}
496 
test scrollbar-6.18 {ScrollbarPosition procedure} {pcOnly} {
497 
    .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll]
498 
} {trough1}
499 
test scrollbar-6.19 {ScrollbarPosition procedure} {pcOnly} {
500 
    .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \
501 
                                                + [testmetrics cyvscroll] - 1]
502 
} {trough1}
503 
 
504 
test scrollbar-6.20 {ScrollbarPosition procedure} {macOrUnix} {
505 
    .s identify 8 52
506 
} {slider}
507 
test 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}
512 
test scrollbar-6.22 {ScrollbarPosition procedure} {pcOnly} {
513 
    .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \
514 
                                                + [testmetrics cyvscroll]]
515 
} {slider}
516 
test scrollbar-6.23 {ScrollbarPosition procedure} {pcOnly} {
517 
    .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \
518 
                                                 + [testmetrics cyvscroll] - 1]
519 
} {slider}
520 
 
521 
test scrollbar-6.24 {ScrollbarPosition procedure} {macOrUnix} {
522 
    .s identify 8 84
523 
} {trough2}
524 
test scrollbar-6.25 {ScrollbarPosition procedure} {unixOnly} {
525 
    .s identify 8 179
526 
} {trough2}
527 
test scrollbar-6.26 {ScrollbarPosition procedure} {macOnly} {
528 
    .s identify 8 179
529 
} {arrow2}
530 
test scrollbar-6.27 {ScrollbarPosition procedure} {pcOnly} {
531 
    .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \
532 
                                                 + [testmetrics cyvscroll]]
533 
} {trough2}
534 
test scrollbar-6.28 {ScrollbarPosition procedure} {pcOnly} {
535 
    .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \
536 
                                                 - [testmetrics cyvscroll] - 1]
537 
} {trough2}
538 
 
539 
test scrollbar-6.29 {ScrollbarPosition procedure} {macOrUnix} {
540 
    .s identify 8 180
541 
} {arrow2}
542 
test scrollbar-6.30 {ScrollbarPosition procedure} {unixOnly} {
543 
    .s identify 8 195
544 
} {arrow2}
545 
test scrollbar-6.31 {ScrollbarPosition procedure} {macOnly} {
546 
    .s identify 8 195
547 
} {}
548 
test scrollbar-6.32 {ScrollbarPosition procedure} {pcOnly} {
549 
    .s identify [expr [winfo width .s] / 2]  [expr [winfo height .s] \
550 
                                                  - [testmetrics cyvscroll]]
551 
} {arrow2}
552 
test scrollbar-6.33 {ScrollbarPosition procedure} {pcOnly} {
553 
    .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1]
554 
} {arrow2}
555 
 
556 
test scrollbar-6.34 {ScrollbarPosition procedure} {macOrUnix} {
557 
    .s identify 4 100
558 
} {trough2}
559 
test scrollbar-6.35 {ScrollbarPosition procedure} {unixOnly} {
560 
    .s identify 18 100
561 
} {trough2}
562 
test scrollbar-6.36 {ScrollbarPosition procedure} {macOnly} {
563 
    .s identify 18 100
564 
} {}
565 
test scrollbar-6.37 {ScrollbarPosition procedure} {pcOnly} {
566 
    .s identify 0 100
567 
} {trough2}
568 
test scrollbar-6.38 {ScrollbarPosition procedure} {pcOnly} {
569 
    .s identify [expr [winfo width .s] - 1] 100
570 
} {trough2}
571 
 
572 
catch {destroy .t}
573 
toplevel .t -width 250 -height 150
574 
wm geometry .t +0+0
575 
scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2
576 
place .t.s -width 200
577 
.t.s set .2 .4
578 
update
579 
test scrollbar-6.39 {ScrollbarPosition procedure} {macOrUnix} {
580 
    .t.s identify 4 8
581 
} {arrow1}
582 
test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} {
583 
    .t.s identify 0 [expr [winfo height .t.s] / 2]
584 
} {arrow1}
585 
test scrollbar-6.41 {ScrollbarPosition procedure} {unixOnly} {
586 
    .t.s identify 82 8
587 
} {slider}
588 
test scrollbar-6.42 {ScrollbarPosition procedure} {macOnly} {
589 
    .t.s identify 82 8
590 
} {}
591 
test scrollbar-6.43 {ScrollbarPosition procedure} {pcOnly} {
592 
    .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll] \
593 
                       - 1] [expr [winfo height .t.s] / 2]
594 
} {slider}
595 
test scrollbar-6.44 {ScrollbarPosition procedure} {unixOnly} {
596 
    .t.s identify 100 18
597 
} {trough2}
598 
test scrollbar-6.45 {ScrollbarPosition procedure} {macOnly} {
599 
    .t.s identify 100 18
600 
} {}
601 
test scrollbar-6.46 {ScrollbarPosition procedure} {pcOnly} {
602 
    .t.s identify 100 [expr [winfo height .t.s] - 1]
603 
} {trough2}
604 
 
605 
test scrollbar-7.1 {EventuallyRedraw} {
606 
    .s configure -orient horizontal
607 
    update
608 
    set result [.s cget -orient]
609 
    .s configure -orient vertical
610 
    update
611 
    lappend result [.s cget -orient]
612 
} {horizontal vertical}
613 
 
614 
catch {destroy .t}
615 
toplevel .t
616 
wm geometry .t +0+0
617 
test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} {
618 
    proc doit {args} { destroy .t.f }
619 
    proc bgerror {args} {}
620 
    frame .t.f
621 
    scrollbar .t.f.s -command doit
622 
    pack .t.f -fill both -expand 1
623 
    pack .t.f.s -fill y -expand 1 -side right
624 
    wm geometry .t 100x100
625 
    .t.f.s set 0 .5
626 
    update
627 
    set result [winfo exists .t.f.s]
628 
    event generate .t.f.s  -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
629 
    update
630 
    lappend result [winfo exists .t.f.s] [winfo exists .t.f]
631 
    rename bgerror {}
632 
    set result
633 
} {1 0 0}
634 
test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} {
635 
    proc doit {args} { destroy .t.f.s }
636 
    proc bgerror {args} {}
637 
    frame .t.f
638 
    scrollbar .t.f.s -command doit
639 
    pack .t.f -fill both -expand 1
640 
    pack .t.f.s -fill y -expand 1 -side right
641 
    wm geometry .t 100x100
642 
    .t.f.s set 0 .5
643 
    update
644 
    set result [winfo exists .t.f.s]
645 
    event generate .t.f.s  -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
646 
    update
647 
    lappend result [winfo exists .t.f.s] [winfo exists .t.f]
648 
    rename bgerror {}
649 
    set result
650 
} {1 0 1}
651 
 
652 
set l [interp hidden]
653 
eval destroy [winfo children .]
654 
 
655 
test scrollbar-9.1 {scrollbar widget vs hidden commands} {
656 
    catch {destroy .s}
657 
    scrollbar .s
658 
    interp hide {} .s
659 
    destroy .s
660 
    list [winfo children .] [interp hidden]
661 
} [list {} $l]
662 
 
663 
catch {destroy .s}
664 
catch {destroy .t}
665 
concat {}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.