raco pkg config: show all by default
Also, better help, checking, and error reporting on arguments.
Related to PR 14180
Merge to v6.0
(cherry picked from commit 53ce3b7b96)
This commit is contained in:
Matthew Flatt
Ryan Culpepper
parent
86a64e95d7
commit
3a09e8fa0a
|
|
@ -157,11 +157,15 @@ directory should be removed after the package content is no longer
|
|||
needed, and a list of module paths provided by the package.}
|
||||
|
||||
|
||||
@defproc[(pkg-config [set? boolean?] [keys/vals list?])
|
||||
@defproc[(pkg-config [set? boolean?] [keys/vals list?]
|
||||
[#:from-command-line? from-command-line? boolean? #f])
|
||||
void?]{
|
||||
|
||||
Implements @racket[pkg-config-command].
|
||||
|
||||
If @racket[from-command-line?] is true, error messages may suggest
|
||||
specific command-line flags for @command-ref{config}.
|
||||
|
||||
The package lock must be held (allowing writes if @racket[set?] is true); see
|
||||
@racket[with-pkg-lock].}
|
||||
|
||||
|
|
|
|||
|
|
@ -599,8 +599,14 @@ the given @nonterm{pkg}s.
|
|||
]
|
||||
}
|
||||
|
||||
@subcommand{@command/toc{config} @nonterm{option} ... @nonterm{key} @nonterm{val} ... ---
|
||||
View and modify configuration of the package manager itself, with the following @nonterm{option}s:
|
||||
@subcommand{@command/toc{config} @nonterm{option} ... @optional[@nonterm{key}] @nonterm{val} ... ---
|
||||
View and modify the configuration of the package manager. If @nonterm{key} is not provided,
|
||||
the values for all recognized keys are shown. The @nonterm{val} arguments are allowed
|
||||
only when @DFlag{set} is used, in which case the @nonterm{val}s are used as the new values
|
||||
for @nonterm{key}.
|
||||
|
||||
The @exec{config} sub-command accepts
|
||||
with the following @nonterm{option}s:
|
||||
|
||||
@itemlist[
|
||||
@item{@DFlag{set} --- Sets an option, rather than printing it.}
|
||||
|
|
@ -614,6 +620,8 @@ View and modify configuration of the package manager itself, with the following
|
|||
|
||||
The valid @nonterm{key}s are:
|
||||
@itemlist[
|
||||
@item{@exec{name} --- A string for the installation's name, which is used by @exec{user}
|
||||
@tech{package scope} and defaults to the Racket version.}
|
||||
@item{@exec{catalogs} --- A list of URLs for @tech{package catalogs}.}
|
||||
@item{@exec{default-scope} --- Either @exec{installation} or @exec{user}.
|
||||
The value of this key at @exec{user} scope (possibly defaulting from
|
||||
|
|
@ -621,8 +629,6 @@ View and modify configuration of the package manager itself, with the following
|
|||
the default @tech{package scope} for @exec{raco pkg} commands for which
|
||||
a scope is not inferred from a given set of package names
|
||||
(even for @command{config}, which is consistent but potentially confusing).}
|
||||
@item{@exec{name} --- A string for the installation's name, which is used by @exec{user}
|
||||
@tech{package scope} and defaults to the Racket version.}
|
||||
@item{@exec{download-cache-dir} --- A directory that holds copies of
|
||||
downloaded packages, used to avoid re-downloading if the
|
||||
same URL and checksum combination is requested again. The default cache directory is
|
||||
|
|
|
|||
|
|
@ -6,7 +6,8 @@
|
|||
(for-syntax racket/base
|
||||
racket/list
|
||||
racket/syntax
|
||||
syntax/parse))
|
||||
syntax/parse
|
||||
syntax/stx))
|
||||
|
||||
(define ((string->option what valid-options) str)
|
||||
(define s (string->symbol str))
|
||||
|
|
@ -104,15 +105,36 @@
|
|||
#:attr (command-line 1)
|
||||
(syntax->list #'(#:usage-help s ...))])
|
||||
|
||||
(define-splicing-syntax-class arguments
|
||||
#:attributes (accum args (body 1) help-strs)
|
||||
[pattern (~seq #:args args
|
||||
body:expr ...)
|
||||
#:with accum #'ignored
|
||||
#:with help-strs (with-syntax ([strs
|
||||
(map symbol->string
|
||||
(map syntax->datum
|
||||
(let loop ([args #'args])
|
||||
(cond
|
||||
[(stx-null? args) null]
|
||||
[(stx-pair? args)
|
||||
(cons (stx-car args)
|
||||
(loop (stx-cdr args)))]
|
||||
[else
|
||||
(list args)]))))])
|
||||
#`(list . strs))]
|
||||
[pattern (~seq #:handlers
|
||||
(lambda (accum . args) body:expr ...)
|
||||
help-strs:expr)])
|
||||
|
||||
(define-syntax-class command
|
||||
#:attributes (name function variables command-line)
|
||||
[pattern (name:id doc:expr uh:usage-help ... og:option-group ... #:args args body:expr ...)
|
||||
[pattern (name:id doc:expr uh:usage-help ... og:option-group ... arg:arguments)
|
||||
#:do
|
||||
[(define name-str (symbol->string (syntax->datum #'name)))]
|
||||
#:attr function
|
||||
(syntax/loc #'name
|
||||
(define (name og.param ... ... . args)
|
||||
body ...))
|
||||
(define (name og.param ... ... . arg.args)
|
||||
arg.body ...))
|
||||
#:attr variables
|
||||
(syntax/loc #'name
|
||||
(begin og.variable ...))
|
||||
|
|
@ -122,8 +144,10 @@
|
|||
doc doc
|
||||
uh.command-line ... ...
|
||||
og.command-line ... ...
|
||||
#:args args
|
||||
(args-app args (name og.call ... ...))])]))
|
||||
#:handlers
|
||||
(lambda (accum . arg.args)
|
||||
(args-app arg.args (name og.call ... ...)))
|
||||
arg.help-strs])]))
|
||||
|
||||
(define-syntax (args-app stx)
|
||||
(syntax-parse stx
|
||||
|
|
|
|||
|
|
@ -2360,10 +2360,35 @@
|
|||
(unless quiet?
|
||||
(printf "Packages migrated\n")))))
|
||||
|
||||
(define (pkg-config config:set key+vals)
|
||||
(define (pkg-config config:set key+vals
|
||||
#:from-command-line? [from-command-line? #f])
|
||||
(cond
|
||||
[config:set
|
||||
(match key+vals
|
||||
[(list)
|
||||
(pkg-error "no config key given")]
|
||||
[(list (and key
|
||||
(or "default-scope"
|
||||
"name"
|
||||
"download-cache-max-files"
|
||||
"download-cache-max-bytes"
|
||||
"download-cache-dir")))
|
||||
(pkg-error (~a "missing value for config key\n"
|
||||
" config key: ~a")
|
||||
key)]
|
||||
[(list* (and key
|
||||
(or "default-scope"
|
||||
"name"
|
||||
"download-cache-max-files"
|
||||
"download-cache-max-bytes"
|
||||
"download-cache-dir"))
|
||||
val
|
||||
more-vals)
|
||||
(pkg-error (~a "too many values provided for config key\n"
|
||||
" config key: ~a\n"
|
||||
" given values:~a")
|
||||
key
|
||||
(format-list (cons val more-vals)))]
|
||||
[(list* (and key "catalogs") val)
|
||||
(update-pkg-cfg! 'catalogs val)]
|
||||
[(list (and key "default-scope") val)
|
||||
|
|
@ -2381,6 +2406,16 @@
|
|||
" current package scope: ~a")
|
||||
(current-pkg-scope)))
|
||||
(update-pkg-cfg! 'installation-name val)]
|
||||
[(list (and key "download-cache-dir")
|
||||
val)
|
||||
(unless (complete-path? val)
|
||||
(pkg-error (~a "invalid value for config key\n"
|
||||
" not an absolute path\n"
|
||||
" config key: ~a\n"
|
||||
" given value: ~a")
|
||||
key
|
||||
val))
|
||||
(update-pkg-cfg! (string->symbol key) val)]
|
||||
[(list (and key (or "download-cache-max-files"
|
||||
"download-cache-max-bytes"))
|
||||
val)
|
||||
|
|
@ -2391,32 +2426,45 @@
|
|||
" valid values: real numbers")
|
||||
key
|
||||
val))
|
||||
(update-pkg-cfg! (string->symbol key) val)]
|
||||
[(list key)
|
||||
(pkg-error "unsupported config key\n key: ~e" key)]
|
||||
[(list)
|
||||
(pkg-error "config key not provided")])]
|
||||
(update-pkg-cfg! (string->symbol key) (string->number val))]
|
||||
[(list* key args)
|
||||
(pkg-error "unsupported config key\n key: ~a" key)])]
|
||||
[else
|
||||
(define (show key+vals indent)
|
||||
(match key+vals
|
||||
[(list key)
|
||||
(match key
|
||||
["catalogs"
|
||||
(for ([s (in-list (read-pkg-cfg/def 'catalogs))])
|
||||
(printf "~a\n" s))]
|
||||
(printf "~a~a\n" indent s))]
|
||||
["default-scope"
|
||||
(printf "~a\n" (read-pkg-cfg/def 'default-scope))]
|
||||
(printf "~a~a\n" indent (read-pkg-cfg/def 'default-scope))]
|
||||
["name"
|
||||
(printf "~a\n" (read-pkg-cfg/def 'installation-name))]
|
||||
(printf "~a~a\n" indent (read-pkg-cfg/def 'installation-name))]
|
||||
[(or "download-cache-dir"
|
||||
"download-cache-max-files"
|
||||
"download-cache-max-bytes")
|
||||
(printf "~a\n" (read-pkg-cfg/def (string->symbol key)))]
|
||||
(printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))]
|
||||
[_
|
||||
(pkg-error "unsupported config key\n key: ~e" key)])]
|
||||
[(list)
|
||||
(pkg-error "config key not provided")]
|
||||
[_
|
||||
(pkg-error "multiple config keys provided (not in value-setting mode)")])]))
|
||||
(pkg-error (~a "multiple config keys provided"
|
||||
(if from-command-line?
|
||||
";\n supply `--set' to set a config key's value"
|
||||
"")))]))
|
||||
(match key+vals
|
||||
[(list)
|
||||
(for ([key (in-list '("name"
|
||||
"catalogs"
|
||||
"default-scope"
|
||||
"download-cache-dir"
|
||||
"download-cache-max-files"
|
||||
"download-cache-max-bytes"))])
|
||||
(printf "~a:\n" key)
|
||||
(show (list key) " "))]
|
||||
[_ (show key+vals "")])]))
|
||||
|
||||
(define (create-as-is create:format pkg-name dir orig-dir
|
||||
#:quiet? [quiet? #f]
|
||||
|
|
@ -3057,7 +3105,8 @@
|
|||
boolean?
|
||||
pkg-desc?)]
|
||||
[pkg-config
|
||||
(-> boolean? list?
|
||||
(->* (boolean? (listof string?))
|
||||
(#:from-command-line? boolean?)
|
||||
void?)]
|
||||
[pkg-create
|
||||
(->* ((or/c 'zip 'tgz 'plt 'MANIFEST)
|
||||
|
|
|
|||
|
|
@ -138,8 +138,8 @@
|
|||
;; ----------------------------------------
|
||||
[install
|
||||
"Install packages"
|
||||
#:usage-help "Installs the packages specified by <pkg-source> ..."
|
||||
"If no sources are specified, installs the current directory."
|
||||
#:usage-help "Installs the packages specified by <pkg-source> ..., and"
|
||||
"if no sources are specified, installs the current directory"
|
||||
#:once-each
|
||||
install-type-flags ...
|
||||
#:once-any
|
||||
|
|
@ -385,20 +385,27 @@
|
|||
;; ----------------------------------------
|
||||
[config
|
||||
"View and modify the package manager's configuration"
|
||||
#:once-each
|
||||
[#:bool set () "Set <key> to <val> ..."]
|
||||
#:usage-help "Shows value for <key>, shows values for all <key>s if"
|
||||
" none is given, or sets a single <key>"
|
||||
" if --set is specified"
|
||||
#:once-any
|
||||
[#:bool set () "Set <key> to <val>s"]
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
#:args (key . val)
|
||||
#:handlers
|
||||
(lambda (accum . key+vals)
|
||||
(call-with-package-scope
|
||||
'config
|
||||
scope scope-dir installation user #f #f
|
||||
(lambda ()
|
||||
(if set
|
||||
(with-pkg-lock
|
||||
(pkg-config #t (cons key val)))
|
||||
(pkg-config #t key+vals
|
||||
#:from-command-line? #t))
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-config #f (cons key val))))))]
|
||||
(pkg-config #f key+vals
|
||||
#:from-command-line? #t))))))
|
||||
(list "key" "val")]
|
||||
;; ----------------------------------------
|
||||
[catalog-show
|
||||
"Show package information as reported by a catalog"
|
||||
|
|
|
|||
|
|
@ -39,7 +39,21 @@
|
|||
[(_ #:program prog
|
||||
#:argv args
|
||||
general-description
|
||||
[name description long-description body ... #:args formals final-expr] ...)
|
||||
clause ...)
|
||||
(with-syntax ([(((name description long-description body ...)
|
||||
accum formals arg-help-strs final-expr)
|
||||
...)
|
||||
(map (lambda (clause)
|
||||
(syntax-case clause ()
|
||||
[[name description long-description body ...
|
||||
#:args formals final-expr]
|
||||
#'((name description long-description body ...)
|
||||
ignored formals (pimap symbol->string 'formals) final-expr)]
|
||||
[(name description long-description body ...
|
||||
#:handlers (lambda (accum . formals) final-expr) arg-help-strs)
|
||||
#'((name description long-description body ...)
|
||||
accum formals arg-help-strs final-expr)]))
|
||||
(syntax->list #'(clause ...)))])
|
||||
(with-syntax ([(n ...) (generate-temporaries #'(name ...))])
|
||||
#'(let* ([p prog]
|
||||
[a args]
|
||||
|
|
@ -61,8 +75,8 @@
|
|||
#:argv remainder
|
||||
body ...
|
||||
#:handlers
|
||||
(λ (_ . formals) final-expr)
|
||||
(pimap symbol->string 'formals)
|
||||
(λ (accum . formals) final-expr)
|
||||
arg-help-strs
|
||||
(λ (help-string)
|
||||
(for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80))
|
||||
(newline)
|
||||
|
|
@ -70,7 +84,7 @@
|
|||
(display help-string)
|
||||
(exit))))] ...
|
||||
["help" (help)]
|
||||
[else (help)]))))]))
|
||||
[else (help)])))))]))
|
||||
|
||||
|
||||
;; display-help-message : string string (listof (list string string)) -> void
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user