Implemented the themed spinbox widget ttk::spinbox.

9 files changed, 175 insertions, 9 deletions

diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl
index e604373..0a4ce05 100644
--- a/library/ttk/altTheme.tcl
+++ b/library/ttk/altTheme.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: altTheme.tcl,v 1.7 2008/05/23 20:20:05 jenglish Exp $
+# $Id: altTheme.tcl,v 1.8 2008/11/01 15:34:24 patthoyts Exp $
 #
 # Ttk widget set: Alternate theme
 #
@@ -60,6 +60,11 @@ namespace eval ttk::theme::alt {
 	ttk::style map TCombobox -fieldbackground \
 		[list readonly $colors(-frame) disabled $colors(-frame)]
 
+	ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
+	ttk::style map TSpinbox -fieldbackground \
+	    [list readonly $colors(-frame) disabled $colors(-frame)] \
+	    -arrowcolor [list disabled $colors(-disabledfg)]
+
 	ttk::style configure Toolbutton -relief flat -padding 2
 	ttk::style map Toolbutton -relief \
 	    {disabled flat selected sunken pressed sunken active raised}
diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl
index 799b6ae..8498f1e 100644
--- a/library/ttk/clamTheme.tcl
+++ b/library/ttk/clamTheme.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: clamTheme.tcl,v 1.7 2008/05/23 20:20:06 jenglish Exp $
+# $Id: clamTheme.tcl,v 1.8 2008/11/01 15:34:24 patthoyts Exp $
 #
 # "Clam" theme.
 #
@@ -106,6 +106,14 @@ namespace eval ttk::theme::clam {
 	    -foreground [list {readonly focus} $colors(-selectfg)] \
 	    ;
 
+	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}
 	ttk::style map TNotebook.Tab \
 	    -padding [list selected {6 4 6 2}] \
diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl
index 48c3df8..72473df 100644
--- a/library/ttk/classicTheme.tcl
+++ b/library/ttk/classicTheme.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: classicTheme.tcl,v 1.7 2008/05/23 20:20:06 jenglish Exp $
+# $Id: classicTheme.tcl,v 1.8 2008/11/01 15:34:24 patthoyts Exp $
 #
 # "classic" Tk theme.
 #
@@ -71,6 +71,10 @@ namespace eval ttk::theme::classic {
 	ttk::style map TCombobox -fieldbackground \
 		[list readonly $colors(-frame) disabled $colors(-frame)]
 
+	ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
+	ttk::style map TSpinbox -fieldbackground \
+	    [list readonly $colors(-frame) disabled $colors(-frame)]
+
 	ttk::style configure TLabelframe -borderwidth 2 -relief groove
 
 	ttk::style configure TScrollbar -relief raised
diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl
index dfb6654..98185ee5 100644
--- a/library/ttk/defaults.tcl
+++ b/library/ttk/defaults.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: defaults.tcl,v 1.7 2008/05/23 20:20:06 jenglish Exp $
+# $Id: defaults.tcl,v 1.8 2008/11/01 15:34:24 patthoyts Exp $
 #
 # Settings for default theme.
 #
@@ -66,6 +66,11 @@ namespace eval ttk::theme::default {
 	ttk::style map TCombobox -fieldbackground \
 	    [list readonly $colors(-frame) disabled $colors(-frame)]
 
+	ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
+	ttk::style map TSpinbox -fieldbackground \
+	    [list readonly $colors(-frame) disabled $colors(-frame)] \
+	    -arrowcolor [list disabled $colors(-disabledfg)]
+
 	ttk::style configure TLabelframe \
 	    -relief groove -borderwidth 2
 
diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl
index 360954e..d54328a 100644
--- a/library/ttk/entry.tcl
+++ b/library/ttk/entry.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: entry.tcl,v 1.5 2008/10/28 20:02:03 jenglish Exp $
+# $Id: entry.tcl,v 1.6 2008/11/01 15:34:24 patthoyts Exp $
 #
 # DERIVED FROM: tk/library/entry.tcl r1.22
 #
@@ -228,7 +228,7 @@ proc ttk::entry::See {w {index insert}} {
 #	position following the next end-of-word position.
 #
 set ::ttk::entry::State(startNext) \
-	[string equal $tcl_platform(platform) "windows"]
+	[string equal $::tcl_platform(platform) "windows"]
 
 proc ttk::entry::NextWord {w start} {
     variable State
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
new file mode 100644
index 0000000..579a22c
--- /dev/null
+++ b/library/ttk/spinbox.tcl
@@ -0,0 +1,121 @@
+#
+# $Id: spinbox.tcl,v 1.1 2008/11/01 15:34:24 patthoyts Exp $
+#
+# Tile widget set: spinbox bindings.
+#
+#
+
+namespace eval ttk::spinbox {
+    variable Values	;# Values($cb) is -listvariable of listbox widget
+
+    variable State
+    set State(entryPress) 0
+}
+
+### Spinbox bindings.
+#
+# Duplicate the Entry bindings, override if needed:
+#
+
+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 <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}
+
+
+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
+            }
+        }
+    }
+}
+
+proc ttk::spinbox::Release {w x y} {
+    variable State
+    unset -nocomplain State(xPress) State(yPress)
+    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
+        }
+    }
+    ::ttk::entry::Select $w 0 $units
+
+    # Run -command callback:
+    #
+    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]
+        }
+    }
+    return -code continue
+}
+
+#*EOF*
diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl
index c4d0ff1..8bc1478 100644
--- a/library/ttk/ttk.tcl
+++ b/library/ttk/ttk.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: ttk.tcl,v 1.8 2007/12/13 15:27:08 dgp Exp $
+# $Id: ttk.tcl,v 1.9 2008/11/01 15:34:24 patthoyts Exp $
 #
 # Ttk widget set initialization script.
 #
