installers site: include documentation of built packages

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)
 
 # ------------------------------------------------------------

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))

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) string<?))])
                 (define inst (hash-ref table key))
-                `(tr (td (a ((href ,(url->string
+                `(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")])

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)))

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"))
+

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 (cond
-               ;; 
+                         [root? #f] ; no up from root
-               [up-path     (and (not root?)
+                         [main?
-                                 (if main?
+                          ;; #t make the "up" link go to the (user's) start page
-                                     #t
+                          ;; using cookies:
-                                     (build-path (find-user-doc-dir) "index.html")))]
+                          #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

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))