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.

2 files changed, 111 insertions, 91 deletions

diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl
index 1a07e3a..808c8a4 100644
--- a/library/ttk/clamTheme.tcl
+++ b/library/ttk/clamTheme.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: clamTheme.tcl,v 1.9 2008/11/29 00:43:48 patthoyts Exp $
+# $Id: clamTheme.tcl,v 1.10 2008/12/07 18:42:55 jenglish Exp $
 #
 # "Clam" theme.
 #
@@ -111,9 +111,6 @@ namespace eval ttk::theme::clam {
 	ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
 	ttk::style map TSpinbox \
 	    -background [list  readonly $colors(-frame)] \
-	    -bordercolor [list  focus $colors(-selectbg)] \
-	    -lightcolor [list  focus "#6f9dc6"] \
-	    -darkcolor [list  focus "#6f9dc6"] \
             -arrowcolor [list disabled $colors(-disabledfg)]
 
 	ttk::style configure TNotebook.Tab -padding {6 2 6 2}
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
index 579a22c..9464b07 100644
--- a/library/ttk/spinbox.tcl
+++ b/library/ttk/spinbox.tcl
@@ -1,16 +1,10 @@
 #
-# $Id: spinbox.tcl,v 1.1 2008/11/01 15:34:24 patthoyts Exp $
+# $Id: spinbox.tcl,v 1.2 2008/12/07 18:42:55 jenglish Exp $
 #
-# Tile widget set: spinbox bindings.
+# ttk::spinbox bindings
 #
-#
-
-namespace eval ttk::spinbox {
-    variable Values	;# Values($cb) is -listvariable of listbox widget
 
-    variable State
-    set State(entryPress) 0
-}
+namespace eval ttk::spinbox { }
 
 ### Spinbox bindings.
 #
@@ -19,103 +13,132 @@ namespace eval ttk::spinbox {
 
 ttk::copyBindings TEntry TSpinbox
 
-bind TSpinbox <Double-Button-1> {ttk::spinbox::Select %W %x %y word}
-bind TSpinbox <Triple-Button-1> {ttk::spinbox::Select %W %x %y line}
+bind TSpinbox <Motion>			{ ttk::spinbox::Motion %W %x %y }
+bind TSpinbox <ButtonPress-1> 		{ ttk::spinbox::Press %W %x %y }
+bind TSpinbox <ButtonRelease-1> 	{ ttk::spinbox::Release %W }
+bind TSpinbox <Double-Button-1> 	{ ttk::spinbox::DoubleClick %W %x %y }
+bind TSpinbox <Triple-Button-1> 	{} ;# disable TEntry triple-click
+
+bind TSpinbox <KeyPress-Up>		{ ttk::spinbox::Spin %W +1 }
+bind TSpinbox <KeyPress-Down> 		{ ttk::spinbox::Spin %W -1 }
 
-bind TSpinbox <ButtonPress-1> { ttk::spinbox::Press %W %x %y }
-bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W %x %y }
-bind TSpinbox <MouseWheel> {ttk::spinbox::Change %W [expr {%D/-120}] line}
-bind TSpinbox <Up> {ttk::spinbox::Change %W +[%W cget -increment] line}
-bind TSpinbox <Down> {ttk::spinbox::Change %W -[%W cget -increment] line}
+bind TSpinbox <<Increment>>		{ ttk::spinbox::Spin %W +1 }
+bind TSpinbox <<Decrement>> 		{ ttk::spinbox::Spin %W -1 }
 
 
+# @@@ x-plat
+bind TSpinbox <MouseWheel> { ttk::spinbox::Spin %W [expr {%D/-120}] }
+
+## Motion --
+#	Sets cursor.
+#
+proc ttk::spinbox::Motion {w x y} {
+    if {   [$w identify $x $y] eq "textarea"
+        && [$w instate {!readonly !disabled}] 
+    } {
+	ttk::setCursor $w text
+    } else {
+	ttk::setCursor $w ""
+    }
+}
+
+## Press --
+#
 proc ttk::spinbox::Press {w x y} {
     if {[$w instate disabled]} { return }
-    variable State
-    set State(xPress) $x
-    set State(yPress) $y
     focus $w
     switch -glob -- [$w identify $x $y] {
-        *uparrow {
-            ttk::Repeatedly Change $w +[$w cget -increment] line
-        }
-        *downarrow {
-            ttk::Repeatedly Change $w -[$w cget -increment] line
-        }
-        *textarea {
-            set State(entryPress) [$w instate !readonly]
-            if {$State(entryPress)} {
-                ttk::entry::Press $w $x
-            }
-        }
+        *textarea	{ ttk::entry::Press $w $x }
+	*rightarrow	-
+        *uparrow 	{ ttk::Repeatedly event generate $w <<Increment>> }
+	*leftarrow	-
+        *downarrow	{ ttk::Repeatedly event generate $w <<Decrement>> }
+	*spinbutton { 
+	    if {$y * 2 >= [winfo height $w]} {
+	    	set event <<Decrement>>
+	    } else {
+	    	set event <<Increment>>
+	    }
+	    ttk::Repeatedly event generate $w $event
+	}
     }
 }
 
-proc ttk::spinbox::Release {w x y} {
-    variable State
-    unset -nocomplain State(xPress) State(yPress)
+## DoubleClick -- 
+#	Select all if over the text area; otherwise same as Press.
+#
+proc ttk::spinbox::DoubleClick {w x y} {
+    if {[$w instate disabled]} { return }
+
+    switch -glob -- [$w identify $x $y] {
+        *textarea	{ SelectAll $w }
+	*		{ Press $w $x $y }
+    }
+}
+
+proc ttk::spinbox::Release {w} {
     ttk::CancelRepeat
 }
 
-proc ttk::spinbox::Change {w n units} {
-    if {[set vlen [llength [$w cget -values]]] != 0} {
-        set index [expr {[$w current] + $n}]
-        if {[catch {$w current $index}]} {
-            if {[$w cget -wrap]} {
-                if {$index == -1} {
-                    set index [llength [$w cget -values]]
-                    incr index -1
-                } else {
-                    set index 0
-                }
-                $w current $index
-            }
-        }
-    } else {
-        if {![catch {expr {[$w get] + $n}} v]} {
-            if {$v < [$w cget -from]} {
-                if {[$w cget -wrap]} {
-                    set v [$w cget -to]
-                } else {
-                    set v [$w cget -from]
-                }
-            } elseif {$v > [$w cget -to]} {
-                if {[$w cget -wrap]} {
-                    set v [$w cget -from]
-                } else {
-                    set v [$w cget -to]
-                }
-            }
-            $w set $v
-        }
+proc ttk::spinbox::SelectAll {w} {
+    $w selection range 0 end
+    $w icursor end
+}
+
+proc ttk::spinbox::Limit {v min max} {
+    if {$v < $min} { return $min }
+    if {$v > $max} { return $max }
+    return $v
+}
+
+proc ttk::spinbox::Wrap {v min max} {
+    if {$v < $min} { return $max }
+    if {$v > $max} { return $min }
+    return $v
+}
+
+proc ttk::spinbox::Adjust {w v min max} {
+    if {[$w cget -wrap]} {
+	return [Wrap $v $min $max]
+    } else  {
+	return [Limit $v $min $max]
     }
-    ::ttk::entry::Select $w 0 $units
+}
 
-    # Run -command callback:
-    #
+proc ttk::spinbox::Spin {w dir} {
+    set nvalues [llength [set values [$w cget -values]]]
+    set value [$w get]
+    if {$nvalues} {
+	set current [lsearch -exact $values $value]
+	set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
+	$w set [lindex $values $index]
+    } else {
+        if {[catch {
+    	    set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
+	}]} {
+	    set v [$w cget -from]
+	}
+	$w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]]
+    }
+    SelectAll $w
     uplevel #0 [$w cget -command]
-
 }
 
-# Spinbox double-click on the arrows needs interception, otherwise
-# pass to the TEntry handler
-proc ttk::spinbox::Select {w x y mode} {
-    if {[$w instate disabled]} { return }
-    variable State
-    set State(xPress) $x
-    set State(yPress) $y
-    switch -glob -- [$w identify $x $y] {
-        *uparrow {
-            ttk::Repeatedly Change $w +[$w cget -increment] units
-        }
-        *downarrow {
-            ttk::Repeatedly Change $w -[$w cget -increment] units
-        }
-        *textarea { 
-            return [::ttk::entry::Select $w $x $mode]
-        }
+proc ttk::spinbox::FormatValue {w val} {
+    set fmt [$w cget -format]
+    if {$fmt eq ""} {
+	# Try to guess a suitable -format based on -increment.
+	set delta [expr {abs([$w cget -increment])}]
+        if {0 < $delta && $delta < 1} {
+	    # NB: This guesses wrong if -increment has more than 1 
+	    # significant digit itself, e.g., -increment 0.25
+	    set nsd [expr {int(ceil(-log10($delta)))}]
+	    set fmt "%.${nsd}f"
+	} else {
+	    set fmt "%.0f"
+	}
     }
-    return -code continue
+    return [format $fmt $val]
 }
 
 #*EOF*