added some pretty-print using term formatters and fixed the

docs for term->pict.

closes PR 13150
This commit is contained in:
Robby Findler 2012-10-01 23:27:48 -05:00
parent d0f981f9cb
commit d6a8ac85b4
3 changed files with 48 additions and 9 deletions

View File

@ -115,13 +115,6 @@
to-lw/stx to-lw/stx
(struct-out lw)) (struct-out lw))
(require (prefix-in lw/ct: "private/loc-wrapper-ct.rkt")
(prefix-in lw/rt: "private/loc-wrapper-rt.rkt"))
(define (to-lw/stx stx)
(lw/rt:add-spans/interp-lws
(syntax->datum
(lw/ct:to-lw/proc stx #f))))
(provide/contract (provide/contract
[just-before (-> (or/c pict? string? symbol?) lw? lw?)] [just-before (-> (or/c pict? string? symbol?) lw? lw?)]
[just-after (-> (or/c pict? string? symbol?) lw? lw?)]) [just-after (-> (or/c pict? string? symbol?) lw? lw?)])

View File

@ -3,6 +3,7 @@
racket/draw racket/draw
racket/class racket/class
racket/match racket/match
racket/pretty
(only-in racket/list drop-right last partition) (only-in racket/list drop-right last partition)
texpict/mrpict texpict/mrpict
@ -15,12 +16,20 @@
"matcher.rkt" "matcher.rkt"
"arrow.rkt" "arrow.rkt"
"core-layout.rkt") "core-layout.rkt")
(require (prefix-in lw/ct: "loc-wrapper-ct.rkt")
(prefix-in lw/rt: "loc-wrapper-rt.rkt"))
(require (for-syntax racket/base (require (for-syntax racket/base
"term-fn.rkt")) "term-fn.rkt"))
(provide render-term (provide render-term
term->pict term->pict
render-term/pretty-write
term->pict/pretty-write
to-lw/stx
language->pict language->pict
render-language render-language
render-language-nts render-language-nts
@ -1186,3 +1195,24 @@
(do-term->pict lang lw)))) (do-term->pict lang lw))))
(define (do-term->pict lang lw) (lw->pict (language-nts lang) lw)) (define (do-term->pict lang lw) (lw->pict (language-nts lang) lw))
(define (render-term/pretty-write lang term [filename #f] #:width [width (pretty-print-columns)])
(if filename
(save-as-ps/pdf (λ () (term->pict/pretty-write lang term #:width width)) filename)
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
(term->pict/pretty-write lang term #:width width))))
(define (term->pict/pretty-write lang term #:width [width (pretty-print-columns)])
(define-values (in out) (make-pipe))
(thread (λ ()
(parameterize ([pretty-print-columns width])
(pretty-write term out))
(close-output-port out)))
(port-count-lines! in)
(lw->pict lang (to-lw/stx (read-syntax #f in))))
(define (to-lw/stx stx)
(lw/rt:add-spans/interp-lws
(syntax->datum
(lw/ct:to-lw/proc stx #f))))

View File

@ -8,7 +8,7 @@
racket/gui racket/gui
racket/pretty racket/pretty
racket/contract racket/contract
mrlib/graph mrlib/graph
(only-in slideshow/pict pict? text dc-for-text-size text-style/c (only-in slideshow/pict pict? text dc-for-text-size text-style/c
vc-append) vc-append)
redex)) redex))
@ -2277,14 +2277,30 @@ sets @racket[dc-for-text-size] and the latter does not.
} }
@defproc[(term->pict [lang compiled-lang?] [term any/c]) pict?]{ @defform[(term->pict lang term)]{
Produces a pict like @racket[render-term], but without Produces a pict like @racket[render-term], but without
adjusting @racket[dc-for-text-size]. adjusting @racket[dc-for-text-size].
The first argument is expected to be a @racket[compiled-language?] and
the second argument is expected to be a term (without the
@racket[term] wrapper). The formatting in the @racket[term] argument
is used to determine how the resulting pict will look.
This function is primarily designed to be used with This function is primarily designed to be used with
Slideshow or with other tools that combine picts together. Slideshow or with other tools that combine picts together.
} }
@defproc[(render-term/pretty-write [lang compiled-lang?] [term any] [filename path-string?] [#:width width #f]) void?]{
Like @racket[render-term], except that the @racket[term] argument is evaluated,
and expected to return a term. Then, @racket[pretty-write] is used
to determine where the line breaks go, using the @racket[width] argument
as a maximum width (via @racket[pretty-print-columns]).
}
@defproc[(term->pict/pretty-write [lang compiled-lang?] [term any] [filename (or/c path-string? #f)] [#:width width #f]) pict?]{
Like @racket[term->pict], but with the same change that
@racket[render-term/pretty-write] has from @racket[render-term].
}
@defproc[(render-language [lang compiled-lang?] @defproc[(render-language [lang compiled-lang?]
[file (or/c false/c path-string?) #f] [file (or/c false/c path-string?) #f]