commit 7ff10149be973494eedeeef10c8976307edf94d1
parent 30ad2e3890ec668961ef7888229bba732429cbdc
Author: Robby Findler <robby@racket-lang.org>
Date: Sun, 10 Nov 2013 15:40:06 -0600
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
Diffstat:
3 files changed, 42 insertions(+), 38 deletions(-)
diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl
@@ -459,6 +459,10 @@ The recognized @tech{style properties} are as follows:
@item{@racket[hover-property] structure --- For HTML, adds a text
label to the title to be shown when the mouse hovers over
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.}
+@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?])]{
As a @tech{style property} on a @tech{part}, causes hyperiinks to the
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt
@@ -25,4 +25,4 @@
[link-resource ([path path-string?])]
[head-extra ([xexpr xexpr/c])]
- [render-pict-as ([type symbol?])])
+ [render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes))])])
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
@@ -105,7 +105,7 @@
(define extra-breaking? (make-parameter #f))
(define current-version (make-parameter (version)))
(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)
(parameterize ([current-url-encode-mode 'unreserved])
@@ -1008,15 +1008,14 @@
d
ri))))))
- (define/public (extract-render-pict-as d)
- (ormap (lambda (v)
- (and (render-pict-as? v)
- (render-pict-as-type v)))
- (style-properties (part-style d))))
+ (define/public (extract-render-convertible-as d)
+ (for/or ([v (in-list (style-properties (part-style d)))])
+ (and (render-convertible-as? v)
+ (render-convertible-as-types v))))
(define/override (render-part-content d ri)
- (parameterize ([current-render-pict-as (or (extract-render-pict-as d)
- (current-render-pict-as))])
+ (parameterize ([current-render-convertible-requests (or (extract-render-convertible-as d)
+ (current-render-convertible-requests))])
(let ([number (collected-info-number (part-collected-info d ri))])
`(,@(let ([pres (extract-pretitle d)])
(append-map (lambda (pre)
@@ -1133,15 +1132,7 @@
[(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
[(and (convertible? e)
- (equal? (current-render-pict-as) 'png-images)
- (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)))
+ (render-as-convertible e (current-render-convertible-requests)))
=> values]
[(image-element? e)
(let* ([src (collects-relative->path (image-element-path e))]
@@ -1293,26 +1284,26 @@
[else
(render-plain-content e part ri)]))
- (define/private (render-as-png e)
- (cond
- [(convert e 'png-bytes)
- =>
- (lambda (bstr)
- (let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)]
- [h (integer-bytes->integer (subbytes bstr 20 24) #f #t)])
- `((img ([src ,(install-file "pict.png" bstr)]
- [alt "image"]
- [width ,(number->string w)]
- [height ,(number->string h)])))))]
- [else #f]))
- (define/private (render-as-svg e)
- (cond
- [(convert e 'svg-bytes)
- => (lambda (bstr)
- `((object
- ([data ,(install-file "pict.svg" bstr)]
- [type "image/svg+xml"]))))]
- [else #f]))
+ (define/private (render-as-convertible e requests)
+ (for/or ([request (in-list requests)])
+ (cond
+ [(and (equal? request 'png-bytes)
+ (convert e 'png-bytes))
+ =>
+ (lambda (bstr)
+ (let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)]
+ [h (integer-bytes->integer (subbytes bstr 20 24) #f #t)])
+ `((img ([src ,(install-file "pict.png" bstr)]
+ [alt "image"]
+ [width ,(number->string w)]
+ [height ,(number->string h)])))))]
+ [(and (equal? request 'svg-bytes)
+ (convert e 'svg-bytes))
+ => (lambda (bstr)
+ `((object
+ ([data ,(install-file "pict.svg" bstr)]
+ [type "image/svg+xml"]))))]
+ [else #f])))
(define/private (render-plain-content e part ri)
(define (attribs) (content-attribs e))
