blob: 9f9e5f9b97110299b7edd3a0af02001b7f265f23 (
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
package require tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands
test progressbar-1.1 "Setup" -body {
ttk::progressbar .pb
} -result .pb
test progressbar-1.2 "Linked variable" -body {
set PB 50
.pb configure -variable PB
.pb cget -value
} -result 50
test progressbar-1.3 "Change linked variable" -body {
set PB 80
.pb cget -value
} -result 80
test progressbar-1.4 "Set linked variable to bad value" -body {
set PB "bogus"
.pb instate invalid
} -result 1
test progressbar-1.4.1 "Set linked variable back to a good value" -body {
set PB 80
.pb instate invalid
} -result 0
test progressbar-1.5 "Set -variable to illegal variable" -body {
set BAD "bogus"
.pb configure -variable BAD
.pb instate invalid
} -result 1
test progressbar-1.6 "Unset -variable" -body {
unset -nocomplain UNSET
.pb configure -variable UNSET
.pb instate disabled
} -result 1
test progressbar-2.0 "step command" -body {
.pb configure -variable {} ;# @@@
.pb configure -value 5 -maximum 10 -mode determinate
.pb step
.pb cget -value
} -result 6.0
test progressbar-2.1 "step command, with stepamount" -body {
.pb step 3
.pb cget -value
} -result 9.0
test progressbar-2.2 "step wraps at -maximum in determinate mode" -body {
.pb step
.pb cget -value
} -result 0.0
test progressbar-2.3 "step doesn't wrap in indeterminate mode" -body {
.pb configure -value 8 -maximum 10 -mode indeterminate
.pb step
.pb step
.pb step
.pb cget -value
} -result 11.0
test progressbar-2.4 "step with linked variable" -body {
.pb configure -variable PB ;# @@@
set PB 5
.pb step
set PB
} -result 6.0
test progressbar-2.5 "error in write trace" -body {
trace add variable PB write { error "YIPES!" ;# }
.pb step
set PB ;# NOTREACHED
} -cleanup { unset PB } -returnCodes error -match glob -result "*YIPES!"
test progressbar-end "Cleanup" -body {
destroy .pb
}
# check existence and default value of each non-core option of the widget
test progressbar-3.1 "progressbar non-core options" -setup {
set res {}
ttk::progressbar .defaultpb
} -body {
foreach option {-anchor -foreground -justify -style -text -wraplength \
-length -maximum -mode -orient -phase -value -variable} {
lappend res [.defaultpb cget $option]
}
set res
} -cleanup {
unset res
destroy .defaultpb
} -result {w black left {} {} 0 75p 100.0 determinate horizontal 0 0.0 {}}
test progressbar-3.2 "TIP #442 options are taken into account" -setup {
set res {}
pack [ttk::progressbar .p -value 0 -maximum 50 -orient horizontal -mode determinate -length 500]
set thefont [font actual {Arial 10}]
} -body {
.p configure -anchor c -foreground blue -justify right \
-text "TIP #442\noptions are now tested" -wraplength 100
update
.p step 10
.p configure -anchor e -font $thefont -foreground green -justify center \
-text "Changing the value of each option\nfrom TIP #442" -wraplength 250
update
.p step 20
.p configure -orient vertical -text "Cannot be seen"
update
foreach option {-anchor -foreground -justify -text -wraplength} {
lappend res [list $option [.p cget $option]]
}
set res
} -cleanup {
unset res thefont
destroy .p
} -result {{-anchor e} {-foreground green} {-justify center} {-text {Cannot be seen}} {-wraplength 250}}
test progressbar-3.3 {horizontal progressbar height with no -text (TIP #442) specified - Bug [8bee4b2009]} -setup {
set res {}
set oldTheme [ttk::style theme use]
} -body {
ttk::style theme use default
set imga [image create photo -file [file join [file dirname [info script]] pb_image.svg] -format {svg -scale 0.8}]
::ttk::style element create Horizontal.Progressbar.pbar image $imga
# -text "": progressbar height does not depend on font height
pack [ttk::progressbar .p -orient horizontal -font {TkDefaultFont 24}]
.p step 25
update
set res [expr {[winfo reqheight .p] == [image height $imga] + 2}]
# -text "something": progressbar height adjusts to contain the font height
.p configure -text Hello -font {TkDefaultFont 24}
update
lappend res [expr {[winfo reqheight .p] == [font metrics [.p cget -font] -linespace] + 2}]
} -cleanup {
destroy .p
ttk::style theme use $oldTheme
# there's no way I know to undo '::ttk::style element create...'
} -result {1 1}
test progressbar-4.1 "style command" -body {
ttk::progressbar .wh ; # default is -orient horizontal
ttk::progressbar .wv -orient vertical
list [.wh cget -style] [.wh style] [winfo class .wh]\
[.wv cget -style] [.wv style] [winfo class .wv]
} -cleanup {
destroy .wh .wv
} -result {{} Horizontal.TProgressbar TProgressbar {} Vertical.TProgressbar TProgressbar}
test progressbar-4.2 "style command" -body {
ttk::style configure customStyle.Vertical.TProgressbar
ttk::progressbar .w -orient vertical -style customStyle.Vertical.TProgressbar
list [.w cget -style] [.w style] [winfo class .w]
} -cleanup {
destroy .w
} -result {customStyle.Vertical.TProgressbar Vertical.customStyle.Vertical.TProgressbar TProgressbar}
tcltest::cleanupTests
|
