From 7f650c4ab40059835666712ae3c95f76157988fa Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 23 Sep 2001 20:37:27 +0000
Subject: [PATCH] wheel events go by pages for unix

original commit: 1c9f723fb10911e993e0d3584d6f4739c411b6d0
---
 collects/framework/private/canvas.ss | 20 ++++++++++++++++++++
 collects/framework/private/main.ss   |  4 ++++
 2 files changed, 24 insertions(+)

diff --git a/collects/framework/private/canvas.ss b/collects/framework/private/canvas.ss
index 679c97d4..d9f11d0a 100644
--- a/collects/framework/private/canvas.ss
+++ b/collects/framework/private/canvas.ss
@@ -16,6 +16,26 @@
       (define basic<%> (interface ((class->interface editor-canvas%))))
       (define basic-mixin
 	(mixin ((class->interface editor-canvas%)) (basic<%>)
+          (inherit get-editor)
+          (rename [super-on-char on-char])
+          (define (do-keymap to-call evt)
+            (let ([t (get-editor)])
+              (when (is-a? t text%)
+                (let ([k (send t get-keymap)])
+                  (when k
+                    (send k call-function to-call t evt #t))))))
+          (define/override (on-char evt)
+            (let ([code (send evt get-key-code)])
+              (cond 
+                [(not (preferences:get 'framework:wheel-mouse-by-page))
+                 (super-on-char evt)]
+                [(eq? code 'wheel-up)
+                 (do-keymap "previous-page" evt)]
+                [(eq? code 'wheel-down)
+                 (do-keymap "next-page" evt)]
+                [else 
+                 (super-on-char evt)])))
+
           (super-instantiate ())))
       
       (define info<%> (interface (basic<%>)))
diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss
index 26988f38..2a6f7231 100644
--- a/collects/framework/private/main.ss
+++ b/collects/framework/private/main.ss
@@ -31,6 +31,10 @@
       (preferences:set-default 'framework:show-status-line #t boolean?)
       (preferences:set-default 'framework:line-offsets #t boolean?)
       
+      (preferences:set-default 'framework:wheel-mouse-by-page 
+                               (eq? (system-type) 'unix)
+                               boolean?)
+      
       (preferences:set-default
        'framework:print-output-mode
        'standard