7265c614d4
instead of copying the file into place. This makes Lion's Preview happier (specifically it now recognizes the file as a revision of the old one and updates itself instead of treating it as a new file and opening a second window) original commit: f9e1c41cb0a7f84766207d7a092443dbb5a17e1c
52 lines
2.0 KiB
Racket
52 lines
2.0 KiB
Racket
#lang scheme/base
|
|
|
|
(require scheme/class scheme/file scheme/path
|
|
racket/port)
|
|
|
|
(provide make-indirect-renderer-mixin)
|
|
|
|
(define (dotless bytes) (regexp-replace #rx#"[.]" bytes #""))
|
|
|
|
(define ((make-indirect-renderer-mixin
|
|
base-renderer base-suffix target-suffix convert)
|
|
%renderer)
|
|
(class (base-renderer %renderer)
|
|
;; set to a temp directory when doing the sub-rendering
|
|
(define tmp-dest-dir #f)
|
|
(define/override (get-dest-directory create?)
|
|
(or tmp-dest-dir (super get-dest-directory create?)))
|
|
(define/override (report-output?)
|
|
(and (not tmp-dest-dir) (super report-output?)))
|
|
(define/override (get-suffix) target-suffix)
|
|
(define/override (render srcs dests ri)
|
|
(define tmp-dir
|
|
(make-temporary-file
|
|
(format "scribble-~a-to-~a-~~a"
|
|
(dotless base-suffix) (dotless target-suffix))
|
|
'directory))
|
|
(define (cleanup)
|
|
(when (directory-exists? tmp-dir) (delete-directory/files tmp-dir)))
|
|
(with-handlers ([void (lambda (e) (cleanup) (raise e))])
|
|
(define tmp-dests
|
|
(map (lambda (dest)
|
|
(build-path tmp-dir
|
|
(path-replace-suffix (file-name-from-path dest)
|
|
base-suffix)))
|
|
dests))
|
|
(set! tmp-dest-dir tmp-dir)
|
|
;; it would be better if it's ok to change current-directory for this
|
|
(super render srcs tmp-dests ri)
|
|
(for ([tmp tmp-dests] [dst dests])
|
|
(parameterize ([current-directory tmp-dir])
|
|
(convert (file-name-from-path tmp)))
|
|
(when (super report-output?) ; use the original
|
|
(printf " [Output to ~a]\n" dst))
|
|
(call-with-output-file dst
|
|
(λ (out-port)
|
|
(call-with-input-file (build-path tmp-dir (file-name-from-path dst))
|
|
(λ (in-port)
|
|
(copy-port in-port out-port))))
|
|
#:exists 'truncate))
|
|
(cleanup)))
|
|
(super-new)))
|