From 8a5a9adfc53984e93e9faa2d667f6126e60ac405 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jens=20Axel=20S=C3=B8gaard?= Date: Mon, 14 Oct 2013 22:25:28 +0200 Subject: [PATCH] Use html-render-pict-as to control whether html-render uses pngs or svgs original commit: 2bc58b5663c7753b0ad9bdabe18acd637276ac96 --- .../scribble-lib/scribble/base.rkt | 3 +- .../scribble-lib/scribble/html-properties.rkt | 3 +- .../scribble-lib/scribble/html-render.rkt | 107 ++++++++++-------- 3 files changed, 61 insertions(+), 52 deletions(-) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt index 5f0757a8..ab8da3cc 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt @@ -6,14 +6,13 @@ "decode-struct.rkt" "html-properties.rkt" "tag.rkt" - "parameters.rkt" scheme/list scheme/class racket/contract/base racket/contract/combinator (for-syntax scheme/base)) -(provide (all-from-out "tag.rkt" "parameters.rkt")) +(provide (all-from-out "tag.rkt")) ;; ---------------------------------------- diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt index ebb8c2f5..39156e88 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt @@ -24,4 +24,5 @@ [install-resource ([path path-string?])] [link-resource ([path path-string?])] - [head-extra ([xexpr xexpr/c])]) + [head-extra ([xexpr xexpr/c])] + [render-pict-as ([type symbol?])]) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index b440664e..2e0c9f1d 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -94,6 +94,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 (url->string* u) (parameterize ([current-url-encode-mode 'unreserved]) @@ -975,54 +976,62 @@ d ri)))))) + (define/public (extract-render-pict-as d) + (or (ormap (lambda (v) + (and (render-pict-as? v) + (render-pict-as-type v))) + (style-properties (part-style d))) + "")) + (define/override (render-part-content d ri) - (let ([number (collected-info-number (part-collected-info d ri))]) - `(,@(let ([pres (extract-pretitle d)]) - (append-map (lambda (pre) - (do-render-paragraph pre d ri #f #t)) - pres)) - ,@(cond - [(and (not (part-title-content d)) (null? number)) null] - [(part-style? d 'hidden) - (map (lambda (t) - `(a ((name ,(format "~a" (anchor-name - (add-current-tag-prefix - (tag-key t ri)))))))) - (part-tags d))] - [else `((,(case (number-depth number) - [(0) 'h2] - [(1) 'h3] - [(2) 'h4] - [else 'h5]) - ,@(format-number number '((tt nbsp))) - ,@(map (lambda (t) - `(a ([name ,(format "~a" (anchor-name - (add-current-tag-prefix - (tag-key t ri))))]))) - (part-tags d)) - ,@(if (part-title-content d) - (render-content (part-title-content d) d ri) - null)))]) - ,@(let ([auths (extract-authors d)]) - (if (null? auths) - null - `((div ([class "SAuthorListBox"]) - (span ([class "SAuthorList"]) - ,@(apply - append - (for/list ([auth (in-list auths)] - [pos (in-naturals)]) - (let ([v (do-render-paragraph auth d ri #f #t)]) - (if (zero? pos) - v - (cons '(span ([class "SAuthorSep"]) (br)) v)))))))))) - ,@(render-flow* (part-blocks d) d ri #f #f) - ,@(let loop ([pos 1] - [secs (part-parts d)]) - (if (null? secs) - null - (append (render-part (car secs) ri) - (loop (add1 pos) (cdr secs)))))))) + (parameterize ([current-render-pict-as (extract-render-pict-as d)]) + (let ([number (collected-info-number (part-collected-info d ri))]) + `(,@(let ([pres (extract-pretitle d)]) + (append-map (lambda (pre) + (do-render-paragraph pre d ri #f #t)) + pres)) + ,@(cond + [(and (not (part-title-content d)) (null? number)) null] + [(part-style? d 'hidden) + (map (lambda (t) + `(a ((name ,(format "~a" (anchor-name + (add-current-tag-prefix + (tag-key t ri)))))))) + (part-tags d))] + [else `((,(case (number-depth number) + [(0) 'h2] + [(1) 'h3] + [(2) 'h4] + [else 'h5]) + ,@(format-number number '((tt nbsp))) + ,@(map (lambda (t) + `(a ([name ,(format "~a" (anchor-name + (add-current-tag-prefix + (tag-key t ri))))]))) + (part-tags d)) + ,@(if (part-title-content d) + (render-content (part-title-content d) d ri) + null)))]) + ,@(let ([auths (extract-authors d)]) + (if (null? auths) + null + `((div ([class "SAuthorListBox"]) + (span ([class "SAuthorList"]) + ,@(apply + append + (for/list ([auth (in-list auths)] + [pos (in-naturals)]) + (let ([v (do-render-paragraph auth d ri #f #t)]) + (if (zero? pos) + v + (cons '(span ([class "SAuthorSep"]) (br)) v)))))))))) + ,@(render-flow* (part-blocks d) d ri #f #f) + ,@(let loop ([pos 1] + [secs (part-parts d)]) + (if (null? secs) + null + (append (render-part (car secs) ri) + (loop (add1 pos) (cdr secs))))))))) (define/private (render-flow* p part ri starting-item? special-last?) ;; Wrap each table with

, except for a trailing table @@ -1091,7 +1100,7 @@ (cond [(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 (equal? (current-html-render-pict-as) 'png) + [(and (equal? (current-render-pict-as) 'png-images) (convertible? e) (convert e 'png-bytes)) => (lambda (bstr) @@ -1101,7 +1110,7 @@ [alt "image"] [width ,(number->string w)] [height ,(number->string h)])))))] - [(and (equal? (current-html-render-pict-as) 'svg) + [(and (equal? (current-render-pict-as) 'svg-images) (convertible? e) (convert e 'svg-bytes)) => (lambda (bstr)