Mouse Wheel

proc MouseWheel {wFired D X Y} {
    # do not double-fire in case the class already has a binding
    if {[bind [winfo class $wFired] <MouseWheel>] ne ""} { return }
    # obtain the window the mouse is over
    set w [winfo containing $X $Y]
    # if we are outside the app, try and scroll the focus widget
    if {![winfo exists $w]} { catch {set w [focus]} }
    if {[winfo exists $w]} {
	 # scrollbars have different call conventions
        if {[winfo class $w] eq "Scrollbar"} {
            catch {tk::ScrollByUnits $w \
                       [string index [$w cget -orient] 0] \
                       [expr {-($D/30)}]}
        } else {
            while {$w ne ""} {
                if {[lsearch $::mw_classes [winfo class $w]] > -1} {
                    if {[$w cget -yscrollcommand] eq ""} {
                        set w [winfo parent $w]
                        continue
                    }
                    catch {$w yview scroll [expr {- ($D / 120) * 4}] units}
                    break
                }
                set w [winfo parent $w]
            }
        }
    }
}


set ::mw_classes [list Text Canvas Listbox Table TreeCtrl]
foreach class $::mw_classes { bind $class <MouseWheel> {} }
if {[tk windowingsystem] eq "x11"} {
    foreach class $::mw_classes {
        bind $class <4> {}
        bind $class <5> {}
    }
}

bind all <MouseWheel> [list MouseWheel %W %D %X %Y]
if {[tk windowingsystem] eq "x11"} {
    # Support for mousewheels on Linux/Unix commonly comes through
    # mapping the wheel to the extended buttons.
    bind all <4> [list MouseWheel %W 120 %X %Y]
    bind all <5> [list MouseWheel %W -120 %X %Y]
}