svn: r8588
This commit is contained in:
Eli Barzilay 2008-02-08 19:32:53 +00:00
parent 0e77057aa9
commit fd1117888e

View File

@ -3,19 +3,20 @@
;; both in setup.ss (pre-zo, pre-cm) and setup-go.ss (use zos and cm). ;; 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. ;; This means that command lines will be parsed twice.
(module setup-cmdline scheme/base #lang scheme/base
(require scheme/cmdline)
(provide parse-cmdline) (require scheme/cmdline)
;; The result of parse-cmdline is three lists: (provide parse-cmdline)
;; - An assoc list mapping flag symbols to booleans
;; (nearly all symbols correspond to parameter names
;; in setup-go.ss)
;; - A list of specific collections
;; - A list of archives
(define (parse-cmdline argv) ;; The result of parse-cmdline is three lists:
;; - An assoc list mapping flag symbols to booleans
;; (nearly all symbols correspond to parameter names
;; in setup-go.ss)
;; - A list of specific collections
;; - A list of archives
(define (parse-cmdline argv)
(define x-specific-planet-packages '()) (define x-specific-planet-packages '())
(define x-flags null) (define x-flags null)
@ -73,8 +74,7 @@
;; this is a bit of a hack, but it's not entirely a coincidence: ;; this is a bit of a hack, but it's not entirely a coincidence:
(unless (module-path? (string->symbol v)) (unless (module-path? (string->symbol v))
(error (format "bad collection path~a: ~a" (error (format "bad collection path~a: ~a"
(cond (cond [(regexp-match? #rx"/$" v)
[(regexp-match? #rx"/$" v)
" (trailing slash not allowed)"] " (trailing slash not allowed)"]
[(regexp-match? #rx"\\\\" v) [(regexp-match? #rx"\\\\" v)
" (backslash not allowed)"] " (backslash not allowed)"]
@ -86,19 +86,17 @@
#:multi #:multi
[("-P") owner package-name maj min [("-P") owner package-name maj min
"Setup specified PLaneT packages only" "Setup specified PLaneT packages only"
(set! (set! x-specific-planet-packages (cons (list owner package-name maj min)
x-specific-planet-packages x-specific-planet-packages))]
(cons (list owner package-name maj min) x-specific-planet-packages))]
#:handlers #:handlers
(lambda (collections . archives) (lambda (collections . archives)
(values (if (null? collections) (values (if (null? collections) null (car collections))
null
(car collections))
archives)) archives))
'("archive") '("archive")
(lambda (s) (lambda (s)
(display s) (display s)
(printf "If no <archive> or -l <collection> is specified, all collections are setup~n") (printf "If no <archive> or -l <collection> is specified, ~a\n"
"all collections are setup")
(exit 0)))) (exit 0))))
(values x-flags x-specific-collections x-specific-planet-packages x-archives))) (values x-flags x-specific-collections x-specific-planet-packages x-archives))