Add hack to utilize mouse wheel under X.

diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index e6dc079ff44f285f0dbc54df709e21a890096408..f93372dd02ac42d56c1abf93a8f40c8461d89951 100644 (file)
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: modefs.scm,v 1.158 2000/03/25 18:49:16 cph Exp $
+;;; $Id: modefs.scm,v 1.159 2000/06/11 04:24:36 cph Exp $
 ;;;
 ;;; Copyright (c) 1985, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -379,6 +379,9 @@ Like Fundamental mode, but no self-inserting characters.")
 ;;; Mouse buttons:
 
 (define-key 'fundamental button1-down 'mouse-set-point)
+;; Next two are for wheel mouse under X.
+(define-key 'fundamental button4-down 'mouse-scroll-down)
+(define-key 'fundamental button5-down 'mouse-scroll-up)
 (define-key 'fundamental button1-up 'mouse-ignore)
 (define-key 'fundamental button2-up 'mouse-ignore)
 (define-key 'fundamental button3-up 'mouse-ignore)

diff --git a/v7/src/edwin/mousecom.scm b/v7/src/edwin/mousecom.scm
index 99e69623bef305982de1608a2e3faa1ca074fece..059eedc1c29f94cd2158a374e9a6ab497bfab90c 100644 (file)
--- a/v7/src/edwin/mousecom.scm
+++ b/v7/src/edwin/mousecom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: mousecom.scm,v 1.3 1999/01/28 04:16:34 cph Exp $
+;;; $Id: mousecom.scm,v 1.4 2000/06/11 04:24:30 cph Exp $
 ;;;
-;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1989-2000 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -70,7 +70,7 @@ Display cursor at that position for a second."
                   (buffer-end (window-buffer window)))))
          (push-current-mark! mark)
          (mark-flash mark))))))
-
+\f
 (define-command mouse-show-event
   "Show the mouse position in the minibuffer."
   ()
@@ -80,6 +80,27 @@ Display cursor at that position for a second."
               " x: " (button-event/x button-event)
               " y: " (button-event/y button-event)))))
 
+(define-command mouse-scroll-up
+  "Scroll up mouse-scroll-increment lines."
+  ()
+  (lambda ()
+    (scroll-window (selected-window)
+                  (ref-variable mouse-scroll-increment)
+                  (lambda () unspecific))))
+
+(define-command mouse-scroll-down
+  "Scroll down mouse-scroll-increment lines."
+  ()
+  (lambda ()
+    (scroll-window (selected-window)
+                  (- (ref-variable mouse-scroll-increment))
+                  (lambda () unspecific))))
+
+(define-variable mouse-scroll-increment
+  "Number of lines by which a mouse-scroll event moves."
+  10
+  exact-nonnegative-integer?)
+
 (define-command mouse-ignore
   "Don't do anything."
   ()