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

raco setup: fix problem with docs

Browse Source 
Support for "moving" pre-built docs into place did not handle
the case that the version number is wrong, which could happen
either because the pre-built version doesn't match or the docs
were built (in an old version) without a "synced.rktd" marker.
This commit is contained in:
Matthew Flatt 2013-06-16 06:28:26 -07:00
parent a89f28118c
commit a1f76598bb
1 changed files with 51 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
collects/setup/scribble.rkt
View File

@ -963,52 +963,58 @@
#f)))) #f))))
(define (move-documentation-into-place doc src-dir setup-printf workerid lock) (define (move-documentation-into-place doc src-dir setup-printf workerid lock)
(define dest-dir (doc-dest-dir doc)) (with-handlers ([exn:fail? (lambda (exn)
(define move? (not (equal? (file-or-directory-identity src-dir) ;; On any failure, log the error and give up.
(and (directory-exists? dest-dir) ;; Maybe further actions are appropriate, but
(file-or-directory-identity dest-dir))))) ;; overall clean-up and repair is intended to be
(setup-printf (string-append ;; the job of the regular documentation builder.
(if workerid (format "~a " workerid) "") (log-error (exn-message exn)))])
(if move? "moving" "syncing")) (define dest-dir (doc-dest-dir doc))
"~a" (define move? (not (equal? (file-or-directory-identity src-dir)
(path->relative-string/setup src-dir)) (and (directory-exists? dest-dir)
(file-or-directory-identity dest-dir)))))
(setup-printf (string-append
(if workerid (format "~a " workerid) "")
(if move? "moving" "syncing"))
"~a"
(path->relative-string/setup src-dir))
(when move? (when move?
(when (directory-exists? dest-dir) (when (directory-exists? dest-dir)
(delete-directory/files dest-dir) (delete-directory/files dest-dir)
(copy-directory/files src-dir dest-dir) (copy-directory/files src-dir dest-dir)
(delete-directory/files src-dir))) (delete-directory/files src-dir)))
;; Register provided-tag information with the database: ;; Register provided-tag information with the database:
(let ([provides-path (build-path dest-dir "provides.sxref")]) (let ([provides-path (build-path dest-dir "provides.sxref")])
(when (file-exists? provides-path) (when (file-exists? provides-path)
;; register keys provided in "out<n>.sxref" with ;; register keys provided in "out<n>.sxref" with
;; the database ;; the database
(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))
(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)))
(call-with-lock (call-with-lock
lock lock
(lambda () (lambda ()
(doc-db-clear-provides db-file filename) (doc-db-clear-provides db-file filename)
(doc-db-add-provides db-file provides filename)))))) (doc-db-add-provides db-file provides filename))))))
;; For each ".html" file, check for a reference to "local-redirect.js", ;; For each ".html" file, check for a reference to "local-redirect.js",
;; and fix up the path if there is a reference: ;; and fix up the path if there is a reference:
(define js-path (if (doc-under-main? doc) (define js-path (if (doc-under-main? doc)
"../local-redirect" "../local-redirect"
(url->string (path->url (build-path (find-user-doc-dir) (url->string (path->url (build-path (find-user-doc-dir)
"local-redirect"))))) "local-redirect")))))
(for ([p (in-directory dest-dir)]) (for ([p (in-directory dest-dir)])
(when (regexp-match? #rx#"[.]html$" (path->bytes p)) (when (regexp-match? #rx#"[.]html$" (path->bytes p))
(fixup-local-redirect-reference p js-path))) (fixup-local-redirect-reference p js-path)))
;; The existence of "synced.rktd" means that the db is in sync ;; The existence of "synced.rktd" means that the db is in sync
;; with "provides.sxref" and ".html" files have been updated. ;; with "provides.sxref" and ".html" files have been updated.
(let ([provided-path (build-path dest-dir "synced.rktd")]) (let ([provided-path (build-path dest-dir "synced.rktd")])
(unless (file-exists? provided-path) (unless (file-exists? provided-path)
(call-with-output-file provided-path (lambda (o) (write '#t o)))))) (call-with-output-file provided-path (lambda (o) (write '#t o)))))))
(define (read-delayed-in! info latex-dest) (define (read-delayed-in! info latex-dest)
(let* ([doc (info-doc info)] (let* ([doc (info-doc info)]