From 6fb5dc58de6fe9b5c2bdf21e718e9a32a7e732c6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 26 Nov 2010 17:49:46 -0700 Subject: [PATCH] scribble: render `pict' content directly --- actually, any value that is convertible to PNG/PDF original commit: 0f86dc15afe6d0bf48a77f8aec7d66fda356082b --- collects/scribble/base-render.rkt | 43 +++++++++++++++--------- collects/scribble/core.rkt | 6 ++-- collects/scribble/html-render.rkt | 10 ++++++ collects/scribble/latex-render.rkt | 35 ++++++++++++------- collects/scribblings/scribble/core.scrbl | 5 +-- 5 files changed, 67 insertions(+), 32 deletions(-) diff --git a/collects/scribble/base-render.rkt b/collects/scribble/base-render.rkt index 2a5cace6..8dd56c06 100644 --- a/collects/scribble/base-render.rkt +++ b/collects/scribble/base-render.rkt @@ -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)))))))) ;; ---------------------------------------- diff --git a/collects/scribble/core.rkt b/collects/scribble/core.rkt index aa68a42f..6e71a8ce 100644 --- a/collects/scribble/core.rkt +++ b/collects/scribble/core.rkt @@ -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) diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt index c31021c9..412b4c34 100644 --- a/collects/scribble/html-render.rkt +++ b/collects/scribble/html-render.rkt @@ -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)] diff --git a/collects/scribble/latex-render.rkt b/collects/scribble/latex-render.rkt index a8b2ae95..459deac0 100644 --- a/collects/scribble/latex-render.rkt +++ b/collects/scribble/latex-render.rkt @@ -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?) diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl index bf9b3aec..a64b56de 100644 --- a/collects/scribblings/scribble/core.scrbl +++ b/collects/scribblings/scribble/core.scrbl @@ -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)]