diff options
Diffstat (limited to 'library/ttk/utils.tcl')
| -rw-r--r-- | library/ttk/utils.tcl | 83 |
1 files changed, 32 insertions, 51 deletions
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index ebb42d0..ea0082f 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -37,12 +37,12 @@ proc ttk::GuessTakeFocus {w} { # Allow traversal to widgets with explicit key or focus bindings: # if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} { - return 1 + return 1; } # Default is nontraversable: # - return 0 + return 0; } ## ttk::traverseTo $w -- @@ -73,7 +73,7 @@ proc ttk::clickToFocus {w} { # proc ttk::takesFocus {w} { if {![winfo viewable $w]} { - return 0 + return 0 } elseif {[catch {$w cget -takefocus} takefocus]} { return [GuessTakeFocus $w] } else { @@ -144,7 +144,7 @@ proc ttk::SaveGrab {w} { set grabbed [grab current $w] if {[winfo exists $grabbed]} { - switch [grab status $grabbed] { + switch [grab status $grabbed] { global { set restoreGrab [list grab -global $grabbed] } local { set restoreGrab [list grab $grabbed] } none { ;# grab window is really in a different interp } @@ -153,7 +153,7 @@ proc ttk::SaveGrab {w} { set focus [focus] if {$focus ne ""} { - set restoreFocus [list focus -force $focus] + set restoreFocus [list focus -force $focus] } set Grab($w) [list $restoreGrab $restoreFocus] @@ -168,7 +168,7 @@ proc ttk::RestoreGrab {w} { variable Grab if {![info exists Grab($w)]} { # Ignore - return + return; } # The previous grab/focus window may have been destroyed, @@ -273,18 +273,6 @@ proc ttk::copyBindings {from to} { # # Platform inconsistencies: # -# On X11, the server typically maps the mouse wheel to Button4 and Button5. -# -# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events. -# -# On Windows, %D must be scaled by a factor of 120. -# -# OSX conventionally uses Shift+MouseWheel for horizontal scrolling, -# and Option+MouseWheel for accelerated scrolling. -# -# The Shift+MouseWheel behavior is not conventional on Windows or most -# X11 toolkits, but it's useful. -# # MouseWheel scrolling is accelerated on X11, which is conventional # for Tk and appears to be conventional for other toolkits (although # Gtk+ and Qt do not appear to use as large a factor). @@ -292,46 +280,39 @@ proc ttk::copyBindings {from to} { ## 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). +# $command will be passed two additional arguments +# specifying the mousewheel change and a factor. # proc ttk::bindMouseWheel {bindtag callback} { - if {[tk windowingsystem] eq "x11"} { - bind $bindtag <Button-4> "$callback -1" - bind $bindtag <Button-5> "$callback +1" - } - if {[tk windowingsystem] eq "aqua"} { - bind $bindtag <MouseWheel> "$callback \[expr {-%D}\]" - bind $bindtag <Option-MouseWheel> "$callback \[expr {-10 * %D}\]" - } else { - bind $bindtag <MouseWheel> "$callback \[expr {-%D / 120}\]" - } + bind $bindtag <MouseWheel> "$callback %D -120.0" + bind $bindtag <Option-MouseWheel> "$callback %D -12.0" } ## Mousewheel bindings for standard scrollable widgets. # -if {[tk windowingsystem] eq "x11"} { - bind TtkScrollable <Button-4> { %W yview scroll -5 units } - bind TtkScrollable <Button-5> { %W yview scroll 5 units } - bind TtkScrollable <Shift-Button-4> { %W xview scroll -5 units } - bind TtkScrollable <Shift-Button-5> { %W xview scroll 5 units } -} -if {[tk windowingsystem] eq "aqua"} { - bind TtkScrollable <MouseWheel> \ - { %W yview scroll [expr {-%D}] units } - bind TtkScrollable <Shift-MouseWheel> \ - { %W xview scroll [expr {-%D}] units } - bind TtkScrollable <Option-MouseWheel> \ - { %W yview scroll [expr {-10 * %D}] units } - bind TtkScrollable <Shift-Option-MouseWheel> \ - { %W xview scroll [expr {-10 * %D}] units } -} else { - bind TtkScrollable <MouseWheel> \ - { %W yview scroll [expr {-%D / 120}] units } - bind TtkScrollable <Shift-MouseWheel> \ - { %W xview scroll [expr {-%D / 120}] units } -} +bind TtkScrollable <MouseWheel> \ + { tk::MouseWheel %W y %D -40.0 } +bind TtkScrollable <Option-MouseWheel> \ + { tk::MouseWheel %W y %D -12.0 } +bind TtkScrollable <Shift-MouseWheel> \ + { tk::MouseWheel %W x %D -40.0 } +bind TtkScrollable <Shift-Option-MouseWheel> \ + { tk::MouseWheel %W x %D -12.0 } +## Touchpad scrolling +# +bind TtkScrollable <TouchpadScroll> { + if {%# %% 5 != 0} { + return + } + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) + if {$tk::Priv(deltaX) != 0} { + %W xview scroll [expr {-$tk::Priv(deltaX)}] units + } + if {$tk::Priv(deltaY) != 0} { + %W yview scroll [expr {-$tk::Priv(deltaY)}] units + } +} #*EOF* |