From e2ee051adc7f5a92de3a3c0bcabd5cc3de460be3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 6 Sep 2013 09:21:21 -0600 Subject: [PATCH] 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. --- .../racket-doc/pkg/scribblings/pkg.scrbl | 2 +- .../racket-doc/pkg/scribblings/strip.scrbl | 5 +- .../racket-index/setup/scribble.rkt | 79 ++++++++++++++++--- .../scribblings/scribble/renderer.scrbl | 2 +- racket/collects/pkg/strip.rkt | 19 ++++- 5 files changed, 87 insertions(+), 20 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 972dd1b16b..9ce0a12f8d 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/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[] diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl index 3f6e7037bc..3c7eae13e4 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl +++ b/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.} diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index d70f7194c6..a0f8570102 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/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? - (let ([std-path (lambda (s) - (cons (collection-file-path s "scribble") - (format "../~a" s)))]) - (list (std-path "scribble.css") - (std-path "scribble-style.css") - (std-path "racket.css") - (std-path "scribble-common.js") - (cons local-redirect-file "../local-redirect/local-redirect.js"))) - (list (cons local-redirect-file - (u:url->string (u:path->url local-redirect-file)))))] - + [alt-paths (let ([std-path (lambda (s) + (cons (collection-file-path s "scribble") + (if root? + s + (format "../~a" s))))]) + (cons (cons local-redirect-file + (if main? + "../local-redirect/local-redirect.js" + (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 @@ -852,7 +881,7 @@ (display (get-file-sha1 info-out-file) o)) (close-output-port o) (sha1 i)) - + (define ((get-doc-info only-dirs latex-dest auto-main? auto-user? with-record-error setup-printf workerid only-fast? force-out-of-date? lock) @@ -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. diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl index 050b69ed1a..9c60d879eb 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl +++ b/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. diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt index 0dbc6075cc..ce88ed0491 100644 --- a/racket/collects/pkg/strip.rkt +++ b/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,9 +262,11 @@ (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))) - (copy-file (build-path (find-dir) f) - (build-path dest-dir f)))))) + (not (directory-exists? (build-path 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) (unmove-tag 'move-man-pages find-user-man-dir)