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