1 files changed, 173 insertions, 0 deletions
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
new file mode 100644
index 0000000..1aa0ccb
--- /dev/null
+++ b/library/ttk/spinbox.tcl
@@ -0,0 +1,173 @@
+#
+# ttk::spinbox bindings
+#
+
+namespace eval ttk::spinbox { }
+
+### Spinbox bindings.
+#
+# Duplicate the Entry bindings, override if needed:
+#
+
+ttk::copyBindings TEntry TSpinbox
+
+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>		{ event generate %W <<Increment>> }
+bind TSpinbox <KeyPress-Down> 		{ event generate %W <<Decrement>> }
+
+bind TSpinbox <<Increment>>		{ ttk::spinbox::Spin %W +1 }
+bind TSpinbox <<Decrement>> 		{ ttk::spinbox::Spin %W -1 }
+
+ttk::bindMouseWheel TSpinbox 		[list ttk::spinbox::MouseWheel %W]
+
+## 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 }
+    focus $w
+    switch -glob -- [$w identify $x $y] {
+        *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
+	}
+    }
+}
+
+## 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
+}
+
+## MouseWheel --
+#	Mousewheel callback.  Turn these into <<Increment>> (-1, up)
+# 	or <<Decrement> (+1, down) events.
+#
+proc ttk::spinbox::MouseWheel {w dir} {
+    if {$dir < 0} {
+	event generate $w <<Increment>>
+    } else {
+	event generate $w <<Decrement>>
+    }
+}
+
+## SelectAll --
+#	Select widget contents.
+#
+proc ttk::spinbox::SelectAll {w} {
+    $w selection range 0 end
+    $w icursor end
+}
+
+## Limit --
+#	Limit $v to lie between $min and $max
+#
+proc ttk::spinbox::Limit {v min max} {
+    if {$v < $min} { return $min }
+    if {$v > $max} { return $max }
+    return $v
+}
+
+## Wrap --
+#	Adjust $v to lie between $min and $max, wrapping if out of bounds.
+#
+proc ttk::spinbox::Wrap {v min max} {
+    if {$v < $min} { return $max }
+    if {$v > $max} { return $min }
+    return $v
+}
+
+## Adjust --
+#	Limit or wrap spinbox value depending on -wrap.
+#
+proc ttk::spinbox::Adjust {w v min max} {
+    if {[$w cget -wrap]} {
+	return [Wrap $v $min $max]
+    } else  {
+	return [Limit $v $min $max]
+    }
+}
+
+## Spin --
+#	Handle <<Increment>> and <<Decrement>> events.
+#	If -values is specified, cycle through the list.
+#	Otherwise cycle through numeric range based on
+#	-from, -to, and -increment.
+#
+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]
+}
+
+## FormatValue --
+#	Reformat numeric value based on -format.
+#
+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 [format $fmt $val]
+}
+
+#*EOF*