#
# ttk::spinbox widget tests
#

package require Tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands

# x11 and win32 need "wm deiconify ." only for a few tests and this is done in
# the individual tests.
# The original tests are from Tk which does not "wm withdraw .", but for some
# reason the tklib test setup does.
# FIXME "x11" (SDL) is untested.
# FIXME aqua is untested.

package require widgetPlus
namespace import ::widgetPlus::ttkSpinboxPlus
testConstraint TkAbove8.6 [expr {[package vsatisfies [package provide Tk] 8.7-]}]

# ------------------------------------------------------------------------------
# This file is copied from Tk trunk (8.7) checkin 127ff912ed,
# file ttk/spinbox.test, with addition of the three lines
# above, application of "s/ttk::spinbox/ttkSpinboxPlus/g" to the code (but not
# to comments, results, test names or other metadata), and further editing of
# failing tests as described below.
#
# The purpose is to check that "ttkSpinboxPlus" does not break any features of
# "ttk::spinbox", including important matters such as validation.
#
# 2 tests require the widgets to be mapped for the tests to pass with
# Tcl/Tk 8.7 (mapping is not required for Tcl 9.0 with Tk 8.7).  The
# corresponding tests in Tk have the same requirement.  The -setup and
# -cleanup sections for these tests have been modified accordingly.
#
# With these revisions, all tests pass.
#
# Adapting the tests for use with Tcl/Tk 8.6.
# 2 tests test new features of Tk 8.7 - these are given the constraint
# TkAbove8.6 which is computed above.
# ------------------------------------------------------------------------------

test spinbox-1.0 "Spinbox tests -- setup" -body {
    ttkSpinboxPlus .sb
} -cleanup { destroy .sb } -result .sb

test spinbox-1.1 "Bad -values list" -setup {
    ttkSpinboxPlus .sb
} -body {
    .sb configure -values "bad \{list"
} -cleanup {
    destroy .sb
} -returnCodes error -result "unmatched open brace in list"

test spinbox-1.3.1 "get retrieves value" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb set 50
    .sb get
} -cleanup {
    destroy .sb
} -result 50

test spinbox-1.3.2 "get retrieves value" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100 -values 55
} -body {
     .sb set 55
    .sb get
} -cleanup {
    destroy .sb
} -result 55

test spinbox-1.4.1 "set changes value" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb set 33
    .sb get
} -cleanup {
    destroy .sb
} -result 33

test spinbox-1.4.2 "set changes value" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100 -values 55
} -body {
    .sb set 33
    .sb get
} -cleanup {
    destroy .sb
} -result 33


test spinbox-1.6.1 "insert start" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb set 5
    .sb insert 0 4
    .sb get
} -cleanup {
    destroy .sb
} -result 45

test spinbox-1.6.2 "insert end" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb set 5
    .sb insert end 4
    .sb get
} -cleanup {
    destroy .sb
} -result 54

test spinbox-1.6.3 "insert invalid index" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb set 5
    .sb insert 100 4
    .sb get
} -cleanup {
    destroy .sb
} -result 54

test spinbox-1.7.1 "-command option: set doesnt fire" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100 -command {set ::spinbox_test 1}
} -body {
    set ::spinbox_test 0
    .sb set 50
    set ::spinbox_test
} -cleanup {
    destroy .sb
} -result 0

test spinbox-1.7.2 "-command option: button handler will fire" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100 -command {set ::spinbox_test 1}
} -body {
    set ::spinbox_test 0
    .sb set 50
    event generate .sb <<Increment>>
    set ::spinbox_test
} -cleanup {
    destroy .sb
} -result 1

test spinbox-1.8.1 "option -validate" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb configure -validate all
    .sb cget -validate
} -cleanup {
    destroy .sb
} -result {all}

test spinbox-1.8.2 "option -validate" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb configure -validate key
    .sb configure -validate focus
    .sb configure -validate focusin
    .sb configure -validate focusout
    .sb configure -validate none
    .sb cget -validate
} -cleanup {
    destroy .sb
} -result none

