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

pasteboard printing fix & editor-canvas chaining fix

Browse Source 
svn: r14490

original commit: ccf5809b45a62393491203add9e73fda2fb03cc5
This commit is contained in:
Matthew Flatt 2009-04-11 14:07:39 +00:00
parent 26bc2fa829
commit 7aac5a7004
2 changed files with 30 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -907,14 +907,15 @@
(set! media #f)
(if oldadmin
(begin
(send admin set-nextadmin oldadmin)
(send admin set-prevadmin (send oldadmin get-prevadmin))
(send oldadmin set-prevadmin admin)
(send oldadmin adjust-std-flag)
(let ([a (send admin get-prevadmin)])
(when a
(send a set-nextadmin admin)
(send a adjust-std-flag)))
(unless (in-chain? admin oldadmin)
(send admin set-nextadmin oldadmin)
(send admin set-prevadmin (send oldadmin get-prevadmin))
(send oldadmin set-prevadmin admin)
(send oldadmin adjust-std-flag)
(let ([a (send admin get-prevadmin)])
(when a
(send a set-nextadmin admin)
(send a adjust-std-flag))))
;; get the right cursor:
(send admin update-cursor))
(begin
@ -927,6 +928,16 @@
(when update?
(repaint))))
(define/private (in-chain? admin oldadmin)
(or (let loop ([oldadmin oldadmin])
(and oldadmin
(or (eq? admin oldadmin)
(loop (send oldadmin get-prevadmin)))))
(let loop ([oldadmin oldadmin])
(and oldadmin
(or (eq? admin oldadmin)
(loop (send oldadmin get-nextadmin)))))))
(define/public (allow-scroll-to-last to-last?)
(set! scroll-to-last? to-last?)
(reset-visual #f)

21
collects/mred/private/wxme/pasteboard.ss
View File

@ -2088,8 +2088,8 @@
[h 0.0])
(get-extent w h)
(let ([hcount (->long (ceiling (/ W w)))]
[vcount (->long (ceiling (/ H h)))])
(let ([hcount (->long (ceiling (/ w W)))]
[vcount (->long (ceiling (/ h H)))])
(if (not print?)
(page . <= . (* hcount vcount))
@ -2097,20 +2097,21 @@
(if (negative? page)
(values 1 (* hcount vcount))
(values page page))])
(for ([p (in-range start end)])
(for ([p (in-range start (add1 end))])
(let ([vpos (quotient (- p 1) hcount)]
[hpos (modulo (- p 1) hcount)])
(let ([x (* hpos w)]
[y (* vpos h)])
(when (negative? page)
(send dc start-page)
(send dc start-page))
(draw dc (+ (- x) hm) (+ (- y) vm)
x y (+ x w) (+ y h)
#f
#f)
(when (negative? page)
(send dc end-page))))))))))))))
(draw dc (+ (- x) hm) (+ (- y) vm)
x y (+ x w) (+ y h)
'no-caret
#f)
(when (negative? page)
(send dc end-page)))))))))))))
;; ----------------------------------------
)