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

within a single document for multi-HTML rendering, add section prefix in generated file names

Browse Source 
svn: r15693
This commit is contained in:
Matthew Flatt 2009-08-09 14:05:43 +00:00
parent 3170f05da2
commit a195a5defd
1 changed files with 28 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -640,7 +640,7 @@
(define next-content '("next " rarr)) (define next-content '("next " rarr))
(define sep-element '(nbsp nbsp)) (define sep-element '(nbsp nbsp))
(define/public (derive-filename d) "bad.html") (define/public (derive-filename d ci ri) "bad.html")
(define/public (include-navigation?) search-box?) (define/public (include-navigation?) search-box?)
@ -1239,17 +1239,34 @@
d)) d))
(super get-dest-directory create?))) (super get-dest-directory create?)))
(define/override (derive-filename d) (define/private (append-part-prefixes d ci ri)
(let ([parents (drop-right
(if ci
(cons d (collect-info-parents ci))
(let loop ([d d])
(if d
(cons d
(loop (collected-info-parent (part-collected-info d ri))))
null)))
1)])
(apply
string-append
(for/list ([p (in-list parents)])
(or (part-tag-prefix p) "")))))
(define/override (derive-filename d ci ri)
(let ([fn (format "~a.html" (let ([fn (format "~a.html"
(regexp-replace* (regexp-replace*
"[^-a-zA-Z0-9_=]" "[^-a-zA-Z0-9_=]"
(let ([s (cadr (car (part-tags d)))]) (string-append
(cond [(string? s) s] (append-part-prefixes d ci ri)
[(part-title-content d) (let ([s (cadr (car (part-tags d)))])
(content->string (part-title-content d))] (cond [(string? s) s]
[else [(part-title-content d)
;; last-ditch effort to make up a unique name: (content->string (part-title-content d))]
(format "???~a" (eq-hash-code d))])) [else
;; last-ditch effort to make up a unique name:
(format "???~a" (eq-hash-code d))])))
"_"))]) "_"))])
(when ((string-length fn) . >= . 48) (when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn)) (error "file name too long (need a tag):" fn))
@ -1281,7 +1298,7 @@
[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)]) (let ([filename (derive-filename d ci #f)])
(parameterize ([current-output-file (parameterize ([current-output-file
(build-path (path-only (current-output-file)) (build-path (path-only (current-output-file))
filename)]) filename)])
@ -1325,7 +1342,7 @@
(not (eq? d (current-top-part)))) (not (eq? d (current-top-part))))
;; Render as just a link, and put the actual content in a ;; Render as just a link, and put the actual content in a
;; new file: ;; new file:
(let* ([filename (derive-filename d)] (let* ([filename (derive-filename d #f ri)]
[full-path (build-path (path-only (current-output-file)) [full-path (build-path (path-only (current-output-file))
filename)]) filename)])
(parameterize ([on-separate-page-ok #f]) (parameterize ([on-separate-page-ok #f])