diff --git a/collects/setup/setup-cmdline.ss b/collects/setup/setup-cmdline.ss index 04b15e3dfe..8c6e06e97e 100644 --- a/collects/setup/setup-cmdline.ss +++ b/collects/setup/setup-cmdline.ss @@ -3,102 +3,100 @@ ;; 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. -(module setup-cmdline scheme/base - (require scheme/cmdline) - - (provide parse-cmdline) +#lang scheme/base - ;; 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 +(require scheme/cmdline) - (define (parse-cmdline argv) - - (define x-specific-planet-packages '()) - (define x-flags null) - (define (add-flags l) - (set! x-flags (append (reverse l) x-flags))) - - (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 " - (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")] - #: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 or -l is specified, all collections are setup~n") - (exit 0)))) +(provide parse-cmdline) - (values x-flags x-specific-collections x-specific-planet-packages x-archives))) +;; 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-flags null) + (define (add-flags l) + (set! x-flags (append (reverse l) x-flags))) + + (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 " + (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")] + #: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 or -l is specified, ~a\n" + "all collections are setup") + (exit 0)))) + + (values x-flags x-specific-collections x-specific-planet-packages x-archives))