From 8792c52e1d55108ccf091598410d656e193c4a7d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 4 Jun 2014 08:01:22 +0100 Subject: [PATCH] raco pkg create: adjust rules for for `{binary,source}-keep-files` 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. --- .../racket-doc/pkg/scribblings/strip.scrbl | 16 +++- racket/collects/pkg/strip.rkt | 84 +++++++++++++------ 2 files changed, 71 insertions(+), 29 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl index 4ea620016b..f65925f691 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl @@ -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[ diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt index f136456074..83920487a2 100644 --- a/racket/collects/pkg/strip.rkt +++ b/racket/collects/pkg/strip.rkt @@ -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)])