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

added some pretty-print using term formatters and fixed the

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/redex/pict.rkt
View File

@ -115,13 +115,6 @@
to-lw/stx
(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
[just-before (-> (or/c pict? string? symbol?) lw? lw?)]
[just-after (-> (or/c pict? string? symbol?) lw? lw?)])

30
collects/redex/private/pict.rkt
View File

@ -3,6 +3,7 @@
racket/draw
racket/class
racket/match
racket/pretty
(only-in racket/list drop-right last partition)
texpict/mrpict
@ -15,12 +16,20 @@
"matcher.rkt"
"arrow.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
"term-fn.rkt"))
(provide render-term
term->pict
render-term/pretty-write
term->pict/pretty-write
to-lw/stx
language->pict
render-language
render-language-nts
@ -1186,3 +1195,24 @@
(do-term->pict 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))))

20
collects/redex/scribblings/ref.scrbl
View File

@ -8,7 +8,7 @@
racket/gui
racket/pretty
racket/contract
mrlib/graph
mrlib/graph
(only-in slideshow/pict pict? text dc-for-text-size text-style/c
vc-append)
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
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
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?]
[file (or/c false/c path-string?) #f]