test spinbox-1.8.3 "option -validate" -setup {
    ttkSpinboxPlus .sb -from 0 -to 100
} -body {
    .sb configure -validate bogus
} -cleanup {
    destroy .sb
} -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}

test spinbox-1.8.4 "-validate option: " -setup {
    set st [wm state .]
    wm deiconify .
    ttkSpinboxPlus .sb -from 0 -to 100
    set ::spinbox_test {}
} -body {
    .sb configure -validate all -validatecommand {set ::spinbox_test %P}
    pack .sb
    update idletasks
    .sb set 50
    focus -force .sb
    set ::spinbox_wait 0
    set timer [after 100 {set ::spinbox_wait 1}]
    vwait ::spinbox_wait
    after cancel $timer
    set ::spinbox_test
} -cleanup {
    destroy .sb
    wm state . $st
    unset st
} -result 50


test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup {
    ttkSpinboxPlus .sb -values [list a b c d e a]
} -body {
    .sb current
} -cleanup {
    destroy .sb
} -result 0
# @@@ for combobox, this is -1.

test spinbox-2.1 "current command -- set index" -constraints nyi -setup {
    ttkSpinboxPlus .sb -values [list a b c d e a]
} -body {
    .sb current 5
    .sb get
} -cleanup {
    destroy .sb
} -result a

test spinbox-2.2 "current command -- change -values" -constraints nyi -setup {
    ttkSpinboxPlus .sb -values [list a b c d e a]
} -body {
    .sb current 5
    .sb configure -values [list c b a d e]
    .sb current
} -cleanup {
    destroy .sb
} -result 2

test spinbox-2.3 "current command -- change value" -constraints nyi -setup {
    ttkSpinboxPlus .sb -values [list c b a d e]
} -body {
    .sb current 2
    .sb set "b"
    .sb current
} -cleanup {
    destroy .sb
} -result 1

test spinbox-2.4 "current command -- value not in list" -constraints nyi -setup {
    ttkSpinboxPlus .sb -values [list c b a d e]
} -body {
    .sb current 2
    .sb set "z"
    .sb current
} -cleanup {
    destroy .sb
} -result -1

test spinbox-3.0 "textarea should expand to fill widget" -setup {
    set st [wm state .]
    wm deiconify .
    set SBV 5
    set ::spinbox_test {}
    ttkSpinboxPlus .sb -from 0 -to 10 -textvariable SBV
} -body {
    grid columnconfigure . 0 -weight 1
    update idletasks
    set timer [after 500 {set ::spinbox_test timedout}]
    bind . <Map> {
        after idle {
            wm geometry . "210x80"
	    update idletasks
            set ::spinbox_test [.sb identify element 25 5]
        }
        bind . <Map> {}
    }
    grid .sb -sticky ew
    vwait ::spinbox_test
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test SBV
    wm state . $st
    unset st
} -result {textarea}

test spinbox-4.0 "Increment with duplicates in -values, wrap" -setup {
    ttkSpinboxPlus .sb -values {one two three 4 5 two six} -wrap true
    set max [expr {[llength [.sb cget -values]] + 2}]
} -body {
    set ::spinbox_test [.sb get]
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Increment>>
        lappend ::spinbox_test [.sb get]
    }
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Decrement>>
        lappend ::spinbox_test [.sb get]
    }
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test max
} -result {one two three 4 5 two six one two one six two 5 4 three two one six}

test spinbox-4.1 "Increment with duplicates in -values, wrap, initial value set" -setup {
    ttkSpinboxPlus .sb -values {one two three 4 5 two six} -wrap true
    set max [expr {[llength [.sb cget -values]] + 2}]
} -body {
    .sb set three
    set ::spinbox_test [.sb get]
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Increment>>
        lappend ::spinbox_test [.sb get]
    }
    .sb set two    ; # the first "two" in the -values list becomes the current value
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Decrement>>
        lappend ::spinbox_test [.sb get]
    }
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test max
} -result {three 4 5 two six one two three 4 5 one six two 5 4 three two one six}

