From b9fd9ad78c931117219aec92121b46e24bb4852d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 10 Jul 2013 16:23:37 -0600 Subject: [PATCH] installers site: include documentation of built packages --- Makefile | 6 ++ pkgs/distro-build/assemble-site.rkt | 8 +++ pkgs/distro-build/download-page.rkt | 17 +++++- pkgs/distro-build/drive-clients.rkt | 6 +- pkgs/distro-build/install-for-docs.rkt | 55 +++++++++++++++++++ .../racket-index/setup/scribble.rkt | 25 ++++++--- racket/lib/collects/setup/setup-unit.rkt | 9 ++- 7 files changed, 113 insertions(+), 13 deletions(-) create mode 100644 pkgs/distro-build/install-for-docs.rkt diff --git a/Makefile b/Makefile index 205442ef85..fbf5280988 100644 --- a/Makefile +++ b/Makefile @@ -204,6 +204,7 @@ server: $(MAKE) server-from-core build/site.rkt: + mkdir -p build echo "#lang distro-build/config" > build/site.rkt echo "(machine)" >> build/site.rkt @@ -391,6 +392,7 @@ DRIVE_CMD_q = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS_q) # Full server build and clients drive, based on `CONFIG': installers: + rm -rf build/installers $(MAKE) server SERVE_DURING_CMD_qq='$(DRIVE_CMD_q)' # Server is already built; start it and drive clients: @@ -408,7 +410,11 @@ site: $(MAKE) installers $(MAKE) site-from-installers +DOC_CATALOGS = build/built/catalog build/native/catalog + site-from-installers: + rm -rf build/docs + $(RACKET) -l- distro-build/install-for-docs build/docs $(CONFIG_MODE_q) "$(PKGS)" $(DOC_CATALOGS) $(RACKET) -l- distro-build/assemble-site $(CONFIG_MODE_q) # ------------------------------------------------------------ diff --git a/pkgs/distro-build/assemble-site.rkt b/pkgs/distro-build/assemble-site.rkt index 874c22e18c..9993ffa72a 100644 --- a/pkgs/distro-build/assemble-site.rkt +++ b/pkgs/distro-build/assemble-site.rkt @@ -9,10 +9,12 @@ (define built-dir (build-path build-dir "built")) (define native-dir (build-path build-dir "native")) +(define docs-dir (build-path build-dir "docs")) (define installers-dir (build-path "installers")) (define pkgs-dir (build-path "pkgs")) (define catalog-dir (build-path "catalog")) +(define doc-dir (build-path "doc")) (define-values (config-file config-mode) (command-line @@ -92,10 +94,16 @@ (copy installers-dir) +(define doc-path (build-path docs-dir doc-dir)) +(when (directory-exists? doc-path) + (copy doc-dir docs-dir)) + (make-download-page (build-path build-dir installers-dir "table.rktd") #:installers-url "installers/" + #:docs-url (and (directory-exists? doc-path) + "doc/index.html") #:dest (build-path dest-dir "index.html") #:git-clone (current-directory)) diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt index 07c41ae1b7..a63ecee59d 100644 --- a/pkgs/distro-build/download-page.rkt +++ b/pkgs/distro-build/download-page.rkt @@ -37,6 +37,7 @@ (define (make-download-page table-file #:dest [dest "index.html"] #:installers-url [installers-url "./"] + #:docs-url [docs-url #f] #:title [title "Racket Downloads"] #:git-clone [git-clone #f] #:post-content [post-content null]) @@ -65,18 +66,27 @@ `(html (head (title ,title) (style ,(~a " .detail { font-size: small; }" - " .checksum, .path { font-family: monospace }"))) + " .checksum, .path { font-family: monospace; }" + " a { text-decoration: none; }"))) (body (h2 ,title) (table ,@(for/list ([key (in-list (sort (hash-keys table) stringstring + `(tr (td (a ((class "installer") + (href ,(url->string (combine-url/relative (string->url installers-url) inst)))) ,key)) (td nbsp) + (td (span ([class "detail"]) + ,(~r (/ (file-size (build-path (path-only table-file) + inst)) + (* 1024 1024)) + #:precision 1) + " MB")) + (td nbsp) (td (span ([class "detail"]) "SHA1: " (span ([class "checksum"]) @@ -84,6 +94,9 @@ (build-path (path-only table-file) inst) sha1))))))) + ,@(if docs-url + `((p (a ((href ,docs-url)) "Documentation"))) + null) ,@(if git-clone (let ([git (find-executable-path "git")]) (define origin (let ([s (system*/string git "remote" "show" "origin")]) diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt index c0e5530870..74072fb00b 100644 --- a/pkgs/distro-build/drive-clients.rkt +++ b/pkgs/distro-build/drive-clients.rkt @@ -313,16 +313,20 @@ (define timeout (or (get-opt c '#:timeout) (* 30 60))) (define orig-thread (current-thread)) + (define timeout? #f) (parameterize ([current-custodian cust]) (thread (lambda () (sleep (* timeout-factor timeout)) ;; try nice interrupt, first: + (set! timeout? #t) (break-thread orig-thread) (sleep 1) ;; force quit: (custodian-shutdown-all cust))) (with-handlers ([exn? (lambda (exn) - (when (exn:break? exn) (set! stop? #t)) + (when (exn:break? exn) + (unless timeout? + (set! stop? #t))) (log-error "~a failed..." (client-name c)) (log-error (exn-message exn)))]) (thunk))) diff --git a/pkgs/distro-build/install-for-docs.rkt b/pkgs/distro-build/install-for-docs.rkt new file mode 100644 index 0000000000..684735ee4b --- /dev/null +++ b/pkgs/distro-build/install-for-docs.rkt @@ -0,0 +1,55 @@ +#lang racket/base +(require racket/cmdline + racket/file + racket/string + racket/system + compiler/find-exe + (only-in "config.rkt" extract-options)) + +(define-values (dir config-file config-mode default-pkgs catalogs) + (command-line + #:args + (dir config-file config-mode default-pkgs . catalog) + (values dir config-file config-mode default-pkgs catalog))) + +(define pkgs + (or (hash-ref (extract-options config-file config-mode) + '#:pkgs + #f) + (string-split default-pkgs))) + +(define (build-path/s . a) + (path->string (path->complete-path (apply build-path dir a)))) +(define (build-path/f . a) + (string-append "file://" + (path->string (path->complete-path (apply build-path a))))) + +(define ht + (hash 'doc-dir (build-path/s "doc") + 'lib-dir (build-path/s "lib") + 'dll-dir (build-path/s "lib") + 'links-file (build-path/s "lib" "links.rktd") + 'pkgs-dir (build-path/s "lib" "pkgs") + 'bin-dir (build-path/s "bin") + 'include-dir (build-path/s "include") + 'catalogs (map build-path/f catalogs))) + +(make-directory* (build-path dir "etc")) + +(call-with-output-file* + (build-path dir "etc" "config.rktd") + #:exists 'truncate/replace + (lambda (o) + (write ht o) + (newline o))) + +(printf "Running `raco pkg install' for packages:\n") +(for ([pkg (in-list pkgs)]) + (printf " ~a\n" pkg)) +(unless (apply system* (find-exe) + "-G" "build/docs/etc" "-l-" + "raco" "pkg" "install" + "-i" "--deps" "search-auto" + pkgs) + (error "install failed")) + diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index 02242904c5..4085d565e6 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt @@ -201,7 +201,9 @@ (define main-doc-dir (find-doc-dir)) (define expected (for/set ([doc (in-list main-docs)]) (doc-dest-dir doc))) - (for ([i (in-list (directory-list main-doc-dir))]) + (for ([i (in-list (if (directory-exists? main-doc-dir) + (directory-list main-doc-dir) + null))]) (define p (build-path main-doc-dir i)) (when (directory-exists? p) (unless (set-member? expected (build-path p)) @@ -613,13 +615,20 @@ (cons local-redirect-file "../local-redirect/local-redirect.js"))) (list (cons local-redirect-file (u:url->string (u:path->url local-redirect-file)))))] - ;; For main-directory, non-start files, up-path is #t, which makes the - ;; "up" link go to the (user's) start page using cookies. For other files, - ;; - [up-path (and (not root?) - (if main? - #t - (build-path (find-user-doc-dir) "index.html")))] + + [up-path (cond + [root? #f] ; no up from root + [main? + ;; #t make the "up" link go to the (user's) start page + ;; using cookies: + #t] + [allow-indirect? + ;; building a package, so also rely on cookies in this + ;; case: + #t] + [else + ;; user-installed and not a package, so hard link is ok: + (build-path (find-user-doc-dir) "index.html")])] ;; In cross-reference information, use paths that are relative ;; to the target rendering directory for documentation that might diff --git a/racket/lib/collects/setup/setup-unit.rkt b/racket/lib/collects/setup/setup-unit.rkt index 75fc2bec72..1ab443ab01 100644 --- a/racket/lib/collects/setup/setup-unit.rkt +++ b/racket/lib/collects/setup/setup-unit.rkt @@ -1619,10 +1619,15 @@ (setup-printf "version" "~a [~a]" (version) (system-type 'gc)) (setup-printf "variants" "~a" (string-join (map symbol->string (available-mzscheme-variants)) ", ")) - (setup-printf "main collects" "~a" (path->string main-collects-dir)) + (setup-printf "main collects" "~a" main-collects-dir) (setup-printf "collects paths" (if (null? (current-library-collection-paths)) " empty!" "")) (for ([p (current-library-collection-paths)]) - (setup-printf #f " ~a" (path->string p))) + (setup-printf #f " ~a" p)) + (setup-printf "main pkgs" "~a" (find-pkgs-dir)) + (setup-printf "pkgs paths" (if (null? (get-pkgs-search-dirs)) " empty!" "")) + (for ([p (get-pkgs-search-dirs)]) + (setup-printf #f " ~a" p)) + (setup-printf "main docs" "~a" (find-doc-dir)) (when (and (not (null? (archives))) no-specific-collections?) (done))