@@ -105,6 +105,7 @@ source [file join $::ttk::library notebook.tcl]
 source [file join $::ttk::library panedwindow.tcl]
 source [file join $::ttk::library entry.tcl]
 source [file join $::ttk::library combobox.tcl]	;# dependency: entry.tcl
+source [file join $::ttk::library spinbox.tcl]  ;# dependency: entry.tcl
 source [file join $::ttk::library treeview.tcl]
 source [file join $::ttk::library sizegrip.tcl]
 
diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl
index 03ca6d2..c27c45a 100644
--- a/library/ttk/winTheme.tcl
+++ b/library/ttk/winTheme.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: winTheme.tcl,v 1.7 2008/05/23 20:20:06 jenglish Exp $
+# $Id: winTheme.tcl,v 1.8 2008/11/01 15:34:24 patthoyts Exp $
 #
 # Settings for 'winnative' theme.
 #
@@ -45,6 +45,8 @@ namespace eval ttk::theme::winnative {
 	    -focusfill	[list {readonly focus} SystemHighlight] \
 	    ;
 
+        ttk::style configure TSpinbox -padding {2 0 16 0}
+
 	ttk::style configure TLabelframe -borderwidth 2 -relief groove
 
 	ttk::style configure Toolbutton -relief flat -padding {8 4}
diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl
index 691dcea..c204233 100644
--- a/library/ttk/xpTheme.tcl
+++ b/library/ttk/xpTheme.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: xpTheme.tcl,v 1.9 2008/05/23 20:20:06 jenglish Exp $
+# $Id: xpTheme.tcl,v 1.10 2008/11/01 15:34:24 patthoyts Exp $
 #
 # Settings for 'xpnative' theme
 #
@@ -52,6 +52,12 @@ namespace eval ttk::theme::xpnative {
 	    -focusfill	[list {readonly focus} SystemHighlight] \
 	    ;
 
+	ttk::style configure TSpinbox -padding {2 0 14 0}
+	ttk::style map TSpinbox \
+	    -selectbackground [list !focus SystemWindow] \
+	    -selectforeground [list !focus SystemWindowText] \
+	    ;
+
 	ttk::style configure Toolbutton -padding {4 4}
 
 	# Vista requires some style modifications. There are some
@@ -75,6 +81,20 @@ namespace eval ttk::theme::xpnative {
 		}
 	    }
 
+            # EDIT EP_EDITBORDER_HVSCROLL
+            ttk::style configure TSpinbox -padding {2 0 15 1}
+            ttk::style element create Vista.Spinbox.field vsapi \
+                EDIT 9 {disabled 4 focus 3 active 2 {} 1} \
+                -padding {1 1 1 2}
+            ttk::style layout TSpinbox {
+                Vista.Spinbox.field -sticky nswe -children {
+                    Spinbox.padding -sticky nswe -children {
+                        Spinbox.textarea -expand 1 -sticky {}
+                    }
+                    Spinbox.uparrow -side top -sticky ens
+                    Spinbox.downarrow -side bottom -sticky ens
+                }
+            }
 	}
     }
 }