suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble: render `pict' content directly

Browse Source 
--- actually, any value that is convertible to PNG/PDF

original commit: 0f86dc15afe6d0bf48a77f8aec7d66fda356082b
This commit is contained in:
Matthew Flatt 2010-11-26 17:49:46 -07:00
parent e30aedf47f
commit 6fb5dc58de
5 changed files with 67 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/scribble/base-render.rkt
View File

@ -8,6 +8,7 @@
scheme/path
setup/main-collects
setup/path-relativize
file/convertible
"render-struct.ss")
(provide render%)
@ -677,6 +678,7 @@
(render-content (traverse-element-content i ri) part ri)]
[(part-relative-element? i)
(render-content (part-relative-element-content i ri) part ri)]
[(convertible? i) (list "???")]
[else (render-other i part ri)]))
(define/public (render-other i part ri)
@ -687,13 +689,15 @@
(define copied-srcs (make-hash))
(define copied-dests (make-hash))
(define/public (install-file fn)
(if refer-to-existing-files
(define/public (install-file fn [content #f])
(if (and refer-to-existing-files
(not content))
(if (string? fn)
(string->path fn)
fn)
(let ([normalized (normal-case-path (simplify-path (path->complete-path fn)))])
(or (hash-ref copied-srcs normalized #f)
(or (and (not content)
(hash-ref copied-srcs normalized #f))
(let ([src-dir (path-only fn)]
[dest-dir (get-dest-directory #t)]
[fn (file-name-from-path fn)])
@ -715,22 +719,26 @@
(let-values ([(dest-file normalized-dest-file)
(let loop ([dest-file dest-file])
(let ([normalized-dest-file
(normal-case-path (simplify-path (path->complete-path dest-file)))])
(if (file-exists? dest-file)
(cond
[(call-with-input-file*
src-file
(lambda (src)
(call-with-input-file*
(normal-case-path (simplify-path (path->complete-path dest-file)))]
[check-same
(lambda (src)
(call-with-input-file*
dest-file
(lambda (dest)
(or (equal? (port-file-identity src)
(port-file-identity dest))
(or (and (not content)
(equal? (port-file-identity src)
(port-file-identity dest)))
(let loop ()
(let ([s (read-bytes 4096 src)]
[d (read-bytes 4096 dest)])
(and (equal? s d)
(or (eof-object? s) (loop))))))))))
(or (eof-object? s) (loop)))))))))])
(if (file-exists? dest-file)
(cond
[(or (and content
(check-same (open-input-bytes content)))
(and (not content)
(call-with-input-file* src-file check-same)))
;; same content at that destination
(values dest-file normalized-dest-file)]
[(hash-ref copied-dests normalized-dest-file #f)
@ -743,10 +751,15 @@
;; new file
(values dest-file normalized-dest-file))))])
(unless (file-exists? dest-file)
(copy-file src-file dest-file))
(if content
(call-with-output-file*
dest-file
(lambda (dest) (write-bytes content dest)))
(copy-file src-file dest-file)))
(hash-set! copied-dests normalized-dest-file #t)
(let ([result (path->string (file-name-from-path dest-file))])
(hash-set! copied-srcs normalized result)
(unless content
(hash-set! copied-srcs normalized result))
result))))))))
;; ----------------------------------------

6
collects/scribble/core.rkt
View File

@ -1,7 +1,8 @@
#lang scheme/base
(require "private/provide-structs.ss"
scheme/serialize
scheme/contract)
scheme/contract
file/convertible)
;; ----------------------------------------
@ -119,7 +120,8 @@
(traverse-element? v)
(part-relative-element? v)
(multiarg-element? v)
(hash-ref content-symbols v #f)))
(hash-ref content-symbols v #f)
(convertible? v)))
(provide element-style?)
(define (element-style? s)

10
collects/scribble/html-render.rkt
View File

@ -9,6 +9,7 @@
scheme/port
scheme/list
scheme/string
file/convertible
mzlib/runtime-path
setup/main-doc
setup/main-collects
@ -947,6 +948,15 @@
(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 (convertible? e)
(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)])))))]
[(image-element? e)
(let* ([src (main-collects-relative->path (image-element-path e))]
[suffixes (image-element-suffixes e)]

35
collects/scribble/latex-render.rkt
View File

@ -9,7 +9,8 @@
scheme/path
scheme/string
scheme/list
setup/main-collects)
setup/main-collects
file/convertible)
(provide render-mixin)
(define current-table-mode (make-parameter #f))
@ -235,18 +236,26 @@
es)]
[style (and (style? es) es)]
[core-render (lambda (e tt?)
(if (and (image-element? e)
(not (disable-images)))
(let ([fn (install-file
(select-suffix
(main-collects-relative->path
(image-element-path e))
(image-element-suffixes e)
'(".pdf" ".ps" ".png")))])
(printf "\\includegraphics[scale=~a]{~a}"
(image-element-scale e) fn))
(parameterize ([rendering-tt (or tt? (rendering-tt))])
(super render-content e part ri))))]
(cond
[(and (image-element? e)
(not (disable-images)))
(let ([fn (install-file
(select-suffix
(main-collects-relative->path
(image-element-path e))
(image-element-suffixes e)
'(".pdf" ".ps" ".png")))])
(printf "\\includegraphics[scale=~a]{~a}"
(image-element-scale e) fn))]
[(and (convertible? e)
(not (disable-images))
(convert e 'pdf-bytes))
=> (lambda (bstr)
(let ([fn (install-file "pict.pdf" bstr)])
(printf "\\includegraphics{~a}" fn)))]
[else
(parameterize ([rendering-tt (or tt? (rendering-tt))])
(super render-content e part ri))]))]
[wrap (lambda (e s tt?)
(printf "\\~a{" s)
(core-render e tt?)

5
collects/scribblings/scribble/core.scrbl
View File

@ -943,8 +943,9 @@ otherwise.}
Returns @racket[#t] if @racket[v] is a string, symbol,
@racket[element], @racket[multiarg-element],
@racket[traverse-element], @racket[delayed-element],
@racket[part-relative-element], or list of @tech{content}, @racket[#f]
otherwise.}
@racket[part-relative-element], a convertible value in
the sense of @racket[convertible?], or list of @tech{content}.
Otherwise, it returns @racket[#f].}
@defstruct[style ([name (or/c string? symbol? #f)]