summaryrefslogtreecommitdiffstats
path: root/library/demos
diff options
context:
space:
mode:
authordas <das>2005-12-13 03:44:33 (GMT)
committerdas <das>2005-12-13 03:44:33 (GMT)
commit3bdbff63fb0c811a2c2a1603ea18ac664882e8aa (patch)
tree6a819ca1e2c3174079895898e9a9b6227bb745e7 /library/demos
parente084245ccaf3d2437d5779d2846af55a36677cc6 (diff)
downloadtk-3bdbff63fb0c811a2c2a1603ea18ac664882e8aa.zip
tk-3bdbff63fb0c811a2c2a1603ea18ac664882e8aa.tar.gz
tk-3bdbff63fb0c811a2c2a1603ea18ac664882e8aa.tar.bz2
* library/demos/cscroll.tcl: add MouseWheel bindings for aqua.
* macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent, GenerateMouseWheelEvent): add support for kEventMouseScroll events (smooth mouse wheel scrolling from mighty mouse or scrolling trackpad) by handling kEventMouseWheelMoved on application target as well as on dispatcher, in order to pick up synthesized MouseWheel events from HIObject handler (c.f. QA1453); add support for horizontal scrolling events by generating MouseWheel XEvent with Shift modifier.
Diffstat (limited to 'library/demos')
-rw-r--r--library/demos/cscroll.tcl16
1 files changed, 15 insertions, 1 deletions
diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index 9e6600c..7ad390a 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a simple canvas that can be
# scrolled in two dimensions.
#
-# RCS: @(#) $Id: cscroll.tcl,v 1.5 2004/12/21 11:56:35 dkf Exp $
+# RCS: @(#) $Id: cscroll.tcl,v 1.6 2005/12/13 03:44:34 das Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -60,6 +60,20 @@ $c bind all <Any-Leave> "scrollLeave $c"
$c bind all <1> "scrollButton $c"
bind $c <2> "$c scan mark %x %y"
bind $c <B2-Motion> "$c scan dragto %x %y"
+if {[tk windowingsystem] eq "aqua"} {
+ bind $c <MouseWheel> {
+ %W yview scroll [expr {- (%D)}] units
+ }
+ bind $c <Option-MouseWheel> {
+ %W yview scroll [expr {-10 * (%D)}] units
+ }
+ bind $c <Shift-MouseWheel> {
+ %W xview scroll [expr {- (%D)}] units
+ }
+ bind $c <Shift-Option-MouseWheel> {
+ %W xview scroll [expr {-10 * (%D)}] units
+ }
+}
proc scrollEnter canvas {
global oldFill