suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Use html-render-pict-as to control whether html-render uses pngs or svgs

Browse Source 
original commit: 2bc58b5663c7753b0ad9bdabe18acd637276ac96
This commit is contained in:
Jens Axel Søgaard 2013-10-14 22:25:28 +02:00
parent 49eac8975b
commit 8a5a9adfc5
3 changed files with 61 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt
View File

@ -6,14 +6,13 @@
"decode-struct.rkt" "decode-struct.rkt"
"html-properties.rkt" "html-properties.rkt"
"tag.rkt" "tag.rkt"
"parameters.rkt"
scheme/list scheme/list
scheme/class scheme/class
racket/contract/base racket/contract/base
racket/contract/combinator racket/contract/combinator
(for-syntax scheme/base)) (for-syntax scheme/base))
(provide (all-from-out "tag.rkt" "parameters.rkt")) (provide (all-from-out "tag.rkt"))
;; ---------------------------------------- ;; ----------------------------------------

3
pkgs/scribble-pkgs/scribble-lib/scribble/html-properties.rkt
View File

@ -24,4 +24,5 @@
[install-resource ([path path-string?])] [install-resource ([path path-string?])]
[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?])])

107
pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
View File

@ -94,6 +94,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 (url->string* u) (define (url->string* u)
(parameterize ([current-url-encode-mode 'unreserved]) (parameterize ([current-url-encode-mode 'unreserved])
@ -975,54 +976,62 @@
d d
ri)))))) 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) (define/override (render-part-content d ri)
(let ([number (collected-info-number (part-collected-info d ri))]) (parameterize ([current-render-pict-as (extract-render-pict-as d)])
`(,@(let ([pres (extract-pretitle d)]) (let ([number (collected-info-number (part-collected-info d ri))])
(append-map (lambda (pre) `(,@(let ([pres (extract-pretitle d)])
(do-render-paragraph pre d ri #f #t)) (append-map (lambda (pre)
pres)) (do-render-paragraph pre d ri #f #t))
,@(cond pres))
[(and (not (part-title-content d)) (null? number)) null] ,@(cond
[(part-style? d 'hidden) [(and (not (part-title-content d)) (null? number)) null]
(map (lambda (t) [(part-style? d 'hidden)
`(a ((name ,(format "~a" (anchor-name (map (lambda (t)
(add-current-tag-prefix `(a ((name ,(format "~a" (anchor-name
(tag-key t ri)))))))) (add-current-tag-prefix
(part-tags d))] (tag-key t ri))))))))
[else `((,(case (number-depth number) (part-tags d))]
[(0) 'h2] [else `((,(case (number-depth number)
[(1) 'h3] [(0) 'h2]
[(2) 'h4] [(1) 'h3]
[else 'h5]) [(2) 'h4]
,@(format-number number '((tt nbsp))) [else 'h5])
,@(map (lambda (t) ,@(format-number number '((tt nbsp)))
`(a ([name ,(format "~a" (anchor-name ,@(map (lambda (t)
(add-current-tag-prefix `(a ([name ,(format "~a" (anchor-name
(tag-key t ri))))]))) (add-current-tag-prefix
(part-tags d)) (tag-key t ri))))])))
,@(if (part-title-content d) (part-tags d))
(render-content (part-title-content d) d ri) ,@(if (part-title-content d)
null)))]) (render-content (part-title-content d) d ri)
,@(let ([auths (extract-authors d)]) null)))])
(if (null? auths) ,@(let ([auths (extract-authors d)])
null (if (null? auths)
`((div ([class "SAuthorListBox"]) null
(span ([class "SAuthorList"]) `((div ([class "SAuthorListBox"])
,@(apply (span ([class "SAuthorList"])
append ,@(apply
(for/list ([auth (in-list auths)] append
[pos (in-naturals)]) (for/list ([auth (in-list auths)]
(let ([v (do-render-paragraph auth d ri #f #t)]) [pos (in-naturals)])
(if (zero? pos) (let ([v (do-render-paragraph auth d ri #f #t)])
v (if (zero? pos)
(cons '(span ([class "SAuthorSep"]) (br)) v)))))))))) v
,@(render-flow* (part-blocks d) d ri #f #f) (cons '(span ([class "SAuthorSep"]) (br)) v))))))))))
,@(let loop ([pos 1] ,@(render-flow* (part-blocks d) d ri #f #f)
[secs (part-parts d)]) ,@(let loop ([pos 1]
(if (null? secs) [secs (part-parts d)])
null (if (null? secs)
(append (render-part (car secs) ri) null
(loop (add1 pos) (cdr secs)))))))) (append (render-part (car secs) ri)
(loop (add1 pos) (cdr secs)))))))))
(define/private (render-flow* p part ri starting-item? special-last?) (define/private (render-flow* p part ri starting-item? special-last?)
;; Wrap each table with <p>, except for a trailing table ;; Wrap each table with <p>, except for a trailing table
@ -1091,7 +1100,7 @@
(cond (cond
[(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 (equal? (current-html-render-pict-as) 'png) [(and (equal? (current-render-pict-as) 'png-images)
(convertible? e) (convertible? e)
(convert e 'png-bytes)) (convert e 'png-bytes))
=> (lambda (bstr) => (lambda (bstr)
@ -1101,7 +1110,7 @@
[alt "image"] [alt "image"]
[width ,(number->string w)] [width ,(number->string w)]
[height ,(number->string h)])))))] [height ,(number->string h)])))))]
[(and (equal? (current-html-render-pict-as) 'svg) [(and (equal? (current-render-pict-as) 'svg-images)
(convertible? e) (convertible? e)
(convert e 'svg-bytes)) (convert e 'svg-bytes))
=> (lambda (bstr) => (lambda (bstr)