Scribble: style adjustments to deter code wrapping

For HTML, the style used in the output of `racketblock' now
disables line wrapping, and the Rkt text styles inherit
line-wrap behavior. This doesn't solve the general problem
of code overflowing the horizontal space, but it makes the
failure mode usefully better.

A new 'vertical-inset nested-flow style is used by
`defproc', `defform', etc. It has no effect for HTML,
but it introduces suitable vertical space for Latex output
(in case you want to use `defproc' in a SIGPLAN-format
paper, for example).

original commit: 4ac85de974ec2e6326df129745228b3ffcbb778f

collects/scribble/html-render.rkt

@@ -1271,12 +1271,15 @@
 
     (define/override (render-nested-flow t part ri)
       `((blockquote [,@(style->attribs (nested-flow-style t))
-                     ,@(if (eq? 'code-inset (style-name (nested-flow-style t)))
+                     ,@(cond
-                           `([class "SCodeFlow"])
+                        [(eq? 'code-inset (style-name (nested-flow-style t)))
-                           (if (and (not (string? (style-name (nested-flow-style t))))
+                         `([class "SCodeFlow"])]
-                                    (not (eq? 'inset (style-name (nested-flow-style t)))))
+                        [(eq? 'vertical-inset (style-name (nested-flow-style t)))
-                               `([class "SubFlow"])
+                         `([class "SVInsetFlow"])]
-                               null))]
+                        [(and (not (string? (style-name (nested-flow-style t))))
+                              (not (eq? 'inset (style-name (nested-flow-style t)))))
+                         `([class "SubFlow"])]
+                        [else null])]
                     ,@(append-map (lambda (i) (render-block i part ri #f))
                                   (nested-flow-blocks t)))))
 

collects/scribble/latex-render.rkt

@@ -574,7 +574,8 @@
       (let* ([kind (or (let ([s (style-name (nested-flow-style t))])
                          (or (and (string? s) s)
                              (and (eq? s 'inset) "quote")
-                             (and (eq? s 'code-inset) "SCodeFlow")))
+                             (and (eq? s 'code-inset) "SCodeFlow")
+                             (and (eq? s 'vertical-inset) "SVInsetFlow")))
                        "Subflow")]
              [props (style-properties (nested-flow-style t))]
              [command? (memq 'command props)]

collects/scribble/private/manual-form.rkt

@@ -346,33 +346,36 @@
   (parameterize ([current-meta-list '(... ...+)])
     (make-box-splice
      (cons
-      (make-table
+      (make-blockquote
-       'boxed
+       'vertical-inset
-       (append
+       (list
-        (map
+        (make-table
-         (lambda (form form-proc)
+         'boxed
-           (list
+         (append
-            (make-flow
+          (map
+           (lambda (form form-proc)
              (list
-              ((or form-proc
+              (make-flow
-                   (lambda (x)
+               (list
-                     (make-omitable-paragraph
+                ((or form-proc
-                      (list (to-element `(,x . ,(cdr form)))))))
+                     (lambda (x)
-               (and kw-id
+                       (make-omitable-paragraph
-                    (eq? form (car forms))
+                        (list (to-element `(,x . ,(cdr form)))))))
-                    (defform-site kw-id)))))))
+                 (and kw-id
-         forms form-procs)
+                      (eq? form (car forms))
-        (if (null? sub-procs)
+                      (defform-site kw-id)))))))
-          null
+           forms form-procs)
-          (list (list flow-empty-line)
+          (if (null? sub-procs)
-                (list (make-flow
+              null
-                       (list (let ([l (map (lambda (sub)
+              (list (list flow-empty-line)
-                                             (map (lambda (f) (f)) sub))
+                    (list (make-flow
-                                           sub-procs)])
+                           (list (let ([l (map (lambda (sub)
-                               (*racketrawgrammars "specgrammar"
+                                                 (map (lambda (f) (f)) sub))
-                                                   (map car l)
+                                               sub-procs)])
-                                                   (map cdr l))))))))
+                                   (*racketrawgrammars "specgrammar"
-        (make-contracts-table contract-procs)))
+                                                       (map car l)
+                                                       (map cdr l))))))))
+          (make-contracts-table contract-procs)))))
       (content-thunk)))))
 
 (define (*specsubform form lits form-thunk subs sub-procs contract-procs content-thunk)
@@ -380,27 +383,30 @@
     (make-blockquote
      "leftindent"
      (cons
-      (make-table
+      (make-blockquote
-       'boxed
+       'vertical-inset
-       (cons
+       (list
-        (list
+        (make-table
-         (make-flow
+         'boxed
+         (cons
           (list
-           (if form-thunk
+           (make-flow
-             (form-thunk)
+            (list
-             (make-omitable-paragraph (list (to-element form)))))))
+             (if form-thunk
-        (append
+                 (form-thunk)
-         (if (null? sub-procs)
+                 (make-omitable-paragraph (list (to-element form)))))))
-             null
+          (append
-             (list (list flow-empty-line)
+           (if (null? sub-procs)
-                   (list (make-flow
+               null
-                          (list (let ([l (map (lambda (sub)
+               (list (list flow-empty-line)
-                                                (map (lambda (f) (f)) sub))
+                     (list (make-flow
-                                              sub-procs)])
+                            (list (let ([l (map (lambda (sub)
-                                  (*racketrawgrammars "specgrammar"
+                                                  (map (lambda (f) (f)) sub))
-                                                      (map car l)
+                                                sub-procs)])
-                                                      (map cdr l))))))))
+                                    (*racketrawgrammars "specgrammar"
-         (make-contracts-table contract-procs))))
+                                                        (map car l)
+                                                        (map cdr l))))))))
+           (make-contracts-table contract-procs))))))
       (flow-paragraphs (decode-flow (content-thunk)))))))
 
 (define (*racketrawgrammars style nonterms clauseses)

collects/scribble/private/manual-proc.rkt

@@ -464,17 +464,20 @@
                 (append* all-args)))
   (make-box-splice
    (cons
-    (make-table
+    (make-blockquote
-     'boxed
+     'vertical-inset
-     (append-map
+     (list
-      do-one
+      (make-table
-      stx-ids prototypes all-args arg-contractss arg-valss result-contracts
+       'boxed
-      (let loop ([ps prototypes] [accum null])
+       (append-map
-        (cond [(null? ps) null]
+        do-one
-              [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
+        stx-ids prototypes all-args arg-contractss arg-valss result-contracts
-               (cons #f (loop (cdr ps) accum))]
+        (let loop ([ps prototypes] [accum null])
-              [else (cons #t (loop (cdr ps)
+          (cond [(null? ps) null]
-                                   (cons (extract-id (car ps)) accum)))]))))
+                [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
+                 (cons #f (loop (cdr ps) accum))]
+                [else (cons #t (loop (cdr ps)
+                                     (cons (extract-id (car ps)) accum)))]))))))
     (content-thunk))))
 
 (define-syntax-rule (defparam id arg contract desc ...)
@@ -757,7 +760,9 @@
            fields field-contracts))))
   (make-box-splice
    (cons
-    main-table
+    (make-blockquote
+     'vertical-inset
+     (list main-table))
     (content-thunk))))
 
 ;; ----------------------------------------
@@ -782,83 +787,86 @@
                    [result-values (map (lambda (x) #f) result-contracts)])
   (make-box-splice
    (cons
-    (make-table
+    (make-blockquote
-     'boxed
+     'vertical-inset
-     (map
+     (list
-      (lambda (stx-id name result-contract result-value)
+      (make-table
-        (list
+       'boxed
-         (make-flow
+       (map
-          (make-table-if-necessary
+        (lambda (stx-id name result-contract result-value)
-           "argcontract"
+          (list
-           (let* ([result-block
+           (make-flow
-                   (and result-value
+            (make-table-if-necessary
-                        (if (block? result-value)
+             "argcontract"
-                            result-value
+             (let* ([result-block
-                            (make-omitable-paragraph (list result-value))))]
+                     (and result-value
-                  [contract-block
+                          (if (block? result-value)
-                   (if (block? result-contract)
+                              result-value
-                       result-contract
+                              (make-omitable-paragraph (list result-value))))]
-                       (make-omitable-paragraph (list result-contract)))]
+                    [contract-block
-                  [total-width (+ (string-length (format "~a" name))
+                     (if (block? result-contract)
-                                  3
+                         result-contract
-                                  (block-width contract-block)
+                         (make-omitable-paragraph (list result-contract)))]
-                                  (if result-block
+                    [total-width (+ (string-length (format "~a" name))
-                                      (+ (block-width result-block) 3)
+                                    3
-                                      0))])
+                                    (block-width contract-block)
-           (append
+                                    (if result-block
-            (list
+                                        (+ (block-width result-block) 3)
-             (append
+                                        0))])
-              (list
+               (append
-               (make-flow
                 (list
-                 (make-omitable-paragraph
+                 (append
                   (list
-                   (let ([target-maker
+                   (make-flow
-                          ((if form? id-to-form-target-maker id-to-target-maker)
+                    (list
-                           stx-id #t)]
+                     (make-omitable-paragraph
-                         [content (list (definition-site name stx-id form?))])
+                      (list
-                     (if target-maker
+                       (let ([target-maker
-                         (target-maker
+                              ((if form? id-to-form-target-maker id-to-target-maker)
-                          content
+                               stx-id #t)]
-                          (lambda (tag)
+                             [content (list (definition-site name stx-id form?))])
-                            (make-toc-target-element
+                         (if target-maker
-                             #f
+                             (target-maker
-                             (list
+                              content
-                              (make-index-element
+                              (lambda (tag)
-                               #f
+                                (make-toc-target-element
-                               content
+                                 #f
-                               tag
+                                 (list
-                               (list (symbol->string name))
+                                  (make-index-element
-                               content
+                                   #f
-                               (with-exporting-libraries
+                                   content
-                                (lambda (libs) (make-thing-index-desc name libs)))))
+                                   tag
-                             tag)))
+                                   (list (symbol->string name))
-                         (car content)))))))
+                                   content
-               (make-flow
+                                   (with-exporting-libraries
-                (list
+                                    (lambda (libs) (make-thing-index-desc name libs)))))
-                 (make-omitable-paragraph
+                                 tag)))
-                  (list
+                             (car content)))))))
-                   spacer ":" spacer))))
+                   (make-flow
-               (make-flow (list contract-block)))
+                    (list
-              (if (and result-value
+                     (make-omitable-paragraph
-                       (total-width . < . 60))
+                      (list
-                  (list
+                       spacer ":" spacer))))
-                   (to-flow (make-element #f (list spacer "=" spacer)))
+                   (make-flow (list contract-block)))
-                   (make-flow (list result-block)))
+                  (if (and result-value
-                  null)))
+                           (total-width . < . 60))
-            (if (and result-value
+                      (list
-                     (total-width . >= . 60))
+                       (to-flow (make-element #f (list spacer "=" spacer)))
-                (list
+                       (make-flow (list result-block)))
-                 (list
+                      null)))
-                  (make-table-if-necessary
+                (if (and result-value
-                   "argcontract"
+                         (total-width . >= . 60))
-                   (list
+                    (list
-                    (list flow-spacer 
+                     (list
-                          (to-flow (make-element #f (list spacer "=" spacer)))
+                      (make-table-if-necessary
-                          (make-flow (list result-block)))))
+                       "argcontract"
-                  'cont))
+                       (list
-                null)))))))
+                        (list flow-spacer 
-      stx-ids names result-contracts result-values))
+                              (to-flow (make-element #f (list spacer "=" spacer)))
+                              (make-flow (list result-block)))))
+                      'cont))
+                    null)))))))
+        stx-ids names result-contracts result-values))))
     (content-thunk))))
 
 (define (defthing/proc id contract descs)

collects/scribble/private/manual-vars.rkt

@@ -2,7 +2,8 @@
 (require "../decode.rkt"
          "../scheme.rkt"
          "../struct.rkt"
-         (only-in "../core.rkt" style-name)
+         (only-in "../core.rkt" style-name 
+                  nested-flow? nested-flow-blocks nested-flow-style)
          scheme/contract
          (for-syntax scheme/base
                      syntax/kerncase
@@ -104,21 +105,28 @@
 (define (*deftogether boxes body-thunk)
   (make-box-splice
    (cons
-    (make-table
+    (make-blockquote 
-     'boxed
+     'vertical-inset 
-     (map
+     (list
-      (lambda (box)
+      (make-table
-        (unless (and (box-splice? box)
+       'boxed
-                     (= 1 (length (splice-run box)))
+       (map
-                     (table? (car (splice-run box)))
+        (lambda (box)
-                     (eq? 'boxed (style-name (table-style (car (splice-run box))))))
+          (unless (and (box-splice? box)
-          (error 'deftogether
+                       (= 1 (length (splice-run box)))
-                 "element is not a boxing splice containing a single table: ~e"
+                       (nested-flow? (car (splice-run box)))
-                 box))
+                       (eq? 'vertical-inset (style-name (nested-flow-style (car (splice-run box)))))
-        (list (make-flow (list (make-table
+                       (let ([l (nested-flow-blocks (car (splice-run box)))])
-                                "together"
+                         (= 1 (length l))
-                                (table-flowss (car (splice-run box))))))))
+                         (table? (car l))
-      boxes))
+                         (eq? 'boxed (style-name (table-style (car l))))))
+            (error 'deftogether
+                   "element is not a boxing splice containing a single nested-flow with a single table: ~e"
+                   box))
+          (list (make-flow (list (make-table
+                                  "together"
+                                  (table-flowss (car (nested-flow-blocks (car (splice-run box))))))))))
+        boxes))))
     (body-thunk))))
 
 (define-syntax (deftogether stx)

collects/scribble/racket.css

@@ -6,6 +6,7 @@
 .RktMod, .RktKw, .RktVar, .RktSym,
 .RktRes, .RktOut, .RktCmt, .RktVal {
   font-family: monospace;
+  white-space: inherit;
 }
 
 /* Serif: */
@@ -130,8 +131,17 @@
   vertical-align: bottom;
 }
 
+.RktBlk {
+  white-space: inherit;
+}
+
+.RktBlk tr {
+  white-space: inherit;
+}
+
 .RktBlk td {
   vertical-align: baseline;
+  white-space: inherit;
 }
 
 .argcontract td {

collects/scribble/scribble.css

@@ -365,6 +365,15 @@ i {
   margin-bottom: 0em;
   margin-right: 0em;
   margin-top: 0em;
+  white-space: nowrap;  
+}
+
+.SVInsetFlow {
+  display: block;
+  margin-left: 0em;
+  margin-bottom: 0em;
+  margin-right: 0em;
+  margin-top: 0em;
 }
 
 .SubFlow {

collects/scribble/scribble.tex

@@ -105,6 +105,13 @@
 \listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=2ex\rightmargin=0pt%
 \itemsep=0pt\parsep=0pt}\item}{\end{list}\SCodePostSkip}
 
+% Inset a 'vertical-inset nested flow:
+\newcommand{\SVInsetPreSkip}{\vskip\abovedisplayskip}
+\newcommand{\SVInsetPostSkip}{\vskip\belowdisplayskip}
+\newenvironment{SVInsetFlow}{\SVInsetPreSkip\begin{list}{}{\topsep=0pt\partopsep=0pt%
+\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=0pt\rightmargin=0pt%
+\itemsep=0pt\parsep=0pt}\item}{\end{list}\SVInsetPostSkip}
+
 % The 'compact itemization style:
 \newenvironment{compact}{\begin{itemize}}{\end{itemize}}
 \newcommand{\compactItem}[1]{\item #1}

collects/scribblings/scribble/core.scrbl

@@ -558,6 +558,9 @@ names are recognized:
  @item{@racket['code-inset] --- Insets the nested flow relative to
        surrounding text in a way suitable for code.}
 
+ @item{@racket['vertical-inset] --- Insets the nested flow vertically
+       relative to surrounding text, but not horizontally.}
+
 ]
 
 The following @tech{style properties} are currently recognized: