wheel events go by pages for unix

original commit: 1c9f723fb10911e993e0d3584d6f4739c411b6d0

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<%>)))

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