commit 0e562a46dafb7ddfc8945fa9291469c08ba6e507
parent 77748d9e134867e96efd423fd3392fa044c9e1a7
Author: Eli Barzilay <eli@racket-lang.org>
Date: Thu, 5 Mar 2009 09:49:53 +0000
* Turn report-output? to an overridable method
* New extra-files field, and `render' installs them
(the render of multi-html copies these files to each directory)
* Add an ++extra argument to the scribble command line
* Fix output of the indirect renderer
svn: r13966
original commit: 9b60be7c5aca4b9d5ff592698c57c4f7b273aa03
Diffstat:
4 files changed, 31 insertions(+), 13 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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 <file>"
(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 <file>"
(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)
