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

text% printer recognizes a line containing only a form-feed character and uses it as a page break; a form-feed character displays as ^L

Browse Source 
original commit: 92a410687731200c8167b29bdcefb7f86c2ead3f
This commit is contained in:
Matthew Flatt 2010-05-11 09:37:08 -06:00
commit b95d39c847
1 changed files with 69 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
collects/mred/private/wxme/text.rkt
View File

@ -5430,6 +5430,14 @@
(set! write-locked? wl?) (set! write-locked? wl?)
(set! flow-locked? fl?)))) (set! flow-locked? fl?))))
(define/private (new-page-line? line)
(let ([len (mline-len line)])
(and (<= 1 len 2)
(let* ([pos (mline-get-position line)]
[s (get-text pos (+ pos len))])
(or (equal? s "\f")
(equal? s "\f\n"))))))
(define/private (has/print-page dc page print?) (define/private (has/print-page dc page print?)
(if flow-locked? (if flow-locked?
#f #f
@ -5463,59 +5471,70 @@
[next-h 0.0]) [next-h 0.0])
(let loop ([h h] (let loop ([h h]
[i i] [i i]
[line line]) [line line]
(if (or (zero? h) [can-continue? #t]
(and (i . < . num-valid-lines) [unline 0.0])
((mline-h line) . < . (- H h)))) (cond
(loop (+ h (mline-h line)) [(or (zero? h)
(and (i . < . num-valid-lines)
((mline-h line) . < . (- H h))
can-continue?))
(let ([lh (mline-h line)]
[new-page? (new-page-line? line)])
(loop (+ h lh)
(add1 i) (add1 i)
(mline-next line)) (mline-next line)
(let-values ([(h i line) (not new-page?)
(if (and (h . < . H) (if new-page? lh unline)))]
(i . < . num-valid-lines) [else
((mline-h line) . > . H)) (let-values ([(h i line)
;; we'll have to break it up anyway; start now? (cond
[(and (h . < . H)
(i . < . num-valid-lines)
((mline-h line) . > . H))
;; we'll have to break it up anyway; start now?
(let* ([pos (find-scroll-line (+ y H))]
[py (scroll-line-location pos)])
(if (py . > . (+ y h))
;; yes, at least one line will fit
(values (+ h (mline-h line))
(add1 i)
(mline-next line))
(values h i line)))]
[else
(values h i line)])])
(let-values ([(next-h h)
(if (h . > . H)
;; only happens if we have something that's too big to fit on a page;
;; look for internal scroll positions
(let* ([pos (find-scroll-line (+ y H))] (let* ([pos (find-scroll-line (+ y H))]
[py (scroll-line-location pos)]) [py (scroll-line-location pos)])
(if (py . > . (+ y h)) (if (py . > . y)
;; yes, at least one line will fit (let ([new-h (- py y)])
(values (+ h (mline-h line)) (values (- h new-h)
(add1 i) new-h))
(mline-next line)) (values next-h h)))
(values h i line))) (values next-h h))])
(values h i line))]) (or (if print?
(let-values ([(next-h h) (begin
(if (h . > . H) (when (or (negative? page) (= this-page page))
;; only happens if we have something that's too big to fit on a page; (begin
;; look for internal scroll positions (when (negative? page)
(let* ([pos (find-scroll-line (+ y H))] (send dc start-page))
[py (scroll-line-location pos)]) (do-redraw dc
(if (py . > . y) (+ y (if (zero? i) 0 1))
(let ([new-h (- py y)]) (+ y (- h 1 unline))
(values (- h new-h) 0 W (+ (- y) vm) hm
new-h)) 'no-caret #f #f)
(values next-h h))) (when (negative? page)
(values next-h h))]) (send dc end-page))))
(or (if print? #f)
(begin (= this-page page))
(when (or (negative? page) (= this-page page)) (ploop (add1 this-page)
(begin line
(when (negative? page) (+ y h)
(send dc start-page)) next-h
(do-redraw dc i))))])))))))))))
(+ y (if (zero? i) 0 1))
(+ y (- h 1))
0 W (+ (- y) vm) hm
'no-caret #f #f)
(when (negative? page)
(send dc end-page))))
#f)
(= this-page page))
(ploop (add1 this-page)
line
(+ y h)
next-h
i)))))))))))))))
(define/override (do-has-print-page? dc page) (define/override (do-has-print-page? dc page)
(has/print-page dc page #f)) (has/print-page dc page #f))