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

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

@ -1047,19 +1047,21 @@
(lambda (k) (assoc k t-style)) (lambda (k) (assoc k t-style))
(lambda (k) #f))) (lambda (k) #f)))
(define (make-row flows style) (define (make-row flows style)
`(tr (,@(if style `([class ,style]) null)) `(tr (,@(if (string? style) `([class ,style]) null))
,@(let loop ([ds flows] ,@(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))))] (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))))] (cons #f (map (lambda (x) #f) flows))))]
[first? #t]) [first? #t])
(cond (cond
[(null? ds) null] [(null? ds) null]
[(eq? (car ds) 'cont) [(eq? (car ds) 'cont)
(loop (cdr ds) (cdr as) (cdr vas) first?)] (loop (cdr ds) (cdr as) (cdr vas) (cdr sts) first?)]
[else [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 (cons
`(td (,@(case a `(td (,@(case a
[(#f) null] [(#f) null]
@ -1071,6 +1073,9 @@
[(top) '((valign "top"))] [(top) '((valign "top"))]
[(baseline) '((valign "baseline"))] [(baseline) '((valign "baseline"))]
[(bottom) '((valign "bottom"))]) [(bottom) '((valign "bottom"))])
,@(if (string? st)
`([class ,st])
null)
,@(if (and (pair? (cdr ds)) ,@(if (and (pair? (cdr ds))
(eq? 'cont (cadr ds))) (eq? 'cont (cadr ds)))
`([colspan `([colspan
@ -1085,7 +1090,7 @@
(omitable-paragraph? (car (flow-paragraphs d)))) (omitable-paragraph? (car (flow-paragraphs d))))
(render-content (paragraph-content (car (flow-paragraphs d))) part ri) (render-content (paragraph-content (car (flow-paragraphs d))) part ri)
(render-flow d part ri #f))) (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"] `((table ([cellspacing "0"]
,@(if need-inline? ,@(if need-inline?
'([style "display: inline-table; vertical-align: text-top;"]) '([style "display: inline-table; vertical-align: text-top;"])

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

@ -299,7 +299,10 @@
[row-styles row-styles]) [row-styles row-styles])
(let ([flows (car flowss)] (let ([flows (car flowss)]
[row-style (car row-styles)]) [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) (unless (null? flows)
(when index? (printf "\\item ")) (when index? (printf "\\item "))
(unless (eq? 'cont (car flows)) (unless (eq? 'cont (car flows))
@ -309,10 +312,12 @@
(loop (cdr flows) (add1 n))] (loop (cdr flows) (add1 n))]
[else n]))]) [else n]))])
(unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt)) (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 (= cnt 1) (printf "}"))
(unless (null? (list-tail flows cnt)) (printf " &\n")))) (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))) (unless (or index? (null? (cdr flowss)))
(printf " \\\\\n") (printf " \\\\\n")
(when (equal? row-style "inferencetop") (printf "\\hline\n"))) (when (equal? row-style "inferencetop") (printf "\\hline\n")))
@ -324,8 +329,17 @@
tableform))))) tableform)))))
null) null)
(define/private (render-table-flow p part ri twidth) (define/private (render-table-flow p part ri twidth vstyle)
;; Emit a \\ between blocks: ;; 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)]) (let loop ([ps (flow-paragraphs p)])
(cond (cond
[(null? ps) (void)] [(null? ps) (void)]
@ -333,14 +347,22 @@
(let ([minipage? (not (or (paragraph? (car ps)) (let ([minipage? (not (or (paragraph? (car ps))
(table? (car ps))))]) (table? (car ps))))])
(when minipage? (when minipage?
(printf "\\begin{minipage}{~a\\linewidth}\n" (/ 1.0 twidth))) (printf "\\begin{minipage}~a{~a\\linewidth}\n"
(cond
[(eq? vstyle 'top) "[t]"]
[else ""])
(/ 1.0 twidth)))
(render-block (car ps) part ri #f) (render-block (car ps) part ri #f)
(when minipage? (when minipage?
(printf " \\end{minipage}\n")) (printf " \\end{minipage}\n"))
(unless (null? (cdr ps)) (unless (null? (cdr ps))
(printf " \\\\\n") (printf " \\\\\n")
(when in-table?
(printf " ~ \\\\\n"))
(loop (cdr ps))))])) (loop (cdr ps))))]))
null) (when in-table?
(printf "\n\\end{tabular}\n"))
null))
(define/override (render-itemization t part ri) (define/override (render-itemization t part ri)
(printf "\n\n\\begin{itemize}\n") (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[]} @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?]{ syntax?]{
Lifts a @scheme[#%require] form corresponding to Lifts a @scheme[#%require] form corresponding to
@scheme[quoted-raw-require-spec] to the top-level or to the top of the @scheme[raw-require-spec] (either as a @tech{syntax object} or datum)
module currently being expanded, wrapping it with @scheme[for-meta] if to the top-level or to the top of the module currently being expanded,
the current expansion context is not @tech{phase level} 0. 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 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 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, @item{@scheme['row-styles] to a list of association lists,
one for each row in the table. Each of these nested one for each row in the table. Each of these nested
association lists maps @scheme['alignment] and association lists can map @scheme['alignment] and
@scheme['valignment] to a list of symbols an @scheme['valignment] to a list of symbols and
@scheme[#f]s, one for each column. The symbols in an @scheme[#f]s (one for each column cell) and/or
@scheme['alignment] list can be @scheme['left], @scheme['style] to a list of strings and @scheme[#f]s
@scheme['right], or @scheme['center]. The symbols in a (one for each column cell) for a CSS class in HTML
@scheme['valignment] list can be @scheme['top], output. The symbols in an @scheme['alignment] list can
@scheme['baseline], or @scheme['bottom].} 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. ;; 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 ;; The 0.0 slide will wit until you advance, but the remaining ones will
;; time out automatically to create the animation. ;; time out automatically to create the animation.
(define (play #:title [title #f] mid) (define (play #:title [title #f] #:layout [layout 'auto] mid)
(slide #:title title (mid 0)) (slide #:title title #:layout layout (mid 0))
(if condense? (if condense?
(skip-slides 10) (skip-slides 10)
(map (lambda (n) (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 ([cnt 10])
(let loop ([n cnt]) (let loop ([n cnt])
(if (zero? n) (if (zero? n)
@ -36,14 +36,15 @@
;; arguments will be 0.0. The first argument goes from 0.0 to 1.0 ;; 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 ;; 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. ;; 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 ([n (procedure-arity mid)])
(let loop ([post (vector->list (make-vector n))] (let loop ([post (vector->list (make-vector n))]
[pre null]) [pre null])
(if (null? post) (if (null? post)
(slide #:title title (apply mid pre)) (slide #:title title #:layout layout (apply mid pre))
(begin (begin
(play #:title title (play #:title title
#:layout layout
(lambda (n) (lambda (n)
(apply mid (append pre (list n) (cdr post))))) (apply mid (append pre (list n) (cdr post)))))
(loop (cdr post) (cons 1.0 pre))))))) (loop (cdr post) (cons 1.0 pre)))))))