suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

editor-canvas clean-up of internal scroll method

Browse Source 
svn: r14481

original commit: 8fe203ad728c57f08f7c1f69fffc0c52567efecb
This commit is contained in:
Matthew Flatt 2009-04-09 23:22:50 +00:00
parent 237172a3e1
commit 52ab67351a
1 changed files with 19 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
collects/mred/private/wxme/editor-canvas.ss
View File

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