diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 96e23f0c..d5fbe71c 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -19,7 +19,8 @@ [root-path #f] [prefix-file #f] [style-file #f] - [style-extra-files null]) + [style-extra-files null] + [extra-files null]) (define/public (get-dest-directory [create? #f]) (when (and dest-dir create? (not (directory-exists? dest-dir))) @@ -44,9 +45,9 @@ (substring s 0 (sub1 (string-length s)))) sep))) - (field [report-output? #f]) - (define/public (report-output!) - (set! report-output? #t)) + (field [report-output?? #f]) + (define/public (report-output?) report-output??) + (define/public (report-output!) (set! report-output?? #t)) ;; ---------------------------------------- @@ -348,10 +349,16 @@ ;; ---------------------------------------- ;; render methods + (define/public (install-extra-files) + (for ([fn extra-files]) (install-file fn))) + (define/public (render ds fns ri) + ;; maybe this should happen even if fns is empty or all #f? + ;; or maybe it should happen for each file rendered (when d is not #f)? + (unless (andmap not ds) (install-extra-files)) (map (lambda (d fn) (define (one) (render-one d ri fn)) - (when report-output? (printf " [Output to ~a]\n" fn)) + (when (report-output?) (printf " [Output to ~a]\n" fn)) (if fn (with-output-to-file fn #:exists 'truncate/replace one) ;; a #f filename means return the contents as a string diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 062e0236..958c7379 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -1184,9 +1184,9 @@ render-one-part render-content part-whole-page? - format-number) - - (inherit-field report-output?) + format-number + install-extra-files + report-output?) (define/override (get-suffix) #"") @@ -1237,11 +1237,13 @@ (define/override (render ds fns ri) (map (lambda (d fn) - (when report-output? + (when (report-output?) (printf " [Output to ~a/index.html]\n" fn)) (unless (directory-exists? fn) (make-directory fn)) (parameterize ([current-subdirectory (file-name-from-path fn)]) + ;; install files for each directory + (install-extra-files) (let ([fn (build-path fn "index.html")]) (with-output-to-file fn #:exists 'truncate/replace (lambda () (render-one d ri fn)))))) diff --git a/collects/scribble/private/indirect-renderer.ss b/collects/scribble/private/indirect-renderer.ss index 5a1de536..d1fe335d 100644 --- a/collects/scribble/private/indirect-renderer.ss +++ b/collects/scribble/private/indirect-renderer.ss @@ -10,9 +10,12 @@ 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 @@ -35,6 +38,8 @@ (for ([tmp tmp-dests] [dst dests]) (parameterize ([current-directory tmp-dir]) (convert (file-name-from-path tmp))) - (copy-file (build-path tmp-dir(file-name-from-path dst)) dst)) + (when (super report-output?) ; use the original + (printf " [Output to ~a]\n" dst)) + (copy-file (build-path tmp-dir (file-name-from-path dst)) dst)) (cleanup))) (super-new))) diff --git a/collects/scribble/run.ss b/collects/scribble/run.ss index b32c9fc7..ef5266b5 100644 --- a/collects/scribble/run.ss +++ b/collects/scribble/run.ss @@ -23,6 +23,7 @@ (define current-prefix-file (make-parameter #f)) (define current-style-file (make-parameter #f)) (define current-style-extra-files (make-parameter null)) +(define current-extra-files (make-parameter null)) (define current-redirect (make-parameter #f)) (define current-redirect-main (make-parameter #f)) @@ -61,6 +62,10 @@ [("--info-out") file "write format-specific link information to " (current-info-output-file file)] #:multi + [("++extra") file "add given file" + (current-extra-files (cons file (current-extra-files)))] + [("++style") file "add given .css/.tex file" + (current-style-extra-files (cons file (current-style-extra-files)))] [("++info-in") file "load format-specific link information from " (current-info-input-files (cons file (current-info-input-files)))] @@ -76,8 +81,6 @@ 'scribble "bad procedure identifier for ++ref-in: ~s" proc-id)) (current-xref-input-modules (cons (cons mod id) (current-xref-input-modules))))] - [("++style") file "add given .css/.tex file" - (current-style-extra-files (cons file (current-style-extra-files)))] #:args (file . another-file) (let ([files (cons file another-file)]) (build-docs (map (lambda (file) (dynamic-require `(file ,file) 'doc)) @@ -91,7 +94,8 @@ [dest-dir dir] [prefix-file (current-prefix-file)] [style-file (current-style-file)] - [style-extra-files (reverse (current-style-extra-files))])]) + [style-extra-files (reverse (current-style-extra-files))] + [extra-files (reverse (current-extra-files))])]) (when (current-redirect) (send renderer set-external-tag-path (current-redirect))) (when (current-redirect-main)