/usr/share/racket/collects/setup/setup-cmdline.rkt is in racket-common 6.7-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 | #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.rkt (use zos and cm).
;; This means that command lines will be parsed twice.
(require racket/cmdline
raco/command-name
pkg/name
"private/command-name.rkt")
(provide parse-cmdline)
;; 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.rkt)
;; - 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 (short-name long-name raco?) (get-names))
(define disable-action-flags
'((make-zo #f)
(call-install #f)
(call-post-install #f)
(make-launchers #f)
(make-info-domain #f)
(make-docs #f)
(check-dependencies #f)
(make-foreign-libs #f)))
;; Beware of the poor-man's duplicate of this command-line specification
;; in "main.rkt"!
(define-values (x-specific-collections x-specific-packages x-archives)
(command-line
#:program long-name
#:argv argv
#:help-labels
" --------------------------- collections --------------------------- "
" If no collection, package, or archive is specified, all are setup"
#:once-each
[("--only") "Set up only specified, even if none"
(add-flags '((make-only #t)))]
[("-l") => (lambda (flag . collections)
(check-collections short-name collections)
(cons 'collections (map list collections)))
'("Setup specified <collection>s" "collection")]
[("--pkgs") => (lambda (flag . pkgs)
(check-packages short-name pkgs)
(cons 'packages pkgs))
'("Setup collections in specified <pkg>s" "pkg")]
#:multi
[("-P") owner package-name maj min
"Setup specified PLaneT packages"
(set! x-specific-planet-packages (cons (list owner package-name maj min)
x-specific-planet-packages))]
#:once-each
[("--doc-index") "Rebuild documentation index along with specified"
(add-flags '((make-doc-index #t)))]
[("--tidy") "Clear references to removed items outside of specified"
(add-flags '((make-tidy #t)))]
#:help-labels
" ------------------------------ tasks ------------------------------ "
#:once-each
[("-c" "--clean") "Delete existing compiled files; implies -nxiIFDK"
(add-flags (append '((clean #t))
disable-action-flags))]
[("--fast-clean") "Like --clean, but non-bootstrapping (can fail)"
(add-flags (append '((clean #t))
disable-action-flags))]
[("-n" "--no-zo") "Do not create \".zo\" files"
(add-flags '((make-zo #f)))]
[("--trust-zos") "Trust existing \".zo\"s (use only with prepackaged \".zo\"s)"
(add-flags '((trust-existing-zos #t)))]
[("-x" "--no-launcher") "Do not produce launcher programs"
(add-flags '((make-launchers #f)))]
[("-F" "--no-foreign-libs") "Do not install foreign libraries"
(add-flags '((make-foreign-libs #f)))]
[("--only-foreign-libs") "Disable actions except installing foreign libraries"
(add-flags (for/list ([fl (in-list disable-action-flags)]
#:unless (eq? (car fl) 'make-foreign-libs))
fl))]
[("-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 compile .scrbl files and do not build documentation"
(add-flags '((make-docs #f)))]
[("--doc-pdf") dir "Build documentation PDFs, write to <dir>"
(add-flags `((doc-pdf-dest ,dir)))]
[("-K" "--no-pkg-deps") "Do not check package dependencies"
(add-flags '((check-dependencies #f)))]
[("--check-pkg-deps") "Check package dependencies when collections specified"
(add-flags '((always-check-dependencies #t)))]
[("--fix-pkg-deps") "Auto-repair package-dependency declarations"
(add-flags '((always-check-dependencies #t)
(fix-dependencies #t)))]
[("--unused-pkg-deps") "Check for unused package-dependency declarations"
(add-flags '((check-dependencies #t)
(check-unused-dependencies #t)))]
#:help-labels
" ------------------------------ users ------------------------------ "
#:once-each
[("-U" "--no-user") "Do not setup user-specific collections (implies --no-planet)"
(add-flags '((make-user #f) (make-planet #f)))]
[("--no-planet") "Do not setup PLaneT packages"
(add-flags '((make-planet #f)))]
[("--avoid-main") "Do not make main-installation files"
(add-flags '((avoid-main-installation #t)))]
[("--force-user-docs") "User-specific documentation even if matching installation"
(add-flags '((force-user-docs #t)))]
#:help-labels
" ------------------------------ modes ------------------------------ "
#:once-each
[("-j" "--jobs" "--workers") n "Use <n> parallel jobs"
(add-flags `((parallel-workers ,(string->number n))))]
[("-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)))]
[("--mode") mode "Select a compilation mode, such as \"errortrace\""
(add-flags `((compile-mode ,mode)))]
[("--fail-fast") "Trigger a break on the first error"
(add-flags '((fail-fast #t)))]
[("-p" "--pause") "Pause at the end if there are any errors"
(add-flags '((pause-on-errors #t)))]
#:help-labels
" ---------------------------- archives ----------------------------- "
#:once-each
[("-A") => (λ (flag . archives)
(cons 'archives archives))
'("Unpack and install <archive>s" "archive")]
[("--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)))]
#:help-labels
" ------------------------------ misc ------------------------------- "
#:handlers
(lambda (collections/pkgs/archives . rest)
(define (get key)
(if (and (pair? collections/pkgs/archives)
(eq? (caar collections/pkgs/archives) key))
(cdr (car collections/pkgs/archives))
'()))
(let ([pre-archives (get 'archives)]
[pre-collections (get 'collections)]
[pre-packages (get 'packages)])
(cond
[raco?
(check-collections short-name rest)
(values (append pre-collections (map list rest))
pre-packages
pre-archives)]
[else
(values pre-collections
pre-packages
(append pre-archives rest))])))
(if raco? '("collection") '("archive"))
(lambda (s)
(display s)
(exit 0))))
(values short-name x-flags
x-specific-collections x-specific-packages x-specific-planet-packages
x-archives))
(define (check-collections name 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))
(raise-user-error (string->symbol name)
"bad collection path~a: ~a"
(cond [(regexp-match? #rx"/$" v)
" (trailing slash not allowed)"]
[(regexp-match? #rx"\\\\" v)
" (backslash not allowed)"]
[else ""])
v))))
(define (check-packages name packages)
(for ((v (in-list packages)))
(define-values (n type) (package-source->name+type v #f))
(unless (and (eq? type 'name)
(equal? n v))
(raise-user-error (string->symbol name)
"bad package name: ~a"
v))))
|