diff options
| -rw-r--r-- | library/demos/cscroll.tcl | 8 | ||||
| -rw-r--r-- | library/iconlist.tcl | 6 | ||||
| -rw-r--r-- | library/listbox.tcl | 8 | ||||
| -rw-r--r-- | library/scrlbar.tcl | 10 | ||||
| -rw-r--r-- | library/tclIndex | 1 | ||||
| -rw-r--r-- | library/text.tcl | 16 | ||||
| -rw-r--r-- | library/tk.tcl | 7 | ||||
| -rw-r--r-- | library/ttk/combobox.tcl | 8 | ||||
| -rw-r--r-- | library/ttk/spinbox.tcl | 6 | ||||
| -rw-r--r-- | library/ttk/utils.tcl | 12 |
10 files changed, 43 insertions, 39 deletions
diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 52a9e1a..90b1afc 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -60,16 +60,16 @@ if {[package vsatisfies [package provide Tk] 8.7-]} { bind $c <Button-2> "$c scan mark %x %y" bind $c <B2-Motion> "$c scan dragto %x %y" bind $c <MouseWheel> { - %W yview scroll [expr {%D/-30.0}] units + tk::MouseWheel %W y %D -30.0 } bind $c <Option-MouseWheel> { - %W yview scroll [expr {%D/-3.0}] units + tk::MouseWheel %W y %D -3.0 } bind $c <Shift-MouseWheel> { - %W xview scroll [expr {%D/-30.0}] units + tk::MouseWheel %W x %D -30.0 } bind $c <Shift-Option-MouseWheel> { - %W xview scroll [expr {%D/-3.0}] units + tk::MouseWheel %W x %D -3.0 } } elseif {[tk windowingsystem] eq "aqua"} { bind $c <Button-3> "$c scan mark %x %y" diff --git a/library/iconlist.tcl b/library/iconlist.tcl index f9dff2e..c052efb 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -447,7 +447,7 @@ package require Tk bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}] bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}] - bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel [expr {10*%D}]}] + bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel %D -12}] bind $canvas <<PrevLine>> [namespace code {my UpDown -1}] @@ -496,11 +496,11 @@ package require Tk # ---------------------------------------------------------------------- # Event handlers - method MouseWheel {amount} { + method MouseWheel {amount {factor -120.0}} { if {$noScroll || $::tk_strictMotif} { return } - $canvas xview scroll [expr {$amount/-120.0}] units + $canvas xview scroll [expr {$amount/$factor}] units } method Btn1 {x y} { focus $canvas diff --git a/library/listbox.tcl b/library/listbox.tcl index f6ece12..ffedee6 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -177,16 +177,16 @@ bind Listbox <B2-Motion> { } bind Listbox <MouseWheel> { - %W yview scroll [expr {%D/-30.0}] units + tk::MouseWheel %W y %D -30.0 } bind Listbox <Option-MouseWheel> { - %W yview scroll [expr {%D/-3.0}] units + tk::MouseWheel %W y %D -3.0 } bind Listbox <Shift-MouseWheel> { - %W xview scroll [expr {%D/-30.0}] units + tk::MouseWheel %W x %D -30.0 } bind Listbox <Shift-Option-MouseWheel> { - %W xview scroll [expr {%D/-3.0}] units + tk::MouseWheel %W x %D -3.0 } # ::tk::ListboxBeginSelect -- diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index a8ea3bf..f545785 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -130,10 +130,10 @@ bind Scrollbar <<LineEnd>> { } bind Scrollbar <MouseWheel> { - tk::ScrollByUnits %W hv [expr {%D/-30.0}] + tk::ScrollByUnits %W hv %D -30.0 } bind Scrollbar <Option-MouseWheel> { - tk::ScrollByUnits %W hv [expr {%D/-3.0}] + tk::ScrollByUnits %W hv %D -3.0 } # tk::ScrollButtonDown -- @@ -306,7 +306,7 @@ proc ::tk::ScrollEndDrag {w x y} { # horizontal, "v" for vertical, "hv" for both. # amount - How many units to scroll: typically 1 or -1. -proc ::tk::ScrollByUnits {w orient amount} { +proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { set cmd [$w cget -command] if {$cmd eq "" || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { @@ -314,9 +314,9 @@ proc ::tk::ScrollByUnits {w orient amount} { } set info [$w get] if {[llength $info] == 2} { - uplevel #0 $cmd scroll $amount units + uplevel #0 $cmd scroll [expr {$amount/$factor}] units } else { - uplevel #0 $cmd [expr {[lindex $info 2] + $amount}] + uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}] } } diff --git a/library/tclIndex b/library/tclIndex index 919fa8a..06006cd 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -199,6 +199,7 @@ set auto_index(::tk::RestoreFocusGrab) [list source [file join $dir tk.tcl]] set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]] set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]] set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]] +set auto_index(::tk::MouseWheel) [list source [file join $dir tk.tcl]] set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]] set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]] diff --git a/library/text.tcl b/library/text.tcl index 24dd6d2..f25f639 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -453,24 +453,16 @@ set ::tk::Priv(prevPos) {} # (int)-1/3 = -1 # The following code ensure equal +/- behaviour. bind Text <MouseWheel> { - if {%D >= 0} { - %W yview scroll [expr {-%D/3}] pixels - } else { - %W yview scroll [expr {(2-%D)/3}] pixels - } + tk::MouseWheel y %D -3.0 pixels } bind Text <Option-MouseWheel> { - %W yview scroll [expr {-3*%D}] pixels + tk::MouseWheel y %D -0.3 pixels } bind Text <Shift-MouseWheel> { - if {%D >= 0} { - %W xview scroll [expr {-%D/3}] pixels - } else { - %W xview scroll [expr {(2-%D)/3}] pixels - } + tk::MouseWheel x %D -3.0 pixels } bind Text <Shift-Option-MouseWheel> { - %W xview scroll [expr {-3*%D}] pixels + tk::MouseWheel x %D -0.3 pixels } # ::tk::TextClosestGap -- diff --git a/library/tk.tcl b/library/tk.tcl index dfa60d4..bf00e6f 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -533,6 +533,13 @@ proc ::tk::CancelRepeat {} { set Priv(afterId) {} } +## ::tk::MouseWheel $w $dir $amount $factor $units + +proc ::tk::MouseWheel {w dir amount factor {units units}} { + $w ${dir}view scroll [expr {$amount/$factor}] $units +} + + # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. # It sends a <<TraverseOut>> virtual event to the previous focus window, diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 0a7e519..c72d02e 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -182,11 +182,15 @@ proc ttk::combobox::SelectEntry {cb index} { ## Scroll -- Mousewheel binding # -proc ttk::combobox::Scroll {cb dir} { +proc ttk::combobox::Scroll {cb dir {factor 1.0}} { $cb instate disabled { return } set max [llength [$cb cget -values]] set current [$cb current] - incr current $dir + set d [expr {round($dir/factor)}] + if {$d == 0 && $dir != 0} { + if {$dir > 0} {set d 1} else {set d -1} + } + incr current $d if {$max != 0 && $current == $current % $max} { SelectEntry $cb $current } diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 33936d9..19a330f 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -82,11 +82,11 @@ proc ttk::spinbox::Release {w} { # Mousewheel callback. Turn these into <<Increment>> (-1, up) # or <<Decrement> (+1, down) events. # -proc ttk::spinbox::MouseWheel {w dir} { +proc ttk::spinbox::MouseWheel {w dir {factor 1}} { if {[$w instate disabled]} { return } - if {$dir < 0} { + if {($dir < 0) ^ ($factor < 0)} { event generate $w <<Increment>> - } else { + } elseif {$dir > 0} { event generate $w <<Decrement>> } } diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index c58d39e..de7565c 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -285,8 +285,8 @@ proc ttk::copyBindings {from to} { # proc ttk::bindMouseWheel {bindtag callback} { - bind $bindtag <MouseWheel> [append callback { [expr {%D/-120.0}]}] - bind $bindtag <Option-MouseWheel> [append callback { [expr {%D/-12.0}]}] + bind $bindtag <MouseWheel> [append callback { %D -120.0}] + bind $bindtag <Option-MouseWheel> [append callback { %D -12.0}] } ## Mousewheel bindings for standard scrollable widgets. @@ -298,12 +298,12 @@ proc ttk::bindMouseWheel {bindtag callback} { # bind TtkScrollable <MouseWheel> \ - { %W yview scroll [expr {%D/-120.0}] units } + { tk::MouseWheel %W y %D -120.0 } bind TtkScrollable <Option-MouseWheel> \ - { %W yview scroll [expr {%D/-12.0}] units } + { tk::MouseWheel %W y %D -12.0 } bind TtkScrollable <Shift-MouseWheel> \ - { %W xview scroll [expr {%D/-120.0}] units } + { tk::MouseWheel %W x %D -120.0 } bind TtkScrollable <Shift-Option-MouseWheel> \ - { %W xview scroll [expr {%D/-12.0}] units } + { tk::MouseWheel %W x %D -120.0 } #*EOF* |