TIP 171: Change Default <MouseWheel> Bindings Behavior

Login
Bounty program for improvements to Tcl and certain Tcl packages.
Author:         Jeff Hobbs <jeffh@activestate.com>
Author:         Keith Vetter <kvetter@alltel.net>
State:          Final
Type:           Project
Vote:           Done
Created:        05-Mar-2004
Post-History:   
Tcl-Version:    8.6

Abstract

This TIP proposes changing the default bindings in Tk to have "better" behaved defaults for a larger set of applications.

Rationale

The existing bindings only operate on a small handful of widgets, and only when they have focus. This essentially means that only the text widget ever has useful behavior. This is not how the majority of applications wish to use the MouseWheel. They operate primarily on a mouse-focus model (scroll what the mouse is over, not what has focus). In addition, horizontal scrolling support is added.

Specification

The bindings changes are very simply these:

proc ::tk::MouseWheel {wFired X Y D {shifted 0}} {
    # Set event to check based on call
    set evt "<[expr {$shifted?{Shift-}:{}}]MouseWheel>"
    # do not double-fire in case the class already has a binding
    if {[bind [winfo class $wFired] $evt] 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]} {
	if {[bind $w $evt] ne ""} {
	    # Awkward ... this widget has a MouseWheel binding, but to
	    # trigger successfully in it, we must give it focus.
	    catch {focus} old
	    if {$w ne $old} { focus $w }
	    event generate $w $evt -rootx $X -rooty $Y -delta $D
	    if {$w ne $old} { focus $old }
	    return
	}
	# aqua and x11/win32 have different delta handling
	if {[tk windowingsystem] ne "aqua"} {
	    set delta [expr {- ($D / 30)}]
	} else {
	    set delta [expr {- ($D)}]
	}
	# scrollbars have different call conventions
	if {[string match "*Scrollbar" [winfo class $w]]} {
	    catch {tk::ScrollByUnits $w \
		       [string index [$w cget -orient] 0] $delta}
	} else {
	    set cmd [list $w [expr {$shifted ? "xview" : "yview"}] \
			 scroll $delta units]
	    # Walking up to find the proper widget handles cases like
	    # embedded widgets in a canvas
	    while {[catch $cmd] && [winfo toplevel $w] ne $w} {
		set w [winfo parent $w]
	    }
	}
    }
}
bind all <MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 0]
bind all <Shift-MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 1]
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 ::tk::MouseWheel %W %X %Y 120]
    bind all <5> [list ::tk::MouseWheel %W %X %Y -120]
}

Instead of requiring a widget to have focus to receive MouseWheel events, the new proposal operates with MouseWheel as a global binding. When fired, it first does a safety check to prevent double-firing if an existing MouseWheel binding is on the widget. It then finds the widget which the mouse if over and uses that as the target for the scrolling event. If that widget doesn't exist (usually meaning that it returned {} indicating we are outside the Tk app), then use the widget which has the actual focus.

In scrolling, the scrollbar must be treated separately, since it has its own calling conventions. All others widgets get called with the standard yview scroll command, caught in case of errors, which are ignored.

This has been discussed on the tcl-mac mailing list already as the desired behavior, and confirmed to be more intuitive on Windows as well. The above code is already in use by applications that use widget extensions and megawidgets such as BWidgets without any adverse effects seen. Note that the existing MouseWheel bindings must first be removed, using the following code:

set mw_classes [list Text 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> {}
    }
}

Reference Implementation

See above.

Discussion

Shift-MouseWheel was added after initial discussion.

Use of "*Scrollbar" is to catch TScrollbar as well.

This is adapted from tklib/style/as.tcl mousewheel adjustments and has proved useful and workable across a variety of applications.

There is a bit of awkwardness in handling widgets that have their own MouseWheel bindings in that core Tk requires these have focus to receive the event. It may be better to fix this forced limitation in Tk rather than the special-case code above (although that code does work).

Copyright

This document has been placed in the public domain.

History