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

raco pkg create: adjust rules for for {binary,source}-keep-files

Browse Source 
Allow `{binary,source}-keep-files` to override omission of an
enclosing directory. Also, adjust the default for binary mode to
keep "doc" and "info.rkt" within "scribblings" and not "tests".

With this change, starting with Minimal Racket and installing DrRacket
in binary mode gets you a working DrRacket with documentation. A
binary install is less than half the space of a non-binary install,
in part because the binary installation has fewer dependencies.
This commit is contained in:
Matthew Flatt 2014-06-04 08:01:22 +01:00
parent 15214b9983
commit 8792c52e1d
2 changed files with 71 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -89,7 +89,8 @@ and directories:
]
Any of the above removals can be suppressed through
@racketidfont{source-keep-files}.
@racketidfont{source-keep-files}---even for files and directories
within an otherwise removed directory.
Creating a @tech{binary package} prunes the following additional files
and directories:
@ -106,15 +107,22 @@ and directories:
@item{directories/files ending with @filepath{.css} or @filepath{.js}
immediately within a directory named @filepath{doc};}
@item{directories/files named @filepath{tests} or
@filepath{scribblings} (but see the exception below for
@filepath{doc} and @filepath{info.rkt};}
@item{directories/files named in an @filepath{info.rkt} file's
@racket[binary-omit-files] definition.}
]
Any of the above removals can be suppressed through
@racketidfont{binary-keep-files}.
Creating a @tech{binary package} further adjusts the following files:
@racketidfont{binary-keep-files}---even files and directories within
an otherwise removed directory. Furthermore, a @filepath{doc} or
@filepath{info.rkt} directory/file is kept when it is within a
@filepath{scribblings} directory and not within a @filepath{tests}
directory. Creating a @tech{binary package} further adjusts the
following files (when they are not pruned):
@itemlist[

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

@ -5,6 +5,7 @@
syntax/modread
racket/match
racket/file
racket/path
racket/list
racket/set)
@ -86,6 +87,26 @@
(equal? #"info_rkt.dep" bstr))]
[(built)
(immediate-doc/css-or-doc/js?)])))
(define (keep-override-by-default? path dir)
(case mode
[(binary)
(define bstr (path->bytes path))
(define (path-elements)
(if (eq? dir 'base)
null
(map path-element->bytes (explode-path dir))))
(cond
[(or (equal? bstr #"doc")
(equal? bstr #"info.rkt"))
;; Keep "doc" and "info.rkt" (that might be for
;; documentation) when under "scribblings" and not under
;; "tests":
(define l (path-elements))
(and (member #"scribblings" l)
(not (member #"tests" l)))]
[else #f])]
[else #f]))
(define (fixup new-p path src-base level)
(unless (eq? mode 'source)
@ -104,6 +125,7 @@
paths ; paths in `base'
drops ; hash table of paths (relative to start) to drop
keeps ; hash table of paths (relative to start) to keep
drop-all-by-default? ; in dropped directory?
level) ; 'package, 'collection, or 'subcollection
(define next-level (case level
[(package) 'collection]
@ -112,30 +134,42 @@
(define p (if (eq? base 'same)
path
(build-path base path)))
(when (and (not (hash-ref drops p #f))
(or (hash-ref keeps p #f)
(not (drop-by-default?
path
(lambda () (build-path dir p))))))
(define old-p (build-path dir p))
(define new-p (build-path dest-dir p))
(cond
[(file-exists? old-p)
(copy-file old-p new-p)
(file-or-directory-modify-seconds
new-p
(file-or-directory-modify-seconds old-p))
(fixup new-p path base level)]
[(directory-exists? old-p)
(define-values (new-drops new-keeps)
(add-drop+keeps old-p p drops keeps))
(make-directory new-p)
(explore p
(directory-list old-p)
new-drops
new-keeps
next-level)]
[else (error 'strip "file or directory disappeared?")]))))
(define keep? (and (not (hash-ref drops p #f))
(or (hash-ref keeps p #f)
(and drop-all-by-default?
(keep-override-by-default?
path
base))
(not (or drop-all-by-default?
(drop-by-default?
path
(lambda () (build-path dir p))))))))
(define old-p (build-path dir p))
(define new-p (build-path dest-dir p))
(cond
[(and keep? (file-exists? old-p))
(when drop-all-by-default?
(make-directory* (path-only new-p)))
(copy-file old-p new-p)
(file-or-directory-modify-seconds
new-p
(file-or-directory-modify-seconds old-p))
(fixup new-p path base level)]
[(directory-exists? old-p)
(define-values (new-drops new-keeps)
(add-drop+keeps old-p p drops keeps))
(when keep?
(if drop-all-by-default?
(make-directory* new-p)
(make-directory new-p)))
(explore p
(directory-list old-p)
new-drops
new-keeps
(not keep?)
next-level)]
[keep? (error 'strip "file or directory disappeared?")]
[else (void)])))
(define-values (drops keeps)
(add-drop+keeps dir 'same #hash() #hash()))
@ -148,7 +182,7 @@
'collection] ; single-collection package
[else 'package])))
(explore 'same (directory-list dir) drops keeps level)
(explore 'same (directory-list dir) drops keeps #f level)
(case mode
[(binary built) (unmove-files dir dest-dir drop-keep-ns)]
[else (void)])