Added support for the MouseWheel event.

10 files changed, 199 insertions, 31 deletions

diff --git a/changes b/changes
index 508f128..3f26b56 100644
--- a/changes
+++ b/changes
@@ -2,7 +2,7 @@ This file summarizes all changes made to Tk since version 1.0 was
 released on March 13, 1991.  Changes that aren't backward compatible
 are marked specially.
 
-RCS: @(#) $Id: changes,v 1.21 1998/09/14 18:22:44 stanton Exp $
+RCS: @(#) $Id: changes,v 1.22 1998/10/10 00:30:34 rjohnson Exp $
 
 3/16/91 (bug fix) Modified tkWindow.c to remove Tk's Tcl commands from
 the interpreter when the main window is deleted (otherwise there will
@@ -4250,3 +4250,13 @@ on windows.  If you build your own Tk main program, you no longer
 need to compile and link this yourself. (SKS)
 
 -------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/13/98 ------
+
+10/5/98 (new feature) Added the event "MouseWheel" that will fire on
+Windows applications in response to mouse wheel movement.  You can
+bind to the MouseWheel event and use the %D substitution to get the
+delta the wheel moved.  The "event generate" command has also been
+enhanced with the -delta flag so you can generate these events from
+Tcl.  See the bind and event man pages for more details.  The listbox
+and text widgets' default bindings have been updated to understand
+MouseWheel events. (RJ)
+
diff --git a/doc/bind.n b/doc/bind.n
index 199829c..87d7b93 100644
--- a/doc/bind.n
+++ b/doc/bind.n
@@ -1,14 +1,15 @@
 '\"
 '\" Copyright (c) 1990 The Regents of the University of California.
 '\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998 by Scriptics Corporation.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: bind.n,v 1.2 1998/09/14 18:22:54 stanton Exp $
+'\" RCS: @(#) $Id: bind.n,v 1.3 1998/10/10 00:30:35 rjohnson Exp $
 '\" 
 .so man.macros
-.TH bind n 4.1 Tk "Tk Built-In Commands"
+.TH bind n 8.0 Tk "Tk Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -158,20 +159,59 @@ time and space requirement.
 .SH "EVENT TYPES"
 .PP
 The \fItype\fR field may be any of the standard X event types, with a
-few extra abbreviations.  Below is a list of all the valid types;
-where two names appear together, they are synonyms.
+few extra abbreviations.  The \fItype\fR field will also accept a
+couple non-standard X event types that were added to better support
+the Macintosh and Windows platforms.  Below is a list of all the valid
+types; where two names appear together, they are synonyms.
 .DS C
 .ta 5c 10c
-\fBButtonPress, Button	Expose	Map
-ButtonRelease	FocusIn	Motion
-Circulate	FocusOut	Property	
+\fBActivate	Enter	Map
+ButtonPress, Button	Expose	Motion
+.VS
+ButtonRelease	FocusIn	MouseWheel	
+.VE
+Circulate	FocusOut	Property
 Colormap	Gravity	Reparent
 Configure	KeyPress, Key	Unmap
-Destroy	KeyRelease	Visibility
-Enter	Leave	Activate
-Deactivate\fR
+Deactivate	KeyRelease	Visibility
+Destroy	Leave\fR
 .DE
 .PP
+.VS
+Most of the above events have the same fields and behaviors as events
+in the X Windowing system.  You can find more detailed descriptions of
+these events in any X window programming book.  A couple of the events
+are extensions to the X event system to support features unique to the
+Macintosh and Windows platforms.  We provide a little more detail on
+these events here.  These include:
+.IP \fBActivate\fR 5
+.IP \fBDeactivate\fR 5
+These two events are sent to every sub-window of a toplevel when they
+change state.  In addition to the focus Window, the Macintosh platform
+and Windows platforms have a notion of an active window (which often
+has but is not required to have the focus).  On the Macintosh, widgets
+in the active window have a different appearance than widgets in
+deactive windows.  The \fBActivate\fR event is sent to all the
+sub-windows in a toplevel when it changes from being deactive to
+active.  Likewise, the \fBDeactive\fR event is sent when the window's
+state changes from active to deactive.  There are no useful percent
+substitutions you would make when binding to these events.
+.IP \fBMouseWheel\fR 5
+Some mice on the Windows platform support a mouse wheel which is used
+for scrolling documents without using the scrollbars.  By rolling the
+wheel, the system will generate \fBMouseWheel\fR events that the
+application can use to scroll.  Like \fBKey\fR events the event is
+always routed to the window that currently has focus. When the event
+is received you can use the \fB%D\fR substitution to get the
+\fIdelta\fR field for the event which is a integer value of motion
+that the mouse wheel has moved.  The smallest value for which the
+system will report is defined by the OS.  On Windows 95 & 98 machines
+this value is at least 120 before it is reported.  However, higher
+resolution devices may be available in the future.  The sign of the
+value determines which direction your widget should scroll.  Positive
+values should scroll up and negative values should scroll down.
+.VE
+.PP
 The last part of a long event specification is \fIdetail\fR.  In the
 case of a \fBButtonPress\fR or \fBButtonRelease\fR event, it is the
 number of a button (1-5).  If a button number is given, then only an
@@ -258,7 +298,7 @@ The \fIfocus\fR field from the event (\fB0\fR or \fB1\fR).  Valid only
 for \fBEnter\fR and \fBLeave\fR events.
 .IP \fB%h\fR 5
 .VS
-The \fIheight\fR field from the event.  Valid only for \fBConfigure\fR and
+The \fIheight\fR field from the event.  Valid for the \fBConfigure\fR and
 \fBExpose\fR events.
 .VE
 .IP \fB%k\fR 5
@@ -308,6 +348,15 @@ Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
 .IP \fB%B\fR 5
 The \fIborder_width\fR field from the event.  Valid only for
 \fBConfigure\fR events.
+.VS
+.IP \fB%D\fR 5
+This reports the \fIdelta\fR value of a \fBMouseWheel\fR event.  The
+\fIdelta\fR value represents the rotation units the mouse wheel has
+been moved.  On Windows 95 & 98 systems the smallest value for the
+delta is 120.  Future systems may support higher resolution values for
+the delta.  The sign of the value represents the direction the mouse
+wheel was scrolled.
+.VE
 .IP \fB%E\fR 5
 The \fIsend_event\fR field from the event.  Valid for all event types.
 .IP \fB%K\fR 5
diff --git a/doc/event.n b/doc/event.n
index 0f1ac60..b6e4854 100644
--- a/doc/event.n
+++ b/doc/event.n
@@ -1,13 +1,14 @@
 '\"
 '\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998 by Scriptics Corporation.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: event.n,v 1.2 1998/09/14 18:22:55 stanton Exp $
+'\" RCS: @(#) $Id: event.n,v 1.3 1998/10/10 00:30:35 rjohnson Exp $
 '\" 
 .so man.macros
-.TH event n 4.4 Tk "Tk Built-In Commands"
+.TH event n 8.0 Tk "Tk Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -105,6 +106,19 @@ Corresponds to the \fB%b\fR substitution for binding scripts.
 for the event.  Valid for \fBExpose\fR events.
 Corresponds to the \fB%c\fR substitution for binding scripts.
 .TP
+\fB\-delta\fI number\fR
+.VS
+\fINumber\fR must be an integer;  it specifies the \fIdelta\fR field
+for the \fBMouseWheel\fR event.  The \fIdelta\fR refers to the
+direction and magnitude the mouse wheel was rotated.  Note the value
+is not a screen distance but are units of motion in the mouse wheel.
+Typically these values are multiples of 120.  For example, 120 should
+scroll the text widget up 4 lines and -240 would scroll the text
+widget down 8 lines.  Of course, other widgets may define different
+behaviors for mouse wheel motion.  This field corresponds to the
+\fB%D\fR substitution for binding scripts.
+.VE
+.TP
 \fB\-detail\fI detail\fR
 \fIDetail\fR specifies the \fIdetail\fR field for the event
 and must be one of the following:
diff --git a/generic/tk.h b/generic/tk.h
index ddfd176..de694ae 100644
--- a/generic/tk.h
+++ b/generic/tk.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tk.h,v 1.13 1998/09/30 19:01:19 rjohnson Exp $
+ * RCS: @(#) $Id: tk.h,v 1.14 1998/10/10 00:30:35 rjohnson Exp $
  */
 
 #ifndef _TK
@@ -416,11 +416,14 @@ typedef struct Tk_GeomMgr {
 #define VirtualEvent	    (LASTEvent)
 #define ActivateNotify	    (LASTEvent + 1)
 #define DeactivateNotify    (LASTEvent + 2)
-#define TK_LASTEVENT	    (LASTEvent + 3)
+#define MouseWheelEvent     (LASTEvent + 3)
+#define TK_LASTEVENT	    (LASTEvent + 4)
+
+#define MouseWheelMask	    (1L << 28)
 
-#define VirtualEventMask    (1L << 30)
 #define ActivateMask	    (1L << 29)
-#define TK_LASTEVENT	    (LASTEvent + 3)
+#define VirtualEventMask    (1L << 30)
+#define TK_LASTEVENT	    (LASTEvent + 4)
 
 
 /*
diff --git a/generic/tkBind.c b/generic/tkBind.c
index 6fcafd2..8166b18 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -6,11 +6,12 @@
  *
  * Copyright (c) 1989-1994 The Regents of the University of California.
  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkBind.c,v 1.3 1998/09/14 18:23:03 stanton Exp $
+ * RCS: @(#) $Id: tkBind.c,v 1.4 1998/10/10 00:30:36 rjohnson Exp $
  */
 
 #include "tkPort.h"
@@ -495,6 +496,7 @@ static EventInfo eventArray[] = {
     {"Colormap",	ColormapNotify,		ColormapChangeMask},
     {"Activate",	ActivateNotify,		ActivateMask},
     {"Deactivate",	DeactivateNotify,	ActivateMask},
+    {"MouseWheel",	MouseWheelEvent,	MouseWheelMask},
     {(char *) NULL,	0,			0}
 };
 static Tcl_HashTable eventTable;
@@ -567,7 +569,8 @@ static int flagArray[TK_LASTEVENT] = {
    /* MappingNotify */		0,
    /* VirtualEvent */		VIRTUAL,
    /* Activate */		ACTIVATE,	    
-   /* Deactivate */		ACTIVATE
+   /* Deactivate */		ACTIVATE,
+   /* MouseWheel */		KEY
 };
 
 /*
@@ -2394,6 +2397,13 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
 	    case 'B':
 		number = eventPtr->xcreatewindow.border_width;
 		goto doNumber;
+	    case 'D':
+		/*
+		 * This is used only by the MouseWheel event.
+		 */
+		    
+		number = eventPtr->xkey.keycode;
+		goto doNumber;
 	    case 'E':
 		number = (int) eventPtr->xany.send_event;
 		goto doNumber;
@@ -3164,7 +3174,7 @@ HandleEventGenerate(interp, mainwin, argc, argv)
     flags = flagArray[event.xany.type];
     if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
 	event.xkey.state = pat.needMods;
-	if (flags & KEY) {
+	if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {
 	    /*
 	     * When mapping from a keysym to a keycode, need information about
 	     * the modifier state that should be used so that when they call 
@@ -3279,6 +3289,15 @@ HandleEventGenerate(interp, mainwin, argc, argv)
 	    } else {
 		goto badopt;
 	    }
+	} else if (strcmp(field, "-delta") == 0) {
+	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
+	        event.xkey.keycode = number;
+	    } else {
+		goto badopt;
+	    }
 	} else if (strcmp(field, "-detail") == 0) {
 	    number = TkFindStateNum(interp, field, notifyDetail, value);
 	    if (number < 0) {
@@ -3315,7 +3334,7 @@ HandleEventGenerate(interp, mainwin, argc, argv)
 	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (flags & KEY) {
+	    if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
 	        event.xkey.keycode = number;
 	    } else {
 		goto badopt;
@@ -3353,7 +3372,7 @@ HandleEventGenerate(interp, mainwin, argc, argv)
 		    break;
 		}
 	    }	    
-	    if (flags & KEY) {
+	    if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
 		event.xkey.keycode = number;
 	    } else {
 		goto badopt;
diff --git a/generic/tkEvent.c b/generic/tkEvent.c
index 2e32b8f..6403001 100644
--- a/generic/tkEvent.c
+++ b/generic/tkEvent.c
@@ -6,11 +6,12 @@
  *
  * Copyright (c) 1990-1994 The Regents of the University of California.
  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkEvent.c,v 1.2 1998/09/14 18:23:09 stanton Exp $
+ * RCS: @(#) $Id: tkEvent.c,v 1.3 1998/10/10 00:30:36 rjohnson Exp $
  */
 
 #include "tkPort.h"
@@ -129,7 +130,8 @@ static unsigned long eventMasks[TK_LASTEVENT] = {
     0,					/* Mapping Notify */
     VirtualEventMask,			/* VirtualEvents */
     ActivateMask,			/* ActivateNotify */
-    ActivateMask			/* DeactivateNotify */
+    ActivateMask,			/* DeactivateNotify */
+    MouseWheelMask			/* MouseWheelEvent */
 };
 
 /*
@@ -546,10 +548,13 @@ Tk_HandleEvent(eventPtr)
     
 	/*
 	 * Redirect KeyPress and KeyRelease events to the focus window,
-	 * or ignore them entirely if there is no focus window.
+	 * or ignore them entirely if there is no focus window.  We also
+	 * route the MouseWheel event to the focus window.  The MouseWheel
+	 * event is an extension to the X event set.  Currently, it is only
+	 * available on the Windows version of Tk.
 	 */
     
-	if (mask & (KeyPressMask|KeyReleaseMask)) {
+	if (mask & (KeyPressMask|KeyReleaseMask|MouseWheelMask)) {
 	    winPtr->dispPtr->lastEventTime = eventPtr->xkey.time;
 	    winPtr = TkFocusKeyEvent(winPtr, eventPtr);
 	    if (winPtr == NULL) {
diff --git a/library/listbox.tcl b/library/listbox.tcl
index ebef6ed..45f0b9b 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,10 +3,11 @@
 # 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.3 1998/09/14 18:23:23 stanton Exp $
+# RCS: @(#) $Id: listbox.tcl,v 1.4 1998/10/10 00:30:36 rjohnson Exp $
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -171,6 +172,14 @@ bind Listbox <B2-Motion> {
     %W scan dragto %x %y
 }
 
+# The MouseWheel will typically only fire on Windows.  However,
+# someone could use the "event generate" command to produce one
+# on other platforms.
+
+bind Listbox <MouseWheel> {
+    %W yview scroll [expr - (%D / 120) * 4] units
+}
+
 # tkListboxBeginSelect --
 #
 # This procedure is typically invoked on button-1 presses.  It begins
diff --git a/library/text.tcl b/library/text.tcl
index b0bc2e5..6ef185c 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,10 +3,11 @@
 # 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.4 1998/09/14 18:23:25 stanton Exp $
+# RCS: @(#) $Id: text.tcl,v 1.5 1998/10/10 00:30:36 rjohnson Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -447,6 +448,14 @@ bind Text <B2-Motion> {
 }
 set tkPriv(prevPos) {}
 
+# The MouseWheel will typically only fire on Windows.  However,
+# someone could use the "event generate" command to produce one
+# on other platforms.
+
+bind Text <MouseWheel> {
+    %W yview scroll [expr - (%D / 120) * 4] units
+}
+
 # tkTextClosestGap --
 # Given x and y coordinates, this procedure finds the closest boundary
 # between characters to the given coordinates and returns the index
diff --git a/tests/bind.test b/tests/bind.test
index b70cc21..e3e5f51 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -4,11 +4,12 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: bind.test,v 1.3 1998/09/14 18:23:42 stanton Exp $
+# RCS: @(#) $Id: bind.test,v 1.4 1998/10/10 00:30:37 rjohnson Exp $
 
 if {[string compare test [info procs test]] != 0} {
     source defs
@@ -2532,5 +2533,27 @@ test bind-30.2 {Tk_BackgroundError procedure} {
     (command bound to event)}}
 rename bgerror {}
 
+test bind-31.1 {MouseWheel events} {
+    setup
+    set x {}
+    bind .b.f <MouseWheel> {set x Wheel}
+    event gen .b.f <MouseWheel>
+    set x
+} {Wheel}
+test bind-31.2 {MouseWheel events} {
+    setup
+    set x {}
+    bind .b.f <MouseWheel> {set x %D}
+    event gen .b.f <MouseWheel> -delta 120
+    set x
+} {120}
+test bind-31.2 {MouseWheel events} {
+    setup
+    set x {}
+    bind .b.f <MouseWheel> {set x "%D %x %y"}
+    event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30
+    set x
+} {240 10 30}
+
 
 destroy .b
diff --git a/win/tkWinX.c b/win/tkWinX.c
index 0d776a2..50a9e24 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -5,17 +5,24 @@
  *
  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  * Copyright (c) 1994 Software Research Associates, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinX.c,v 1.3 1998/09/14 18:24:01 stanton Exp $
+ * RCS: @(#) $Id: tkWinX.c,v 1.4 1998/10/10 00:30:37 rjohnson Exp $
  */
 
 #include "tkInt.h"
 #include "tkWinInt.h"
 
 /*
+ * The zmouse.h file includes the definition for WM_MOUSEWHEEL.
+ */
+
+#include <zmouse.h>
+
+/*
  * Definitions of extern variables supplied by this file.
  */
 
@@ -591,6 +598,7 @@ Tk_TranslateWinEvent(hwnd, message, wParam, lParam, resultPtr)
 	case WM_SYSKEYUP:
 	case WM_KEYDOWN:
 	case WM_KEYUP:
+	case WM_MOUSEWHEEL:
  	    GenerateXEvent(hwnd, message, wParam, lParam);
 	    return 1;
 	case WM_MENUCHAR:
@@ -698,6 +706,13 @@ GenerateXEvent(hwnd, message, wParam, lParam)
 	    event.xselectionclear.time = TkpGetMS();
 	    break;
 	    
+	case WM_MOUSEWHEEL:
+	    /*
+	     * The mouse wheel event is closer to a key event than a
+	     * mouse event in that the message is sent to the window
+	     * that has focus.
+	     */
+	    
 	case WM_CHAR:
 	case WM_SYSKEYDOWN:
 	case WM_SYSKEYUP:
@@ -739,6 +754,18 @@ GenerateXEvent(hwnd, message, wParam, lParam)
 	     */
 
 	    switch (message) {
+		case WM_MOUSEWHEEL:
+		    /*
+		     * We have invented a new X event type to handle
+		     * this event.  It still uses the KeyPress struct.
+		     * However, the keycode field has been overloaded
+		     * to hold the zDelta of the wheel.
+		     */
+		    
+		    event.type = MouseWheelEvent;
+		    event.xany.send_event = -1;
+		    event.xkey.keycode = (short) HIWORD(wParam);
+		    break;
 		case WM_SYSKEYDOWN:
 		case WM_KEYDOWN:
 		    /*