fix problem building docs for planet

svn: r11480

original commit: 6230ed7ed726353ffb32a0f1b0e363b2fe0dcc59
This commit is contained in:
Matthew Flatt 2008-08-29 13:15:09 +00:00
commit fb906ad2d0
2 changed files with 16 additions and 10 deletions

View File

@ -64,12 +64,15 @@
p))
(define/public (root-relative->path p)
(if (and (pair? p)
(mobile-root? (car p)))
(if (root-relative? p)
(apply build-path (mobile-root-path (car p))
(map bytes->path-element (cdr p)))
p))
(define/public (root-relative? p)
(and (pair? p)
(mobile-root? (car p))))
;; ----------------------------------------
;; marshal info

View File

@ -249,7 +249,8 @@
;; ----------------------------------------
(inherit path->root-relative
root-relative->path)
root-relative->path
root-relative?)
(define (path->relative p)
(let ([p (path->main-doc-relative p)])
@ -261,14 +262,16 @@
(intern-taglet p))))
(define (relative->path p)
(let ([p (main-doc-relative->path p)])
(if (path? p)
p
(let ([p (main-collects-relative->path p)])
(if (root-relative? p)
(root-relative->path p)
(let ([p (if (or (not (pair? p))
(eq? (car p) 'doc))
(main-doc-relative->path p)
p)])
(if (path? p)
p
(root-relative->path p))))))
p
(main-collects-relative->path p)))))
;; ----------------------------------------
(define/override (start-collect ds fns ci)