summaryrefslogtreecommitdiffstats
path: root/library/ttk/spinbox.tcl
diff options
context:
space:
mode:
authorhobbs <hobbs>2010-08-26 02:06:08 (GMT)
committerhobbs <hobbs>2010-08-26 02:06:08 (GMT)
commitb29adcfbfc2e03e058536524f1aa3378b948e7ed (patch)
treefa90e1e6d32590addfbb0a1599a40b1f7f99ea3b /library/ttk/spinbox.tcl
parent7dec1714e5d5efd6b7d095657c1434fa68af0f87 (diff)
downloadtk-b29adcfbfc2e03e058536524f1aa3378b948e7ed.zip
tk-b29adcfbfc2e03e058536524f1aa3378b948e7ed.tar.gz
tk-b29adcfbfc2e03e058536524f1aa3378b948e7ed.tar.bz2
Major backport of 8.6 Ttk for 8.5.9. Most changes were only being
committed to head (8.6), although they could apply for 8.5 as well. This re-sync makes future work easier to maintain and adds some useful work for 8.5 users. Notable changes: - Lots of code cleanup - Some bug fixes never backported - Addition of ttk::spinbox - minor color changes - Improved Vista/7 styling - Move to tile version 0.8.6 (pseudo-package) - ABI and API compatible (even $w identify) - minor new features (extended $w identify)
Diffstat (limited to 'library/ttk/spinbox.tcl')
-rw-r--r--library/ttk/spinbox.tcl175
1 files changed, 175 insertions, 0 deletions
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
new file mode 100644
index 0000000..a717379
--- /dev/null
+++ b/library/ttk/spinbox.tcl
@@ -0,0 +1,175 @@
+#
+# $Id: spinbox.tcl,v 1.3.2.2 2010/08/26 02:06:10 hobbs Exp $
+#
+# 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*