suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

* Turn report-output? to an overridable method

Browse Source 
* 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
This commit is contained in:
Eli Barzilay 2009-03-05 09:49:53 +00:00
parent 77748d9e13
commit 0e562a46da
4 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/scribble/base-render.ss
View File

@ -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

10
collects/scribble/html-render.ss
View File

@ -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))))))

7
collects/scribble/private/indirect-renderer.ss
View File

@ -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)))

10
collects/scribble/run.ss
View File

@ -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)