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

test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -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 {5.0}
test scrollbar-10.1.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -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 -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {5.0}

test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -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.4}
test scrollbar-10.2.2 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {aqua} -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 -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}
test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -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.4}
test scrollbar-10.2.4 {<MouseWheel> event on horizontal scrollbar} -constraints {aqua} -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 -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}

#
# 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