suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add #:exact-columns option to table-display

Browse Source 
Least invasive change I could think of to solve #1252.
When `--full-checksum` is set, never truncates the checksum column.

Examples:
```
$ raco pkg show typed-racket
Installation-wide:
 Package       Checksum               Source
 typed-racket  32d0a97058b797a8ef...  clone...=typed-racket
User-specific for installation "development":
 [none]
```

```
$ raco pkg show --full-checksum typed-racket
Installation-wide:
 Package       Checksum                                  Source
 typed-racket  32d0a97058b797a8efe794336dde069156b98630  clone...=typed-racket
User-specific for installation "development":
 [none]
```

```
$ raco pkg show --long typed-racket
Installation-wide:
 Package         Checksum                                    Source
 typed-racket    32d0a97058b797a8efe794336dde069156b98630    (clone "/Users/ben/code/racket/fork/extra-pkgs/typed-racket/typed-racket" "git://github.com/racket/typed-racket/?path=typed-racket")
User-specific for installation "development":
 [none]
```
This commit is contained in:
ben 2016-02-23 19:23:03 -05:00
parent 98ba277948
commit c15a357417
1 changed files with 31 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
racket/collects/pkg/private/show.rkt
View File

@ -21,10 +21,6 @@
(raise-user-error name "regular expression flag does not make sense without package names")) (raise-user-error name "regular expression flag does not make sense without package names"))
(define db (read-pkg-db)) (define db (read-pkg-db))
(define pkgs (sort (hash-keys db) string-ci<=?)) (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 auto-shown? #f)
(define to-show (define to-show
(for/list ([pkg (in-list pkgs)] (for/list ([pkg (in-list pkgs)]
@ -41,7 +37,7 @@
pkg pkg
(if auto? "*" "")) (if auto? "*" ""))
(if (or checksum long?) (if (or checksum long?)
(format "~a" (shorten-checksum checksum full-checksum)) (format "~a" checksum)
"") "")
(let ([src (case (car orig-pkg) (let ([src (case (car orig-pkg)
[(link static-link clone) [(link static-link clone)
@ -65,18 +61,24 @@
empty)))) empty))))
(if (null? to-show) (if (null? to-show)
(printf " [none]\n") (printf " [none]\n")
(table-display (let* ([col-headers (list* (format "~aPackage~a"
(if full-checksum +inf.0 long?) indent
(list* 'right 'right 'middle (if auto-shown? "[*=auto]" ""))
(if dir? '(left) '())) "Checksum"
(list* "Source"
(list* (format "~aPackage~a" (if dir? '("Directory") '()))]
indent [checksum-index (for/first ([hdr (in-list col-headers)]
(if auto-shown? "[*=auto]" "")) [i (in-naturals)]
"Checksum" #:when (string=? hdr "Checksum")) i)]
"Source" [exact-columns (if (and full-checksum checksum-index)
(if dir? '("Directory") '())) (list checksum-index)
to-show))) '())])
(table-display
#:exact-columns exact-columns
long?
(list* 'right 'right 'middle
(if dir? '(left) '()))
(list* col-headers to-show))))
(unless (or only-pkgs show-auto?) (unless (or only-pkgs show-auto?)
(define n (for/sum ([pkg (in-list pkgs)] (define n (for/sum ([pkg (in-list pkgs)]
#:when (pkg-info-auto? (hash-ref db pkg))) #:when (pkg-info-auto? (hash-ref db pkg)))
@ -87,7 +89,7 @@
n n
(if (= n 1) "" "s"))))) (if (= n 1) "" "s")))))
(define (table-display long? dots-poses l) (define (table-display long? dots-poses l #:exact-columns [exact-columns '()])
(define how-many-cols (length (first l))) (define how-many-cols (length (first l)))
(define full-max-widths (define full-max-widths
(for/list ([col (in-range how-many-cols)]) (for/list ([col (in-range how-many-cols)])
@ -112,13 +114,15 @@
(* sep (sub1 how-many-cols)))) (* sep (sub1 how-many-cols))))
(cons (car full-max-widths) (cons (car full-max-widths)
(for/list ([(c i) (in-indexed (in-list (cdr full-max-widths)))]) (for/list ([(c i) (in-indexed (in-list (cdr full-max-widths)))])
(define frac (if (memq (+ i 1) exact-columns)
;; Give last column twice the space: c
(if (= i (sub1 how-many-cols)) (let ([frac
(/ 2 how-many-cols) ;; Give last column twice the space:
(/ 1 how-many-cols))) (if (= i (sub1 how-many-cols))
(max 3 (/ 2 how-many-cols)
(floor (* avail frac)))))])) (/ 1 how-many-cols))])
(max 3
(floor (* avail frac)))))))]))
(for ([row (in-list l)]) (for ([row (in-list l)])
(for ([col (in-list row)] (for ([col (in-list row)]
[i (in-naturals 1)] [i (in-naturals 1)]
@ -126,7 +130,8 @@
[dots-pos (in-list dots-poses)]) [dots-pos (in-list dots-poses)])
(define col-width (string-length col)) (define col-width (string-length col))
(printf "~a~a" (printf "~a~a"
(if (col-width . <= . width) (if (or (col-width . <= . width)
(memq (- i 1) exact-columns))
col col
(case dots-pos (case dots-pos
[(right) [(right)