From 52ab67351a4791e392797a6b15c24a097fd3d890 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 9 Apr 2009 23:22:50 +0000 Subject: [PATCH] editor-canvas clean-up of internal scroll method svn: r14481 original commit: 8fe203ad728c57f08f7c1f69fffc0c52567efecb --- collects/mred/private/wxme/editor-canvas.ss | 41 ++++++++++----------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/collects/mred/private/wxme/editor-canvas.ss b/collects/mred/private/wxme/editor-canvas.ss index eb0c6a25..78c236f9 100644 --- a/collects/mred/private/wxme/editor-canvas.ss +++ b/collects/mred/private/wxme/editor-canvas.ss @@ -427,7 +427,7 @@ -1 1)) 0)]) - (scroll x y #t))))] + (do-scroll x y #t))))] [else (when (and media (not (send media get-printing))) (using-admin @@ -673,7 +673,7 @@ (send hscroll set-value sx)) (when vscroll (send vscroll set-value sy)) - (scroll sx sy refresh?) + (do-scroll sx sy refresh?) #t) #f))))))))) @@ -840,26 +840,23 @@ retval))))))) - (define/override scroll - (case-lambda - [(x y refresh?) - (let ([savenoloop? noloop?]) - (set! noloop? #t) - - (when (and (x . > . -1) - (not fake-x-scroll?)) - (when (positive? scroll-width) - (set-scroll-pos 'horizontal (->long (min x scroll-width))))) - - (when (and (y . > . -1) - (not fake-y-scroll?)) - (when (positive? scroll-height) - (set-scroll-pos 'vertical (->long (min y scroll-height))))) - - (set! noloop? savenoloop?) - - (when refresh? (repaint)))] - [(scroll x y) (void)])) + (define/private (do-scroll x y refresh?) + (let ([savenoloop? noloop?]) + (set! noloop? #t) + + (when (and (x . > . -1) + (not fake-x-scroll?)) + (when (positive? scroll-width) + (set-scroll-pos 'horizontal (->long (min x scroll-width))))) + + (when (and (y . > . -1) + (not fake-y-scroll?)) + (when (positive? scroll-height) + (set-scroll-pos 'vertical (->long (min y scroll-height))))) + + (set! noloop? savenoloop?) + + (when refresh? (repaint)))) (define/override (set-scrollbars x y x2 y2 x3 y3 x4 y4 ?) (void))