raco setup: avoid duplicate "scribble.css" files, improve style customization

Arrange for documentation added through an installation-wide package to
use the installation's "scribble.css", etc., files. Also, add "doc-site.css"
and "doc-site.js" files (both empty) to allow installation-specific customization
that will not get overwritten by document installs or builds.

pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -25,7 +25,7 @@
 @author[@author+email["Jay McCarthy" "jay@racket-lang.org"]]
 
 The Racket package manager lets you install new libraries and
-collections, and the Racket package sever helps other Racket
+collections, and the Racket package catalog  helps other Racket
 programmers find libraries that you make available.
 
 @table-of-contents[]

pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl

@@ -91,7 +91,7 @@ and directories:
 Any of the above removals can be suppressed through
 @racketidfont{source-keep-files}.
 
-Creating a @tech{binary package} prunes the following addition files
+Creating a @tech{binary package} prunes the following additional files
 and directories:
 
 @itemlist[
@@ -103,6 +103,9 @@ and directories:
  @item{directories/files with names ending in @filepath{.scrbl},
        @filepath{_scrbl.zo}, or @filepath{.dep};}
 
+ @item{directories/files ending with @filepath{.css} or @filepath{.js}
+       immediately within a directory named @filepath{doc};}
+
  @item{directories/files named in an @filepath{info.rkt} file's
        @racket[source-omit-files] definition.}
 

pkgs/racket-pkgs/racket-index/setup/scribble.rkt

@@ -242,6 +242,18 @@
            (path->relative-string/setup p))
           (delete-directory/files p)))))
 
