suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

for multi-HTML output, check for parts whose filenames are the same modulo case

Browse Source 
svn: r16536
This commit is contained in:
Matthew Flatt 2009-11-04 12:12:29 +00:00
parent e60cf2b4e2
commit 509de53fca
1 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -89,6 +89,7 @@
(define current-no-links (make-parameter #f)) (define current-no-links (make-parameter #f))
(define extra-breaking? (make-parameter #f)) (define extra-breaking? (make-parameter #f))
(define current-version (make-parameter (version))) (define current-version (make-parameter (version)))
(define current-part-files (make-parameter #f))
(define (toc-part? d) (define (toc-part? d)
(part-style? d 'toc)) (part-style? d 'toc))
@ -1285,6 +1286,7 @@
(collecting-whole-page)) (collecting-whole-page))
(define/override (start-collect ds fns ci) (define/override (start-collect ds fns ci)
(parameterize ([current-part-files (make-hash)])
(map (lambda (d fn) (map (lambda (d fn)
(parameterize ([collecting-sub (parameterize ([collecting-sub
(if (part-style? d 'non-toc) (if (part-style? d 'non-toc)
@ -1292,7 +1294,14 @@
0)]) 0)])
(super start-collect (list d) (list fn) ci))) (super start-collect (list d) (list fn) ci)))
ds ds
fns)) fns)))
(define/private (check-duplicate-filename orig-s)
(let ([s (string-downcase (path->string orig-s))])
(when (hash-ref (current-part-files) s #f)
(error 'htmls-render "multiple parts have the same filename (modulo case): ~e"
orig-s))
(hash-set! (current-part-files) s #t)))
(define/override (collect-part d parent ci number) (define/override (collect-part d parent ci number)
(let ([prev-sub (collecting-sub)]) (let ([prev-sub (collecting-sub)])
@ -1302,10 +1311,11 @@
[collecting-whole-page (prev-sub . <= . 1)]) [collecting-whole-page (prev-sub . <= . 1)])
(if (and (current-part-whole-page? d) (if (and (current-part-whole-page? d)
(not (eq? d (current-top-part)))) (not (eq? d (current-top-part))))
(let ([filename (derive-filename d ci #f)]) (let* ([filename (derive-filename d ci #f)]
(parameterize ([current-output-file [full-filename (build-path (path-only (current-output-file))
(build-path (path-only (current-output-file))
filename)]) filename)])
(check-duplicate-filename full-filename)
(parameterize ([current-output-file full-filename])
(super collect-part d parent ci number))) (super collect-part d parent ci number)))
(super collect-part d parent ci number))))) (super collect-part d parent ci number)))))