From e105d191b100264545b7e05df1f9e6dfc1812884 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 21 Jun 2010 16:57:44 -0500 Subject: [PATCH] Adjusted 'raco setup' so that the arguments are collections (left setup-plt alone) --- collects/setup/main.rkt | 2 +- collects/setup/private/command-name.rkt | 17 +++++-- collects/setup/setup-cmdline.rkt | 68 ++++++++++++++++--------- 3 files changed, 57 insertions(+), 30 deletions(-) diff --git a/collects/setup/main.rkt b/collects/setup/main.rkt index d32de5aa47..bf641edccb 100644 --- a/collects/setup/main.rkt +++ b/collects/setup/main.rkt @@ -23,7 +23,7 @@ (namespace-attach-module cns ''#%builtin ns) ns))) - (define-values (short-name long-names) + (define-values (short-name long-names raco?) ;; Load the name modulewithout using .zos, and in its own namespace to ;; avoid poluting the cm-managed namespace later (parameterize ([use-compiled-file-paths null] diff --git a/collects/setup/private/command-name.rkt b/collects/setup/private/command-name.rkt index d946c15610..4da9c12fa3 100644 --- a/collects/setup/private/command-name.rkt +++ b/collects/setup/private/command-name.rkt @@ -14,7 +14,16 @@ (program+command-name)) ;; Hack for bootstrapping, if the program name is "raco", ;; then claim to be the "setup" command: - (if (equal? (path->string name) "raco") - (values (format "~a setup" name) - (format "~a setup" p)) - (values (path->string name) p)))))))) + ;; if the program name is "racket", assume that there's a "racket -l setup" + ;; going on in there and also claim to be the "raco setup" command + (if (if (equal? (path->string name) "raco") + #t + (equal? (path->string name) "racket")) + (values "raco setup" + (string-append (regexp-replace* + #rx"racket$" + (format "~a" p) + "raco") + " setup") + #t) + (values (path->string name) p #f)))))))) diff --git a/collects/setup/setup-cmdline.rkt b/collects/setup/setup-cmdline.rkt index 8f886fddb3..7ef0d9e660 100644 --- a/collects/setup/setup-cmdline.rkt +++ b/collects/setup/setup-cmdline.rkt @@ -1,10 +1,9 @@ +#lang racket/base ;; Command-line parsing is in its own module because it has to be used ;; both in setup.ss (pre-zo, pre-cm) and setup-go.ss (use zos and cm). ;; This means that command lines will be parsed twice. -#lang racket/base - (require racket/cmdline raco/command-name "private/command-name.rkt") @@ -25,7 +24,7 @@ (define (add-flags l) (set! x-flags (append (reverse l) x-flags))) - (define-values (short-name long-name) (get-names)) + (define-values (short-name long-name raco?) (get-names)) ;; Beware of the poor-man's duplicate of this command-line specification ;; in "main.rkt"! @@ -78,36 +77,55 @@ (add-flags `((compile-mode ,mode)))] [("--doc-pdf") dir "Write doc PDF to " (add-flags `((doc-pdf-dest ,dir)))] - [("-l") => - (lambda (flag . collections) - (map (lambda (v) - ;; A normal-form collection path matches a symbolic module path; - ;; this is a bit of a hack, but it's not entirely a coincidence: - (unless (module-path? (string->symbol v)) - (error (format "bad collection path~a: ~a" - (cond [(regexp-match? #rx"/$" v) - " (trailing slash not allowed)"] - [(regexp-match? #rx"\\\\" v) - " (backslash not allowed)"] - [else ""]) - v))) - (list v)) - collections)) - '("Setup specific s only" "collection")] + [("-l") => (lambda (flag . collections) + (check-collections collections) + (cons 'collections (map list collections))) + '("Setup specific s only" "collection")] + [("-A") => (λ (flag . archives) + (cons 'archives archives)) + '("Unpack and install s" "archive")] #:multi [("-P") owner package-name maj min "Setup specified PLaneT packages only" (set! x-specific-planet-packages (cons (list owner package-name maj min) x-specific-planet-packages))] #:handlers - (lambda (collections . archives) - (values (if (null? collections) null (car collections)) - archives)) - '("archive") + (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)) + '())]) + (cond + [raco? + (check-collections rest) + (values (append pre-collections (map list rest)) + pre-archives)] + [else + (values pre-collections + (append pre-archives rest))]))) + (if raco? '("collection") '("archive")) (lambda (s) (display s) - (printf "If no or -l is specified, ~a\n" - "all collections are setup") + (if raco? + (printf "If no is specified, all collections are setup\n") + (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)) + +(define (check-collections collections) + (for ((v (in-list collections))) + ;; A normal-form collection path matches a symbolic module path; + ;; this is a bit of a hack, but it's not entirely a coincidence: + (unless (module-path? (string->symbol v)) + (error (format "bad collection path~a: ~a" + (cond [(regexp-match? #rx"/$" v) + " (trailing slash not allowed)"] + [(regexp-match? #rx"\\\\" v) + " (backslash not allowed)"] + [else ""]) + v)))))