blob: c65bb4a8a1d10b5e0411e390667f86bb423dd2de (
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
|
package require tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands
testConstraint coreScrollbar [expr {[tk windowingsystem] eq "aqua"}]
# Before 2019 the code in library/ttk/scrollbar.tcl would replace the
# constructor of ttk::scrollbar with the constructor of tk::scrollbar
# unless the -class or -style options were specified..
# Now there is an implementation of ttk::scrollbar for macOS. The
# tests are left in place, though, except that scrollbar-swapout-1
# test was changed to expect the class to be TScrollbar instead of
# Scrollbar.
test scrollbar-swapout-1 "Don't use core scrollbars on OSX..." \
-constraints {
coreScrollbar
} -body {
ttk::scrollbar .sb -command "yadda"
list [winfo class .sb] [.sb cget -command]
} -result [list TScrollbar yadda] -cleanup {
destroy .sb
}
test scrollbar-swapout-2 "... regardless of whether -style ..." \
-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 is specified." -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
pack .tsb -side right -anchor e -expand 1 -fill y
wm geometry . 200x200
update
set w [winfo width .tsb] ; set h [winfo height .tsb]
expr {$h > $w}
} -result 1
test scrollbar-1.3 "Change orientation" -body {
.tsb configure -orient horizontal
pack .tsb -side bottom -anchor s -expand 1 -fill x
wm geometry . 200x200
update
set w [winfo width .tsb] ; set h [winfo height .tsb]
expr {$h < $w}
} -result 1
test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -setup {
destroy .t .s
} -body {
pack [text .t -yscrollcommand {.s set}] -side left
for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
update
focus -force .s
event generate .s <MouseWheel> -delta -120
after 200 {set eventprocessed 1} ; vwait eventprocessed
.t index @0,0
} -cleanup {
destroy .t .s
} -result {4.0}
test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -setup {
destroy .t .s
} -body {
pack [text .t -xscrollcommand {.s set} -wrap none] -side top
for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
update
focus -force .s
event generate .s <Shift-MouseWheel> -delta -120
after 200 {set eventprocessed 1} ; vwait eventprocessed
.t index @0,0
} -cleanup {
destroy .t .s
} -result {1.3}
test scrollbar-10.2.2 {<MouseWheel> event on horizontal scrollbar} -setup {
destroy .t .s
} -body {
pack [text .t -xscrollcommand {.s set} -wrap none] -side top
for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
update
focus -force .s
event generate .s <MouseWheel> -delta -120
after 200 {set eventprocessed 1} ; vwait eventprocessed
.t index @0,0
} -cleanup {
destroy .t .s
} -result {1.3}
test scrollbar-11.1 "style command" -body {
ttk::scrollbar .wv ; # default is -orient vertical
ttk::scrollbar .wh -orient horizontal
list [.wv cget -style] [.wv style] [winfo class .wv] \
[.wh cget -style] [.wh style] [winfo class .wh]
} -cleanup {
destroy .wv .wh
} -result {{} Vertical.TScrollbar TScrollbar {} Horizontal.TScrollbar TScrollbar}
test scrollbar-11.2 "style command" -body {
ttk::style configure customStyle.Horizontal.TScrollbar
ttk::scrollbar .w -orient horizontal -style customStyle.Horizontal.TScrollbar
list [.w cget -style] [.w style] [winfo class .w]
} -cleanup {
destroy .w
} -result {customStyle.Horizontal.TScrollbar Horizontal.customStyle.Horizontal.TScrollbar TScrollbar}
tcltest::cleanupTests
|
