reformat
svn: r8588
This commit is contained in:
Eli Barzilay
parent
0e77057aa9
commit
fd1117888e
|
|
@ -3,102 +3,100 @@
|
||||||
;; 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 x-specific-planet-packages '())
|
(define (parse-cmdline argv)
|
||||||
(define x-flags null)
|
|
||||||
(define (add-flags l)
|
|
||||||
(set! x-flags (append (reverse l) x-flags)))
|
|
||||||
|
|
||||||
(define-values (x-specific-collections x-archives)
|
(define x-specific-planet-packages '())
|
||||||
(command-line
|
(define x-flags null)
|
||||||
#:argv argv
|
(define (add-flags l)
|
||||||
#:once-each
|
(set! x-flags (append (reverse l) x-flags)))
|
||||||
[("-c" "--clean") "Delete existing compiled files; implies -nxi"
|
|
||||||
(add-flags '((clean #t)
|
|
||||||
(make-zo #f)
|
|
||||||
(call-install #f)
|
|
||||||
(make-launchers #f)
|
|
||||||
(make-info-domain #f)
|
|
||||||
(make-docs #f)))]
|
|
||||||
[("-n" "--no-zo") "Do not produce .zo files"
|
|
||||||
(add-flags '((make-zo #f)))]
|
|
||||||
[("-x" "--no-launcher") "Do not produce launcher programs"
|
|
||||||
(add-flags '((make-launchers #f)))]
|
|
||||||
[("-i" "--no-install") "Do not call collection-specific pre-installers"
|
|
||||||
(add-flags '((call-install #f)))]
|
|
||||||
[("-I" "--no-post-install") "Do not call collection-specific post-installers"
|
|
||||||
(add-flags '((call-post-install #f)))]
|
|
||||||
[("-d" "--no-info-domain") "Do not produce info-domain caches"
|
|
||||||
(add-flags '((make-info-domain #f)))]
|
|
||||||
[("-D" "--no-docs") "Do not produce documentation"
|
|
||||||
(add-flags '((make-docs #f)))]
|
|
||||||
[("--no-planet") "Do not setup PLaneT packages"
|
|
||||||
(add-flags '((make-planet #f)))]
|
|
||||||
[("-v" "--verbose") "See names of compiled files and info printfs"
|
|
||||||
(add-flags '((verbose #t)))]
|
|
||||||
[("-m" "--make-verbose") "See make and compiler usual messages"
|
|
||||||
(add-flags '((make-verbose #t)))]
|
|
||||||
[("-r" "--compile-verbose") "See make and compiler verbose messages"
|
|
||||||
(add-flags '((make-verbose #t)
|
|
||||||
(compiler-verbose #t)))]
|
|
||||||
[("--trust-zos") "Trust existing .zos (use only with prepackaged .zos)"
|
|
||||||
(add-flags '((trust-existing-zos #t)))]
|
|
||||||
[("-p" "--pause") "Pause at the end if there are any errors"
|
|
||||||
(add-flags '((pause-on-errors #t)))]
|
|
||||||
[("--force") "Treat version mismatches for archives as mere warnings"
|
|
||||||
(add-flags '((force-unpacks #t)))]
|
|
||||||
[("-a" "--all-users") "Install archives to main (not user-specific) installation"
|
|
||||||
(add-flags '((all-users #t)))]
|
|
||||||
[("--mode") mode "Select a compilation mode"
|
|
||||||
(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")]
|
|
||||||
#: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 (s)
|
|
||||||
(display s)
|
|
||||||
(printf "If no <archive> or -l <collection> is specified, all collections are setup~n")
|
|
||||||
(exit 0))))
|
|
||||||
|
|
||||||
(values x-flags x-specific-collections x-specific-planet-packages x-archives)))
|
(define-values (x-specific-collections x-archives)
|
||||||
|
(command-line
|
||||||
|
#:argv argv
|
||||||
|
#:once-each
|
||||||
|
[("-c" "--clean") "Delete existing compiled files; implies -nxi"
|
||||||
|
(add-flags '((clean #t)
|
||||||
|
(make-zo #f)
|
||||||
|
(call-install #f)
|
||||||
|
(make-launchers #f)
|
||||||
|
(make-info-domain #f)
|
||||||
|
(make-docs #f)))]
|
||||||
|
[("-n" "--no-zo") "Do not produce .zo files"
|
||||||
|
(add-flags '((make-zo #f)))]
|
||||||
|
[("-x" "--no-launcher") "Do not produce launcher programs"
|
||||||
|
(add-flags '((make-launchers #f)))]
|
||||||
|
[("-i" "--no-install") "Do not call collection-specific pre-installers"
|
||||||
|
(add-flags '((call-install #f)))]
|
||||||
|
[("-I" "--no-post-install") "Do not call collection-specific post-installers"
|
||||||
|
(add-flags '((call-post-install #f)))]
|
||||||
|
[("-d" "--no-info-domain") "Do not produce info-domain caches"
|
||||||
|
(add-flags '((make-info-domain #f)))]
|
||||||
|
[("-D" "--no-docs") "Do not produce documentation"
|
||||||
|
(add-flags '((make-docs #f)))]
|
||||||
|
[("--no-planet") "Do not setup PLaneT packages"
|
||||||
|
(add-flags '((make-planet #f)))]
|
||||||
|
[("-v" "--verbose") "See names of compiled files and info printfs"
|
||||||
|
(add-flags '((verbose #t)))]
|
||||||
|
[("-m" "--make-verbose") "See make and compiler usual messages"
|
||||||
|
(add-flags '((make-verbose #t)))]
|
||||||
|
[("-r" "--compile-verbose") "See make and compiler verbose messages"
|
||||||
|
(add-flags '((make-verbose #t)
|
||||||
|
(compiler-verbose #t)))]
|
||||||
|
[("--trust-zos") "Trust existing .zos (use only with prepackaged .zos)"
|
||||||
|
(add-flags '((trust-existing-zos #t)))]
|
||||||
|
[("-p" "--pause") "Pause at the end if there are any errors"
|
||||||
|
(add-flags '((pause-on-errors #t)))]
|
||||||
|
[("--force") "Treat version mismatches for archives as mere warnings"
|
||||||
|
(add-flags '((force-unpacks #t)))]
|
||||||
|
[("-a" "--all-users") "Install archives to main (not user-specific) installation"
|
||||||
|
(add-flags '((all-users #t)))]
|
||||||
|
[("--mode") mode "Select a compilation mode"
|
||||||
|
(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")]
|
||||||
|
#: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 (s)
|
||||||
|
(display s)
|
||||||
|
(printf "If no <archive> or -l <collection> is specified, ~a\n"
|
||||||
|
"all collections are setup")
|
||||||
|
(exit 0))))
|
||||||
|
|
||||||
|
(values x-flags x-specific-collections x-specific-planet-packages x-archives))
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user