summaryrefslogtreecommitdiffstats
path: root/library/demos/cscroll.tcl
diff options
context:
space:
mode:
authordas <das>2005-12-13 03:44:41 (GMT)
committerdas <das>2005-12-13 03:44:41 (GMT)
commitc97f485feb8a8de6050fa13f72a5a808cc6f05d0 (patch)
treefbb79b1fd0e2a596050d2b087290c6b5ecf7a3b5 /library/demos/cscroll.tcl
parentd5a443172ee410e009c7e6d7769f8b774d74d3e0 (diff)
downloadtk-c97f485feb8a8de6050fa13f72a5a808cc6f05d0.zip
tk-c97f485feb8a8de6050fa13f72a5a808cc6f05d0.tar.gz
tk-c97f485feb8a8de6050fa13f72a5a808cc6f05d0.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/cscroll.tcl')
-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 8aad050..1a01417 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.3 2001/06/14 10:56:58 dkf Exp $
+# RCS: @(#) $Id: cscroll.tcl,v 1.3.4.1 2005/12/13 03:44:42 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