From 7cb15899ae205b21dc10896c8e4433210143e23c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 26 Nov 2010 11:47:24 -0700 Subject: [PATCH] add `output' argument to post-script-dc% and pdf-dc% for a byte string insteda of writing to a file --- .../racket/draw/private/post-script-dc.rkt | 39 ++++++++++++------- .../draw/post-script-dc-class.scrbl | 12 ++++-- 2 files changed, 34 insertions(+), 17 deletions(-) diff --git a/collects/racket/draw/private/post-script-dc.rkt b/collects/racket/draw/private/post-script-dc.rkt index cb2ab554e0..449165002b 100644 --- a/collects/racket/draw/private/post-script-dc.rkt +++ b/collects/racket/draw/private/post-script-dc.rkt @@ -22,9 +22,15 @@ (init [interactive #t] [parent #f] [use-paper-bbox #f] - [as-eps #t]) + [as-eps #t] + [output #f]) - (define-values (s port-box width height landscape?) + (unless (or (not output) + (path-string? output) + (output-port? output)) + (raise-type-error (init-name (if pdf? 'pdf-dc% 'post-script-dc%)) "path string, output port, or #f" output)) + + (define-values (s port-box close-port? width height landscape?) (let ([su (if interactive ((gui-dynamic-require 'get-ps-setup-from-user) #f parent) (current-ps-setup))]) @@ -44,23 +50,26 @@ (and fn (file-name-from-path fn)) (if pdf? "pdf" "ps")))] [fn (if to-file? - (if interactive - (get-file (send pss get-file)) - (let ([fn (send pss get-file)]) - (or fn (get-file #f)))) + (or output + (if interactive + (get-file (send pss get-file)) + (let ([fn (send pss get-file)]) + (or fn (get-file #f))))) #f)]) (if (and to-file? (not fn)) - (values #f #f #f #f #f) + (values #f #f #f #f #f #f) (let* ([paper (assoc (send pss get-paper-name) paper-sizes)] [w (cadr paper)] [h (caddr paper)] [landscape? (eq? (send pss get-orientation) 'landscape)] - [file (open-output-file - (or fn (make-temporary-file (if pdf? - "draw~a.pdf" - "draw~a.ps"))) - #:exists 'truncate/replace)] + [file (if (output-port? fn) + fn + (open-output-file + (or fn (make-temporary-file (if pdf? + "draw~a.pdf" + "draw~a.ps"))) + #:exists 'truncate/replace))] [port-box (make-immobile file)]) (let-values ([(w h) (if (and pdf? landscape?) (values h w) @@ -74,11 +83,12 @@ w h) port-box ; needs to be accessible as long as `s' + (not (output-port? fn)) w h landscape?)))))] [else - (values #f #f #f #f #f)]))) + (values #f #f #f #f #f #f)]))) (define-values (margin-x margin-y) (let ([xb (box 0)] [yb (box 0.0)]) @@ -119,7 +129,8 @@ (cairo_destroy c) (set! c #f) (set! s #f) - (close-output-port (ptr-ref port-box _racket)) + (when close-port? + (close-output-port (ptr-ref port-box _racket))) (set! port-box #f)) (define/override (init-cr-matrix c) diff --git a/collects/scribblings/draw/post-script-dc-class.scrbl b/collects/scribblings/draw/post-script-dc-class.scrbl index 8767e7e0c7..721849ba07 100644 --- a/collects/scribblings/draw/post-script-dc-class.scrbl +++ b/collects/scribblings/draw/post-script-dc-class.scrbl @@ -15,7 +15,8 @@ See also @scheme[printer-dc%]. @defconstructor[([interactive any/c #t] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) false/c) #f] [use-paper-bbox any/c #f] - [as-eps any/c #t])]{ + [as-eps any/c #t] + [output (or/c path-string? output-port? #f) #f])]{ If @scheme[interactive] is true, the user is given a dialog for setting printing parameters (see @scheme[get-ps-setup-from-user]); @@ -31,8 +32,8 @@ If @scheme[parent] is not @scheme[#f], it is used as the parent window of If @scheme[interactive] is @scheme[#f], then the settings returned by @scheme[current-ps-setup] are used. A file dialog is still presented to the user if the @method[ps-setup% get-file] method returns - @scheme[#f], and the user may hit cancel in that case so that - @method[dc<%> ok?] returns @scheme[#f]. + @scheme[#f] and @racket[output] is @racket[#f], and the user may + hit @onscreen{Cancel} in that case so that @method[dc<%> ok?] returns @scheme[#f]. If @scheme[use-paper-bbox] is @scheme[#f], then the PostScript bounding box for the output is determined by drawing commands issued @@ -49,6 +50,11 @@ If @scheme[use-paper-bbox] is @scheme[#f], then the PostScript PostScript header. Otherwise, the generated PostScript includes a header that identifiers it as EPS. +When @racket[output] is not @racket[#f], then file-mode output is + written to @racket[output]. If @racket[output] is @racket[#f], then + the destination is determined via @racket[current-ps-setup] or by + prompting the user for a pathname. + See also @scheme[ps-setup%] and @scheme[current-ps-setup]. The settings for a particular @scheme[post-script-dc%] object are fixed to the values in the current configuration when the object is created