raco setup: fix several triggers for building a doc index

In particular, fix various triggers that affect installing and
uninstalling packages.
This commit is contained in:
Matthew Flatt 2013-09-17 12:36:22 -06:00
parent 7016d3ab58
commit 007f7d5992
2 changed files with 28 additions and 15 deletions

View File

@ -255,10 +255,15 @@
setup-printf))))) setup-printf)))))
(define (can-build*? docs) (can-build? only-dirs docs)) (define (can-build*? docs) (can-build? only-dirs docs))
(define auto-main? (and auto-start-doc? (ormap can-build*? main-docs))) (define auto-main? (and auto-start-doc?
(define auto-user? (and auto-start-doc? (ormap can-build*? user-docs))) (or (ormap can-build*? main-docs)
(and tidy? (not avoid-main?)))))
(define auto-user? (and auto-start-doc?
(or (ormap can-build*? user-docs)
(and tidy? make-user?))))
(define (can-build**? docs) (can-build? only-dirs docs auto-main? auto-user?))
(define force-out-of-date? #f) (define force-out-of-date? #f)
(define lock-ch #f) (define lock-ch #f)
(define lock-ch-in #f) (define lock-ch-in #f)
(define (init-lock-ch!) (define (init-lock-ch!)
@ -289,7 +294,7 @@
[else [else
(add1 (loop (cdr docs)))]))) (add1 (loop (cdr docs)))])))
(define infos (define infos
(and (ormap can-build*? docs) (and (ormap can-build**? docs)
(filter (filter
values values
(if ((min worker-count (length docs)) . < . 2) (if ((min worker-count (length docs)) . < . 2)
@ -517,14 +522,17 @@
;; Record a definite dependency: ;; Record a definite dependency:
(define i (out-path->info found-dep infos out-path->info-cache)) (define i (out-path->info found-dep infos out-path->info-cache))
(unless i (unless i
(error "failed to find info for path: ~s" found-dep)) (setup-printf
;; Record this known dependency: "WARNING" "failed to find info for path: ~a"
(when (not (hash-ref known-deps i #f)) found-dep))
(hash-set! known-deps i #t)) (when i
(when (not (hash-ref deps i #f)) ;; Record this known dependency:
;; Record dependency in "expected", too, which triggers (when (not (hash-ref known-deps i #f))
;; a re-run if needed: (hash-set! known-deps i #t))
(add-dependency info i))) (when (not (hash-ref deps i #f))
;; Record dependency in "expected", too, which triggers
;; a re-run if needed:
(add-dependency info i))))
(for ([s-key (in-list missing)]) (for ([s-key (in-list missing)])
(not-found s-key)))) (not-found s-key))))
;; Check whether this document needs a re-run: ;; Check whether this document needs a re-run:
@ -791,8 +799,12 @@
[else [else
(build-path (if user? (find-user-doc-dir) (find-doc-dir)) "docindex.sqlite")])) (build-path (if user? (find-user-doc-dir) (find-doc-dir)) "docindex.sqlite")]))
(define (can-build? only-dirs doc) (define (can-build? only-dirs doc [auto-main? #f] [auto-user? #f])
(or (not only-dirs) (or (not only-dirs)
(and auto-main?
(memq 'depends-all-main (doc-flags doc)))
(and auto-user?
(memq 'depends-all (doc-flags doc)))
(ormap (lambda (d) (ormap (lambda (d)
(let ([d (path->directory-path d)]) (let ([d (path->directory-path d)])
(let loop ([dir (path->directory-path (doc-src-dir doc))]) (let loop ([dir (path->directory-path (doc-src-dir doc))])

View File

@ -1193,8 +1193,9 @@
(lambda (exn) (lambda (exn)
(setup-printf #f "docs failure: ~a" (exn->string exn)))]) (setup-printf #f "docs failure: ~a" (exn->string exn)))])
(define auto-start-doc? (define auto-start-doc?
(and (not (null? (archives))) (or (and (not (null? (archives)))
(archive-implies-reindex))) (archive-implies-reindex))
(make-doc-index)))
(doc:setup-scribblings #f auto-start-doc?))) (doc:setup-scribblings #f auto-start-doc?)))
(define (doc-pdf-dest-step) (define (doc-pdf-dest-step)