~ chicken-core (chicken-5) 16d7e81a1ce457a19d3c59c84e1882a87531831b
commit 16d7e81a1ce457a19d3c59c84e1882a87531831b
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Mar 15 12:52:28 2018 +0100
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun Mar 18 17:28:51 2018 +0100
chicken-status: -cached shows eggs currently in cache
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/chicken-status.scm b/chicken-status.scm
index 984313df..a1aa03d7 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -48,19 +48,31 @@
(define host-extensions #t)
(define target-extensions #t)
+ (define get-terminal-width
+ (let ((default-width 79)) ; Standard default terminal width
+ (lambda ()
+ (let ((cop (current-output-port)))
+ (if (terminal-port? cop)
+ (let ((w (nth-value 1 (terminal-size cop))))
+ (if (zero? w)
+ default-width
+ (min default-width w)))
+ default-width)))))
+
+ (define list-width (quotient (- (get-terminal-width) 2) 2))
+
(define (repo-path)
(if (and cross-chicken (not host-extensions))
- (destination-repository 'target)
- (repository-path)))
+ (destination-repository 'target)
+ (repository-path)))
(define (grep rx lst)
(filter (cut irregex-search rx <>) lst))
- (define (read-info egg)
+ (define (read-info egg #!optional (dir (repo-path))
+ (ext +egg-info-extension+))
(load-egg-info
- (or (chicken.load#find-file
- (make-pathname #f egg +egg-info-extension+)
- (repo-path))
+ (or (chicken.load#find-file (make-pathname #f egg ext) dir)
(error "egg not found" egg))))
(define (filter-eggs patterns mtch)
@@ -94,30 +106,32 @@
(string-append pad str)
(string-append str pad) ) ) )
- (define get-terminal-width
- (let ((default-width 80)) ; Standard default terminal width
- (lambda ()
- (let ((cop (current-output-port)))
- (if (terminal-port? cop)
- (let ((w (nth-value 1 (terminal-size cop))))
- (if (zero? w)
- default-width
- (min default-width w)))
- default-width)))))
+ (define (list-installed-eggs eggs #!optional (dir (repo-path))
+ (ext +egg-info-extension+))
+ (for-each (cut list-egg-info <> dir ext)
+ (sort eggs string<?)))
- (define (list-installed-eggs eggs)
- (let ((w (quotient (- (get-terminal-width) 2) 2)))
- (for-each
- (lambda (egg)
- (let ((version (get-egg-property (read-info egg) 'version)))
- (if version
- (print
- (format-string (string-append egg " ") w #f #\.)
- (format-string
- (string-append " version: " (->string version))
- w #t #\.))
- (print egg))))
- (sort eggs string<?))))
+ (define (list-egg-info egg dir ext)
+ (let ((version
+ (cond ((get-egg-property (read-info egg dir ext)
+ 'version))
+ ((file-exists? (make-pathname (list dir egg)
+ +version-file+))
+ => (lambda (fname)
+ (with-input-from-file fname read)))
+ (else "unknown"))))
+ (print (format-string (string-append egg " ")
+ list-width #f #\.)
+ (format-string (string-append " version: "
+ (->string version))
+ list-width #t #\.))))
+
+ (define (list-cached-eggs)
+ (for-each
+ (lambda (egg)
+ (list-egg-info egg (make-pathname cache-directory egg)
+ +egg-extension+))
+ (sort (directory cache-directory) string<?)))
(define (gather-components lst mode)
(append-map (cut gather-components-rec <> mode) lst))
@@ -186,6 +200,7 @@ usage: chicken-status [OPTION ...] [NAME ...]
-h -help show this message
-version show version and exit
-c -components list installed components
+ -cached list eggs in cache
-f -files list installed files
-list dump installed extensions and their versions in "override" format
-match treat NAME as glob pattern
@@ -201,6 +216,7 @@ EOF
(let ((files #f)
(comps #f)
(dump #f)
+ (cached #f)
(mtch #f))
(let loop ((args args) (pats '()))
(if (null? args)
@@ -208,6 +224,7 @@ EOF
(with-output-to-port (current-error-port)
(cut print "-components cannot be used with -list."))
(exit 1))
+ (cached (list-cached-eggs))
(dump (dump-installed-versions))
(else
(let ((eggs (filter-eggs pats mtch)))
@@ -229,6 +246,9 @@ EOF
((string=? arg "-match")
(set! mtch #t)
(loop (cdr args) pats))
+ ((string=? arg "-cached")
+ (set! cached #t)
+ (loop (cdr args) pats))
((string=? arg "-list")
(set! dump #t)
(loop (cdr args) pats))
diff --git a/manual/Extensions b/manual/Extensions
index 0ad06287..d70931b8 100644
--- a/manual/Extensions
+++ b/manual/Extensions
@@ -622,6 +622,7 @@ Available options:
; {{-target}} : when cross-compiling, show eggs for target system only
; {{-list}} : list installed egg version in format suitable for {{chicken-install -override}} or {{-from-list}}
; {{-c -components}} : list installed components
+; {{-cached}} : list eggs that are locally cached
=== Security
@@ -727,7 +728,7 @@ and for providing a temporary location for building the eggs before
they are installed.
By default the cache is located in the directory
-{{.chicken-install.cache}} is the user's home directory ({{$HOME}} on
+{{.chicken-install/cache}} is the user's home directory ({{$HOME}} on
UNIX, or {{%USERPROFILE%}} on Windows. If the respective environment
variable is not set, then {{/tmp}} or {{/Temp}} is used.
@@ -739,6 +740,8 @@ the first download and re-download is not needed.
{{chicken-install}} tries to take extreme care to avoid stale binaries,
but should you be in doubt, simply delete the directory, or run
{{chicken-install -purge}} to clear the cache or parts of it.
+{{chicken-status -cached}} will list the eggs that are currently
+in the cache.
You can override the location of the cache by setting the
{{CHICKEN_EGG_CACHE}} environment variable.
Trap