Add native aqua elements for ttk::spinbox [Bug 2219588].

Moved most spinbox "business logic" out of ttkEntry.c into Tcl bindings.
Minor spinbox appearance improvements in clam theme.

1 files changed, 90 insertions, 49 deletions

diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test
index a1b8b1f..3397e37 100644
--- a/tests/ttk/spinbox.test
+++ b/tests/ttk/spinbox.test
@@ -2,12 +2,10 @@
 # ttk::spinbox widget tests
 #
 
-package require Tk 8.5
+package require Tk
 package require tcltest ; namespace import -force tcltest::*
 loadTestedCommands
 
-set PI [expr {acos(-1)}]
-
 test spinbox-1.0 "Spinbox tests -- setup" -body {
     ttk::spinbox .sb
 } -cleanup { destroy .sb } -result .sb
@@ -20,22 +18,6 @@ test spinbox-1.1 "Bad -values list" -setup {
     destroy .sb
 } -returnCodes error -result "unmatched open brace in list"
 
-test spinbox-1.2.1 "starts within range" -setup {
-    ttk::spinbox .sb -from 0 -to 100
-} -body {
-    .sb get
-} -cleanup {
-    destroy .sb
-} -result 0
-
-test spinbox-1.2.2 "starts within range" -setup {
-    ttk::spinbox .sb -from 100 -to 110
-} -body {
-    .sb get
-} -cleanup {
-    destroy .sb
-} -result 100
-
 test spinbox-1.3.1 "get retrieves value" -setup {
     ttk::spinbox .sb -from 0 -to 100
 } -body {
@@ -48,6 +30,7 @@ test spinbox-1.3.1 "get retrieves value" -setup {
 test spinbox-1.3.2 "get retrieves value" -setup {
     ttk::spinbox .sb -from 0 -to 100 -values 55
 } -body {
+     .sb set 55
     .sb get
 } -cleanup {
     destroy .sb
@@ -71,23 +54,6 @@ test spinbox-1.4.2 "set changes value" -setup {
     destroy .sb
 } -result 33
 
-test spinbox-1.5.1 "format accounts for -increment" -setup {
-    ttk::spinbox .sb -from 0 -to 10 -increment 0.1
-} -body {
-    ::ttk::spinbox::Change .sb [expr {acos(-1)}] line
-    .sb get
-} -cleanup {
-    destroy .sb
-} -result 3.1
-
-test spinbox-1.5.2 "format accounts for -increment" -setup {
-    ttk::spinbox .sb -from 0 -to 10 -increment 0.1
-} -body {
-    .sb set $PI
-    .sb get
-} -cleanup {
-    destroy .sb
-} -result 3.1
 
 test spinbox-1.6.1 "insert start" -setup {
     ttk::spinbox .sb -from 0 -to 100
@@ -128,20 +94,20 @@ test spinbox-1.7.1 "-command option: set doesnt fire" -setup {
 } -cleanup {
     destroy .sb
 } -result 0
-    
+
 test spinbox-1.7.2 "-command option: button handler will fire" -setup {
     ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1}
 } -body {
     set ::spinbox_test 0
     .sb set 50
-    ::ttk::spinbox::Change .sb [expr {acos(-1)}] line
+    event generate .sb <<Increment>>
     set ::spinbox_test
 } -cleanup {
     destroy .sb
 } -result 1
 
 test spinbox-1.8.1 "option -validate" -setup {
-    ttk::spinbox .sb -from 0 -to 100 
+    ttk::spinbox .sb -from 0 -to 100
 } -body {
     .sb configure -validate all
     .sb cget -validate
@@ -150,7 +116,7 @@ test spinbox-1.8.1 "option -validate" -setup {
 } -result {all}
 
 test spinbox-1.8.2 "option -validate" -setup {
-    ttk::spinbox .sb -from 0 -to 100 
+    ttk::spinbox .sb -from 0 -to 100
 } -body {
     .sb configure -validate key
     .sb configure -validate focus
@@ -163,7 +129,7 @@ test spinbox-1.8.2 "option -validate" -setup {
 } -result {none}
 
 test spinbox-1.8.3 "option -validate" -setup {
-    ttk::spinbox .sb -from 0 -to 100 
+    ttk::spinbox .sb -from 0 -to 100
 } -body {
     .sb configure -validate bogus
 } -cleanup {
@@ -177,23 +143,24 @@ test spinbox-1.8.4 "-validate option: " -setup {
     .sb configure -validate all -validatecommand {lappend ::spinbox_test %P}
     pack .sb
     .sb set 50
-    focus -force .sb
-    update
+    focus .sb
+    after 100 {set ::spinbox_wait 1} ; vwait ::spinbox_wait
     set ::spinbox_test
 } -cleanup {
     destroy .sb
 } -result {50}
-    
 
-test spinbox-2.0 "current command -- unset should be 0" -setup {
+
+test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup {
     ttk::spinbox .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" -setup {
+test spinbox-2.1 "current command -- set index" -constraints nyi -setup {
     ttk::spinbox .sb -values [list a b c d e a]
 } -body {
     .sb current 5
@@ -202,7 +169,7 @@ test spinbox-2.1 "current command -- set index" -setup {
     destroy .sb
 } -result a
 
-test spinbox-2.2 "current command -- change -values" -setup {
+test spinbox-2.2 "current command -- change -values" -constraints nyi -setup {
     ttk::spinbox .sb -values [list a b c d e a]
 } -body {
     .sb current 5
@@ -212,7 +179,7 @@ test spinbox-2.2 "current command -- change -values" -setup {
     destroy .sb
 } -result 2
 
-test spinbox-2.3 "current command -- change value" -setup {
+test spinbox-2.3 "current command -- change value" -constraints nyi -setup {
     ttk::spinbox .sb -values [list c b a d e]
 } -body {
     .sb current 2
@@ -222,7 +189,7 @@ test spinbox-2.3 "current command -- change value" -setup {
     destroy .sb
 } -result 1
 
-test spinbox-2.4 "current command -- value not in list" -setup {
+test spinbox-2.4 "current command -- value not in list" -constraints nyi -setup {
     ttk::spinbox .sb -values [list c b a d e]
 } -body {
     .sb current 2
@@ -232,6 +199,80 @@ test spinbox-2.4 "current command -- value not in list" -setup {
     destroy .sb
 } -result -1
 
+# 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
+    ttk::spinbox .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
+    ttk::spinbox .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
+    ttk::spinbox .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
+    ttk::spinbox .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
+    ttk::spinbox .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]
+    ttk::spinbox .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
+}
+
 tcltest::cleanupTests
 
 # Local variables: