diff --git a/collects/mzlib/cm.ss b/collects/mzlib/cm.ss index 268ed859e5..931ce71f3a 100644 --- a/collects/mzlib/cm.ss +++ b/collects/mzlib/cm.ss @@ -90,7 +90,7 @@ (lambda (op) (write (cons (version) (append (map path->main-collects-relative deps) - (map (lambda (x) (path->main-collects-relative (cons 'ext x))) + (map (lambda (x) (cons 'ext (path->main-collects-relative x))) external-deps))) op) (newline op))))) @@ -264,7 +264,12 @@ (when (> t path-zo-time) (trace-printf "newer: ~a (~a > ~a)..." d t path-zo-time)) (> t path-zo-time))) - (map main-collects-relative->path (cdr deps))) + (map (lambda (p) + (if (and (pair? p) + (eq? 'ext (car p))) + (cons 'ext (main-collects-relative->path (cdr p))) + (main-collects-relative->path p))) + (cdr deps))) (compile-zo mode path)))))) (let ((stamp (get-compiled-time mode path #t))) (hash-table-put! up-to-date path stamp) diff --git a/collects/scheme/private/contract-helpers.ss b/collects/scheme/private/contract-helpers.ss index 7cf43bea82..2e5fe567ff 100644 --- a/collects/scheme/private/contract-helpers.ss +++ b/collects/scheme/private/contract-helpers.ss @@ -78,7 +78,11 @@ [r (and bs (path->main-collects-relative bs))]) (and bs (bytes->string/locale (if (and (pair? r) (eq? 'collects (car r))) - (bytes-append #"/" (cdr r)) + (apply bytes-append + #"" + (map (lambda (s) + (bytes-append #"/" s)) + (cdr r))) bs))))) ;; build-src-loc-string : syntax -> (union #f string) diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 65058a9fa6..0455d9b4b2 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -76,6 +76,8 @@ format-number quiet-table-of-contents) + (init-field [css-path #f]) + (define/override (get-suffix) #".html") ;; ---------------------------------------- @@ -132,6 +134,9 @@ (define/private (reveal-subparts? p) (part-style? p 'reveal)) + + (define/public (toc-wrap table) + null) (define/public (render-toc-view d ri) (let-values ([(top mine) @@ -185,10 +190,11 @@ (class "tocviewlink")) ,@(render-content (or (part-title-content top) '("???")) d ri))) (div nbsp) - (table - ((class "tocviewlist") - (cellspacing "0")) - ,@toc-content))))) + ,@(toc-wrap + `(table + ((class "tocviewlist") + (cellspacing "0")) + ,@toc-content)))))) ,@(render-onthispage-contents d ri top) ,@(apply append (map (lambda (t) @@ -311,18 +317,31 @@ null)) (link ((rel "stylesheet") (type "text/css") - (href "scribble.css") + (href ,(or css-path "scribble.css")) (title "default")))) (body ,@(render-toc-view d ri) (div ((class "maincolumn")) - (div ((class "main")) ,@(render-part d ri)))))]) - (install-file scribble-css) + (div ((class "main")) + ,@(render-version d ri) + ,@(render-part d ri)))))]) + (unless css-path + (install-file scribble-css)) (printf "\n") (xml:write-xml/content (xml:xexpr->xml xpr))))) (define/override (render-one d ri fn) (render-one-part d ri fn null)) + (define/public (render-version d ri) + `((div ([class "versionbox"]) + ,@(render-content + (list + (make-element "version" + (list "Version: " + (current-version)))) + d + ri)))) + (define/override (render-part d ri) (let ([number (collected-info-number (part-collected-info d ri))]) `(,@(if (and (not (part-title-content d)) @@ -645,6 +664,9 @@ (define/override (get-onthispage-label) `((div ((class "tocsubtitle")) "On this page:"))) + + (define/override (toc-wrap p) + (list p)) (define contents-content '("contents")) (define index-content '("index")) @@ -654,7 +676,11 @@ (define no-next-content next-content) (define sep-element (make-element #f '(nbsp nbsp))) - (inherit render-table) + (inherit render-table + render-paragraph) + + (define/override (render-version r i) + null) (define/private (find-siblings d ri) (let ([parent (collected-info-parent (part-collected-info d ri))]) @@ -705,68 +731,56 @@ (let ([d (car (last-pair subs))]) (and (part-style? d 'index) d)))))))]) - `(,@(render-table (make-table - 'at-left - (list - (cons - (make-flow - (list - (make-paragraph - (list - (make-element - (if parent - (make-target-url "index.html") - "nonavigation") - contents-content))))) - (if index - (list - (make-flow - (list - (make-paragraph - (list - 'nbsp - (if (eq? d index) - (make-element - "nonavigation" - index-content) - (make-link-element - #f - index-content - (car (part-tags index))))))))) - null)))) - d ri) - ,@(render-table (make-table - 'at-right - (list - (list - (make-flow - (list - (make-paragraph - (list - (make-element - (if parent - (make-target-url (if prev - (derive-filename prev) - "index.html")) - "nonavigation") - prev-content) - sep-element - (make-element - (if parent - (make-target-url - (if (toc-part? parent) - (derive-filename parent) - "index.html")) - "nonavigation") - up-content) - sep-element - (make-element - (if next - (make-target-url (derive-filename next)) - "nonavigation") - next-content)))))))) - d - ri))))) + `((div ([class "navleft"]) + ,@(render-content + (append + (list + (make-element + (if parent + (make-target-url "index.html") + "nonavigation") + contents-content)) + (if index + (list + 'nbsp + (if (eq? d index) + (make-element + "nonavigation" + index-content) + (make-link-element + #f + index-content + (car (part-tags index))))) + null)) + d + ri)) + (div ([class "navright"]) + ,@(render-content + (list + (make-element + (if parent + (make-target-url (if prev + (derive-filename prev) + "index.html")) + "nonavigation") + prev-content) + sep-element + (make-element + (if parent + (make-target-url + (if (toc-part? parent) + (derive-filename parent) + "index.html")) + "nonavigation") + up-content) + sep-element + (make-element + (if next + (make-target-url (derive-filename next)) + "nonavigation") + next-content)) + d + ri)))))) (define/override (render-part d ri) (parameterize ([current-version @@ -796,20 +810,9 @@ [on-separate-page #f]) (if sep? ;; Navigation bars; - `(,@(navigation d ri) + `(,@(super render-version d ri) + ,@(navigation d ri) (p nbsp) - ,@(render-table (make-table - "versionbox" - (list - (list - (make-flow - (list - (make-paragraph (list - (make-element "version" - (list "Version: " - (current-version)))))))))) - d - ri) ,@(super render-part d ri) (p nbsp) ,@(navigation d ri) diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 7f0f3dd98f..e47bf76a72 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -1,497 +1,431 @@ - body { - color: black; - background-color: #ffffff; - } - - table td { - padding-left: 0; - padding-right: 0; - } - - .maincolumn { - font-family: monospace; - width: 43em; - margin-right: -40em; - margin-left: 15em; - } - - .main { - font-family: serif; - text-align: left; - } - - .versionbox { - position: relative; - float: right; - left: 3em; - top: -2em; - height: 0em; - width: 13em; - margin: 0em -13em 0em 0em; - } - .version { - font-family: sans-serif; - - } - - .refpara { - font-family: monospace; - position: relative; - float: right; - left: 1em; - top: -1em; - height: 0em; - width: 13em; - margin: 0em -13em 0em 0em; - } - - .refcolumn { - background-color: #F5F5DC; - display: block; - position: relative; - width: 13em; - font-size: 85%; - border: 0.5em solid #F5F5DC; - } - - .refcontent { - font-family: serif; - } - - .tocset { - font-family: monospace; - position: relative; - float: left; - width: 12.5em; - margin-right: 2em; - } - - .tocview { - font-family: serif; - text-align: left; - background-color: #F5F5DC; - } - - .tocsub { - font-family: serif; - margin-top: 1em; - text-align: left; - background-color: #DCF5F5; - } - - .tocviewtitle { - font-size: 80%; - font-weight: bold; - margin: 0.2em 0.2em 0.2em 0.2em; - } - - .tocviewlist { - margin: 0.2em 0.2em 0.2em 0.2em; - } - - .tocviewlist td { - font-size: 80%; - vertical-align: top; - } - - .tocviewlink { - text-decoration: none; - } - - .tocsublist { - margin: 0.2em 0.2em 0.2em 0.2em; - } - - .tocsublist td { - vertical-align: top; - padding-left: 1em; - text-indent: -1em; - } - - .tocsublinknumber { - font-size: 80%; - } - - .tocsublink { - text-decoration: none; - } - - .tocsubseclink { - font-size: 80%; - text-decoration: none; - } - - .tocsubtitle { - font-size: 80%; - font-style: italic; - margin: 0.2em 0.2em 0.2em 0.2em; - } - - .leftindent { - margin-left: 1em; - margin-right: 0em; - } - - .insetpara { - margin-left: 1em; - margin-right: 1em; - } - - .toclink { - text-decoration: none; - color: blue; - font-size: 85%; - } - - .toptoclink { - text-decoration: none; - color: blue; - font-weight: bold; - } - - .inherited { - width: 100%; - margin-top: 1em; - text-align: left; - background-color: #ECF5F5; - } - - .inherited td { - padding-left: 1em; - text-indent: -0.8em; - padding-right: 0.2em; - } - - .inheritedlbl { - font-style: italic; - font-size: 85%; - } - - .indexlink { - text-decoration: none; - } - - .nobreak { - white-space: nowrap; - } - - .stt { - font-family: monospace; - } - - .title { - font-size: 200%; - font-weight: normal; - margin-top: 2.8em; - text-align: center; - } - - .partheading { - font-size: 100%; - } - - .chapterheading { - font-size: 100%; - } - - .beginsection { - font-size: 110%; - } - - .tiny { - font-size: 40%; - } - - .scriptsize { - font-size: 60%; - } - - .footnotesize { - font-size: 75%; - } - - .small { - font-size: 90%; - } - - .normalsize { - font-size: 100%; - } - - .large { - font-size: 120%; - } - - .largecap { - font-size: 150%; - } - - .largeup { - font-size: 200%; - } - - .huge { - font-size: 300%; - } - - .hugecap { - font-size: 350%; - } - - pre { - margin-left: 2em; - } - - blockquote { - margin-left: 2em; - } - - ol { - list-style-type: decimal; - } - - ol ol { - list-style-type: lower-alpha; - } - - ol ol ol { - list-style-type: lower-roman; - } - - ol ol ol ol { - list-style-type: upper-alpha; - } - - i { - font-family: serif; - } - - .boxed { - width: 100%; - background-color: #E8E8FF; - } - - .together { - width: 100%; - } - - .prototype td { - vertical-align: top; - } - .longprototype td { - vertical-align: bottom; - } - - .schemeblock td { - vertical-align: baseline; - } - - .argcontract td { - vertical-align: top; - } - - .centered { - horiz-align: center; - } - - .verbatim em { - font-family: serif; - } - - .ghost { - color: white; - } - - .scheme em { - color: black; - font-family: serif; - } - - .highlighted { - background-color: #ddddff; - } - - .defmodule { - width: 100%; - background-color: #F5F5DC; - } - - .specgrammar { - float: right; - } - - .hspace { - font-family: monospace; - } - - .small { - font-size: 80%; - } - - .inferencetop td { - border-bottom: 1px solid black; - text-align: center; - } - .inferencebottom td { - text-align: center; - } - - .schemeinput { - color: brown; - background-color: #eeeeee; - font-family: monospace; - } - - .schemeinputbg { - background-color: #eeeeee; - } - - .schemereader { - font-family: monospace; - } - - .schemeparen { - color: #843c24; - font-family: monospace; - } - - .schememeta { - color: #262680; - font-family: monospace; - } - - .schememod { - color: black; - font-family: monospace; - } - - .schemeopt { - color: black; - } - - .schemekeyword { - color: black; - font-weight: bold; - font-family: monospace; - } - - .schemeerror { - color: red; - font-style: italic; - } - - .schemevariable { - color: #262680; - font-style: italic; - font-family: monospace; - } - - .schemesymbol { - color: #262680; - font-family: monospace; - } - - .schemevaluelink { - text-decoration: none; - color: blue; - } - - .schememodlink { - text-decoration: none; - color: blue; - } - - .schemesyntaxlink { - text-decoration: none; - color: black; - font-weight: bold; - } - - .badlink { - text-decoration: underline; - color: red; - } - - .plainlink { - text-decoration: none; - color: blue; - } - - .techlink { - text-decoration: none; - color: black; - } - .techlink:hover { - text-decoration: underline; - color: blue; - } - - .schemeresult { - color: #0000af; - font-family: monospace; - } - - .schemestdout { - color: #960096; - font-family: monospace; - } - - .schemecomment { - color: #c2741f; - font-family: monospace; - } - - .schemevalue { - color: #228b22; - font-family: monospace; - } - - .bibliography td { - vertical-align: top; - } - - .imageleft { - float: left; - margin-right: 0.3em; - } - - .nonavigation { - color: #EEEEEE; - } - - .disable { - /* color: #e5e5e5; */ - color: gray; - } - - .smallcaps { - font-size: 75%; - } - - .smallprint { - color: gray; - font-size: 75%; - text-align: right; - } - - .footnoterule { - text-align: left; - width: 40%; - } - - .colophon { - color: gray; - font-size: 80%; - font-style: italic; - text-align: right; - } - - .colophon a { - color: gray; - } - - .mywbr { - width: 0; - font-size: 1px; - } +body { + color: black; + background-color: #ffffff; +} + +table td { + padding-left: 0; + padding-right: 0; +} + +.maincolumn { + font-family: monospace; + width: 43em; + margin-right: -40em; + margin-left: 15em; +} + +.main { + font-family: serif; + text-align: left; +} + +.navleft { + position: relative; + float: left; +} +.navright { + position: relative; + float: right; +} + +.versionbox { + position: relative; + float: right; + left: 3em; + height: 0em; + width: 13em; + margin: 0em -13em 0em 0em; +} +.version { + font-family: sans-serif; + font-size: small; +} + +.refpara { + font-family: monospace; + position: relative; + float: right; + left: 1em; + top: -1em; + height: 0em; + width: 13em; + margin: 0em -13em 0em 0em; +} + +.refcolumn { + background-color: #F5F5DC; + display: block; + position: relative; + width: 13em; + font-size: 85%; + border: 0.5em solid #F5F5DC; +} + +.refcontent { + font-family: serif; +} + +.tocset { + font-family: monospace; + position: relative; + float: left; + width: 12.5em; + margin-right: 2em; +} + +.tocview { + font-family: serif; + text-align: left; + background-color: #F5F5DC; +} + +.tocsub { + font-family: serif; + margin-top: 1em; + text-align: left; + background-color: #DCF5F5; +} + +.tocviewtitle { + font-size: 80%; + font-weight: bold; + margin: 0.2em 0.2em 0.2em 0.2em; +} + +.tocviewlist { + margin: 0.2em 0.2em 0.2em 0.2em; +} + +.tocviewlist td { + font-size: 80%; + vertical-align: top; +} + +.tocviewlink { + text-decoration: none; +} + +.tocsublist { + margin: 0.2em 0.2em 0.2em 0.2em; +} + +.tocsublist td { + vertical-align: top; + padding-left: 1em; + text-indent: -1em; +} + +.tocsublinknumber { + font-size: 80%; +} + +.tocsublink { + text-decoration: none; +} + +.tocsubseclink { + font-size: 80%; + text-decoration: none; +} + +.tocsubtitle { + font-size: 80%; + font-style: italic; + margin: 0.2em 0.2em 0.2em 0.2em; +} + +.leftindent { + margin-left: 1em; + margin-right: 0em; +} + +.insetpara { + margin-left: 1em; + margin-right: 1em; +} + +.toclink { +text-decoration: none; +color: blue; +font-size: 85%; +} + +.toptoclink { +text-decoration: none; +color: blue; +font-weight: bold; +} + +.inherited { + width: 100%; + margin-top: 1em; + text-align: left; + background-color: #ECF5F5; +} + +.inherited td { + padding-left: 1em; + text-indent: -0.8em; + padding-right: 0.2em; +} + +.inheritedlbl { + font-style: italic; + font-size: 85%; +} + +.indexlink { + text-decoration: none; +} + +.nobreak { + white-space: nowrap; +} + +.stt { + font-family: monospace; +} + +.title { + font-size: 200%; + font-weight: normal; + margin-top: 2.8em; + text-align: center; +} + +.partheading { + font-size: 100%; +} + +.chapterheading { + font-size: 100%; +} + +.beginsection { + font-size: 110%; +} + +pre { + margin-left: 2em; +} + +blockquote { + margin-left: 2em; +} + +ol { + list-style-type: decimal; +} + +ol ol { + list-style-type: lower-alpha; +} + +ol ol ol { + list-style-type: lower-roman; +} + +ol ol ol ol { + list-style-type: upper-alpha; +} + +i { + font-family: serif; +} + +.boxed { + width: 100%; + background-color: #E8E8FF; +} + +.together { + width: 100%; +} + +.prototype td { + vertical-align: top; +} +.longprototype td { + vertical-align: bottom; +} + +.schemeblock td { + vertical-align: baseline; +} + +.argcontract td { + vertical-align: top; +} + +.centered { + horiz-align: center; +} + +.verbatim em { + font-family: serif; +} + +.ghost { + color: white; +} + +.scheme em { + color: black; + font-family: serif; +} + +.highlighted { + background-color: #ddddff; +} + +.defmodule { + width: 100%; + background-color: #F5F5DC; +} + +.specgrammar { + float: right; +} + +.hspace { + font-family: monospace; +} + +.inferencetop td { + border-bottom: 1px solid black; + text-align: center; +} +.inferencebottom td { + text-align: center; +} + +.schemeinput { + color: brown; + background-color: #eeeeee; + font-family: monospace; +} + +.schemeinputbg { + background-color: #eeeeee; +} + +.schemereader { + font-family: monospace; +} + +.schemeparen { + color: #843c24; + font-family: monospace; +} + +.schememeta { + color: #262680; + font-family: monospace; +} + +.schememod { + color: black; + font-family: monospace; +} + +.schemeopt { + color: black; +} + +.schemekeyword { + color: black; + font-weight: bold; + font-family: monospace; +} + +.schemeerror { + color: red; + font-style: italic; +} + +.schemevariable { + color: #262680; + font-style: italic; + font-family: monospace; +} + +.schemesymbol { + color: #262680; + font-family: monospace; +} + +.schemevaluelink { + text-decoration: none; + color: blue; +} + +.schememodlink { + text-decoration: none; + color: blue; +} + +.schemesyntaxlink { + text-decoration: none; + color: black; + font-weight: bold; +} + +.badlink { + text-decoration: underline; + color: red; +} + +.plainlink { + text-decoration: none; + color: blue; +} + +.techlink { + text-decoration: none; + color: black; +} + +.techlink:hover { + text-decoration: underline; + color: blue; +} + +.schemeresult { + color: #0000af; + font-family: monospace; +} + +.schemestdout { + color: #960096; + font-family: monospace; +} + +.schemecomment { + color: #c2741f; + font-family: monospace; +} + +.schemevalue { + color: #228b22; + font-family: monospace; +} + +.bibliography td { + vertical-align: top; +} + +.imageleft { + float: left; + margin-right: 0.3em; +} + +.nonavigation { + color: #EEEEEE; +} + +.mywbr { + width: 0; + font-size: 1px; +} diff --git a/collects/scribblings/start/info.ss b/collects/scribblings/start/info.ss index 2010807a4a..128168045b 100644 --- a/collects/scribblings/start/info.ss +++ b/collects/scribblings/start/info.ss @@ -1,4 +1,4 @@ (module info setup/infotab (define name "Scribblings: Start") - (define scribblings '(("start.scrbl" (always-run)))) + (define scribblings '(("start.scrbl" (main-doc-root always-run)))) (define doc-categories '(omit))) diff --git a/collects/setup/path-relativize.ss b/collects/setup/path-relativize.ss index 4db530fa5a..a896686e8c 100644 --- a/collects/setup/path-relativize.ss +++ b/collects/setup/path-relativize.ss @@ -17,59 +17,58 @@ ;; `path->main-collects-relative' misses some usages, as long as it ;; works when we prepare a distribution tree. Otherwise, things ;; will continue to work fine and .dep files will just contain - ;; absolute path names. These functions work on .dep elements: - ;; either a pathname or a pair with a pathname in its cdr; the - ;; `path->main-collects-relative' pathname will itself be a pair. + ;; absolute path names. ;; We need to compare paths to find when something is in the plt - ;; tree -- this does some basic "normalization" that should work - ;; fine: getting rid of `.' and `..', collapsing multiple - ;; `/'s to one `/', and converting '/'s to '\'s under Windows. - (define (simplify-path* bytes) - (path->bytes (normal-case-path (simplify-path (bytes->path bytes))))) + ;; tree, so we explode the paths. This slower than the old way (by + ;; a factor of 2 or so), but it's simpler and more portable. + (define (explode-path* path) + (explode-path (simplify-path (path->complete-path path)))) + + (define (explode-path orig-path) + (let loop ([path orig-path][rest null]) + (let-values ([(base name dir?) (split-path path)]) + (if (path? base) + (loop base (cons name rest)) + (cons name rest))))) (define main-collects-dir/ (delay (let ([dir (find-main-dir)]) - (and dir (simplify-path* (path->bytes (path->directory-path dir))))))) - - (define (maybe-cdr-op fname f) - (lambda (x) - (cond [(and (pair? x) (not (eq? tag (car x)))) - (cons (car x) (f (cdr x)))] - [else (f x)]))) + (and dir (explode-path* dir))))) ;; path->main-collects-relative* : path-or-bytes -> datum-containing-bytes-or-path - (define (path->main-collects-relative* path) - (let* ([path (cond [(bytes? path) path] - [(path? path) (path->bytes path)] - [else (error 'path->main-collects-relative - "expecting a byte-string, got ~e" path)])] - [path* (simplify-path* path)] - [main-collects-dir/ (force main-collects-dir/)] - [mcd-len (bytes-length main-collects-dir/)]) - (cond [(and path* - mcd-len - (> (bytes-length path*) mcd-len) - (equal? (subbytes path* 0 mcd-len) - main-collects-dir/)) - (cons tag (subbytes path* mcd-len))] - [(equal? path* main-collects-dir/) (cons tag #"")] - [else path]))) + (define (path->main-relative* path) + (let loop ([exploded (explode-path* (if (bytes? path) + (bytes->path path) + path))] + [main-exploded (force main-collects-dir/)]) + (cond + [(null? main-exploded) (cons tag (map path-element->bytes exploded))] + [(null? exploded) path] + [(equal? (normal-case-path (car exploded)) + (normal-case-path (car main-exploded))) + (loop (cdr exploded) (cdr main-exploded))] + [else path]))) ;; main-collects-relative->path* : datum-containing-bytes-or-path -> path - (define (main-collects-relative->path* path) + (define (main-relative->path* path) (cond [(and (pair? path) (eq? tag (car path)) - (bytes? (cdr path))) + (or (bytes? (cdr path)) ; backward compatibility + (and (list? (cdr path)) + (andmap bytes? (cdr path))))) (let ([dir (or (find-main-dir) ;; No main "collects"/"doc"/whatever? Use original working directory: (find-system-path 'orig-dir))]) - (if (equal? (cdr path) #"") - dir - (build-path dir (bytes->path (cdr path)))))] - [(bytes? path) (bytes->path path)] + (if (bytes? (cdr path)) + ;; backward compatibilty: + (if (equal? (cdr path) #"") + dir + (build-path dir (bytes->path (cdr path)))) + ;; Normal mode: + (apply build-path dir + (map bytes->path-element (cdr path)))))] [else path])) - (values - (maybe-cdr-op to-rel-name path->main-collects-relative*) - (maybe-cdr-op from-rel-name main-collects-relative->path*)))) + (values path->main-relative* + main-relative->path*))) diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss index c849bcfdcd..22af4222ae 100644 --- a/collects/setup/scribble.ss +++ b/collects/setup/scribble.ss @@ -16,7 +16,7 @@ (define verbose (make-parameter #t)) -(define-struct doc (src-dir src-file dest-dir flags)) +(define-struct doc (src-dir src-file dest-dir flags under-main?)) (define-struct info (doc sci provides undef searches deps build? time out-time need-run? need-in-write? need-out-write? @@ -38,6 +38,7 @@ (and (list? (cadr v)) (andmap (lambda (i) (member i '(main-doc + main-doc-root multi-page always-run))) (cadr v)) @@ -46,7 +47,10 @@ (relative-path? (caddr v)))))))) s)) (map (lambda (d) - (let ([flags (if (pair? (cdr d)) (cadr d) null)]) + (let* ([flags (if (pair? (cdr d)) (cadr d) null)] + [under-main? (and (not (memq 'main-doc-root flags)) + (or (memq 'main-doc flags) + (pair? (path->main-collects-relative dir))))]) (make-doc dir (build-path dir (car d)) (let ([name (if (and (pair? (cdr d)) @@ -55,11 +59,13 @@ (cadr d) (let-values ([(base name dir?) (split-path (car d))]) (path-replace-suffix name #"")))]) - (if (or (memq 'main-doc flags) - (pair? (path->main-collects-relative dir))) - (build-path (find-doc-dir) name) - (build-path dir "doc" name))) - flags))) + (if (memq 'main-doc-root flags) + (find-doc-dir) + (if under-main? + (build-path (find-doc-dir) name) + (build-path dir "doc" name)))) + flags + under-main?))) s) (begin (fprintf (current-error-port) @@ -174,7 +180,10 @@ [dest-dir (if (memq 'multi-page (doc-flags doc)) (let-values ([(base name dir?) (split-path (doc-dest-dir doc))]) base) - (doc-dest-dir doc))]))) + (doc-dest-dir doc))] + [css-path (if (doc-under-main? doc) + "../scribble.css" + #f)]))) (define (pick-dest latex-dest doc) (if latex-dest @@ -269,7 +278,7 @@ (list-ref v-out 2) ; provides (list-ref v-in 1) ; undef (list-ref v-in 3) ; searches - (map string->path (list-ref v-in 2)) ; deps, in case we don't need to build... + (map rel->path (list-ref v-in 2)) ; deps, in case we don't need to build... can-run? my-time info-out-time (and can-run? (memq 'always-run (doc-flags doc))) @@ -399,7 +408,7 @@ (list (list (info-vers info) (doc-flags doc)) (info-undef info) (map (lambda (i) - (path->string (doc-src-file (info-doc i)))) + (path->rel (doc-src-file (info-doc i)))) (info-deps info)) (info-searches info)))))))))) @@ -409,3 +418,15 @@ (define (write-in info) (make-directory* (doc-dest-dir (info-doc info))) (write- info "in.sxref" (lambda (o i) i))) + +(define (rel->path r) + (if (bytes? r) + (bytes->path r) + (main-collects-relative->path r))) + +(define (path->rel r) + (let ([r (path->main-collects-relative r)]) + (if (path? r) + (path->bytes r) + r))) + diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss index 22524922a5..f5f0b3adeb 100644 --- a/collects/setup/setup-unit.ss +++ b/collects/setup/setup-unit.ss @@ -18,8 +18,6 @@ compiler/sig launcher/launcher-sig - (prefix-in doc: "scribble.ss") - "unpack.ss" "getinfo.ss" "dirs.ss" @@ -412,9 +410,11 @@ (with-input-from-file path read))]) (when (and (pair? deps) (list? deps)) (for ([s (cdr deps)]) - (let ([s (main-collects-relative->path s)]) - (when (path-string? s) - (hash-table-put! dependencies s #t))))))) + (unless (and (pair? s) + (eq? 'ext (car s))) + (let ([s (main-collects-relative->path s)]) + (when (path-string? s) + (hash-table-put! dependencies s #t)))))))) (delete-file path)) (define (delete-files-in-directory path printout dependencies) @@ -738,16 +738,23 @@ ;; Docs ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (define (doc:verbose) + (parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)]) + (dynamic-require 'setup/scribble 'verbose))) + (define (doc:setup-scribblings) + (parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)]) + (dynamic-require 'setup/scribble 'setup-scribblings))) + (when (make-docs) (setup-printf "Building documentation") - (doc:verbose (verbose)) + ((doc:verbose) (verbose)) (with-handlers ([exn:fail? (lambda (exn) (setup-printf "Docs failure: ~a" (if (exn? exn) (exn-message exn) exn)))]) - (doc:setup-scribblings + ((doc:setup-scribblings) (if no-specific-collections? #f (map cc-path ccs-to-compile)) #f))) @@ -789,8 +796,8 @@ void (lambda () (make-directory tmp-dir) - (doc:verbose (verbose)) - (doc:setup-scribblings + ((doc:verbose) (verbose)) + ((doc:setup-scribblings) (if no-specific-collections? #f (map cc-path ccs-to-compile)) tmp-dir) (parameterize ([current-directory tmp-dir]) diff --git a/collects/setup/xref.ss b/collects/setup/xref.ss index f1e4e593b2..1720d0bffb 100644 --- a/collects/setup/xref.ss +++ b/collects/setup/xref.ss @@ -18,10 +18,12 @@ (let-values ([(base name dir?) (split-path (car d))]) (path-replace-suffix name #"")))]) (build-path - (if (or (memq 'main-doc flags) - (pair? (path->main-collects-relative dir))) - (build-path (find-doc-dir) name) - (build-path dir "compiled" "doc" name)) + (if (memq 'main-doc-root flags) + (find-doc-dir) + (if (or (memq 'main-doc flags) + (pair? (path->main-collects-relative dir))) + (build-path (find-doc-dir) name) + (build-path dir "compiled" "doc" name))) "out.sxref")) #f)) ((get-info/full dir) 'scribblings)))