test spinbox-4.2 "Increment with duplicates in -values, no wrap" -setup {
    ttkSpinboxPlus .sb -values {one two three 4 5 two six} -wrap false
    set max [expr {[llength [.sb cget -values]] + 2}]
} -body {
    set ::spinbox_test [.sb get]
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Increment>>
        lappend ::spinbox_test [.sb get]
    }
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Decrement>>
        lappend ::spinbox_test [.sb get]
    }
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test max
} -result {one two three 4 5 two six six six two 5 4 three two one one one one}


# nostomp: NB intentional difference between ttk::spinbox and tk::spinbox;
# see also #1439266
#
test spinbox-nostomp-1 "don't stomp on -variable (init; -from/to)" -body {
    set SBV 55
    ttkSpinboxPlus .sb -textvariable SBV -from 0 -to 100 -increment 5
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list 55 55]

test spinbox-nostomp-2 "don't stomp on -variable (init; -values)" -body {
    set SBV Apr
    ttkSpinboxPlus .sb -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug}
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list Apr Apr]

test spinbox-nostomp-3 "don't stomp on -variable (configure; -from/to)" -body {
    set SBV 55
    ttkSpinboxPlus .sb
    .sb configure -textvariable SBV -from 0 -to 100 -increment 5
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list 55 55]

test spinbox-nostomp-4 "don't stomp on -variable (configure; -values)" -body {
    set SBV Apr
    ttkSpinboxPlus .sb
    .sb configure -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug}
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list Apr Apr]

test spinbox-dieoctaldie-1 "Cope with leading zeros" -body {
    # See SF#2358545 -- ttk::spinbox also affected
    set secs 07
    ttkSpinboxPlus .sb -from 0 -to 59 -format %02.0f -textvariable secs

    set result [list $secs]
    event generate .sb <<Increment>>; lappend result $secs
    event generate .sb <<Increment>>; lappend result $secs
    event generate .sb <<Increment>>; lappend result $secs
    event generate .sb <<Increment>>; lappend result $secs

    event generate .sb <<Decrement>>; lappend result $secs
    event generate .sb <<Decrement>>; lappend result $secs
    event generate .sb <<Decrement>>; lappend result $secs
    event generate .sb <<Decrement>>; lappend result $secs

    set result
} -result [list 07 08 09 10 11 10 09 08 07] -cleanup {
    destroy .sb
    unset secs
}

test spinbox-dieoctaldie-2 "Cope with general bad input" -body {
    set result [list]
    ttkSpinboxPlus .sb -from 0 -to 100 -format %03.0f
    .sb set asdfasdf ; lappend result [.sb get]
    event generate .sb <<Increment>> ; lappend result [.sb get]
    .sb set asdfasdf ; lappend result [.sb get]
    event generate .sb <<Decrement>> ; lappend result [.sb get]
} -result [list asdfasdf 000 asdfasdf 000] -cleanup {
    destroy .sb
}

test spinbox-5.1 "style command" -constraints {TkAbove8.6} -body {
    ttkSpinboxPlus .w
    list [.w cget -style] [.w style] [winfo class .w]
} -cleanup {
    destroy .w
} -result {{} TSpinbox TSpinbox}
test spinbox-5.2 "style command" -constraints {TkAbove8.6} -body {
    ttk::style configure customStyle.TSpinbox
    ttkSpinboxPlus .w -style customStyle.TSpinbox
    list [.w cget -style] [.w style] [winfo class .w]
} -cleanup {
    destroy .w
} -result {customStyle.TSpinbox customStyle.TSpinbox TSpinbox}

tcltest::cleanupTests

# Local variables:
# mode: tcl
# End: