indirect-renderer.rkt (1870B)
1 #lang racket/base 2 3 (require racket/class racket/file racket/path) 4 5 (provide make-indirect-renderer-mixin) 6 7 (define (dotless bytes) (regexp-replace #rx#"[.]" bytes #"")) 8 9 (define ((make-indirect-renderer-mixin 10 base-renderer base-suffix target-suffix convert) 11 %renderer) 12 (class (base-renderer %renderer) 13 ;; set to a temp directory when doing the sub-rendering 14 (define tmp-dest-dir #f) 15 (define/override (get-dest-directory create?) 16 (or tmp-dest-dir (super get-dest-directory create?))) 17 (define/override (report-output?) 18 (and (not tmp-dest-dir) (super report-output?))) 19 (define/override (get-suffix) target-suffix) 20 (define/override (render srcs dests ri) 21 (define tmp-dir 22 (make-temporary-file 23 (format "scribble-~a-to-~a-~~a" 24 (dotless base-suffix) (dotless target-suffix)) 25 'directory)) 26 (define (cleanup) 27 (when (directory-exists? tmp-dir) (delete-directory/files tmp-dir))) 28 (with-handlers ([void (lambda (e) (cleanup) (raise e))]) 29 (define tmp-dests 30 (map (lambda (dest) 31 (build-path tmp-dir 32 (path-replace-suffix (file-name-from-path dest) 33 base-suffix))) 34 dests)) 35 (set! tmp-dest-dir tmp-dir) 36 ;; it would be better if it's ok to change current-directory for this 37 (super render srcs tmp-dests ri) 38 (for ([tmp tmp-dests] [dst dests]) 39 (parameterize ([current-directory tmp-dir]) 40 (convert (file-name-from-path tmp))) 41 (when (super report-output?) ; use the original 42 (printf " [Output to ~a]\n" dst)) 43 (copy-file (build-path tmp-dir (file-name-from-path dst)) 44 dst 45 #t)) 46 (cleanup))) 47 (super-new)))