diff --git a/pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-doc/pkg/scribblings/lib.scrbl index fd0dd53397..206204b1b7 100644 --- a/pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -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?] diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 9b686a63ed..f221671335 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -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?)) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 6091fbbe2b..3ee8c1d18c 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -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 as regular expressions"] + [#:bool rx () "Treat 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 diff --git a/racket/collects/pkg/private/show.rkt b/racket/collects/pkg/private/show.rkt index 140dc9ba7f..184e226191 100644 --- a/racket/collects/pkg/private/show.rkt +++ b/racket/collects/pkg/private/show.rkt @@ -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"