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

Adjusted 'raco setup' so that the arguments are collections (left setup-plt alone)

Browse Source
This commit is contained in:
Robby Findler 2010-06-21 16:57:44 -05:00
parent 4925e7e51f
commit e105d191b1
3 changed files with 57 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/setup/main.rkt
View File

@ -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]

17
collects/setup/private/command-name.rkt
View File

@ -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))))))))

68
collects/setup/setup-cmdline.rkt
View File

@ -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 <dir>"
(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 <collection>s only" "collection")]
[("-l") => (lambda (flag . collections)
(check-collections collections)
(cons 'collections (map list collections)))
'("Setup specific <collection>s only" "collection")]
[("-A") => (λ (flag . archives)
(cons 'archives archives))
'("Unpack and install <archive>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 <archive> or -l <collection> is specified, ~a\n"
"all collections are setup")
(if raco?
(printf "If no <collection> is specified, all collections are setup\n")
(printf "If no <archive> or -l <collection> 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)))))