Scribble: clean up text-mode output

- line-flow paragraphs to fit in 72 columns
 - better indentation for itemizations
 - format tables with paragraphs and nested tables

original commit: 60c4acb094286e2501bdfc40a6bec2fd86faee4f

collects/scribble/text-render.rkt

@@ -1,9 +1,30 @@
 
-(module text-render mzscheme
+(module text-render racket/base
   (require "core.ss"
-           mzlib/class)
+           racket/class
+           racket/port)
   (provide render-mixin)
 
+  (define current-preserve-spaces (make-parameter #f))
+
+  (define current-indent (make-parameter 0))
+  (define (make-indent amt)
+    (+ amt (current-indent)))
+  (define (indent)
+    (let ([i (current-indent)])
+      (unless (zero? i)
+        (display (make-string i #\space)))))
+  (define (indented-newline)
+    (newline)
+    (indent))
+    
+  (define indent-pxs (make-hash))
+  (define (indent->paragraph-px amt)
+    (or (hash-ref indent-pxs amt #f)
+        (let ([px (pregexp (format "^ *(.{1,~a}(?<! ))(?: |$)" (- 72 amt)))])
+          (hash-set! indent-pxs amt px)
+          px)))
+
   (define (render-mixin %)
     (class %
       
@@ -14,15 +35,10 @@
 	  (#rx"''" "\U201D")
 	  (#rx"'" "\U2019")))
 
-      (inherit render-content
+      (inherit render-block)
-               render-paragraph
-               render-block)
 
       (define/override (render-part d ht)
         (let ([number (collected-info-number (part-collected-info d ht))])
-          (when (or (ormap values number)
-                    (part-title-content d))
-            (newline))
           (for-each (lambda (n)
                       (when n
                         (printf "~s." n)))
@@ -33,15 +49,16 @@
             (render-content (part-title-content d) d ht))
           (when (or (ormap values number)
                     (part-title-content d))
-            (newline))
             (newline)
+            (newline))
           (render-flow (part-blocks d) d ht #f)
           (let loop ([pos 1]
-                     [secs (part-parts d)])
+                     [secs (part-parts d)]
+                     [need-newline? (pair? (part-blocks d))])
             (unless (null? secs)
-              (newline)
+              (when need-newline? (newline))
               (render-part (car secs) ht)
-              (loop (add1 pos) (cdr secs))))))
+              (loop (add1 pos) (cdr secs) #t)))))
 
       (define/override (render-flow f part ht starting-item?)
         (if (null? f)
@@ -50,26 +67,60 @@
              append
              (render-block (car f) part ht starting-item?)
              (map (lambda (p)
-                    (newline) (newline)
+                    (indented-newline)
                     (render-block p part ht #f))
                   (cdr f)))))
 
 
       (define/override (render-intrapara-block p part ri first? last? starting-item?)
-        (unless first? (newline) (newline))
+        (unless first? (indented-newline))
         (super render-intrapara-block p part ri first? last? starting-item?))
       
       (define/override (render-table i part ht inline?)
         (let ([flowss (table-blockss i)])
           (if (null? flowss)
               null
-              (apply
+              (let* ([strs (map (lambda (flows)
-               append
+                                  (map (lambda (d) 
-               (map (lambda (d) (unless (eq? d 'cont) (render-block d part ht #f))) (car flowss))
+                                         (if (eq? d 'cont) 
-               (map (lambda (flows)
+                                             d
+                                             (let ([o (open-output-string)])
+                                               (parameterize ([current-indent 0]
+                                                              [current-output-port o])
+                                                 (render-block d part ht #f))
+                                               (regexp-split
+                                                #rx"\n"
+                                                (regexp-replace #rx"\n$" (get-output-string o) "")))))
+                                       flows))
+                                flowss)]
+                     [widths (map (lambda (col)
+                                    (for/fold ([d 0]) ([i (in-list col)])
+                                      (if (eq? i 'cont)
+                                          0
+                                          (apply max d (map string-length i)))))
+                                  (apply map list strs))])
+                (for/fold ([indent? #f]) ([row (in-list strs)])
+                  (let ([h (apply max 0 (map length row))])
+                    (let ([row* (for/list ([i (in-range h)])
+                                  (for/list ([col (in-list row)])
+                                    (if (i . < . (length col))
+                                        (list-ref col i)
+                                        "")))])
+                      (for/fold ([indent? indent?]) ([sub-row (in-list row*)])
+                        (when indent? (indent))
+                        (for/fold ([space? #f]) ([col (in-list sub-row)]
+                                                 [w (in-list widths)])
+                          (when space? (display " "))
+                          (let ([col (if (eq? col 'cont)
+                                         ""
+                                         col)])
+                            (display col)
+                            (display (make-string (- w (string-length col)) #\space)))
+                          #t)
                         (newline)
-                      (map (lambda (d) (unless (eq? d 'cont) (render-block d part ht #f))) flows))
+                        #t)))
-                    (cdr flowss))))))
+                  #t)
+                null))))
 
       (define/override (render-itemization i part ht)
         (let ([flows (itemization-blockss i)])
@@ -78,12 +129,51 @@
               (apply append
                      (begin
                        (printf "* ")
-                       (render-flow (car flows) part ht #t))
+                       (parameterize ([current-indent (make-indent 2)])
+                         (render-flow (car flows) part ht #t)))
                      (map (lambda (d)
-                            (printf "\n\n* ")
+                            (indented-newline)
-                            (render-flow d part ht #f))
+                            (printf "* ")
+                            (parameterize ([current-indent (make-indent 2)])
+                              (render-flow d part ht #f)))
                           (cdr flows))))))
 
+      (define/override (render-paragraph p part ri)
+        (let ([o (open-output-string)])
+          (parameterize ([current-output-port o])
+            (super render-paragraph p part ri))
+          (let ([i (open-input-string
+                    (regexp-replace* #rx"\n" (get-output-string o) " "))]
+                [px (indent->paragraph-px (current-indent))])
+            (let loop ([indent? #f])
+              (cond
+               [(or (regexp-try-match px i)
+                    (regexp-try-match #px"^ *(.+(?<! ))(?: |$)" i))
+                => (lambda (m)
+                     (when indent? (indent))
+                     (write-bytes (cadr m))
+                     (newline)
+                     (loop #t))]
+               [else 
+                (regexp-try-match "^ +" i)
+                (let ([b (read-byte i)])
+                  (unless (eof-object? b)
+                    (when indent? (indent))
+                    (write-byte b)
+                    (copy-port i (current-output-port))
+                    (newline)))])))
+          null))
+
+      (define/override (render-content i part ri)
+        (if (and (element? i)
+                 (let ([s (element-style i)])
+                   (or (eq? 'hspace s)
+                       (and (style? s)
+                            (eq? 'hspace (style-name s))))))
+            (parameterize ([current-preserve-spaces #t])
+              (super render-content i part ri))
+            (super render-content i part ri)))
+      
       (define/override (render-other i part ht)
         (cond
          [(symbol? i)
@@ -96,12 +186,14 @@
                      [(lang) ">"]
                      [(rang) "<"]
                      [(rarr) "->"]
-                     [(nbsp) " "]
+                     [(nbsp) "\uA0"]
                      [(prime) "'"]
                      [(alpha) "\u03B1"]
                      [(infin) "\u221E"]
                      [else (error 'text-render "unknown element symbol: ~e" i)]))]
-         [(string? i) (display i)]
+         [(string? i) (if (current-preserve-spaces)
+                          (display (regexp-replace* #rx" " i "\uA0"))
+                          (display i))]
          [else (write i)])
         null)
 

collects/tests/scribble/docs/autobib.txt

@@ -1,9 +1,7 @@
-
+ (Felleisen et al. 2010)  (Felleisen et al. 2010, part I)  (Felleisen et
- (Felleisen et al. 2010)
+al. 2010, part II)  (Felleisen et al. 2010)
- (Felleisen et al. 2010, part I)
- (Felleisen et al. 2010, part II)
- (Felleisen et al. 2010)
 
 Bibliography
 
-Matthias Felleisen, Robert Bruce Findler, and Matthew Flatt. Semantics Engineering with PLT Redex. MIT Press, 2010.
+Matthias Felleisen, Robert Bruce Findler, and Matthew Flatt. Semantics
+Engineering with PLT Redex. MIT Press, 2010.                          

collects/tests/scribble/docs/codeblock-quote.txt

@@ -1,5 +1,4 @@
-
 quote
 
-  @itemlist[#:style 'ordered
+  @itemlist[#:style 'ordered   
-            @item{Eat cookie.}]
+            @item{Eat cookie.}]

collects/tests/scribble/docs/eval-false.txt

@@ -1,4 +1,3 @@
-
 Example:
-  > #f
+  > #f  
-  #f
+  #f    

collects/tests/scribble/docs/print-lines.txt

@@ -1,18 +1,17 @@
-
 Pretty-Print-Handler Bug Example
 
 Example:                                                       
-  > '((x "positional 1")
+  > '((x "positional 1")                                       
-        (rest ("positional 2" "positional 3"))
+        (rest ("positional 2" "positional 3"))                 
-        (a ())
+        (a ())                                                 
-        (b ("b-arg"))
+        (b ("b-arg"))                                          
-        (c (("first c1" "second c1") ("first c2" "second c2")))
+        (c (("first c1" "second c1") ("first c2" "second c2")))
-        (d #f)
+        (d #f)                                                 
-        (e ()))
+        (e ()))                                                
-  '((x "positional 1")
+  '((x "positional 1")                                         
-    (rest ("positional 2" "positional 3"))
+    (rest ("positional 2" "positional 3"))                     
-    (a ())
+    (a ())                                                     
-    (b ("b-arg"))
+    (b ("b-arg"))                                              
-    (c (("first c1" "second c1") ("first c2" "second c2")))
+    (c (("first c1" "second c1") ("first c2" "second c2")))    
-    (d #f)
+    (d #f)                                                     
-    (e ()))
+    (e ()))                                                    

collects/tests/scribble/docs/text.scrbl

@@ -0,0 +1,76 @@
+#lang scribble/manual
+@(require (for-label racket/base))
+
+@title{Document}
+
+This document exercises various constructs to check text output.
+
+@section{Part A}
+
+Scribble is a collection of tools for creating prose documents---papers, books, library documentation, etc.---in HTML or PDF (via Latex)
+form. More generally, Scribble helps you 
+write programs that are rich
+in textual content, whether the content is prose to be typeset or any
+other form of text to be generated 
+programmatically.
+
+@subsection{A Subsection}
+
+Here's some Racket code:
+
+@racketblock[
+ (define half (lambda (x) 
+                (x x)))
+ (x x)
+]
+
+@subsection{Another Subsection}
+
+@defmodule[racket/base]
+
+@defproc[(cons [car (or/c #f 
+                          other?)]
+               [cdr any?])
+         stuff?]{
+
+Ok?}
+
+@section{B}
+
+       @itemlist[
+
+         @item{Run
+                @commandline{scribble --pdf mouse.scrbl}
+               to generate PDF as @filepath{mouse.pdf}. This will
+               work only if you have @exec{pdflatex} installed.
+               If you'd like to see the intermediate Latex, try
+                @commandline{scribble --latex mouse.scrbl}
+               to generate @filepath{mouse.tex}.}
+
+         @item{Run
+               @commandline{scribble --html mouse.scrbl}
+              to generate HTML as @filepath{mouse.html}.  You may
+              notice that the apostrophe in ``he's'' turned into a
+              curly apostrophe.}
+
+         @item{Run
+               @commandline{scribble --htmls mouse.scrbl}
+              to generate HTML as @filepath{mouse/index.html}.
+              Sub-sections (which we add next) will appear as separate
+              HTML files in the @filepath{mouse} directory.}
+
+          ]
+
+Run the @exec{scribble} command(s) from the old section
+again. You may notice the curly double-quotes in the output, and
+the @litchar{---} turned into an em dash.
+
+@section{C}
+
+@subsection{Inside C}
+
+Section C had no text before its subsections.
+
+@subsection{Inside C, Again}
+
+But the subsections have text.

collects/tests/scribble/docs/text.txt

@@ -0,0 +1,71 @@
+Document
+
+This document exercises various constructs to check text output.
+
+1. Part A
+
+Scribble is a collection of tools for creating prose documents—papers,
+books, library documentation, etc.—in HTML or PDF (via Latex) form. More
+generally, Scribble helps you write programs that are rich in textual
+content, whether the content is prose to be typeset or any other form of
+text to be generated programmatically.
+
+1.1. A Subsection
+
+Here’s some Racket code:
+
+  (define half (lambda (x)
+                 (x x)))  
+  (x x)                   
+
+1.2. Another Subsection
+
+ (require racket/base)
+
+(cons car cdr) -> stuff?  
+   car   :   (or/c #f     
+                   other?)
+  cdr : any?              
+
+Ok?
+
+2. B
+
+* Run
+
+    scribble --pdf mouse.scrbl
+
+  to generate PDF as "mouse.pdf". This will work only if you have
+  pdflatex installed. If you’d like to see the intermediate Latex, try
+
+    scribble --latex mouse.scrbl
+
+  to generate "mouse.tex".
+
+* Run
+
+    scribble --html mouse.scrbl
+
+  to generate HTML as "mouse.html".  You may notice that the apostrophe
+  in “he’s” turned into a curly apostrophe.
+
+* Run
+
+    scribble --htmls mouse.scrbl
+
+  to generate HTML as "mouse/index.html". Sub-sections (which we add
+  next) will appear as separate HTML files in the "mouse" directory.
+
+Run the scribble command(s) from the old section again. You may notice
+the curly double-quotes in the output, and the --- turned into an em
+dash.
+
+3. C
+
+3.1. Inside C
+
+Section C had no text before its subsections.
+
+3.2. Inside C, Again
+
+But the subsections have text.