From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 11 Jun 2000 04:24:36 +0000 (+0000)
Subject: Add hack to utilize mouse wheel under X.
X-Git-Tag: 20090517-FFI~3554
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ae4fc84ac0d67cf3b1109f88a79d88e8fb52680a;p=mit-scheme.git

Add hack to utilize mouse wheel under X.
---

diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index e6dc079ff..f93372dd0 100644
--- 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 99e69623b..059eedc1c 100644
--- 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))))))
-
+
 (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."
   ()