suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix some Scribble rendering issues with tables containing flows abd cell styles; extend Slideshow play to handle more optional arguments; fix some docs

Browse Source 
svn: r13843

original commit: 90bc1d816d4645f7f7a3be99cf2e05c9bdfbef8d
This commit is contained in:
Matthew Flatt 2009-02-25 21:14:22 +00:00
parent 8f086861ee
commit de160f7842
3 changed files with 65 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/scribble/html-render.ss
View File

@ -1044,22 +1044,24 @@
(with-attributes-style raw-style)
raw-style))
(define t-style-get (if (and (pair? t-style) (list? t-style))
(lambda (k) (assoc k t-style))
(lambda (k) #f)))
(lambda (k) (assoc k t-style))
(lambda (k) #f)))
(define (make-row flows style)
`(tr (,@(if style `([class ,style]) null))
`(tr (,@(if (string? style) `([class ,style]) null))
,@(let loop ([ds flows]
[as (cdr (or (t-style-get 'alignment)
[as (cdr (or (and (list? style) (assq 'alignment style))
(cons #f (map (lambda (x) #f) flows))))]
[vas (cdr (or (t-style-get 'valignment)
[vas (cdr (or (and (list? style) (assq 'valignment style))
(cons #f (map (lambda (x) #f) flows))))]
[sts (cdr (or (and (list? style) (assq 'style style))
(cons #f (map (lambda (x) #f) flows))))]
[first? #t])
(cond
[(null? ds) null]
[(eq? (car ds) 'cont)
(loop (cdr ds) (cdr as) (cdr vas) first?)]
(loop (cdr ds) (cdr as) (cdr vas) (cdr sts) first?)]
[else
(let ([d (car ds)] [a (car as)] [va (car vas)])
(let ([d (car ds)] [a (car as)] [va (car vas)] [st (car sts)])
(cons
`(td (,@(case a
[(#f) null]
@ -1071,6 +1073,9 @@
[(top) '((valign "top"))]
[(baseline) '((valign "baseline"))]
[(bottom) '((valign "bottom"))])
,@(if (string? st)
`([class ,st])
null)
,@(if (and (pair? (cdr ds))
(eq? 'cont (cadr ds)))
`([colspan
@ -1085,7 +1090,7 @@
(omitable-paragraph? (car (flow-paragraphs d))))
(render-content (paragraph-content (car (flow-paragraphs d))) part ri)
(render-flow d part ri #f)))
(loop (cdr ds) (cdr as) (cdr vas) #f)))]))))
(loop (cdr ds) (cdr as) (cdr vas) (cdr sts) #f)))]))))
`((table ([cellspacing "0"]
,@(if need-inline?
'([style "display: inline-table; vertical-align: text-top;"])

62
collects/scribble/latex-render.ss
View File

@ -299,7 +299,10 @@
[row-styles row-styles])
(let ([flows (car flowss)]
[row-style (car row-styles)])
(let loop ([flows flows])
(let loop ([flows flows]
[col-v-styles (and (list? row-style)
(let ([p (assoc 'valignment row-style)])
(and p (cdr p))))])
(unless (null? flows)
(when index? (printf "\\item "))
(unless (eq? 'cont (car flows))
@ -309,10 +312,12 @@
(loop (cdr flows) (add1 n))]
[else n]))])
(unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt))
(render-table-flow (car flows) part ri twidth)
(render-table-flow (car flows) part ri twidth (and col-v-styles
(car col-v-styles)))
(unless (= cnt 1) (printf "}"))
(unless (null? (list-tail flows cnt)) (printf " &\n"))))
(unless (null? (cdr flows)) (loop (cdr flows)))))
(unless (null? (cdr flows)) (loop (cdr flows)
(and col-v-styles (cdr col-v-styles))))))
(unless (or index? (null? (cdr flowss)))
(printf " \\\\\n")
(when (equal? row-style "inferencetop") (printf "\\hline\n")))
@ -324,23 +329,40 @@
tableform)))))
null)
(define/private (render-table-flow p part ri twidth)
;; Emit a \\ between blocks:
(let loop ([ps (flow-paragraphs p)])
(cond
[(null? ps) (void)]
[else
(let ([minipage? (not (or (paragraph? (car ps))
(table? (car ps))))])
(when minipage?
(printf "\\begin{minipage}{~a\\linewidth}\n" (/ 1.0 twidth)))
(render-block (car ps) part ri #f)
(when minipage?
(printf " \\end{minipage}\n"))
(unless (null? (cdr ps))
(printf " \\\\\n")
(loop (cdr ps))))]))
null)
(define/private (render-table-flow p part ri twidth vstyle)
;; Emit a \\ between blocks in single-column mode,
;; used a nested table otherwise for multiple elements.
(let ([in-table? (or (and (not (= twidth 1))
((length (flow-paragraphs p)) . > . 1))
(eq? vstyle 'top))])
(when in-table?
(printf "\\begin{tabular}~a{@{}l@{}}\n"
(cond
[(eq? vstyle 'top) "[t]"]
[else ""])))
(let loop ([ps (flow-paragraphs p)])
(cond
[(null? ps) (void)]
[else
(let ([minipage? (not (or (paragraph? (car ps))
(table? (car ps))))])
(when minipage?
(printf "\\begin{minipage}~a{~a\\linewidth}\n"
(cond
[(eq? vstyle 'top) "[t]"]
[else ""])
(/ 1.0 twidth)))
(render-block (car ps) part ri #f)
(when minipage?
(printf " \\end{minipage}\n"))
(unless (null? (cdr ps))
(printf " \\\\\n")
(when in-table?
(printf " ~ \\\\\n"))
(loop (cdr ps))))]))
(when in-table?
(printf "\n\\end{tabular}\n"))
null))
(define/override (render-itemization t part ri)
(printf "\n\n\\begin{itemize}\n")

17
collects/scribblings/scribble/struct.scrbl
View File

@ -418,13 +418,16 @@ The @scheme[style] can be any of the following:
@item{@scheme['row-styles] to a list of association lists,
one for each row in the table. Each of these nested
association lists maps @scheme['alignment] and
@scheme['valignment] to a list of symbols an
@scheme[#f]s, one for each column. The symbols in an
@scheme['alignment] list can be @scheme['left],
@scheme['right], or @scheme['center]. The symbols in a
@scheme['valignment] list can be @scheme['top],
@scheme['baseline], or @scheme['bottom].}
association lists can map @scheme['alignment] and
@scheme['valignment] to a list of symbols and
@scheme[#f]s (one for each column cell) and/or
@scheme['style] to a list of strings and @scheme[#f]s
(one for each column cell) for a CSS class in HTML
output. The symbols in an @scheme['alignment] list can
be @scheme['left], @scheme['right], or
@scheme['center]. The symbols in a @scheme['valignment]
list can be @scheme['top], @scheme['baseline], or
@scheme['bottom].}
]}