From 90bc1d816d4645f7f7a3be99cf2e05c9bdfbef8d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 25 Feb 2009 21:14:22 +0000 Subject: [PATCH] fix some Scribble rendering issues with tables containing flows abd cell styles; extend Slideshow play to handle more optional arguments; fix some docs svn: r13843 --- collects/scribble/html-render.ss | 21 ++++--- collects/scribble/latex-render.ss | 62 +++++++++++++------ .../scribblings/reference/stx-trans.scrbl | 9 +-- collects/scribblings/scribble/struct.scrbl | 17 ++--- collects/slideshow/play.ss | 11 ++-- 5 files changed, 76 insertions(+), 44 deletions(-) diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 3349b37adf..2f1bf1556f 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -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;"]) diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index e0e4798880..19ff53071b 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -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") diff --git a/collects/scribblings/reference/stx-trans.scrbl b/collects/scribblings/reference/stx-trans.scrbl index 2e12e90b4c..50e2613777 100644 --- a/collects/scribblings/reference/stx-trans.scrbl +++ b/collects/scribblings/reference/stx-trans.scrbl @@ -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 diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl index abdbfbd61d..f0912ac1d6 100644 --- a/collects/scribblings/scribble/struct.scrbl +++ b/collects/scribblings/scribble/struct.scrbl @@ -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].} ]} diff --git a/collects/slideshow/play.ss b/collects/slideshow/play.ss index caa81f8c0f..873cdc8888 100644 --- a/collects/slideshow/play.ss +++ b/collects/slideshow/play.ss @@ -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)))))))