blob: 341b5c187982ec34ddaf926ad6b71b0170ffb89c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
package require Tk 8.5
package require tcltest ; namespace import -force tcltest::*
loadTestedCommands
testConstraint coreScrollbar [expr {[tk windowingsystem] eq "aqua"}]
test scrollbar-swapout-1 "Use core scrollbars on OSX..." -constraints {
coreScrollbar
} -body {
ttk::scrollbar .sb -command "yadda"
list [winfo class .sb] [.sb cget -command]
} -result [list Scrollbar yadda] -cleanup {
destroy .sb
}
test scrollbar-swapout-2 "... unless -style is specified ..." -constraints {
coreScrollbar
} -body {
ttk::style layout Vertical.Custom.TScrollbar \
[ttk::style layout Vertical.TScrollbar] ; # See #1833339
ttk::scrollbar .sb -command "yadda" -style Custom.TScrollbar
list [winfo class .sb] [.sb cget -command] [.sb cget -style]
} -result [list TScrollbar yadda Custom.TScrollbar] -cleanup {
destroy .sb
}
test scrollbar-swapout-3 "... or -class." -constraints {
coreScrollbar
} -body {
ttk::scrollbar .sb -command "yadda" -class Custom.TScrollbar
list [winfo class .sb] [.sb cget -command]
} -result [list Custom.TScrollbar yadda] -cleanup {
destroy .sb
}
test scrollbar-1.0 "Setup" -body {
ttk::scrollbar .tsb
} -result .tsb
test scrollbar-1.1 "Set method" -body {
.tsb set 0.2 0.4
.tsb get
} -result [list 0.2 0.4]
test scrollbar-1.2 "Set orientation" -body {
.tsb configure -orient vertical
set w [winfo reqwidth .tsb] ; set h [winfo reqheight .tsb]
expr {$h > $w}
} -result 1
test scrollbar-1.3 "Change orientation" -body {
.tsb configure -orient horizontal
set w [winfo reqwidth .tsb] ; set h [winfo reqheight .tsb]
expr {$h < $w}
} -result 1
#
# Scale tests:
#
test scale-1.0 "Self-destruction" -body {
trace variable v w { destroy .s ;# }
ttk::scale .s -variable v
pack .s ; update
.s set 1 ; update
} -returnCodes 1 -match glob -result "*"
test scale-2.1 "-state option" -setup {
ttk::scale .s
set res ""
} -body {
# defaults
lappend res [.s instate disabled] [.s cget -state]
# set -state: instate returns accordingly
.s configure -state disabled
lappend res [.s instate disabled] [.s cget -state]
# back to normal
.s configure -state normal
lappend res [.s instate disabled] [.s cget -state]
# use state command: -state does NOT reflect it
.s state disabled
lappend res [.s instate disabled] [.s cget -state]
# further use state command
.s state readonly
lappend res [.s state] [.s cget -state]
} -cleanup {
destroy .s
unset -nocomplain res
} -result {0 normal 1 disabled 0 normal 1 normal {disabled readonly} normal}
tcltest::cleanupTests
|
