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

fix "racket-index" package installed in user scope

Browse Source 
When the "racket-index" package is in user scope, then the
the documentation-build process should not try to write to
"doc" in the installation.

Merge to v6.0
This commit is contained in:
Matthew Flatt 2013-11-28 05:49:42 -07:00
parent 40812031a8
commit 20af636cfb
4 changed files with 91 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -178,8 +178,7 @@
(map (lambda (d) (map (lambda (d)
(let* ([flags (cadr d)] (let* ([flags (cadr d)]
[under-main? [under-main?
(and (not (memq 'main-doc-root flags)) (and (not (memq 'user-doc-root flags))
(not (memq 'user-doc-root flags))
(not (memq 'user-doc flags)) (not (memq 'user-doc flags))
(or (memq 'main-doc flags) (or (memq 'main-doc flags)
(hash-ref main-dirs dir #f)))]) (hash-ref main-dirs dir #f)))])
@ -220,6 +219,8 @@
make-user?)) make-user?))
doc<?)) doc<?))
(define-values (main-docs user-docs) (partition doc-under-main? docs)) (define-values (main-docs user-docs) (partition doc-under-main? docs))
(define main-doc-exists? (ormap (lambda (d) (member 'main-doc-root (doc-flags d)))
main-docs))
(when (and (or (not only-dirs) tidy?) (when (and (or (not only-dirs) tidy?)
(not avoid-main?) (not avoid-main?)
@ -283,7 +284,8 @@
(log-setup-info "getting document information") (log-setup-info "getting document information")
(define (make-sequential-get-info only-fast?) (define (make-sequential-get-info only-fast?)
(get-doc-info only-dirs latex-dest auto-main? auto-user? (get-doc-info only-dirs latex-dest
auto-main? auto-user? main-doc-exists?
with-record-error setup-printf #f with-record-error setup-printf #f
only-fast? force-out-of-date? only-fast? force-out-of-date?
no-lock)) no-lock))
@ -315,7 +317,8 @@
(min worker-count (length (list-tail docs num-sequential))) (min worker-count (length (list-tail docs num-sequential)))
(lambda (workerid) (lambda (workerid)
(init-lock-ch!) (init-lock-ch!)
(list workerid program-name (verbose) only-dirs latex-dest auto-main? auto-user? (list workerid program-name (verbose) only-dirs latex-dest
auto-main? auto-user? main-doc-exists?
force-out-of-date? lock-ch)) force-out-of-date? lock-ch))
(list-queue (list-queue
(list-tail docs num-sequential) (list-tail docs num-sequential)
@ -327,8 +330,10 @@
(lambda (work errmsg outstr errstr) (lambda (work errmsg outstr errstr)
(parallel-do-error-handler setup-printf work errmsg outstr errstr))) (parallel-do-error-handler setup-printf work errmsg outstr errstr)))
(define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest (define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest
auto-main? auto-user? force-out-of-date? lock-ch) auto-main? auto-user? main-doc-exists?
(define ((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user? force-out-of-date? lock-ch)
(define ((get-doc-info-local program-name only-dirs latex-dest
auto-main? auto-user? main-doc-exists?
force-out-of-date? lock force-out-of-date? lock
send/report) send/report)
doc) doc)
@ -345,7 +350,8 @@
(raise exn))]) (raise exn))])
(go))) (go)))
(s-exp->fasl (serialize (s-exp->fasl (serialize
((get-doc-info only-dirs latex-dest auto-main? auto-user? ((get-doc-info only-dirs latex-dest
auto-main? auto-user? main-doc-exists?
with-record-error setup-printf workerid with-record-error setup-printf workerid
#f force-out-of-date? lock) #f force-out-of-date? lock)
(deserialize (fasl->s-exp doc)))))) (deserialize (fasl->s-exp doc))))))
@ -353,7 +359,8 @@
(verbose verbosev) (verbose verbosev)
(match-message-loop (match-message-loop
[doc (send/success [doc (send/success
((get-doc-info-local program-name only-dirs latex-dest auto-main? auto-user? ((get-doc-info-local program-name only-dirs latex-dest
auto-main? auto-user? main-doc-exists?
force-out-of-date? (lock-via-channel lock-ch) force-out-of-date? (lock-via-channel lock-ch)
send/report) send/report)
doc))]))))))))) doc))])))))))))
@ -391,8 +398,8 @@
(get-files! #f) (get-files! #f)
(doc-db-clean-files user-db files)))) (doc-db-clean-files user-db files))))
(define main-db (find-doc-db-path latex-dest #f)) (define main-db (find-doc-db-path latex-dest #f main-doc-exists?))
(define user-db (find-doc-db-path latex-dest #t)) (define user-db (find-doc-db-path latex-dest #t main-doc-exists?))
(define (make-loop first? iter) (define (make-loop first? iter)
(let ([infos (filter-not info-failed? infos)] (let ([infos (filter-not info-failed? infos)]
@ -577,7 +584,7 @@
(for ([info (in-list infos)]) (for ([info (in-list infos)])
(when (and (info-need-in-write? info) (when (and (info-need-in-write? info)
(not (info-need-run? info))) (not (info-need-run? info)))
(write-in/info latex-dest info no-lock) (write-in/info latex-dest info no-lock main-doc-exists?)
(set-info-need-in-write?! info #f))) (set-info-need-in-write?! info #f)))
;; Iterate, if any need to run: ;; Iterate, if any need to run:
(when (and (ormap info-need-run? infos) (iter . < . 30)) (when (and (ormap info-need-run? infos) (iter . < . 30))
@ -613,12 +620,13 @@
(for ([i (in-list need-rerun)]) (for ([i (in-list need-rerun)])
(say-rendering i #f) (say-rendering i #f)
(prep-info! i) (prep-info! i)
(update-info! i (build-again! latex-dest i with-record-error no-lock))) (update-info! i (build-again! latex-dest i with-record-error no-lock
main-doc-exists?)))
(parallel-do (parallel-do
(min worker-count (length need-rerun)) (min worker-count (length need-rerun))
(lambda (workerid) (lambda (workerid)
(init-lock-ch!) (init-lock-ch!)
(list workerid (verbose) latex-dest lock-ch)) (list workerid (verbose) latex-dest lock-ch main-doc-exists?))
(list-queue (list-queue
need-rerun need-rerun
(lambda (i workerid) (lambda (i workerid)
@ -639,7 +647,8 @@
(update-info! i (deserialize (fasl->s-exp r)))) (update-info! i (deserialize (fasl->s-exp r))))
(lambda (i errmsg outstr errstr) (lambda (i errmsg outstr errstr)
(parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr))) (parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr)))
(define-worker (build-again!-worker2 workerid verbosev latex-dest lock-ch) (define-worker (build-again!-worker2 workerid verbosev latex-dest lock-ch
main-doc-exists?)
(define (with-record-error cc go fail-k) (define (with-record-error cc go fail-k)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(lambda (x) (lambda (x)
@ -653,7 +662,8 @@
(s-exp->fasl (serialize (build-again! latex-dest (s-exp->fasl (serialize (build-again! latex-dest
(deserialize (fasl->s-exp info)) (deserialize (fasl->s-exp info))
with-record-error with-record-error
(lock-via-channel lock-ch)))))]))))) (lock-via-channel lock-ch)
main-doc-exists?))))])))))
;; If we only build 1, then it reaches it own fixpoint ;; If we only build 1, then it reaches it own fixpoint
;; even if the info doesn't seem to converge immediately. ;; even if the info doesn't seem to converge immediately.
;; This is a useful shortcut when re-building a single ;; This is a useful shortcut when re-building a single
@ -671,7 +681,8 @@
(when infos (when infos
(make-loop #t 0) (make-loop #t 0)
;; cache info to disk ;; cache info to disk
(for ([i infos] #:when (info-need-in-write? i)) (write-in/info latex-dest i no-lock)))) (for ([i infos] #:when (info-need-in-write? i))
(write-in/info latex-dest i no-lock main-doc-exists?))))
(define shared-style-files (define shared-style-files
(list "scribble.css" (list "scribble.css"
@ -801,12 +812,15 @@
(build-path latex-dest (path-replace-suffix name (string-append "." file))))] (build-path latex-dest (path-replace-suffix name (string-append "." file))))]
[(not latex-dest) (build-path (doc-dest-dir doc) file)])) [(not latex-dest) (build-path (doc-dest-dir doc) file)]))
(define (find-doc-db-path latex-dest user?) (define (find-doc-db-path latex-dest user? main-doc-exists?)
(cond (cond
[latex-dest [latex-dest
(build-path latex-dest "docindex.sqlite")] (build-path latex-dest "docindex.sqlite")]
[else [else
(build-path (if user? (find-user-doc-dir) (find-doc-dir)) "docindex.sqlite")])) (build-path (if (or user? (not main-doc-exists?))
(find-user-doc-dir)
(find-doc-dir))
"docindex.sqlite")]))
(define (can-build? only-dirs doc [auto-main? #f] [auto-user? #f]) (define (can-build? only-dirs doc [auto-main? #f] [auto-user? #f])
(or (not only-dirs) (or (not only-dirs)
@ -874,21 +888,23 @@
(for ([i skip]) (fasl->s-exp x)) (for ([i skip]) (fasl->s-exp x))
(fasl->s-exp x)))) (fasl->s-exp x))))
(define (find-db-file doc latex-dest) (define (find-db-file doc latex-dest main-doc-exists?)
(define p (find-doc-db-path latex-dest (not (main-doc? doc)))) (define p (find-doc-db-path latex-dest (not (main-doc? doc)) main-doc-exists?))
(define-values (base name dir?) (split-path p)) (define-values (base name dir?) (split-path p))
(unless (directory-exists? base) (unless (directory-exists? base)
(make-directory* base)) (make-directory* base))
p) p)
(define (xref-transfer-db renderer ci doc latex-dest (define (xref-transfer-db renderer ci doc latex-dest
main-doc-exists?
#:quiet-fail? [quiet-fail? #f]) #:quiet-fail? [quiet-fail? #f])
(define shutdown void) (define shutdown void)
(define xref (make-collections-xref (define xref (make-collections-xref
#:quiet-fail? quiet-fail? #:quiet-fail? quiet-fail?
#:no-user? (main-doc? doc) #:no-user? (main-doc? doc)
#:no-main? (not main-doc-exists?)
#:doc-db (and latex-dest #:doc-db (and latex-dest
(find-doc-db-path latex-dest #t)) (find-doc-db-path latex-dest #t main-doc-exists?))
#:register-shutdown! (lambda (s) #:register-shutdown! (lambda (s)
(set! shutdown s)))) (set! shutdown s))))
(xref-transfer-info renderer ci xref) (xref-transfer-info renderer ci xref)
@ -903,7 +919,8 @@
(close-output-port o) (close-output-port o)
(sha1 i)) (sha1 i))
(define ((get-doc-info only-dirs latex-dest auto-main? auto-user? (define ((get-doc-info only-dirs latex-dest
auto-main? auto-user? main-doc-exists?
with-record-error setup-printf workerid with-record-error setup-printf workerid
only-fast? force-out-of-date? lock) only-fast? force-out-of-date? lock)
doc) doc)
@ -917,12 +934,13 @@
(or (not (directory-exists? (doc-dest-dir doc))) (or (not (directory-exists? (doc-dest-dir doc)))
force-out-of-date? force-out-of-date?
(not (file-exists? (build-path (doc-dest-dir doc) "synced.rktd"))))) (not (file-exists? (build-path (doc-dest-dir doc) "synced.rktd")))))
(move-documentation-into-place doc rendered-dir setup-printf workerid lock))) (move-documentation-into-place doc rendered-dir setup-printf workerid lock
main-doc-exists?)))
(let* ([info-out-files (for/list ([i (add1 (doc-out-count doc))]) (let* ([info-out-files (for/list ([i (add1 (doc-out-count doc))])
(sxref-path latex-dest doc (format "out~a.sxref" i)))] (sxref-path latex-dest doc (format "out~a.sxref" i)))]
[info-in-file (sxref-path latex-dest doc "in.sxref")] [info-in-file (sxref-path latex-dest doc "in.sxref")]
[db-file (find-db-file doc latex-dest)] [db-file (find-db-file doc latex-dest main-doc-exists?)]
[stamp-file (sxref-path latex-dest doc "stamp.sxref")] [stamp-file (sxref-path latex-dest doc "stamp.sxref")]
[out-file (build-path (doc-dest-dir doc) "index.html")] [out-file (build-path (doc-dest-dir doc) "index.html")]
[src-zo (let-values ([(base name dir?) (split-path (doc-src-file doc))]) [src-zo (let-values ([(base name dir?) (split-path (doc-src-file doc))])
@ -1021,9 +1039,10 @@
(exn-message exn))) (exn-message exn)))
(for-each delete-file info-out-files) (for-each delete-file info-out-files)
(delete-file info-in-file) (delete-file info-in-file)
((get-doc-info only-dirs latex-dest auto-main? ((get-doc-info only-dirs latex-dest
auto-user? with-record-error auto-main? auto-user? main-doc-exists?
setup-printf workerid #f #f lock) with-record-error setup-printf workerid
#f #f lock)
doc))]) doc))])
(let ([v-in (load-sxref info-in-file)]) (let ([v-in (load-sxref info-in-file)])
(unless (equal? (car v-in) (list vers (doc-flags doc))) (unless (equal? (car v-in) (list vers (doc-flags doc)))
@ -1066,7 +1085,9 @@
;; It's ok if cross-reference information isn't available ;; It's ok if cross-reference information isn't available
;; at this point, but we can sometimes save another iteration ;; at this point, but we can sometimes save another iteration
;; if the information is available at this pass. ;; if the information is available at this pass.
[db-shutdown (xref-transfer-db renderer ci doc latex-dest #:quiet-fail? #t)] [db-shutdown (xref-transfer-db renderer ci doc latex-dest
main-doc-exists?
#:quiet-fail? #t)]
[ri (send renderer resolve (list v) (list dest-dir) ci)] [ri (send renderer resolve (list v) (list dest-dir) ci)]
[out-vs (and info-out-time [out-vs (and info-out-time
(with-handlers ([exn:fail? (lambda (exn) #f)]) (with-handlers ([exn:fail? (lambda (exn) #f)])
@ -1116,7 +1137,7 @@
(set-info-need-out-write?! info #f) (set-info-need-out-write?! info #f)
(set-info-done-time! info (current-inexact-milliseconds))) (set-info-done-time! info (current-inexact-milliseconds)))
(when (info-need-in-write? info) (when (info-need-in-write? info)
(render-time "xref-in" (write-in/info latex-dest info lock)) (render-time "xref-in" (write-in/info latex-dest info lock main-doc-exists?))
(set-info-need-in-write?! info #f)) (set-info-need-in-write?! info #f))
(let ([data (cons src-sha1 aux-sha1s)]) (let ([data (cons src-sha1 aux-sha1s)])
@ -1154,7 +1175,8 @@
(call-with-output-file* dest void))) (call-with-output-file* dest void)))
(hash-set! done dir #t))) (hash-set! done dir #t)))
(define (move-documentation-into-place doc src-dir setup-printf workerid lock) (define (move-documentation-into-place doc src-dir setup-printf workerid lock
main-doc-exists?)
(with-handlers ([exn:fail? (lambda (exn) (with-handlers ([exn:fail? (lambda (exn)
;; On any failure, log the error and give up. ;; On any failure, log the error and give up.
;; Maybe further actions are appropriate, but ;; Maybe further actions are appropriate, but
@ -1187,7 +1209,7 @@
(define providess (call-with-input-file* (define providess (call-with-input-file*
provides-path provides-path
(lambda (in) (fasl->s-exp in)))) (lambda (in) (fasl->s-exp in))))
(define db-file (find-db-file doc #f)) (define db-file (find-db-file doc #f main-doc-exists?))
(for ([provides (in-list providess)] (for ([provides (in-list providess)]
[n (in-naturals)]) [n (in-naturals)])
(define filename (sxref-path #f doc (format "out~a.sxref" n))) (define filename (sxref-path #f doc (format "out~a.sxref" n)))
@ -1281,7 +1303,8 @@
searches searches
scis))])])) scis))])]))
(define (build-again! latex-dest info-or-list with-record-error lock) (define (build-again! latex-dest info-or-list with-record-error lock
main-doc-exists?)
;; If `info-or-list' is a list, then we're in a parallel build, and ;; If `info-or-list' is a list, then we're in a parallel build, and
;; it provides just enough of `info' from the main place to re-build ;; it provides just enough of `info' from the main place to re-build
;; in this place along with the content of "in.sxref". ;; in this place along with the content of "in.sxref".
@ -1322,7 +1345,7 @@
[dest-dir (pick-dest latex-dest doc)] [dest-dir (pick-dest latex-dest doc)]
[fp (render-time "traverse" (send renderer traverse (list v) (list dest-dir)))] [fp (render-time "traverse" (send renderer traverse (list v) (list dest-dir)))]
[ci (render-time "collect" (send renderer collect (list v) (list dest-dir) fp))] [ci (render-time "collect" (send renderer collect (list v) (list dest-dir) fp))]
[db-shutdown (xref-transfer-db renderer ci doc latex-dest)] [db-shutdown (xref-transfer-db renderer ci doc latex-dest main-doc-exists?)]
[ri (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci))] [ri (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci))]
[scis (render-time "serialize" (send renderer serialize-infos ri (add1 (doc-out-count doc)) v))] [scis (render-time "serialize" (send renderer serialize-infos ri (add1 (doc-out-count doc)) v))]
[defss (render-time "defined" (send renderer get-defineds ci (add1 (doc-out-count doc)) v))] [defss (render-time "defined" (send renderer get-defineds ci (add1 (doc-out-count doc)) v))]
@ -1333,7 +1356,7 @@
[out-delta? (not (for/and ([sci scis] [out-delta? (not (for/and ([sci scis]
[ff-sci ff-scis]) [ff-sci ff-scis])
(serialized=? sci ff-sci)))] (serialized=? sci ff-sci)))]
[db-file (find-db-file doc latex-dest)]) [db-file (find-db-file doc latex-dest main-doc-exists?)])
(verbose/log "~a~afor ~a" (verbose/log "~a~afor ~a"
(if in-delta? "New in " "") (if in-delta? "New in " "")
(cond [out-delta? "New out "] (cond [out-delta? "New out "]
@ -1471,7 +1494,7 @@
(doc-db-add-searches db-file searches filename)))) (doc-db-add-searches db-file searches filename))))
void)) void))
(define (write-in/info latex-dest info lock) (define (write-in/info latex-dest info lock main-doc-exists?)
(when (eq? 'delayed (info-undef info)) (when (eq? 'delayed (info-undef info))
(read-delayed-in! info latex-dest)) (read-delayed-in! info latex-dest))
(write-in latex-dest (write-in latex-dest
@ -1480,7 +1503,7 @@
(info-undef info) (info-undef info)
(info-deps->rel-doc-src-file info) (info-deps->rel-doc-src-file info)
(info-searches info) (info-searches info)
(find-db-file (info-doc info) latex-dest) (find-db-file (info-doc info) latex-dest main-doc-exists?)
lock)) lock))
(define (rel->path r) (define (rel->path r)

27
pkgs/scribble-pkgs/scribble-lib/setup/xref.rkt
View File

@ -14,7 +14,7 @@
(define cached-xref #f) (define cached-xref #f)
(define (get-dests tag no-user?) (define (get-dests tag no-user? no-main?)
(define main-dirs (define main-dirs
(for/hash ([k (in-list (find-relevant-directories (list tag) 'no-user))]) (for/hash ([k (in-list (find-relevant-directories (list tag) 'no-user))])
(values k #t))) (values k #t)))
@ -39,7 +39,8 @@
1)]) 1)])
(if (not (and (len . >= . 3) (memq 'omit (caddr d)))) (if (not (and (len . >= . 3) (memq 'omit (caddr d))))
(let ([d (doc-path dir name flags (hash-ref main-dirs dir #f) (let ([d (doc-path dir name flags (hash-ref main-dirs dir #f)
(if no-user? 'never 'false-if-missing))]) (if no-user? 'never 'false-if-missing)
#:main? (not no-main?))])
(if d (if d
(for*/list ([i (in-range (add1 out-count))] (for*/list ([i (in-range (add1 out-count))]
[p (in-value (build-path d (format "out~a.sxref" i)))] [p (in-value (build-path d (format "out~a.sxref" i)))]
@ -67,11 +68,12 @@
;; provide a root for deserialization: ;; provide a root for deserialization:
(path-only dest)))))) (path-only dest))))))
(define (make-key->source db-path no-user? quiet-fail? register-shutdown!) (define (make-key->source db-path no-user? no-main? quiet-fail? register-shutdown!)
(define main-db (cons (or db-path (define main-db (and (not no-main?)
(cons (or db-path
(build-path (find-doc-dir) "docindex.sqlite")) (build-path (find-doc-dir) "docindex.sqlite"))
;; cache for a connection: ;; cache for a connection:
(box #f))) (box #f))))
(define user-db (and (not no-user?) (define user-db (and (not no-user?)
(cons (build-path (find-user-doc-dir) "docindex.sqlite") (cons (build-path (find-user-doc-dir) "docindex.sqlite")
;; cache for a connection: ;; cache for a connection:
@ -83,13 +85,13 @@
(if (box-cas! (cdr p) c #f) (if (box-cas! (cdr p) c #f)
(doc-db-disconnect c) (doc-db-disconnect c)
(close p)))) (close p))))
(close main-db) (when main-db (close main-db))
(when user-db (close user-db)))) (when user-db (close user-db))))
(define done-ht (make-hash)) ; tracks already-loaded documents (define done-ht (make-hash)) ; tracks already-loaded documents
(define forced-all? #f) (define forced-all? #f)
(define (force-all) (define (force-all)
;; force all documents ;; force all documents
(define thunks (get-reader-thunks no-user? quiet-fail? done-ht)) (define thunks (get-reader-thunks no-user? no-main? quiet-fail? done-ht))
(set! forced-all? #t) (set! forced-all? #t)
(lambda () (lambda ()
;; return a procedure so we can produce a list of results: ;; return a procedure so we can produce a list of results:
@ -128,10 +130,10 @@
(unless forced-all? (unless forced-all?
(force-all))]))) (force-all))])))
(define (get-reader-thunks no-user? quiet-fail? done-ht) (define (get-reader-thunks no-user? no-main? quiet-fail? done-ht)
(map (dest->source done-ht quiet-fail?) (map (dest->source done-ht quiet-fail?)
(filter values (append (get-dests 'scribblings no-user?) (filter values (append (get-dests 'scribblings no-user? no-main?)
(get-dests 'rendered-scribblings no-user?))))) (get-dests 'rendered-scribblings no-user? no-main?)))))
(define (load-collections-xref [report-loading void]) (define (load-collections-xref [report-loading void])
(or cached-xref (or cached-xref
@ -141,11 +143,12 @@
cached-xref))) cached-xref)))
(define (make-collections-xref #:no-user? [no-user? #f] (define (make-collections-xref #:no-user? [no-user? #f]
#:no-main? [no-main? #f]
#:doc-db [db-path #f] #:doc-db [db-path #f]
#:quiet-fail? [quiet-fail? #f] #:quiet-fail? [quiet-fail? #f]
#:register-shutdown! [register-shutdown! void]) #:register-shutdown! [register-shutdown! void])
(if (doc-db-available?) (if (doc-db-available?)
(load-xref null (load-xref null
#:demand-source (make-key->source db-path no-user? quiet-fail? #:demand-source (make-key->source db-path no-user? no-main? quiet-fail?
register-shutdown!)) register-shutdown!))
(load-xref (get-reader-thunks no-user? quiet-fail? (make-hash))))) (load-xref (get-reader-thunks no-user? no-main? quiet-fail? (make-hash)))))

15
racket/collects/setup/private/path-utils.rkt
View File

@ -5,18 +5,25 @@
(provide doc-path) (provide doc-path)
;; user-doc-mode can be `false-if-missing' or `never' ;; user-doc-mode can be `false-if-missing' or `never'
(define (doc-path dir name flags under-main? [user-doc-mode #f]) (define (doc-path dir name flags under-main? [user-doc-mode #f]
#:main? [main? #t])
(define (user-doc [sub #f]) (define (user-doc [sub #f])
(and (not (eq? 'never user-doc-mode)) (and (not (eq? 'never user-doc-mode))
(let ([d (find-user-doc-dir)]) (let ([d (find-user-doc-dir)])
(and (or (not (eq? 'false-if-missing user-doc-mode)) (and (or (not (eq? 'false-if-missing user-doc-mode))
(directory-exists? d)) (directory-exists? d))
(if sub (build-path d sub) d))))) (if sub (build-path d sub) d)))))
(cond [(memq 'main-doc-root flags) (find-doc-dir)] (cond [(memq 'main-doc-root flags) (if under-main?
(and main? (find-doc-dir))
;; Effectively no main doc dir:
(user-doc (build-path "main" name)))]
[(memq 'user-doc-root flags) (user-doc)] [(memq 'user-doc-root flags) (user-doc)]
[(memq 'user-doc flags) (user-doc name)] [(memq 'user-doc flags) (user-doc name)]
[(or under-main? (memq 'main-doc flags) (pair? (path->main-collects-relative dir))) [(or under-main?
(build-path (find-doc-dir) name)] (memq 'main-doc flags)
(pair? (path->main-collects-relative dir)))
(and main?
(build-path (find-doc-dir) name))]
[else [else
(and (not (eq? 'never user-doc-mode)) (and (not (eq? 'never user-doc-mode))
(build-path dir "doc" name))])) (build-path dir "doc" name))]))

5
racket/collects/setup/private/pkg-deps.rkt
View File

@ -346,7 +346,10 @@
[check? [check?
(for ([dep (in-list (doc-db-get-dependencies (build-path dest-dir "in.sxref") (for ([dep (in-list (doc-db-get-dependencies (build-path dest-dir "in.sxref")
db-file db-file
#:attach (if main? #f main-db-file)))]) #:attach (if main?
#f
(and (file-exists? main-db-file)
main-db-file))))])
(check-doc! pkg dep dest-dir))] (check-doc! pkg dep dest-dir))]
[else [else
(hash-set! doc-pkgs (path->directory-path dest-dir) pkg)]))))) (hash-set! doc-pkgs (path->directory-path dest-dir) pkg)])))))