diff options
| author | wolfsuit <wolfsuit> | 2004-02-16 23:09:23 (GMT) |
|---|---|---|
| committer | wolfsuit <wolfsuit> | 2004-02-16 23:09:23 (GMT) |
| commit | 6b8cb98d74ed7563290ff2fe719b4694ef5de02c (patch) | |
| tree | 69f58a89b8fb407fc269b837af99f9d81fed77ca /library | |
| parent | 304822dcdcdc1a1445448a983ff16a5e6c8b4fc5 (diff) | |
| download | tk-6b8cb98d74ed7563290ff2fe719b4694ef5de02c.zip tk-6b8cb98d74ed7563290ff2fe719b4694ef5de02c.tar.gz tk-6b8cb98d74ed7563290ff2fe719b4694ef5de02c.tar.bz2 | |
This gets the scroll wheel working for listboxes and text widgets for Mac OS
X. It also changes the model to route scrollwheel events to the window under
the pointer, not the focus window on X (and only on X). That is the correct
behavior for Mac OS X.
Diffstat (limited to 'library')
| -rw-r--r-- | library/listbox.tcl | 13 | ||||
| -rw-r--r-- | library/text.tcl | 13 |
2 files changed, 20 insertions, 6 deletions
diff --git a/library/listbox.tcl b/library/listbox.tcl index ff3b549..dcc3cde 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk listbox widgets # and provides procedures that help in implementing those bindings. # -# RCS: @(#) $Id: listbox.tcl,v 1.13 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: listbox.tcl,v 1.13.2.1 2004/02/16 23:09:25 wolfsuit Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. @@ -179,8 +179,15 @@ bind Listbox <B2-Motion> { # someone could use the "event generate" command to produce one # on other platforms. -bind Listbox <MouseWheel> { - %W yview scroll [expr {- (%D / 120) * 4}] units +if {[string equal [tk windowingsystem] "classic"] + || [string equal [tk windowingsystem] "aqua"]} { + bind Listbox <MouseWheel> { + %W yview scroll [expr {- (%D)}] units + } +} else { + bind Listbox <MouseWheel> { + %W yview scroll [expr {- (%D / 120) * 4}] units + } } if {[string equal "x11" [tk windowingsystem]]} { diff --git a/library/text.tcl b/library/text.tcl index eb227c2..85d83f1 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.24 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: text.tcl,v 1.24.2.1 2004/02/16 23:09:25 wolfsuit Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -458,8 +458,15 @@ set ::tk::Priv(prevPos) {} # someone could use the "event generate" command to produce one # on other platforms. -bind Text <MouseWheel> { - %W yview scroll [expr {- (%D / 120) * 4}] units +if {[string equal [tk windowingsystem] "classic"] + || [string equal [tk windowingsystem] "aqua"]} { + bind Text <MouseWheel> { + %W yview scroll [expr {- (%D)}] units + } +} else { + bind Text <MouseWheel> { + %W yview scroll [expr {- (%D / 120) * 4}] units + } } if {[string equal "x11" [tk windowingsystem]]} { |