+  (unless latex-dest
+    ;; Make sure "scribble.css", etc., is in place:
+    (let ([ht (make-hash)])
+      (for ([doc (in-list docs)])
+        (when (can-build? only-dirs doc)
+          (check-shared-files (doc-dest-dir doc)
+                              (or (memq 'main-doc-root (doc-flags doc))
+                                  (memq 'user-doc-root (doc-flags doc)))
+                              (doc-under-main? doc)
+                              ht
+                              setup-printf)))))
+
   (define (can-build*? docs) (can-build? only-dirs docs))
   (define auto-main? (and auto-start-doc? (ormap can-build*? main-docs)))
   (define auto-user? (and auto-start-doc? (ormap can-build*? user-docs)))
@@ -653,6 +665,16 @@
     ;; cache info to disk
     (for ([i infos] #:when (info-need-in-write? i)) (write-in/info latex-dest i no-lock))))
 
+(define shared-style-files
+  (list "scribble.css"
+        "scribble-style.css"
+        "racket.css"
+        "scribble-common.js"))
+(define shared-empty-style-files
+  (list "doc-site.css"))
+(define shared-empty-script-files
+  (list "doc-site.js"))
+
 (define (make-renderer latex-dest doc)
   (if latex-dest
       (new (latex:render-mixin render%)
@@ -690,18 +712,19 @@
                [dest-dir (if multi?
                              (let-values ([(base name dir?) (split-path ddir)]) base)
                              ddir)]
-               [alt-paths   (if main?
+               [alt-paths   (let ([std-path (lambda (s)
-                                (let ([std-path (lambda (s)
                                               (cons (collection-file-path s "scribble")
-                                                        (format "../~a" s)))])
+                                                    (if root?
-                                  (list (std-path "scribble.css")
+                                                        s
-                                        (std-path "scribble-style.css")
+                                                        (format "../~a" s))))])
-                                        (std-path "racket.css")
+                              (cons (cons local-redirect-file 
-                                        (std-path "scribble-common.js")
+                                          (if main?
-                                        (cons local-redirect-file "../local-redirect/local-redirect.js")))
+                                              "../local-redirect/local-redirect.js"
-                                (list (cons local-redirect-file 
+                                              (u:url->string (u:path->url local-redirect-file))))
-                                            (u:url->string (u:path->url local-redirect-file)))))]
+                                    (map std-path (append
-
+                                                   shared-style-files
+                                                   shared-empty-style-files
+                                                   shared-empty-script-files))))]
                [up-path (cond
                          [root? #f] ; no up from root
                          [main?
@@ -721,7 +744,13 @@
                ;; be moved into a binary package:
                [root-path (and allow-indirect? ddir)]
 
+               [style-extra-files (map (lambda (s)
+                                         (collection-file-path s "scribble"))
+                                       shared-empty-style-files)]
+
                [search-box? #t]))
+        (for ([s (in-list shared-empty-script-files)])
+          (send r add-extra-script-file (collection-file-path s "scribble")))
         (when allow-indirect?
           ;; For documentation that might be moved into a binary package
           ;; or that can contain an indirect reference, use a server indirection
@@ -1078,6 +1107,30 @@
              (lambda () #f))
             #f))))
 
+(define (check-shared-files dir root? main? done setup-printf)
+  (define dest-dir (simplify-path (if root?
+                                      dir
+                                      (build-path dir 'up))))
+  (unless (hash-ref done dir #f)
+    (for ([f (in-list shared-style-files)])
+      (define src (collection-file-path f "scribble"))
+      (define dest (build-path dest-dir f))
+      (unless (and (file-exists? dest)
+                   (equal? (file->bytes src)
+                           (file->bytes dest)))
+        (when (or (verbose) main?)
+          (setup-printf "installing" "~a" dest))
+        (make-directory* dest-dir)
+        (copy-file src dest #t)))
+    (for ([f (in-list (append shared-empty-style-files
+                              shared-empty-script-files))])
+      (define dest (build-path dest-dir f))
+      (unless (file-exists? dest)
+        (setup-printf "installing" "~a" dest)
+        (make-directory* dest-dir)
+        (call-with-output-file* dest void)))
+    (hash-set! done dir #t)))
+
 (define (move-documentation-into-place doc src-dir setup-printf workerid lock)
   (with-handlers ([exn:fail? (lambda (exn)
                                ;; On any failure, log the error and give up.

pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl

@@ -70,7 +70,7 @@ is created using @racket[make-directory*] if it is non-@racket[#f] and
 does not exist already.
 
 The @racket[helper-file-prefix], @racket[prefix-file],
-@racket[style-file], @racket[extra-style-files], and
+@racket[style-file], @racket[style-extra-files], and
 @racket[extra-files] arguments are passed on to the @racket[render%]
 constructor.
 

racket/collects/pkg/strip.rkt

@@ -58,6 +58,14 @@
   
   (define (drop-by-default? path get-p)
     (define bstr (path->bytes path))
+    (define (immediate-doc/css-or-doc/js?)
+      ;; Drop ".css" and ".js" immediately in a "doc" directory:
+      (and (regexp-match? #rx#"(?:[.]css|[.]js)$" bstr)
+           (let-values ([(base name dir?) (split-path (get-p))])
+             (and (path? base)
+                  (let-values ([(base name dir?) (split-path base)])
+                    (and (path? name)
+                         (equal? #"doc" (path-element->bytes name))))))))
     (or (regexp-match? #rx#"^(?:[.]git.*|[.]svn|.*~|#.*#)$"
                        bstr)
         ;; can appear as a marker in rendered documentation:
@@ -72,11 +80,12 @@
                     (not (equal? #"info.rkt" bstr))
                     (file-exists? (let-values ([(base name dir?) (split-path (get-p))])
                                     (build-path base "compiled" (path-add-suffix name #".zo")))))
+               (immediate-doc/css-or-doc/js?)
                ;; drop these, because they're recreated on fixup:
                (equal? #"info_rkt.zo" bstr)
                (equal? #"info_rkt.dep" bstr))]
           [(built)
-           #f])))
+           (immediate-doc/css-or-doc/js?)])))
   
   (define (fixup new-p path src-base)
     (unless (eq? mode 'source)
@@ -253,8 +262,10 @@
         (define l (info tag (lambda () null)))
         (for ([f (in-list l)])
           (when (and (not (file-exists? (build-path dir f)))
-                     (file-exists? (build-path (find-dir) f)))
+                     (not (directory-exists? (build-path dir f)))
-            (copy-file (build-path (find-dir) f) 
+                     (or (file-exists? (build-path (find-dir) f))
+                         (directory-exists? (build-path (find-dir) f))))
+            (copy-directory/files (build-path (find-dir) f) 
                                   (build-path dest-dir f))))))
     (unmove-tag 'move-foreign-libs find-user-lib-dir)
     (unmove-tag 'move-shared-files find-user-share-dir)