Restore low-res scrollwheel behavior; insert a placeholder for sending touchpad events.

4 files changed, 58 insertions, 113 deletions

diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index 54d98e0..98a4be2 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -17,7 +17,7 @@ wm iconname $w "cscroll"
 positionWindow $w
 set c $w.c
 
-label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with either shift-button 1 or button 2 in the canvas.  If you click button 1 on one of the rectangles, its indices will be printed on stdout."
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas.  If you click button 1 on one of the rectangles, its indices will be printed on stdout."
 pack $w.msg -side top
 
 ## See Code / Dismiss buttons
@@ -25,27 +25,8 @@ set btns [addSeeDismiss $w.buttons $w]
 pack $btns -side bottom -fill x
 
 frame $w.grid
-ttk::scrollbar $w.hscroll -orient horizontal -command "$c xview"
-ttk::scrollbar $w.vscroll -command "$c yview"
-# Override the scrollbar's mousewheel binding to speed it up: 
-set fastwheel {
-    set HiresScrollMask 512
-    set ShiftMask 1
-    if {[expr {%s & $ShiftMask}]} {
-	set orientation "h";
-    } else {
-	set orientation "v";
-    }
-    if {[expr {%s & $HiresScrollMask}]} {
-	tk::ScrollByUnits %W $orientation %D -1.0
-    } else {
-	tk::ScrollByUnits %W $orientation %D -30.0
-    }
-    break
-}
-bind $w.vscroll <MouseWheel> $fastwheel
-bind $w.hscroll <MouseWheel> $fastwheel
-
+scrollbar $w.hscroll -orient horizontal -command "$c xview"
+scrollbar $w.vscroll -command "$c yview"
 canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \
 	-xscrollcommand "$w.hscroll set" \
 	-yscrollcommand "$w.vscroll set"
