From d6a8ac85b4423c69e45857f5557814e970932cc4 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 1 Oct 2012 23:27:48 -0500
Subject: [PATCH] added some pretty-print using term formatters and fixed the
 docs for term->pict.

closes PR 13150
---
 collects/redex/pict.rkt              |  7 -------
 collects/redex/private/pict.rkt      | 30 ++++++++++++++++++++++++++++
 collects/redex/scribblings/ref.scrbl | 20 +++++++++++++++++--
 3 files changed, 48 insertions(+), 9 deletions(-)

diff --git a/collects/redex/pict.rkt b/collects/redex/pict.rkt
index cf20a48648..2068d1d33b 100644
--- a/collects/redex/pict.rkt
+++ b/collects/redex/pict.rkt
@@ -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?)])
diff --git a/collects/redex/private/pict.rkt b/collects/redex/private/pict.rkt
index 8709076efb..4d95adc35f 100644
--- a/collects/redex/private/pict.rkt
+++ b/collects/redex/private/pict.rkt
@@ -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))))
+
diff --git a/collects/redex/scribblings/ref.scrbl b/collects/redex/scribblings/ref.scrbl
index a4a05cf581..7b7df63cfb 100644
--- a/collects/redex/scribblings/ref.scrbl
+++ b/collects/redex/scribblings/ref.scrbl
@@ -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]