From 4939c9cff0812d832311f9f1e68fcf542b0934be Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 26 Jun 2007 08:18:55 +0000 Subject: [PATCH] regexp table formatted for new docs svn: r6740 original commit: c79499e8b62857200dab946fbfd267e712af36f7 --- collects/scribble/base-render.ss | 7 +++- collects/scribble/html-render.ss | 69 +++++++++++++++++++++---------- collects/scribble/latex-render.ss | 46 +++++++++++++++++---- collects/scribble/manual.ss | 6 ++- collects/scribble/scribble.css | 12 ++++++ collects/scribble/struct.ss | 2 +- 6 files changed, 108 insertions(+), 34 deletions(-) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 226820f7..66cd2756 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -116,7 +116,8 @@ [else (collect-paragraph p ht)])) (define/public (collect-table i ht) - (for-each (lambda (d) (collect-flow d ht)) + (for-each (lambda (d) (when (flow? d) + (collect-flow d ht))) (apply append (table-flowss i)))) (define/public (collect-itemization i ht) @@ -209,7 +210,9 @@ [else (render-paragraph p part ht)])) (define/public (render-table i part ht) - (map (lambda (d) (render-flow d part ht)) + (map (lambda (d) (if (flow? i) + (render-flow d part ht) + null)) (apply append (table-flowss i)))) (define/public (render-itemization i part ht) diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 102a6a69..fe8f4525 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -245,27 +245,53 @@ ,@(if (string? (table-style t)) `((class ,(table-style t))) null)) - ,@(map (lambda (flows) - `(tr ,@(map (lambda (d a va) - `(td (,@(case a - [(#f) null] - [(right) '((align "right"))] - [(center) '((align "center"))] - [(left) '((align "left"))]) - ,@(case va - [(#f) null] - [(top) '((valign "top"))] - [(baseline) '((valign "baseline"))] - [(bottom) '((valign "bottom"))])) - ,@(render-flow d part ht))) - flows - (cdr (or (and (list? (table-style t)) - (assoc 'alignment (or (table-style t) null))) - (cons #f (map (lambda (x) #f) flows)))) - (cdr (or (and (list? (table-style t)) - (assoc 'valignment (or (table-style t) null))) - (cons #f (map (lambda (x) #f) flows))))))) - (table-flowss t))))) + ,@(map (lambda (flows style) + `(tr (,@(if style + `((class ,style)) + null)) + ,@(let loop ([ds flows] + [as (cdr (or (and (list? (table-style t)) + (assoc 'alignment (or (table-style t) null))) + (cons #f (map (lambda (x) #f) flows))))] + [vas + (cdr (or (and (list? (table-style t)) + (assoc 'valignment (or (table-style t) null))) + (cons #f (map (lambda (x) #f) flows))))]) + (if (null? ds) + null + (if (eq? (car ds) 'cont) + (loop (cdr ds) (cdr as) (cdr vas)) + (let ([d (car ds)] + [a (car as)] + [va (car vas)]) + (cons + `(td (,@(case a + [(#f) null] + [(right) '((align "right"))] + [(center) '((align "center"))] + [(left) '((align "left"))]) + ,@(case va + [(#f) null] + [(top) '((valign "top"))] + [(baseline) '((valign "baseline"))] + [(bottom) '((valign "bottom"))]) + ,@(if (and (pair? (cdr ds)) + (eq? 'cont (cadr ds))) + `((colspan + ,(number->string + (let loop ([n 2] + [ds (cddr ds)]) + (cond + [(null? ds) n] + [(eq? 'cont (car ds)) (loop (+ n 1) (cdr ds))] + [else n]))))) + null)) + ,@(render-flow d part ht)) + (loop (cdr ds) (cdr as) (cdr vas))))))))) + (table-flowss t) + (cdr (or (and (list? (table-style t)) + (assoc 'row-styles (or (table-style t) null))) + (cons #f (map (lambda (x) #f) (table-flowss t))))))))) (define/override (render-blockquote t part ht) `((blockquote ,@(if (string? (blockquote-style t)) @@ -286,6 +312,7 @@ (cond [(string? i) (list i)] [(eq? i 'mdash) `(" " ndash " ")] + [(eq? i 'hline) `((hr))] [(symbol? i) (list i)] [else (list (format "~s" i))])) diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 983afad1..a666be2a 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -59,6 +59,7 @@ (printf "\\newcommand{\\textsub}[1]{$_{#1}$}\n") (printf "\\newcommand{\\textsuper}[1]{$^{#1}$}\n") (printf "\\newcommand{\\refcontent}[1]{#1}\n") + (printf "\\newcommand{\\smaller}[1]{{\\footnotesize #1}}\n") (printf "\\definecolor{PaleBlue}{rgb}{0.90,0.90,1.0}\n") (printf "\\definecolor{LightGray}{rgb}{0.90,0.90,0.90}\n") (printf "\\newcommand{\\schemeinput}[1]{\\colorbox{LightGray}{\\hspace{-0.5ex}\\schemeinputcol{#1}\\hspace{-0.5ex}}}\n") @@ -170,7 +171,8 @@ [opt (if (zero? (current-table-depth)) "[l]" "")]) - (unless (null? (table-flowss t)) + (unless (or (null? (table-flowss t)) + (null? (car (table-flowss t)))) (parameterize ([current-table-depth (add1 (current-table-depth))]) (if index? (printf "\n\n\\begin{theindex}\n") @@ -185,18 +187,41 @@ tableform opt (apply string-append - (map (lambda (i) "l@{}") - (car (table-flowss t)))))) - (for-each (lambda (flows) + (map (lambda (i align) "~a@{}" + (case align + [(center) "c"] + [(right) "r"] + [else "l"])) + (car (table-flowss t)) + (cdr (or (and (list? (table-style t)) + (assoc 'alignment (or (table-style t) null))) + (cons #f (map (lambda (x) #f) (car (table-flowss t)))))))))) + (for-each (lambda (flows row-style) (let loop ([flows flows]) (unless (null? flows) - (render-flow (car flows) part ht) + (unless (eq? 'cont (car flows)) + (let ([cnt (let loop ([flows (cdr flows)][n 1]) + (cond + [(null? flows) n] + [(eq? (car flows) 'cont) (loop (cdr flows) (add1 n))] + [else n]))]) + (unless (= cnt 1) + (printf "\\multicolumn{~a}{l}{" cnt)) + (render-flow (car flows) part ht) + (unless (= cnt 1) + (printf "}")) + (unless (null? (list-tail flows cnt)) + (printf " &\n")))) (unless (null? (cdr flows)) - (printf " &\n") (loop (cdr flows))))) (unless index? - (printf " \\\\\n"))) - (table-flowss t)) + (printf " \\\\\n") + (when (equal? row-style "inferencetop") + (printf "\\hline\n")))) + (table-flowss t) + (cdr (or (and (list? (table-style t)) + (assoc 'row-styles (table-style t))) + (cons #f (map (lambda (x) #f) (table-flowss t)))))) (printf "\n\n\\end{~a}~a\n" tableform (if (equal? tableform "longtable") @@ -234,7 +259,10 @@ [(rdquo) "''"] [(rsquo) "'"] [(prime) "$'$"] - [(rarr) "$\\rightarrow$"]))] + [(rarr) "$\\rightarrow$"] + [(alpha) "$\\alpha$"] + [(infin) "$\\infty$"] + [else (error 'render "unknown symbol element: ~e" i)]))] [else (display-protected (format "~s" i))]) null) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index 5db07c20..dcd345bb 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -182,7 +182,7 @@ (provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none specform specform/subs - specsubform specsubform/subs specspecsubform specsubform/inline + specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline schemegrammar schemegrammar* var svar void-const undefined-const) @@ -310,6 +310,10 @@ (syntax-rules () [(_ spec desc ...) (make-blockquote "leftindent" (list (specsubform spec desc ...)))])) + (define-syntax specspecsubform/subs + (syntax-rules () + [(_ spec subs desc ...) + (make-blockquote "leftindent" (list (specsubform/subs spec subs desc ...)))])) (define-syntax specform (syntax-rules () [(_ #:literals (lit ...) spec desc ...) diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 58a00a9c..887ca883 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -221,6 +221,18 @@ font-family: Courier; font-size: 80%; } + .smaller { + font-size: 80%; + } + + .inferencetop td { + border-bottom: 1px solid black; + text-align: center; + } + .inferencebottom td { + text-align: center; + } + .schemeinput { color: brown; background-color: #eeeeee; diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index fe5ff5c2..63839ebc 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -63,7 +63,7 @@ [paragraph ([content list?])] [(styled-paragraph paragraph) ([style any/c])] [table ([style any/c] - [flowss (listof (listof flow?))])] + [flowss (listof (listof (or/c flow? (one-of/c 'cont))))])] [delayed-flow-element ([render (any/c part? any/c . -> . flow-element?)])] [itemization ([flows (listof flow?)])] [blockquote ([style any/c]