@@ -75,40 +56,61 @@ for {set i 0} {$i < 20} {incr i} {
 $c bind all <Enter> "scrollEnter $c"
 $c bind all <Leave> "scrollLeave $c"
 $c bind all <Button-1> "scrollButton $c"
-
-bind $c <Button-2> "$c scan mark %x %y"
-bind $c <B2-Motion> "$c scan dragto %x %y"
-bind $c <Shift-Button-1> "$c scan mark %x %y"
-bind $c <Shift-B1-Motion> "$c scan dragto %x %y"
-
-if {[package vsatisfies [package provide Tk] 8.7-]} {
-    # Bindings for 8.7 and up
-    $c configure -yscrollincrement 1 -xscrollincrement 1
+if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} {
+    bind $c <Button-3> "$c scan mark %x %y"
+    bind $c <B3-Motion> "$c scan dragto %x %y"
     bind $c <MouseWheel> {
-	tk::MouseWheel %W y %D -1.0
-    }
-    bind $c <Shift-MouseWheel> {
-	tk::MouseWheel %W x %D -1.0
+	%W yview scroll [expr {-%D}] units
     }
     bind $c <Option-MouseWheel> {
-	tk::MouseWheel %W y %D -0.3
+	%W yview scroll [expr {-10*%D}] units
     }
-    bind $c <Option-Shift-MouseWheel> {
-	tk::MouseWheel %W x %D -0.3
+    bind $c <Shift-MouseWheel> {
+	%W xview scroll [expr {-%D}] units
+    }
+    bind $c <Shift-Option-MouseWheel> {
+	%W xview scroll [expr {-10*%D}] units
     }
 } else {
+    bind $c <Button-2> "$c scan mark %x %y"
+    bind $c <B2-Motion> "$c scan dragto %x %y"
+    # We must make sure that positive and negative movements are rounded
+    # equally to integers, avoiding the problem that
+    #     (int)1/-30 = -1,
+    # but
+    #     (int)-1/-30 = 0
+    # The following code ensure equal +/- behaviour.
     bind $c <MouseWheel> {
-	%W yview scroll [expr {-%D}] units
+	if {%D >= 0} {
+	    %W yview scroll [expr {%D/-30}] units
+	} else {
+	    %W yview scroll [expr {(%D-29)/-30}] units
+	}
     }
     bind $c <Option-MouseWheel> {
-	%W yview scroll [expr {-10*%D}] units
+	if {%D >= 0} {
+	    %W yview scroll [expr {%D/-3}] units
+	} else {
+	    %W yview scroll [expr {(%D-2)/-3}] units
+	}
     }
     bind $c <Shift-MouseWheel> {
-	%W xview scroll [expr {-%D}] units
+	if {%D >= 0} {
+	    %W xview scroll [expr {%D/-30}] units
+	} else {
+	    %W xview scroll [expr {(%D-29)/-30}] units
+	}
     }
     bind $c <Shift-Option-MouseWheel> {
-	%W xview scroll [expr {-10*%D}] units
+	if {%D >= 0} {
+	    %W xview scroll [expr {%D/-3}] units
+	} else {
+	    %W xview scroll [expr {(%D-2)/-3}] units
+	}
     }
+}
+
+if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} {
     # Support for mousewheels on Linux/Unix commonly comes through mapping
     # the wheel to the extended buttons.  If you have a mousewheel, find
     # Linux configuration info at:
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 0a0c2c6..c18d4a8 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -130,20 +130,10 @@ bind Scrollbar <<LineEnd>> {
 }
 
 bind Scrollbar <MouseWheel> {
-    set direction [tk::ScrollDirection %s]
-    if {[tk::IsHiResScroll %s]} {
-	tk::ScrollByUnits %W $direction %D -10.0
-    } else {
-	tk::ScrollByUnits %W $direction [tk::ScaleNum %D] -30.0
-    }
+    tk::ScrollByUnits %W hv %D -40.0
 }
 bind Scrollbar <Option-MouseWheel> {
-    set direction [tk::ScrollDirection %s]
-    if {[tk::IsHiResScroll %s]} {
-	tk::ScrollByUnits %W $direction %D -1.0
-    } else {
-	tk::ScrollByUnits %W $direction [tk::ScaleNum %D] -3.0
-    }
+    tk::ScrollByUnits %W hv %D -12.0
 }
 
 # tk::ScrollButtonDown --
@@ -318,24 +308,16 @@ proc ::tk::ScrollEndDrag {w x y} {
 
 proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} {
     set cmd [$w cget -command]
-    if {$cmd eq ""} {
+    if {$cmd eq "" || ([string first \
+	    [string index [$w cget -orient] 0] $orient] < 0)} {
 	return
     }
-    set xyview [lindex [split $cmd] end]
-    if {$orient eq "v"} {
-	if {$xyview eq "xview"} {
-	    return
-	}
-	set size [winfo height $w]
-    }
-    if {$orient eq "h"} {
-	if {$xyview eq "yview"} {
-	    return
-	}
-	set size [winfo width $w]
+    set info [$w get]
+    if {[llength $info] == 2} {
+	uplevel #0 $cmd scroll [expr {$amount/$factor}] units
+    } else {
+	uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}]
     }
-    set scale [expr {[$w delta 1.0 1.0] * $size}]
-    uplevel #0 $cmd scroll [expr {$amount * $scale / $factor}] units
 }
 
 # ::tk::ScrollByPages --
diff --git a/library/text.tcl b/library/text.tcl
index 631759d..eb73db0 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -455,33 +455,18 @@ bind Text <B2-Motion> {
     }
 }
 set ::tk::Priv(prevPos) {}
+
 bind Text <MouseWheel> {
-    if {[tk::IsHiResScroll %s]} {
-	tk::MouseWheel %W y %D -1.0 pixels
-    } else {
-	tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels
-    }
+    tk::MouseWheel %W y %D -4.0 pixels
 }
 bind Text <Option-MouseWheel> {
-    if {[tk::IsHiResScroll %s]} {
-	tk::MouseWheel %W y %D -0.3 pixels
-    } else {
-	tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels
-    }
+    tk::MouseWheel %W y %D -1.2 pixels
 }
 bind Text <Shift-MouseWheel> {
-    if {[tk::IsHiResScroll %s]} {
-	tk::MouseWheel %W x %D -1.0 pixels
-    } else {
-	tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels
-    }
+    tk::MouseWheel %W x %D -4.0 pixels
 }
 bind Text <Shift-Option-MouseWheel> {
-    if {[tk::IsHiResScroll %s]} {
-	tk::MouseWheel %W x %D -0.3 pixels
-    } else {
-	tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels
-    }
+    tk::MouseWheel %W x %D -1.2 pixels
 }
 
 # ::tk::TextClosestGap --
diff --git a/library/tk.tcl b/library/tk.tcl
index 74942cb..a6dc37c 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -543,30 +543,6 @@ proc ::tk::CancelRepeat {} {
     set Priv(afterId) {}
 }
 
-
-# ::tk::IsHiResScroll $state --
-# Checks whether the HiResScrollMask bit is set in the state.
-
-proc ::tk::IsHiResScroll state {
-    if {[expr {$state & 512}]} {
-	return 1
-    } else {
-	return 0
-    }
-}
-
-# ::tk::ScrollDirection $state --
-# Checks if ShiftMask is set in the MouseWheelEvent state.
-# Returns h for a horizontal scroll, v for a vertical scroll
-
-proc ::tk::ScrollDirection state {
-    if {[expr {$state & 1}]} {
-	return "h"
-    } else {
-	return "v"
-    }
-}
-
 ## ::tk::MouseWheel $w $dir $amount $factor $units
 
 proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} {