fix raco pkg show --rx on bad patterns
Fix error reporting so it's not an internal error. Also, report errors before printing a scope, and update the docs for earlier changes. Closes #1251
This commit is contained in:
Matthew Flatt
parent
13ebd0e1c8
commit
c0bbfe8237
|
|
@ -399,19 +399,32 @@ The @racket[name] parameter is the name of the new package.
|
|||
|
||||
|
||||
@defproc[(pkg-show [indent string?]
|
||||
[pkgs-or-patterns (or/c #f (listof string?))]
|
||||
[#:prefix-line prefix-line (or/c #f string?) #f]
|
||||
[#:auto? auto? boolean? #f]
|
||||
[#:rx? rx? boolean? #f]
|
||||
[#:long? long? boolean? #f]
|
||||
[#:full-checksum? full-checksum? boolean? #f]
|
||||
[#:directory show-dir? boolean? #f])
|
||||
void?]{
|
||||
|
||||
Implements @racket[pkg-show-command] for a single package scope,
|
||||
printing to the current output port. See also
|
||||
printing to the current output port. If @racket[prefix-line]s is not
|
||||
@racket[#f], it is printed before the output. See also
|
||||
@racket[installed-pkg-names] and @racket[installed-pkg-table].
|
||||
|
||||
If @racket[pkgs-or-patterns] is @racket[#f], then information is shown
|
||||
for all installed packages, otherwise only matching packages are shown.
|
||||
In @racket[rx?] is true, then elements of @racket[pkgs-or-patterns]
|
||||
are treated as regular expression patterns, otherwise they are treated
|
||||
as package names.
|
||||
|
||||
The package lock must be held to allow reads; see
|
||||
@racket[with-pkg-lock/read-only].
|
||||
|
||||
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:long?] argument.}]}
|
||||
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:long?] argument.}
|
||||
#:changed "6.1.1.6" @elem{Added the @racket[#:full-checksum?] and @racket[#:rx?] arguments.}
|
||||
#:changed "6.5.0.1" @elem{Added the @racket[#:prefix-line] argument.}]}
|
||||
|
||||
|
||||
@defproc[(pkg-migrate [from-version string?]
|
||||
|
|
|
|||
|
|
@ -134,11 +134,12 @@
|
|||
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
|
||||
[pkg-show
|
||||
(->* (string? (or/c #f (listof string?)))
|
||||
(#:directory? boolean?
|
||||
#:long? boolean?
|
||||
#:auto? boolean?
|
||||
#:full-checksum? boolean?
|
||||
#:rx? boolean?)
|
||||
(#:prefix-line (or/c #f string?)
|
||||
#:directory? boolean?
|
||||
#:long? boolean?
|
||||
#:auto? boolean?
|
||||
#:full-checksum? boolean?
|
||||
#:rx? boolean?)
|
||||
void?)]
|
||||
[pkg-install
|
||||
(->* ((listof pkg-desc?))
|
||||
|
|
|
|||
|
|
@ -395,7 +395,7 @@
|
|||
[#:bool all ("-a") "Show auto-installed packages, too"]
|
||||
[#:bool long ("-l") "Show full column content"]
|
||||
[#:bool full-checksum () "Show the full checksum"]
|
||||
[#:bool rx () "Treat <pkgs> as regular expressions"]
|
||||
[#:bool rx () "Treat <pkg>s as regular expressions"]
|
||||
[#:bool dir ("-d") "Show the directory where the package is installed"]
|
||||
#:once-any
|
||||
scope-flags ...
|
||||
|
|
@ -420,17 +420,19 @@
|
|||
(simple-form-path d)))))
|
||||
'(user)))])
|
||||
(when (or (equal? mode only-mode) (not only-mode))
|
||||
(unless only-mode
|
||||
(printf "~a\n" (case mode
|
||||
[(installation) "Installation-wide:"]
|
||||
[(user) (format "User-specific for installation ~s:"
|
||||
(or version (get-installation-name)))]
|
||||
[else (format "~a:" mode)])))
|
||||
(define prefix-line
|
||||
(and (not only-mode)
|
||||
(case mode
|
||||
[(installation) "Installation-wide:"]
|
||||
[(user) (format "User-specific for installation ~s:"
|
||||
(or version (get-installation-name)))]
|
||||
[else (format "~a:" mode)])))
|
||||
(parameterize ([current-pkg-scope mode]
|
||||
[current-pkg-error (pkg-error 'show)]
|
||||
[current-pkg-scope-version (or version (get-installation-name))])
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-show (if only-mode "" " ") pkgs*
|
||||
#:prefix-line prefix-line
|
||||
#:auto? all
|
||||
#:long? long
|
||||
#:rx? rx
|
||||
|
|
|
|||
|
|
@ -6,26 +6,34 @@
|
|||
racket/path
|
||||
"../path.rkt"
|
||||
"dirs.rkt"
|
||||
"pkg-db.rkt")
|
||||
"pkg-db.rkt"
|
||||
"print.rkt")
|
||||
|
||||
(provide pkg-show)
|
||||
|
||||
(define (pkg-show indent only-pkgs
|
||||
#:prefix-line [prefix-line #f]
|
||||
#:directory? [dir? #f]
|
||||
#:auto? [show-auto? #f]
|
||||
#:full-checksum? [full-checksum #f]
|
||||
#:long? [long? #t]
|
||||
#:rx? [rx #f]
|
||||
#:rx? [rx? #f]
|
||||
#:name [name 'pkg-show])
|
||||
(when (and rx (not only-pkgs))
|
||||
(raise-user-error name "regular expression flag does not make sense without package names"))
|
||||
(when rx?
|
||||
(when (not only-pkgs)
|
||||
(pkg-error "regular-expression mode requires at least one pattern"))
|
||||
(for ([str (in-list only-pkgs)])
|
||||
(regexp str (lambda (s)
|
||||
(pkg-error (~a "bad regular-expression pattern;\n"
|
||||
" " s "\n"
|
||||
" in: " str))))))
|
||||
(define db (read-pkg-db))
|
||||
(define pkgs (sort (hash-keys db) string-ci<=?))
|
||||
(define auto-shown? #f)
|
||||
(define to-show
|
||||
(for/list ([pkg (in-list pkgs)]
|
||||
#:unless (and only-pkgs
|
||||
(not (memf (λ (v) (if rx (regexp-match? v pkg) (equal? v pkg)))
|
||||
(not (memf (λ (v) (if rx? (regexp-match? v pkg) (equal? v pkg)))
|
||||
only-pkgs)))
|
||||
#:when (or show-auto? only-pkgs
|
||||
(not (pkg-info-auto? (hash-ref db pkg)))))
|
||||
|
|
@ -59,6 +67,8 @@
|
|||
(~s p)
|
||||
(~a p))))
|
||||
empty))))
|
||||
(when prefix-line
|
||||
(printf "~a\n" prefix-line))
|
||||
(if (null? to-show)
|
||||
(printf " [none]\n")
|
||||
(let* ([col-headers (list* (format "~aPackage~a"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user