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

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

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2013-09-06 09:21:21 -06:00
parent 0f439667bf
commit e2ee051adc
5 changed files with 87 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -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[]

5
pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl
View File

@ -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.}

79
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -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.

2
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl
View File

@ -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.

19
racket/collects/pkg/strip.rkt
View File

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