From 4072898a0d3b1e7a4a4f0fab2b8593ab8520a85e Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 15 Mar 2018 12:52:28 +0100
Subject: [PATCH 2/3] chicken-status: -cached shows eggs currently in cache

---
 chicken-status.scm |   74 +++++++++++++++++++++++++++++++++-------------------
 manual/Extensions  |    5 +++-
 2 files changed, 51 insertions(+), 28 deletions(-)

diff --git a/chicken-status.scm b/chicken-status.scm
index 984313d..3401f08 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -48,6 +48,19 @@
   (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)
@@ -56,11 +69,10 @@
   (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 0ad0628..d70931b 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.
-- 
1.7.9.5