commit 4939c9cff0812d832311f9f1e68fcf542b0934be
parent 5552a5c58c1d3e03f0ec0f9e8237d3714fcfac2b
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 26 Jun 2007 08:18:55 +0000
regexp table formatted for new docs
svn: r6740
original commit: c79499e8b62857200dab946fbfd267e712af36f7
Diffstat:
6 files changed, 108 insertions(+), 34 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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]
