diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 73f976e40c..c421993d2f 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -118,19 +118,25 @@ dependency.} @defproc[(pkg-stage [desc pkg-desc?] [#:checksum checksum (or/c #f string?) #f] [#:in-place? in-place? boolean? #f] - [#:namespace namespace namespace? (make-base-namespace)]) + [#:namespace namespace namespace? (make-base-namespace)] + [#:strip strip (or/c #f 'source 'binary) #f]) (values string? path? (or/c #f string?) boolean? (listof module-path?))]{ Locates the implementation of the package specified by @racket[desc] and downloads and unpacks it to a temporary directory (as needed). If @racket[desc] refers to an existing directory and -@racket[in-place?] is true, then the directory is used in place. +@racket[in-place?] is true, then the directory is used in place. The @racket[namespace] argument is passed along to @racket[get-info/full] when the package's @filepath{info.rkt} is loaded. +If @racket[strip] is not @racket[#f], then files and directories are +removed from the prepared directory the same as when creating the +corresponding kind of package. A directory that is staged in-place +cannot be stripped. + The result is the package name, the directory containing the unpacked package content, the checksum (if any) for the unpacked package, whether the directory should be removed after the package content is no longer @@ -162,7 +168,8 @@ Unless @racket[quiet?] is true, information about the output is repotred to the #f] [#:force? force? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f] - [#:quiet? boolean? quiet? #f]) + [#:quiet? boolean? quiet? #f] + [#:strip strip (or/c #f 'source 'binary) #f]) (or/c 'skip #f (listof (or/c path-string? @@ -187,7 +194,8 @@ The package lock must be held; see @racket[with-pkg-lock].} #f] [#:all? all? boolean? #f] [#:deps? deps? boolean? #f] - [#:quiet? boolean? quiet? #f]) + [#:quiet? boolean? quiet? #f] + [#:strip strip (or/c #f 'source 'binary) #f]) (or/c 'skip #f (listof (or/c path-string? diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 8e783130fe..b637052ce5 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -315,6 +315,10 @@ sub-sub-commands: of the given directory will not change for each given directory that implements a @tech{multi-collection package}.} + @item{@DFlag{binary} --- Strips source elements of a package before installing.} + + @item{@DFlag{source} --- Strips built elements of a package before installing.} + @item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source} whose name corresponds to an already-installed package.} @@ -362,6 +366,8 @@ this command fails without installing any of the @nonterm{pkg}s @item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.} @item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.} @item{@DFlag{no-setup} --- Same as for @command-ref{install}.} + @item{@DFlag{binary} --- Same as for @command-ref{install}.} + @item{@DFlag{source} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} ] } diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index e059654048..dbcdd4b9cf 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -709,6 +709,7 @@ check-sums? download-printf metadata-ns + #:strip [strip-mode #f] #:in-place? [in-place? #f] #:in-place-clean? [in-place-clean? #f]) (define-values (inferred-pkg-name type) @@ -732,7 +733,8 @@ pkg-name #:given-checksum given-checksum check-sums? download-printf - metadata-ns)] + metadata-ns + #:strip strip-mode)] [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) (define pkg-url (string->url pkg)) (define scheme (url-scheme pkg-url)) @@ -791,9 +793,11 @@ check-sums? download-printf metadata-ns - #:in-place? #t + #:strip strip-mode + #:in-place? (not strip-mode) #:in-place-clean? #t) - (set! staged? #t))) + (unless strip-mode + (set! staged? #t)))) (λ () (unless staged? (delete-directory/files tmp-dir))))) @@ -869,7 +873,8 @@ #:given-checksum checksum check-sums? download-printf - metadata-ns)) + metadata-ns + #:strip strip-mode)) (λ () (when (or (file-exists? package-path) (directory-exists? package-path)) @@ -953,11 +958,13 @@ check-sums? download-printf metadata-ns - #:in-place? #t + #:strip strip-mode + #:in-place? (not strip-mode) #:in-place-clean? #t) `(file ,(simple-form-path* pkg))) checksum) - (set! staged? #t))) + (unless strip-mode + (set! staged? #t)))) (λ () (unless staged? (delete-directory/files pkg-dir))))] @@ -981,11 +988,18 @@ [else (define pkg-dir (if in-place? - pkg + (if strip-mode + (pkg-error "cannot strip directory in place") + pkg) (let ([pkg-dir (make-temporary-file "pkg~a" 'directory)]) (delete-directory pkg-dir) - (make-parent-directory* pkg-dir) - (copy-directory/files pkg pkg-dir #:keep-modify-seconds? #t) + (if strip-mode + (begin + (make-directory* pkg-dir) + (generate-stripped-directory strip-mode pkg pkg-dir)) + (begin + (make-parent-directory* pkg-dir) + (copy-directory/files pkg pkg-dir #:keep-modify-seconds? #t))) pkg-dir))) (install-info pkg-name `(dir ,(simple-form-path* pkg)) @@ -1003,7 +1017,8 @@ #:given-checksum checksum check-sums? download-printf - metadata-ns)) + metadata-ns + #:strip strip-mode)) (when (and (install-info-checksum info) check-sums? (not (equal? (install-info-checksum info) checksum))) @@ -1019,7 +1034,8 @@ (define (pkg-stage desc #:namespace [metadata-ns (make-metadata-namespace)] #:checksum [checksum #f] - #:in-place? [in-place? #f]) + #:in-place? [in-place? #f] + #:strip [strip-mode #f]) (define i (stage-package/info (pkg-desc-source desc) (pkg-desc-type desc) (pkg-desc-name desc) @@ -1027,7 +1043,8 @@ #t void metadata-ns - #:in-place? in-place?)) + #:in-place? in-place? + #:strip strip-mode)) (values (install-info-name i) (install-info-directory i) (install-info-checksum i) @@ -1064,6 +1081,7 @@ #:quiet? [quiet? #f] #:install-conversation [install-conversation #f] #:update-conversation [update-conversation #f] + #:strip [strip-mode #f] descs) (define download-printf (if quiet? void printf/flush)) (define check-sums? (not ignore-checksums?)) @@ -1321,7 +1339,8 @@ (for/list ([v (in-list descs)]) (stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) check-sums? download-printf - metadata-ns))) + metadata-ns + #:strip strip-mode))) ;; For the top-level call, we need to double-check that all provided packages ;; were distinct: (for/fold ([ht (hash)]) ([i (in-list infos)] @@ -1444,7 +1463,8 @@ #:updating? [updating? #f] #:quiet? [quiet? #f] #:install-conversation [install-conversation #f] - #:update-conversation [update-conversation #f]) + #:update-conversation [update-conversation #f] + #:strip [strip-mode #f]) (define new-descs (remove-duplicates (if (not skip-installed?) @@ -1473,6 +1493,7 @@ #:updating? updating? #:install-conversation inst-conv #:update-conversation updt-conv + #:strip strip-mode (for/list ([dep (in-list deps)]) (pkg-desc dep #f #f #t)))])]) (install-packages @@ -1487,6 +1508,7 @@ #:quiet? quiet? #:install-conversation install-conversation #:update-conversation update-conversation + #:strip strip-mode new-descs))) (define ((update-is-possible? db) pkg-name) @@ -1533,7 +1555,8 @@ #:all? [all? #f] #:dep-behavior [dep-behavior #f] #:deps? [deps? #f] - #:quiet? [quiet? #f]) + #:quiet? [quiet? #f] + #:strip [strip-mode #f]) (define download-printf (if quiet? void printf)) (define metadata-ns (make-metadata-namespace)) (define db (read-pkg-db)) @@ -1564,6 +1587,7 @@ #:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)) #:dep-behavior dep-behavior #:quiet? quiet? + #:strip strip-mode to-update)])) (define (pkg-show indent #:directory? [dir? #f]) @@ -2269,7 +2293,8 @@ (#:dep-behavior dep-behavior/c #:all? boolean? #:deps? boolean? - #:quiet? boolean?) + #:quiet? boolean? + #:strip (or/c #f 'source 'binary)) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-remove (->* ((listof string?)) @@ -2287,7 +2312,8 @@ #:force? boolean? #:ignore-checksums? boolean? #:skip-installed? boolean? - #:quiet? boolean?) + #:quiet? boolean? + #:strip (or/c #f 'source 'binary)) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-catalog-show (->* ((listof string?)) @@ -2315,7 +2341,8 @@ [pkg-stage (->* (pkg-desc?) (#:namespace namespace? #:checksum (or/c #f string?) - #:in-place? boolean?) + #:in-place? boolean? + #:strip (or/c #f 'source 'binary)) (values string? path? (or/c #f string?) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index aff867d9c0..8c6062cdce 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -78,6 +78,8 @@ #:once-any [#:bool link () ("Link a directory package source in place")] [#:bool static-link () ("Link in place, promising collections do not change")] + [#:bool source () ("Strip built elements of the package before installing")] + [#:bool binary () ("Strip source elements of the package before installing")] #:once-each [#:bool skip-installed () ("Skip a if already installed")] #:once-any @@ -92,7 +94,7 @@ [(#:str dir #f) scope-dir () "Install for package scope "] #:once-each [(#:str catalog #f) catalog () "Use instead of configured catalogs"] - [#:bool no-setup () ("Don't run `raco setup' after changing packages (generally" + [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" "not a good idea)")] [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] #:args pkg-source @@ -110,6 +112,7 @@ #:force? force #:ignore-checksums? ignore-checksums #:skip-installed? skip-installed + #:strip (or (and source 'source) (and binary 'binary)) (for/list ([p (in-list pkg-source)]) (define a-type (or (and link 'link) (and static-link 'static-link) @@ -141,8 +144,11 @@ [#:bool user ("-u") "Shorthand for `--scope user'"] [#:bool shared ("-s") "Shorthand for `--scope shared'"] [(#:str dir #f) scope-dir () "Update for package scope "] + #:once-any + [#:bool source () ("Strip built elements of the package before installing")] + [#:bool binary () ("Strip source elements of the package before installing")] #:once-each - [#:bool no-setup () ("Don't run `raco setup' after changing packages (generally" + [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" "not a good idea)")] [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] #:args pkg @@ -155,7 +161,8 @@ (pkg-update pkg #:all? all #:dep-behavior deps - #:deps? update-deps))) + #:deps? update-deps + #:strip (or (and source 'source) (and binary 'binary))))) (setup no-setup setup-collects jobs)))] [remove "Remove packages" @@ -173,7 +180,7 @@ [#:bool shared ("-s") "Shorthand for `--scope shared'"] [(#:str dir #f) scope-dir () "Remove for package scope "] #:once-each - [#:bool no-setup () ("Don't run `raco setup' after changing packages (generally" + [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" "not a good idea)")] [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] #:args pkg