diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/demos/cscroll.tcl | 86 | ||||
| -rw-r--r-- | library/scrlbar.tcl | 36 | ||||
| -rw-r--r-- | library/text.tcl | 25 | ||||
| -rw-r--r-- | library/tk.tcl | 24 |
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}} { |