suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests 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
This commit is contained in:
Matthew Flatt 2009-02-25 21:14:22 +00:00
parent 79b906e713
commit 90bc1d816d
5 changed files with 76 additions and 44 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")

9
collects/scribblings/reference/stx-trans.scrbl
View File

@ -352,13 +352,14 @@ eventually expanded in an expression context.
@transform-time[]}
@defproc[(syntax-local-lift-require [quoted-raw-require-spec any/c][stx syntax?])
@defproc[(syntax-local-lift-require [raw-require-spec any/c][stx syntax?])
syntax?]{
Lifts a @scheme[#%require] form corresponding to
@scheme[quoted-raw-require-spec] to the top-level or to the top of the
module currently being expanded, wrapping it with @scheme[for-meta] if
the current expansion context is not @tech{phase level} 0.
@scheme[raw-require-spec] (either as a @tech{syntax object} or datum)
to the top-level or to the top of the module currently being expanded,
wrapping it with @scheme[for-meta] if the current expansion context is
not @tech{phase level} 0.
The resulting syntax object is the same as @scheme[stx], except that a
fresh @tech{syntax mark} is added. The same @tech{syntax mark} is

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].}
]}

11
collects/slideshow/play.ss
View File

@ -18,12 +18,12 @@
;; Create a slide sequence where `mid' takes a number from 0.0 to 1.0.
;; The 0.0 slide will wit until you advance, but the remaining ones will
;; time out automatically to create the animation.
(define (play #:title [title #f] mid)
(slide #:title title (mid 0))
(define (play #:title [title #f] #:layout [layout 'auto] mid)
(slide #:title title #:layout layout (mid 0))
(if condense?
(skip-slides 10)
(map (lambda (n)
(slide #:title title #:timeout 0.05 (mid n)))
(slide #:title title #:layout layout #:timeout 0.05 (mid n)))
(let ([cnt 10])
(let loop ([n cnt])
(if (zero? n)
@ -36,14 +36,15 @@
;; arguments will be 0.0. The first argument goes from 0.0 to 1.0
;; for the first `play' sequence, and then it stays at 1.0 while
;; the second goes from 0.0 to 1.0 for the second sequence, etc.
(define (play-n #:title [title #f] mid)
(define (play-n #:title [title #f] #:layout [layout 'auto] mid)
(let ([n (procedure-arity mid)])
(let loop ([post (vector->list (make-vector n))]
[pre null])
(if (null? post)
(slide #:title title (apply mid pre))
(slide #:title title #:layout layout (apply mid pre))
(begin
(play #:title title
#:layout layout
(lambda (n)
(apply mid (append pre (list n) (cdr post)))))
(loop (cdr post) (cons 1.0 pre)))))))