From 183323a2c5712ec851148e804255665ede9fa8e6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 18 Jan 2011 14:16:25 -0700 Subject: [PATCH] fix `editor<%>' printing problems - pagination for `pastebard%' - always put everything on a single page for EPS mode - add PDF support to mirror PS support --- collects/mred/private/wxme/editor.rkt | 44 ++++++++++++++++++---- collects/mred/private/wxme/pasteboard.rkt | 29 ++++++++------ collects/mred/private/wxme/text.rkt | 19 ++++++---- collects/mred/private/wxme/wx.rkt | 1 + collects/scribblings/gui/editor-intf.scrbl | 35 +++++++++-------- 5 files changed, 86 insertions(+), 42 deletions(-) diff --git a/collects/mred/private/wxme/editor.rkt b/collects/mred/private/wxme/editor.rkt index 7d80b25ab5..ef04aba583 100644 --- a/collects/mred/private/wxme/editor.rkt +++ b/collects/mred/private/wxme/editor.rkt @@ -2,6 +2,7 @@ (require scheme/class (for-syntax scheme/base) scheme/file + racket/port "../syntax.ss" "private.ss" racket/snip @@ -760,25 +761,52 @@ (def/public (print [bool? [interactive? #t]] [bool? [fit-to-page? #t]] - [(symbol-in standard postscript) [output-mode 'standard]] + [(symbol-in standard postscript pdf) [output-mode 'standard]] [any? [parent #f]] ; checked in ../editor.ss [bool? [force-page-bbox? #t]] [bool? [as-eps? #f]]) - (let ([ps? (eq? output-mode 'postscript)] + (let ([ps? (or (eq? output-mode 'postscript) + (eq? output-mode 'pdf))] [parent (or parent (extract-parent))]) (cond [ps? - (let ([dc (make-object post-script-dc% interactive? parent force-page-bbox? as-eps?)]) + (let* ([ps-dc% (if (eq? output-mode 'postscript) post-script-dc% pdf-dc%)] + [dc (if as-eps? + ;; just for size: + (new ps-dc% [interactive #f] [output (open-output-nowhere)]) + ;; actual target: + (make-object ps-dc% interactive? parent force-page-bbox? #f))]) (when (send dc ok?) (send dc start-doc "printing buffer") (set! printing dc) (let ([data (do-begin-print dc fit-to-page?)]) - (print-to-dc dc) - (set! printing #f) - (do-end-print dc data) - (send dc end-doc) - (invalidate-bitmap-cache 0.0 0.0 'end 'end))))] + (let ([new-dc + (if as-eps? + ;; now that we know the size, create the actual target: + (let ([w (box 0)] + [h (box 0)] + [sx (box 0)] + [sy (box 0)]) + (get-extent w h) + (send (current-ps-setup) get-scaling sx sy) + (let ([dc (make-object ps-dc% interactive? parent force-page-bbox? + #t + (* (unbox w) (unbox sx)) + (* (unbox h) (unbox sy)))]) + (and (send dc ok?) + (send dc start-doc "printing buffer") + (set! printing dc) + dc))) + dc)]) + (when new-dc + (print-to-dc new-dc (if as-eps? 0 -1)) + (when as-eps? + (send new-dc end-doc))) + (set! printing #f) + (do-end-print dc data) + (send dc end-doc) + (invalidate-bitmap-cache 0.0 0.0 'end 'end)))))] [else (let ([data #f]) (run-printout ;; from wx diff --git a/collects/mred/private/wxme/pasteboard.rkt b/collects/mred/private/wxme/pasteboard.rkt index a0ce97fd5f..f52f7c0270 100644 --- a/collects/mred/private/wxme/pasteboard.rkt +++ b/collects/mred/private/wxme/pasteboard.rkt @@ -2118,36 +2118,41 @@ (when (or (zero? (unbox w)) (zero? (unbox h))) (get-default-print-size w h)) - (send (current-ps-setup) get-editor-margin hm vm)) + (unless (zero? page) + (send (current-ps-setup) get-editor-margin hm vm))) (let ([W (- w (* 2 hm))] - [H (- h (* 2 vm))]) + [H (- h (* 2 vm))] + [eps? (zero? page)]) (let-boxes ([w 0.0] [h 0.0]) (get-extent w h) - (let ([hcount (->long (ceiling (/ w W)))] - [vcount (->long (ceiling (/ h H)))]) + (let ([hcount (if eps? 1 (->long (ceiling (/ w W))))] + [vcount (if eps? 1 (->long (ceiling (/ h H))))]) (if (not print?) (page . <= . (* hcount vcount)) (let-values ([(start end) - (if (negative? page) - (values 1 (* hcount vcount)) - (values page page))]) + (cond + [(zero? page) (values 1 1)] + [(negative? page) + (values 1 (* hcount vcount))] + [else + (values page page)])]) (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) + (let ([x (* hpos W)] + [y (* vpos H)]) + (when (page . <= . 0) (send dc start-page)) (draw dc (+ (- x) hm) (+ (- y) vm) - x y (+ x w) (+ y h) + x y (+ x (if eps? w W)) (+ y (if eps? h H)) 'no-caret #f) - (when (negative? page) + (when (page . <= . 0) (send dc end-page))))))))))))) ;; ---------------------------------------- diff --git a/collects/mred/private/wxme/text.rkt b/collects/mred/private/wxme/text.rkt index 806056fc91..67462c398e 100644 --- a/collects/mred/private/wxme/text.rkt +++ b/collects/mred/private/wxme/text.rkt @@ -5593,7 +5593,8 @@ (begin (when (or (zero? (unbox W)) (zero? (unbox H))) (get-default-print-size W H)) - (send (current-ps-setup) get-editor-margin hm vm)) + (when (not (zero? page)) + (send (current-ps-setup) get-editor-margin hm vm))) (let ([H (- H (* 2 vm))] [W (- W (* 2 hm))]) @@ -5619,7 +5620,8 @@ (cond [(or (zero? h) (and (i . < . num-valid-lines) - ((mline-h line) . < . (- H h)) + (or (zero? page) + ((mline-h line) . < . (- H h))) can-continue?)) (let ([lh (mline-h line)] [new-page? (new-page-line? line)]) @@ -5631,7 +5633,8 @@ [else (let-values ([(h i line) (cond - [(and (h . < . H) + [(and (not (zero? page)) + (h . < . H) (i . < . num-valid-lines) ((mline-h line) . > . H)) ;; we'll have to break it up anyway; start now? @@ -5646,7 +5649,8 @@ [else (values h i line)])]) (let-values ([(next-h h) - (if (h . > . H) + (if (and (not (zero? page)) + (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))] @@ -5659,16 +5663,17 @@ (values next-h h))]) (or (if print? (begin - (when (or (negative? page) (= this-page page)) + (when (or (page . <= . 0) + (= this-page page)) (begin - (when (negative? page) + (when (page . <= . 0) (send dc start-page)) (do-redraw dc (+ y (if (zero? i) 0 1)) (+ y (- h 1 unline)) 0 W (+ (- y) vm) hm 'no-caret #f #f) - (when (negative? page) + (when (page . <= . 0) (send dc end-page)))) #f) (= this-page page)) diff --git a/collects/mred/private/wxme/wx.rkt b/collects/mred/private/wxme/wx.rkt index 6528750727..19e4057bef 100644 --- a/collects/mred/private/wxme/wx.rkt +++ b/collects/mred/private/wxme/wx.rkt @@ -27,6 +27,7 @@ bitmap% dc<%> post-script-dc% + pdf-dc% current-eventspace clipboard-client% clipboard<%> diff --git a/collects/scribblings/gui/editor-intf.scrbl b/collects/scribblings/gui/editor-intf.scrbl index 2734d24263..74c0eaa8f0 100644 --- a/collects/scribblings/gui/editor-intf.scrbl +++ b/collects/scribblings/gui/editor-intf.scrbl @@ -1709,7 +1709,7 @@ To extend or re-implement copying, override the @xmethod[text% @defmethod[(print [interactive? any/c #t] [fit-on-page? any/c #t] - [output-mode (or/c 'standard 'postscript) 'standard] + [output-mode (or/c 'standard 'postscript 'pdf) 'standard] [parent (or/c (or/c (is-a?/c frame%) (is-a?/c dialog%)) #f) #f] [force-ps-page-bbox? any/c #t] [as-eps? any/c #f]) @@ -1728,21 +1728,23 @@ If @scheme[fit-on-page?] is a true value, then during printing for a @scheme[text%] editor, the editor's maximum width is set to the width of the page (less margins) and the autowrapping bitmap is removed. -The @scheme[output-mode] setting is used for Windows and Mac OS X. It +The @scheme[output-mode] setting determines whether the output is generated directly as a PostScript - file (using Racket's built-in PostScript system) or generated + file, generated directly as a PDF file, or generated using the platform-specific standard printing mechanism. The possible values are @itemize[ @item{@scheme['standard] --- print using the platform-standard - mechanism (via a @scheme[printer-dc%]) under Windows and - Mac OS X, PostScript for Unix (via a @scheme[post-script-dc%])} + mechanism (via a @scheme[printer-dc%])} @item{@scheme['postscript] --- print to a PostScript file (via a @scheme[post-script-dc%])} + @item{@scheme['pdf] --- print to a PDF file (via a + @scheme[pdf-dc%])} + ] If @scheme[parent] is not @scheme[#f], it is used as the parent window @@ -1753,20 +1755,21 @@ If @scheme[parent] is not @scheme[#f], it is used as the parent window configuration dialogs will have no parent. The @scheme[force-ps-page-bbox?] argument is used for PostScript - printing, and is used as the third initialization argument when - creating the @scheme[post-script-dc%] instance. Unless it is - @scheme[#f], the bounding-box of the resulting PostScript file is set + and PDF printing, and is used as the third initialization argument when + creating the @scheme[post-script-dc%] or @racket[pdf-dc%] instance. Unless it is + @scheme[#f], the bounding-box of the resulting PostScript/PDF file is set to the current paper size. -The @scheme[as-eps?] argument is used for PostScript printing, and is +The @scheme[as-eps?] argument is used for PostScript and PDF printing, and is used as the fourth initialization argument when creating the - @scheme[post-script-dc%] instance. Unless it is @scheme[#f], the + @scheme[post-script-dc%] or @racket[pdf-dc%] instance. Unless it is @scheme[#f], a resulting PostScript file is identified as Encapsulated PostScript (EPS). The printing margins are determined by @method[ps-setup% get-editor-margin] in the current @scheme[ps-setup%] object (as - determined by @scheme[current-ps-setup]). + determined by @scheme[current-ps-setup]), but they are ignored when + @racket[as-eps?] is true. } @@ -1778,11 +1781,13 @@ The printing margins are determined by @method[ps-setup% Prints the editor into the given drawing context. See also @method[editor<%> print]. -If @scheme[page-number] is a non-negative integer, then just the +If @scheme[page-number] is a positive integer, then just the indicated page is printed, where pages are numbered from -@scheme[1]. (So, supplying @scheme[0] as @scheme[page-number] produces -no output.) When @scheme[page-number] is negative, the -@method[dc<%> start-page] and @scheme[dc<%> end-page] methods of @scheme[dc] are +@scheme[1]. If @racket[page-number] is @scheme[0], then the +entire content of the editor is printed on a single page. +When @scheme[page-number] is negative, then the editor content is +split across pages as needed to fit, and the +@method[dc<%> start-page] and @method[dc<%> end-page] methods of @scheme[dc<%>] are called for each page. }