diff --git a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 5921a8fe60..205dcc3cf8 100644 --- a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -726,11 +726,14 @@ package is created. @history[#:added "6.1.1.5"]} -@subcommand{@command/toc{show} @nonterm{option} ... --- Print information about currently installed packages. +@subcommand{@command/toc{show} @nonterm{option} ... @nonterm{pkg} ... --- Print information about currently installed packages. If @nonterm{pkg}s are specified, then only those packages are shown. By default, packages are shown for all @tech{package scopes}, but only for packages - not marked as auto-installed to fulfill dependencies. Unless @Flag{l} or @DFlag{long} is specified, + not marked as auto-installed to fulfill dependencies. If a package is + explicitly specified, it is shown even if it is marked as + auto-installed. Unless @Flag{l} or @DFlag{long} is specified, the output is roughly constrained to 80 columns or the number of columns specified by the @envvar{COLUMNS} - environment variable. + environment variable. Unless @DFlag{full-checksum} is specified, + checksums are abbreviated to 8 characters. The @exec{show} sub-command accepts the following @nonterm{option}s: @@ -739,7 +742,12 @@ package is created. @item{@Flag{a} or @DFlag{all} --- Includes auto-installed packages in the listing.} @item{@Flag{l} or @DFlag{long} --- Show complete columns, instead of abbreviating to a width, - and use a more regular (but less human-readable) format for some columns.} + and use a more regular (but less + human-readable) format for some columns.} + @item{@DFlag{rx} --- Treat the @nonterm{pkg}s as regular expressions + for displaying specific packages.} + @item{@DFlag{full-checksum} --- Print the full instead of the + abbreviated checksum.} @item{@Flag{d} or @DFlag{dir} --- Adds a column in the output for the directory where the package is installed.} @item{@DFlag{scope} @nonterm{scope} --- Shows only packages in @nonterm{scope}, which is one of @@ -756,7 +764,10 @@ package is created. the installation name/version @nonterm{vers}.} ] -@history[#:changed "6.1.1.5" @elem{Added @Flag{l}/@DFlag{--long} and @envvar{COLUMNS} support.}]} +@history[#:changed "6.1.1.5" @elem{Added @Flag{l}/@DFlag{long} and +@envvar{COLUMNS} support.} + #:changed "6.1.1.6" @elem{Added explicit @nonterm{pkg}s and + @DFlag{rx} and @DFlag{full-sha}.}]} @subcommand{@command/toc{migrate} @nonterm{option} ... @nonterm{from-version} --- Installs packages that were previously installed in @exec{user} diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index a7db4c1ba1..708f902dcb 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -127,10 +127,12 @@ #:demote? boolean?) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-show - (->* (string?) + (->* (string? (or/c #f (listof string?))) (#:directory? boolean? #:long? boolean? - #:auto? 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 7a4f4d3a27..398cf35fa4 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -391,11 +391,13 @@ #:once-each [#: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 dir ("-d") "Show the directory where the package is installed"] #:once-any scope-flags ... [(#:str vers #f) version ("-v") "Show user-specific for installation "] - #:args () + #:args pkg (define only-mode (case scope [(installation user) scope] [else @@ -404,6 +406,7 @@ [installation 'installation] [user 'user] [else (if version 'user #f)])])) + (define pkgs* (if (pair? pkg) pkg #f)) (for ([mode (if only-mode (list only-mode) (append (let ([main (find-pkgs-dir)]) @@ -424,9 +427,11 @@ [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 "" " ") + (pkg-show (if only-mode "" " ") pkgs* #:auto? all #:long? long + #:rx? rx + #:full-checksum? full-checksum #:directory? dir)))))] ;; ---------------------------------------- [migrate diff --git a/racket/collects/pkg/private/show.rkt b/racket/collects/pkg/private/show.rkt index 52d596ff0a..9321325b10 100644 --- a/racket/collects/pkg/private/show.rkt +++ b/racket/collects/pkg/private/show.rkt @@ -10,65 +10,75 @@ (provide pkg-show) -(define (pkg-show indent +(define (pkg-show indent only-pkgs #:directory? [dir? #f] #:auto? [show-auto? #f] - #:long? [long? #t]) - (let () - (define db (read-pkg-db)) - (define pkgs (sort (hash-keys db) string-ci<=?)) - (if (null? pkgs) + #:full-checksum? [full-checksum #f] + #:long? [long? #t] + #: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")) + (define db (read-pkg-db)) + (define pkgs (sort (hash-keys db) string-ci<=?)) + (define (shorten-checksum s full) + (if (or full (not (string? s)) (< (string-length s) 11)) + s + (~a (substring s 0 (min 8 (string-length s))) "..."))) + (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))) + only-pkgs))) + #:when (or show-auto? only-pkgs + (not (pkg-info-auto? (hash-ref db pkg))))) + (match-define (pkg-info orig-pkg checksum auto?) (hash-ref db pkg)) + (when auto? (set! auto-shown? #t)) + (append + (list (format "~a~a~a" + indent + pkg + (if auto? "*" "")) + (if (or checksum long?) + (format "~a" (shorten-checksum checksum full-checksum)) + "") + (let ([src (case (car orig-pkg) + [(link static-link clone) + (list* (car orig-pkg) + (path->string + (simple-form-path + (path->complete-path (cadr orig-pkg) + (pkg-installed-dir)))) + (cddr orig-pkg))] + [else orig-pkg])]) + (if long? + (~s src) + (apply ~a #:separator " " src)))) + (if dir? + (let ([p (path->string + (simple-form-path + (pkg-directory* pkg #:db db)))]) + (list (if long? + (~s p) + (~a p)))) + empty)))) + (if (null? to-show) (printf " [none]\n") (begin (table-display long? - (append '(right right middle) - (if dir? - '(left) - '())) + (list* 'right 'right 'middle + (if dir? '(left) '())) (list* - (append - (list (format "~aPackage~a" + (list* (format "~aPackage~a" indent - (if show-auto? "[*=auto]" "")) + (if auto-shown? "[*=auto]" "")) "Checksum" - "Source") - (if dir? - (list "Directory") - empty)) - (for/list ([pkg (in-list pkgs)] - #:when (or show-auto? - (not (pkg-info-auto? (hash-ref db pkg))))) - (match-define (pkg-info orig-pkg checksum auto?) (hash-ref db pkg)) - (append - (list (format "~a~a~a" - indent - pkg - (if auto? "*" "")) - (if (or checksum long?) - (format "~a" checksum) - "") - (let ([src (case (car orig-pkg) - [(link static-link clone) - (list* (car orig-pkg) - (path->string - (simple-form-path - (path->complete-path (cadr orig-pkg) - (pkg-installed-dir)))) - (cddr orig-pkg))] - [else orig-pkg])]) - (if long? - (~s src) - (apply ~a #:separator " " src)))) - (if dir? - (let ([p (path->string - (simple-form-path - (pkg-directory* pkg #:db db)))]) - (list (if long? - (~s p) - (~a p)))) - empty))))) - (unless show-auto? + "Source" + (if dir? '("Directory") '())) + to-show)) + (unless (or only-pkgs show-auto?) (define n (for/sum ([pkg (in-list pkgs)] #:when (pkg-info-auto? (hash-ref db pkg))) 1)) @@ -76,7 +86,7 @@ (printf "~a[~a auto-installed package~a not shown]\n" indent n - (if (= n 1) "" "s")))))))) + (if (= n 1) "" "s"))))))) (define (table-display long? dots-poses l) (define how-many-cols (length (first l))) @@ -94,23 +104,22 @@ 80)) (define max-widths (cond - [(or long? - ((apply + full-max-widths) . < . (- COLUMNS (* sep (sub1 how-many-cols))))) - full-max-widths] - [else - (define avail (- COLUMNS - (car full-max-widths) - (* sep (sub1 how-many-cols)))) - (cons (car full-max-widths) - (for/list ([c (in-list (cdr full-max-widths))] - [i (in-naturals 1)]) - (define frac - ;; Give last column twice the space: - (if (= i (sub1 how-many-cols)) - (/ 2 how-many-cols) - (/ 1 how-many-cols))) - (max 3 - (floor (* avail frac)))))])) + [(or long? + ((apply + full-max-widths) . < . (- COLUMNS (* sep (sub1 how-many-cols))))) + full-max-widths] + [else + (define avail (- COLUMNS + (car full-max-widths) + (* sep (sub1 how-many-cols)))) + (cons (car full-max-widths) + (for/list ([(c i) (in-indexed (in-list (cdr full-max-widths)))]) + (define frac + ;; Give last column twice the space: + (if (= i (sub1 how-many-cols)) + (/ 2 how-many-cols) + (/ 1 how-many-cols))) + (max 3 + (floor (* avail frac)))))])) (for ([row (in-list l)]) (for ([col (in-list row)] [i (in-naturals 1)]