scribble: more nowraps in HTML output

Avoids line-wraps for `examples' output and in function contracts

original commit: 7a2e1aa9001ec002892be146b7e5b425fa757c01

collects/scribble/doclang.rkt

@@ -54,7 +54,7 @@
                                               provide
                                               define-values
                                               define-syntaxes
-                                              define-values-for-syntax
+                                              begin-for-syntax
                                               #%require
                                               #%provide))))
                  #`(begin #,expanded (doc-begin m-id post-process exprs . body))]

collects/scribble/eval.rkt

@@ -149,11 +149,11 @@
                           val-list)))])
               (loop (cdr expr-paras) (cdr val-list+outputs) #f))))])
     (if inset?
-      (let ([p (code-inset (make-table #f lines))])
+      (let ([p (code-inset (make-table block-color lines))])
         (if title
-          (make-table #f (list (list.flow.list title) (list.flow.list p)))
+          (make-table block-color (list (list.flow.list title) (list.flow.list p)))
           p))
-      (make-table #f (if title (cons (list.flow.list title) lines) lines)))))
+      (make-table block-color (if title (cons (list.flow.list title) lines) lines)))))
 
 ;; extracts from a datum or syntax object --- while keeping the
 ;; syntax-objectness of the original intact, instead of always

collects/scribble/html-render.rkt

@@ -148,6 +148,24 @@
                 a)
           a))))
 
+;; combine a 'class attribute from both cl and al
+;;  if cl starts with one
+(define (combine-class cl al)
+  (cond
+   [(and (pair? cl)
+         (eq? (caar cl) 'class)
+         (for/or ([i (in-list al)])
+           (and (eq? (car i) 'class) (cadr i))))
+    => (lambda (s)
+         (cons
+          `[class ,(string-append (cadar cl) " " s)]
+          (append
+           (cdr cl)
+           (for/list ([i (in-list al)]
+                      #:unless (eq? 'class (car i)))
+             i))))]
+   [else (append cl al)]))
+
 (define (style->tag style)
   (for/or ([s (in-list (style-properties style))])
     (and (alt-tag? s)
@@ -926,12 +944,13 @@
                         (if (memq 'div (style-properties style)) 
                             'div 
                             'p))
-                   [,@attrs
+                   [,@(combine-class
-                    ,@(case (style-name style)
+                       (case (style-name style)
-                        [(author) '([class "author"])]
+                         [(author) '([class "author"])]
-                        [(pretitle) '([class "SPretitle"])]
+                         [(pretitle) '([class "SPretitle"])]
-                        [(wraps) null]
+                         [(wraps) null]
-                        [else null])]
+                         [else null])
+                       attrs)]
                    ,@contents))))))
 
     (define/override (render-paragraph p part ri)
@@ -1180,7 +1199,7 @@
                  ,@content))))))
 
     (define/private (element-style->attribs name style)
-      (append
+      (combine-class
        (cond
         [(symbol? name)
          (case name
@@ -1259,11 +1278,12 @@
                 ,@(if starting-item?
                     '([style "display: inline-table; vertical-align: text-top;"])
                     null)
-                ,@(case (style-name (table-style t))
+                ,@(combine-class
-                    [(boxed)    '([class "boxed"])]
+                   (case (style-name (table-style t))
-                    [(centered) '([align "center"])]
+                     [(boxed)    '([class "boxed"])]
-                    [else '()])
+                     [(centered) '([align "center"])]
-                ,@(style->attribs (table-style t)))
+                     [else '()])
+                   (style->attribs (table-style t))))
           ,@(let ([columns (ormap (lambda (p)
                                     (and (table-columns? p)
                                          (map (lambda (s)
@@ -1286,16 +1306,17 @@
                      (extract-table-cell-styles t))))))
 
     (define/override (render-nested-flow t part ri)
-      `((blockquote [,@(style->attribs (nested-flow-style t))
+      `((blockquote [,@(combine-class
-                     ,@(cond
+                        (cond
-                        [(eq? 'code-inset (style-name (nested-flow-style t)))
+                         [(eq? 'code-inset (style-name (nested-flow-style t)))
-                         `([class "SCodeFlow"])]
+                          `([class "SCodeFlow"])]
-                        [(eq? 'vertical-inset (style-name (nested-flow-style t)))
+                         [(eq? 'vertical-inset (style-name (nested-flow-style t)))
-                         `([class "SVInsetFlow"])]
+                          `([class "SVInsetFlow"])]
-                        [(and (not (string? (style-name (nested-flow-style t))))
+                         [(and (not (string? (style-name (nested-flow-style t))))
-                              (not (eq? 'inset (style-name (nested-flow-style t)))))
+                               (not (eq? 'inset (style-name (nested-flow-style t)))))
-                         `([class "SubFlow"])]
+                          `([class "SubFlow"])]
-                        [else null])]
+                         [else null])
+                        (style->attribs (nested-flow-style t)))]
                     ,@(append-map (lambda (i) (render-block i part ri #f))
                                   (nested-flow-blocks t)))))
 

collects/scribble/private/lp.rkt

@@ -50,7 +50,6 @@
                      [(rest ...) (if n
                                      #`((subscript #,(format "~a" n)))
                                      #`())])
-         
          #`(begin
              (require (for-label for-label-mod ... ...))
              #,@(if n

collects/scribble/private/manual-form.rkt

@@ -350,7 +350,7 @@
        vertical-inset-style
        (list
         (make-table
-         'boxed
+         boxed-style
          (append
           (map
            (lambda (form form-proc)
@@ -387,7 +387,7 @@
        vertical-inset-style
        (list
         (make-table
-         'boxed
+         boxed-style
          (cons
           (list
            (make-flow

collects/scribble/private/manual-proc.rkt

@@ -472,7 +472,7 @@
      vertical-inset-style
      (list
       (make-table
-       'boxed
+       boxed-style
        (append-map
         do-one
         stx-ids prototypes all-args arg-contractss arg-valss result-contracts
@@ -579,7 +579,7 @@
                             name-id))]))
   (define main-table
     (make-table
-     'boxed
+     boxed-style
      (cons
       (list (make-flow
              (list
@@ -852,7 +852,7 @@
      vertical-inset-style
      (list
       (make-table
-       'boxed
+       boxed-style
        (map
         (lambda (stx-id name result-contract result-value)
           (list

collects/scribble/private/manual-style.rkt

@@ -30,7 +30,7 @@
   (provide/contract [id styling-f/c] ...))
 (provide-styling racketmodfont racketoutput
                  racketerror racketfont racketvalfont racketresultfont racketidfont racketvarfont
-                 racketparenfont racketkeywordfont racketmetafont
+                 racketcommentfont racketparenfont racketkeywordfont racketmetafont
                  onscreen defterm filepath exec envvar Flag DFlag PFlag DPFlag math
                  procedure
                  indexed-file indexed-envvar idefterm pidefterm)
@@ -101,6 +101,8 @@
   (make-element paren-color (decode-content str)))
 (define (racketmetafont . str)
   (make-element meta-color (decode-content str)))
+(define (racketcommentfont . str)
+  (make-element comment-color (decode-content str)))
 (define (racketmodfont . str)
   (make-element module-color (decode-content str)))
 (define (racketkeywordfont . str)

collects/scribble/private/manual-vars.rkt

@@ -5,6 +5,7 @@
          (only-in "../core.rkt" 
                   make-style style-name 
                   nested-flow? nested-flow-blocks nested-flow-style)
+         "../html-properties.rkt"
          scheme/contract
          (for-syntax scheme/base
                      syntax/kerncase
@@ -14,15 +15,19 @@
 
 (define-struct (box-splice splice) ())
 
-(define vertical-inset-style 
-  (make-style 'vertical-inset null))
-
 (provide/contract
  [struct (box-splice splice) ([run list?])]) ; XXX ugly copying
 (provide deftogether *deftogether
          with-racket-variables
          with-togetherable-racket-variables
-         vertical-inset-style)
+         vertical-inset-style
+         boxed-style)
+
+(define vertical-inset-style 
+  (make-style 'vertical-inset null))
+
+(define boxed-style 
+  (make-style 'boxed (list (make-attributes (list (cons 'class "RBoxed"))))))
 
 (begin-for-syntax (define-struct deftogether-tag () #:omit-define-syntaxes))
 
@@ -73,7 +78,9 @@
                       (let loop ([form (case (syntax-e kind)
                                          [(form) (if (identifier? s-exp)
                                                      null
-                                                     (cdr (syntax-e s-exp)))]
+                                                     (if (pair? (syntax-e s-exp))
+                                                         (cdr (syntax-e s-exp))
+                                                         null))]
                                          [(form/none) s-exp]
                                          [(form/maybe)
                                           (syntax-case s-exp ()
@@ -114,7 +121,7 @@
      vertical-inset-style
      (list
       (make-table
-       'boxed
+       boxed-style
        (map
         (lambda (box)
           (unless (and (box-splice? box)
@@ -124,7 +131,7 @@
                        (let ([l (nested-flow-blocks (car (splice-run box)))])
                          (= 1 (length l))
                          (table? (car l))
-                         (eq? 'boxed (style-name (table-style (car l))))))
+                         (eq? boxed-style (table-style (car l)))))
             (error 'deftogether
                    "element is not a boxing splice containing a single nested-flow with a single table: ~e"
                    box))

collects/scribble/racket.css

@@ -124,6 +124,10 @@
   width: 100%;
 }
 
+.prototype, .argcontract, .RBoxed {
+  white-space: nowrap;
+}
+
 .prototype td {
   vertical-align: text-top;
 }

collects/scribble/text/syntax-utils.rkt

@@ -7,7 +7,7 @@
 
 (begin-for-syntax
   (define definition-ids ; ids that don't require forcing
-    (syntax->list #'(define-values define-syntaxes define-values-for-syntax
+    (syntax->list #'(define-values define-syntaxes begin-for-syntax
                      require provide #%require #%provide)))
   (define stoplist (append definition-ids (kernel-form-identifier-list)))
   (define (definition-id? id)

collects/scribblings/scribble/manual.scrbl

@@ -462,6 +462,9 @@ sub-form in a procedure being documented).}
 @racket[racketfont], but colored as meta-syntax, such as backquote or
 unquote.}
 
+@defproc[(racketcommentfont [pre-content pre-content?] ...) element?]{Like
+@racket[racketfont], but colored as a comment.}
+
 @defproc[(racketerror [pre-content pre-content?] ...) element?]{Like
 @racket[racketfont], but colored as error-message text.}
 

collects/scribblings/scribble/renderer.scrbl

@@ -15,11 +15,17 @@
      (intro)))
 
 @(begin
-  (define-syntax-rule (def-render-mixin id)
+  (define-syntax-rule (def-html-render-mixin id)
     (begin
       (require (for-label scribble/html-render))
       (define id @racket[render-mixin])))
-  (def-render-mixin html:render-mixin))
+  (def-html-render-mixin html:render-mixin))
+@(begin
+  (define-syntax-rule (def-latex-render-mixin id)
+    (begin
+      (require (for-label scribble/latex-render))
+      (define id @racket[render-mixin])))
+  (def-latex-render-mixin latex:render-mixin))
 
 @title[#:tag "renderer"]{Renderers}
 
@@ -281,3 +287,14 @@ files.}
 @defmixin[render-mixin (render%) ()]{
 
 Specializes a @racket[render%] class for generating Latex input.}}
+
+@; ----------------------------------------
+
+@section{PDF Renderer}
+
+@defmodule/local[scribble/pdf-render]{
+
+@defmixin[render-mixin (render%) ()]{
+
+Specializes a @racket[render%] class for generating PDF output via
+Latex, building on @|latex:render-mixin| from @racketmodname[scribble/latex-render].}}

collects/scriblib/figure.rkt

@@ -42,27 +42,17 @@
 (define leftfiguremultiwide-style (make-style "LeftfigureMultiWide" figure-style-extras))
 
 (define (figure tag caption #:style [style centerfigure-style] . content)
-  (apply figure-helper style tag caption content))
+  (apply figure-helper figure-style style tag caption content))
+
 (define (figure-here tag caption . content)
-  (apply figure-helper herefigure-style tag caption content))
+  (apply figure-helper herefigure-style centerfigure-style tag caption content))
-(define (figure-helper style tag caption . content)
+
+(define (figure-helper figure-style content-style tag caption . content)
   (make-nested-flow 
    figure-style 
    (list
-    (make-nested-flow
+     (make-nested-flow content-style (list (make-nested-flow figureinside-style (decode-flow content))))
-     style
+     (make-paragraph centertext-style (list (make-element legend-style (list (Figure-target tag) ": " caption)))))))
-     (list
-      (make-nested-flow
-       figureinside-style
-       (append
-        (decode-flow content)
-        (list)))))
-    (make-paragraph 
-     centertext-style 
-     (list
-      (make-element legend-style
-                    (list (Figure-target tag) ": " 
-                          caption)))))))
 
 (define (*figure style tag caption content)
   (make-nested-flow
@@ -75,15 +65,12 @@
       (list
        (make-paragraph
         plain
-        (list
+        (list (make-element legend-style (list (Figure-target tag) ": " caption))))))))))
-         (make-element legend-style
-                       (list (Figure-target tag) ": " 
-                             caption))))))))))
 
-(define (figure* tag caption #:style [style centerfiguremulti-style] . content)
+(define (figure* tag caption . content)
-  (*figure style tag caption content))
+  (*figure centerfiguremulti-style tag caption content))
-(define (figure** tag caption #:style [style centerfiguremultiwide-style] . content)
+(define (figure** tag caption . content)
-  (*figure style tag caption content))
+  (*figure centerfiguremultiwide-style tag caption content))
 
 (define figures (new-counter "figure"))
 (define (Figure-target tag)

collects/scriblib/figure.tex

@@ -9,12 +9,16 @@
 \newlength{\FigOrigskip}
 \FigOrigskip=\parskip
 
+\newenvironment{Figure}{\begin{figure}}{\end{figure}}
+
+\newenvironment{Centerfigure}{\begin{center}}{\end{center}}
+\def\Centertext#1{\begin{center}#1\end{center}}
+
+\newenvironment{Leftfigure}{\begin{flushleft}}{\end{flushleft}}
+
 \newenvironment{CenterfigureMulti}{\begin{figure*}[t!p]\centering}{\end{figure*}}
 \newenvironment{CenterfigureMultiWide}{\begin{CenterfigureMulti}}{\end{CenterfigureMulti}}
-\newenvironment{Centerfigure}{\begin{figure}[t!p]\centering}{\end{figure}}
-\newenvironment{Herefigure}{\begin{figure}[ht!p]\centering}{\end{figure}}
-\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\topsep=0pt\parsep=\FigOrigskip\partopsep=0pt}\item}{\end{list}}
 
-\newenvironment{LeftfigureMulti}{\begin{figure*}[t!p]}{\end{figure*}}
+\newenvironment{Herefigure}{\begin{figure}[ht!]\centering}{\end{figure}}
-\newenvironment{LeftfigureMultiWide}{\begin{leftfigureMulti}}{\end{leftfigureMulti}}
+
-\newenvironment{Leftfigure}{\begin{figure}[t!p]}{\end{figure}}
+\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\topsep=0pt\parsep=\FigOrigskip\partopsep=0pt}\item}{\end{list}}