diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl index d3325a9a4d..e036d110b2 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -115,6 +115,10 @@ flags: package, in addition to any other specified @|PLaneT| packages or @nonterm{collection}s.} + @item{@DFlag{pkgs} @nonterm{pkg} @racket[...] --- constrain setup + actions to collections that are within (or partially within) the + named @nonterm{pkg}s.} + @item{@DFlag{tidy} --- remove metadata cache information and documentation for non-existent collections (to clean up after removal) even when setup actions are otherwise confined to specified collections.} @@ -249,8 +253,9 @@ collections during an install: @commandline{env PLT_SETUP_OPTIONS="-j 1" make install} -@history[#:changed "1.2" @elem{Added @DFlag{check-pkg-deps} - and @DFlag{fast-break} flags.}] +@history[#:changed "1.2" @elem{Added the @DFlag{pkgs}, + @DFlag{check-pkg-deps}, and + @DFlag{fast-break} flags.}] @; ------------------------------------------------------------------------ diff --git a/racket/collects/setup/option.rkt b/racket/collects/setup/option.rkt index 5ad8e68a76..434e13ad39 100644 --- a/racket/collects/setup/option.rkt +++ b/racket/collects/setup/option.rkt @@ -6,6 +6,7 @@ set-flag-params setup-program-name specific-collections + specific-packages specific-planet-dirs archives archive-implies-reindex @@ -78,6 +79,7 @@ (define-flag-param fail-fast #f) (define specific-collections (make-parameter null)) +(define specific-packages (make-parameter null)) (define specific-planet-dirs (make-parameter null)) (define archives (make-parameter null)) diff --git a/racket/collects/setup/setup-cmdline.rkt b/racket/collects/setup/setup-cmdline.rkt index 1b787f5f3b..f98ba05e68 100644 --- a/racket/collects/setup/setup-cmdline.rkt +++ b/racket/collects/setup/setup-cmdline.rkt @@ -6,6 +6,7 @@ (require racket/cmdline raco/command-name + pkg/name "private/command-name.rkt") (provide parse-cmdline) @@ -28,7 +29,7 @@ ;; Beware of the poor-man's duplicate of this command-line specification ;; in "main.rkt"! - (define-values (x-specific-collections x-archives) + (define-values (x-specific-collections x-specific-packages x-archives) (command-line #:program long-name #:argv argv @@ -105,6 +106,10 @@ (check-collections short-name collections) (cons 'collections (map list collections))) '("Setup specific s only" "collection")] + [("--pkgs") => (lambda (flag . pkgs) + (check-packages short-name pkgs) + (cons 'packages pkgs)) + '("Setup s in specific s only" "pkg")] [("-A") => (λ (flag . archives) (cons 'archives archives)) '("Unpack and install s" "archive")] @@ -114,22 +119,24 @@ (add-flags '((all-users #t)))] #:handlers - (lambda (collections/archives . rest) - (let ([pre-archives (if (and (pair? collections/archives) - (eq? (caar collections/archives) 'archives)) - (cdr (car collections/archives)) - '())] - [pre-collections (if (and (pair? collections/archives) - (eq? (caar collections/archives) 'collections)) - (cdr (car collections/archives)) - '())]) + (lambda (collections/pkgs/archives . rest) + (define (get key) + (if (and (pair? collections/pkgs/archives) + (eq? (caar collections/pkgs/archives) key)) + (cdr (car collections/pkgs/archives)) + '())) + (let ([pre-archives (get 'archives)] + [pre-collections (get 'collections)] + [pre-packages (get 'packages)]) (cond [raco? (check-collections short-name rest) (values (append pre-collections (map list rest)) + pre-packages pre-archives)] [else (values pre-collections + pre-packages (append pre-archives rest))]))) (if raco? '("collection") '("archive")) (lambda (s) @@ -139,7 +146,9 @@ (printf "If no or -l is specified, all collections are setup\n")) (exit 0)))) - (values short-name x-flags x-specific-collections x-specific-planet-packages x-archives)) + (values short-name x-flags + x-specific-collections x-specific-packages x-specific-planet-packages + x-archives)) (define (check-collections name collections) (for ((v (in-list collections))) @@ -154,3 +163,12 @@ " (backslash not allowed)"] [else ""]) v)))) + +(define (check-packages name packages) + (for ((v (in-list packages))) + (define-values (n type) (package-source->name+type v #f)) + (unless (and (eq? type 'name) + (equal? n v)) + (raise-user-error (string->symbol name) + "bad package name: ~a" + v)))) diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index 57b0420cdd..57197ead2d 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -33,7 +33,10 @@ "parallel-build.rkt" "private/cc-struct.rkt" "link.rkt" - "private/pkg-deps.rkt") + "private/pkg-deps.rkt" + "collection-name.rkt" + (only-in pkg/lib pkg-directory + pkg-single-collection)) (define-namespace-anchor anchor) @@ -193,9 +196,29 @@ (let ([p (collection-file-path "scribble.rkt" "setup")]) (or (file-exists? p) (file-exists? (get-compilation-bytecode-file p)))))) + + (define (pkg->collections pkg) + (define dir (pkg-directory pkg)) + (cond + [dir + (define collect (pkg-single-collection dir #:name pkg)) + (if collect + (list (list collect)) + (for/list ([d (directory-list dir)] + #:when (and (directory-exists? (build-path dir d)) + (collection-name-element? (path->string d)))) + (list d)))] + [else + (error 'pkd->collections + (string-append "package not found\n" + " package: ~a") + pkg)])) (define x-specific-collections (append* (specific-collections) + (apply append + (map pkg->collections + (specific-packages))) (if (and (make-doc-index) make-docs?) (append diff --git a/racket/collects/setup/setup-go.rkt b/racket/collects/setup/setup-go.rkt index 4f30d39c93..cb514b3b38 100644 --- a/racket/collects/setup/setup-go.rkt +++ b/racket/collects/setup/setup-go.rkt @@ -6,7 +6,9 @@ (module test racket/base) - (define-values (short-name x-flags x-specific-collections x-specific-planet-packages x-archives) + (define-values (short-name x-flags + x-specific-collections x-specific-packages x-specific-planet-packages + x-archives) (parse-cmdline (current-command-line-arguments))) (define (has-x-flag? s) @@ -23,6 +25,7 @@ [trust-existing-zos (or (has-x-flag? 'trust-existing-zos) (trust-existing-zos))] [specific-collections x-specific-collections] + [specific-packages x-specific-packages] [archives x-archives] [specific-planet-dirs x-specific-planet-packages] diff --git a/racket/collects/setup/setup.rkt b/racket/collects/setup/setup.rkt index c984cbb9dc..f2dc219ae3 100644 --- a/racket/collects/setup/setup.rkt +++ b/racket/collects/setup/setup.rkt @@ -10,6 +10,7 @@ #:get-target-dir [get-target-dir #f] #:planet-specs [planet-specs #f] #:collections [collections #f] + #:pkgs [pkgs #f] #:make-docs? [make-docs? #t] #:make-doc-index? [make-doc-index? #f] #:make-user? [make-user? #t] @@ -31,6 +32,8 @@ [specific-planet-dirs (if planet-specs planet-specs (specific-planet-dirs))] [specific-collections (if collections collections (specific-collections))] + + [specific-packages (if pkgs pkgs (specific-packages))] [make-only (if (or planet-specs collections) #t (make-only))]