ttk::spinbox: Add cross-platform MouseWheel bindings.

Factored out [ttk::bindMouseWheel] procedure.

3 files changed, 76 insertions, 27 deletions

diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
index 5b93374..bec6faa 100644
--- a/library/ttk/combobox.tcl
+++ b/library/ttk/combobox.tcl
@@ -1,13 +1,8 @@
 #
-# $Id: combobox.tcl,v 1.17 2008/12/03 18:44:50 jenglish Exp $
+# $Id: combobox.tcl,v 1.18 2008/12/07 21:24:12 jenglish Exp $
 #
 # Combobox bindings.
 #
-# Each combobox $cb has a child $cb.popdown, which contains
-# a listbox $cb.popdown.l and a scrollbar.  The listbox -listvariable
-# is set to a namespace variable, which is used to synchronize the
-# combobox values with the listbox values.
-#
 # <<NOTE-WM-TRANSIENT>>:
 #
 #	Need to set [wm transient] just before mapping the popdown
@@ -62,11 +57,7 @@ bind TCombobox <Triple-ButtonPress-1> 	{ ttk::combobox::Press "3" %W %x %y }
 bind TCombobox <B1-Motion>		{ ttk::combobox::Drag %W %x }
 bind TCombobox <Motion>			{ ttk::combobox::Motion %W %x %y }
 
-bind TCombobox <MouseWheel> 	{ ttk::combobox::Scroll %W [expr {%D/-120}] }
-if {[tk windowingsystem] eq "x11"} {
-    bind TCombobox <ButtonPress-4>	{ ttk::combobox::Scroll %W -1 }
-    bind TCombobox <ButtonPress-5>	{ ttk::combobox::Scroll %W  1 }
-}
+ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W]
 
 bind TCombobox <<TraverseIn>> 		{ ttk::combobox::TraverseIn %W }
 
@@ -158,7 +149,7 @@ proc ttk::combobox::Drag {w x}  {
 #
 proc ttk::combobox::Motion {w x y} {
     if {   [$w identify $x $y] eq "textarea"
-        && [$w instate {!readonly !disabled}] 
+        && [$w instate {!readonly !disabled}]
     } {
 	ttk::setCursor $w text
     } else {
@@ -324,6 +315,7 @@ proc ttk::combobox::PopdownToplevel {w} {
 	win32 {
 	    $w configure -relief flat -borderwidth 0
 	    wm overrideredirect $w true
+	    wm attributes $w -topmost 1
 	}
 	aqua {
 	    $w configure -relief solid -borderwidth 0
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
index 9464b07..9f7faa4 100644
--- a/library/ttk/spinbox.tcl
+++ b/library/ttk/spinbox.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: spinbox.tcl,v 1.2 2008/12/07 18:42:55 jenglish Exp $
+# $Id: spinbox.tcl,v 1.3 2008/12/07 21:24:12 jenglish Exp $
 #
 # ttk::spinbox bindings
 #
@@ -19,22 +19,20 @@ 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 <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 }
 
-
-# @@@ x-plat
-bind TSpinbox <MouseWheel> { ttk::spinbox::Spin %W [expr {%D/-120}] }
+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}] 
+        && [$w instate {!readonly !disabled}]
     } {
 	ttk::setCursor $w text
     } else {
@@ -53,7 +51,7 @@ proc ttk::spinbox::Press {w x y} {
         *uparrow 	{ ttk::Repeatedly event generate $w <<Increment>> }
 	*leftarrow	-
         *downarrow	{ ttk::Repeatedly event generate $w <<Decrement>> }
-	*spinbutton { 
+	*spinbutton {
 	    if {$y * 2 >= [winfo height $w]} {
 	    	set event <<Decrement>>
 	    } else {
@@ -64,7 +62,7 @@ proc ttk::spinbox::Press {w x y} {
     }
 }
 
-## DoubleClick -- 
+## DoubleClick --
 #	Select all if over the text area; otherwise same as Press.
 #
 proc ttk::spinbox::DoubleClick {w x y} {
@@ -80,23 +78,47 @@ 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]
@@ -105,6 +127,12 @@ proc ttk::spinbox::Adjust {w 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]
@@ -124,13 +152,16 @@ proc ttk::spinbox::Spin {w dir} {
     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 
+	    # 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"
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index 1de8ec8..9f3d12d 100644
--- a/library/ttk/utils.tcl
+++ b/library/ttk/utils.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: utils.tcl,v 1.6 2008/01/06 19:16:12 jenglish Exp $
+# $Id: utils.tcl,v 1.7 2008/12/07 21:24:12 jenglish Exp $
 #
 # Utilities for widget implementations.
 #
@@ -251,10 +251,7 @@ proc ttk::copyBindings {from to} {
     }
 }
 
-## Standard mousewheel bindings.
-#
-# Usage: [ttk::copyBindings TtkScrollable $bindtag]
-# adds mousewheel support to a scrollable widget.
+### Mousewheel bindings.
 #
 # Platform inconsistencies:
 #
@@ -278,6 +275,35 @@ proc ttk::copyBindings {from to} {
 # Gtk+ and Qt do not appear to use as large a factor).
 #
 
+## ttk::bindMouseWheel $bindtag $command...
+#	Adds basic mousewheel support to $bindtag.
+#	$command will be passed one additional argument
+#	specifying the mousewheel direction (-1: up, +1: down).
+#
+
+proc ttk::bindMouseWheel {bindtag callback} {
+    switch -- [tk windowingsystem] {
+	x11 {
+	    bind $bindtag <ButtonPress-4> "$callback -1"
+	    bind $bindtag <ButtonPress-5> "$callback +1"
+	}
+	win32 {
+	    bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}]
+	}
+	aqua {
+	    bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
+	}
+    }
+}
+
+## Mousewheel bindings for standard scrollable widgets.
+#
+# Usage: [ttk::copyBindings TtkScrollable $bindtag]
+#
+# $bindtag should be for a widget that supports the
+# standard scrollbar protocol.
+#
+
 switch -- [tk windowingsystem] {
     x11 {
 	bind TtkScrollable <ButtonPress-4>       { %W yview scroll -5 units }