summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorwolfsuit <wolfsuit>2004-02-16 23:09:23 (GMT)
committerwolfsuit <wolfsuit>2004-02-16 23:09:23 (GMT)
commit6b8cb98d74ed7563290ff2fe719b4694ef5de02c (patch)
tree69f58a89b8fb407fc269b837af99f9d81fed77ca /library
parent304822dcdcdc1a1445448a983ff16a5e6c8b4fc5 (diff)
downloadtk-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.tcl13
-rw-r--r--library/text.tcl13
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]]} {