rename the 'render-pict-as' to 'render-convertible-as'

also, add docs and simplify the interface a little bit
in a way that makes it friendlier to future extension

original commit: 7adece9001dbfed39c5f114d3a7334ac1d6b7c9e
This commit is contained in:
Robby Findler 2013-11-10 15:40:06 -06:00
parent 30ad2e3890
commit 7ff10149be
3 changed files with 42 additions and 38 deletions

View File

@ -459,6 +459,10 @@ The recognized @tech{style properties} are as follows:
@item{@racket[hover-property] structure --- For HTML, adds a text @item{@racket[hover-property] structure --- For HTML, adds a text
label to the title to be shown when the mouse hovers over label to the title to be shown when the mouse hovers over
it.} it.}
@item{@racket[render-convertible-as] structure --- For HTML, controls
how objects that subscribe to the @racketmodname[file/convertible]
protocol are rendered.}
] ]
@ -1510,6 +1514,15 @@ For a @racket[part] that corresponds to an HTML page, adds content to
the @tt{<head>} tag.} the @tt{<head>} tag.}
@defstruct[render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes))])]{
For a @racket[part] that corresponds to an HTML page,
controls how objects that subscribe to the @racketmodname[file/convertible]
protocol are rendered.
The alternatives in the @racket[types] field are tried in order
and the first one that succeeds is used in the html output.
}
@defstruct[part-link-redirect ([url url?])]{ @defstruct[part-link-redirect ([url url?])]{
As a @tech{style property} on a @tech{part}, causes hyperiinks to the As a @tech{style property} on a @tech{part}, causes hyperiinks to the

View File

@ -25,4 +25,4 @@
[link-resource ([path path-string?])] [link-resource ([path path-string?])]
[head-extra ([xexpr xexpr/c])] [head-extra ([xexpr xexpr/c])]
[render-pict-as ([type symbol?])]) [render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes))])])

View File

@ -105,7 +105,7 @@
(define extra-breaking? (make-parameter #f)) (define extra-breaking? (make-parameter #f))
(define current-version (make-parameter (version))) (define current-version (make-parameter (version)))
(define current-part-files (make-parameter #f)) (define current-part-files (make-parameter #f))
(define current-render-pict-as (make-parameter 'png-images)) (define current-render-convertible-requests (make-parameter '(png-bytes svg-bytes)))
(define (url->string* u) (define (url->string* u)
(parameterize ([current-url-encode-mode 'unreserved]) (parameterize ([current-url-encode-mode 'unreserved])
@ -1008,15 +1008,14 @@
d d
ri)))))) ri))))))
(define/public (extract-render-pict-as d) (define/public (extract-render-convertible-as d)
(ormap (lambda (v) (for/or ([v (in-list (style-properties (part-style d)))])
(and (render-pict-as? v) (and (render-convertible-as? v)
(render-pict-as-type v))) (render-convertible-as-types v))))
(style-properties (part-style d))))
(define/override (render-part-content d ri) (define/override (render-part-content d ri)
(parameterize ([current-render-pict-as (or (extract-render-pict-as d) (parameterize ([current-render-convertible-requests (or (extract-render-convertible-as d)
(current-render-pict-as))]) (current-render-convertible-requests))])
(let ([number (collected-info-number (part-collected-info d ri))]) (let ([number (collected-info-number (part-collected-info d ri))])
`(,@(let ([pres (extract-pretitle d)]) `(,@(let ([pres (extract-pretitle d)])
(append-map (lambda (pre) (append-map (lambda (pre)
@ -1133,15 +1132,7 @@
[(string? e) (super render-content e part ri)] ; short-cut for common case [(string? e) (super render-content e part ri)] ; short-cut for common case
[(list? e) (super render-content e part ri)] ; also a short-cut [(list? e) (super render-content e part ri)] ; also a short-cut
[(and (convertible? e) [(and (convertible? e)
(equal? (current-render-pict-as) 'png-images) (render-as-convertible e (current-render-convertible-requests)))
(convertible? e)
(or (render-as-png e)
(render-as-svg e)))
=> values]
[(and (equal? (current-render-pict-as) 'svg-images)
(convertible? e)
(or (render-as-svg e)
(render-as-png e)))
=> values] => values]
[(image-element? e) [(image-element? e)
(let* ([src (collects-relative->path (image-element-path e))] (let* ([src (collects-relative->path (image-element-path e))]
@ -1293,26 +1284,26 @@
[else [else
(render-plain-content e part ri)])) (render-plain-content e part ri)]))
(define/private (render-as-png e) (define/private (render-as-convertible e requests)
(cond (for/or ([request (in-list requests)])
[(convert e 'png-bytes) (cond
=> [(and (equal? request 'png-bytes)
(lambda (bstr) (convert e 'png-bytes))
(let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)] =>
[h (integer-bytes->integer (subbytes bstr 20 24) #f #t)]) (lambda (bstr)
`((img ([src ,(install-file "pict.png" bstr)] (let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)]
[alt "image"] [h (integer-bytes->integer (subbytes bstr 20 24) #f #t)])
[width ,(number->string w)] `((img ([src ,(install-file "pict.png" bstr)]
[height ,(number->string h)])))))] [alt "image"]
[else #f])) [width ,(number->string w)]
(define/private (render-as-svg e) [height ,(number->string h)])))))]
(cond [(and (equal? request 'svg-bytes)
[(convert e 'svg-bytes) (convert e 'svg-bytes))
=> (lambda (bstr) => (lambda (bstr)
`((object `((object
([data ,(install-file "pict.svg" bstr)] ([data ,(install-file "pict.svg" bstr)]
[type "image/svg+xml"]))))] [type "image/svg+xml"]))))]
[else #f])) [else #f])))
(define/private (render-plain-content e part ri) (define/private (render-plain-content e part ri)
(define (attribs) (content-attribs e)) (define (attribs) (content-attribs e))