summaryrefslogtreecommitdiffstats
path: root/library/listbox.tcl
diff options
context:
space:
mode:
authorwolfsuit <wolfsuit>2004-02-16 23:09:23 (GMT)
committerwolfsuit <wolfsuit>2004-02-16 23:09:23 (GMT)
commit2da0744807fc66a4aa8bb9e0d30c15d10286e7aa (patch)
tree69f58a89b8fb407fc269b837af99f9d81fed77ca /library/listbox.tcl
parent4eac5db08a701bc00421a88d35f596085c1dcd4b (diff)
downloadtk-2da0744807fc66a4aa8bb9e0d30c15d10286e7aa.zip
tk-2da0744807fc66a4aa8bb9e0d30c15d10286e7aa.tar.gz
tk-2da0744807fc66a4aa8bb9e0d30c15d10286e7aa.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/listbox.tcl')
-rw-r--r--library/listbox.tcl13
1 files changed, 10 insertions, 3 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]]} {