109 lines
3.2 KiB
Plaintext
109 lines
3.2 KiB
Plaintext
package require Tk 8.5
|
|
package require tcltest ; 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
|
|
|
|
#
|
|
# 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
|
|
|