~ chicken-core (chicken-5) f385034f4e1bffa298cf0baf9f40ad09de5561a0

commit f385034f4e1bffa298cf0baf9f40ad09de5561a0
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Apr 21 21:59:16 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Apr 21 21:59:16 2011 +0200

    chicken-install -scan

diff --git a/chicken-install.scm b/chicken-install.scm
index f567f533..dbca988e 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -38,6 +38,7 @@
   (import foreign)
 
   (define +default-repository-files+
+    ;;XXX keep this up-to-date!
     '("setup-api.so" "setup-api.import.so"
       "setup-download.so" "setup-download.import.so"
       "chicken.import.so"
@@ -578,6 +579,12 @@
 	(print "mapped " eggs " to " eggs2))
       eggs2))
 
+  (define (scan-directory dir)
+    (for-each
+     (lambda (info)
+       (pp (cons (car info) (cadr info))))
+     (gather-egg-information dir)))      
+
   (define ($system str)
     (let ((r (system
               (if *windows-shell*
@@ -619,6 +626,7 @@ usage: chicken-install [OPTION | EXTENSION[:VERSION]] ...
   -D   -feature FEATURE         features to pass to sub-invocations of `csc'
        -debug                   enable full display of error message information
        -keep-going              continue installation even if dependency fails
+       -scan DIRECTORY          scan local directory for highest available egg versions
 EOF
 );|
     (exit code))
@@ -639,6 +647,7 @@ EOF
 
   (define (main args)
     (let ((update #f)
+	  (scan #f)
           (rx (irregex "([^:]+):(.+)")))
       (setup-proxy (get-environment-variable "http_proxy"))
       (let loop ((args args) (eggs '()))
@@ -647,6 +656,7 @@ EOF
 		      (error 
 		       "`-deploy' only makes sense in combination with `-prefix DIRECTORY`"))
 		     (update (update-db))
+		     (scan (scan-directory scan))
                      (else
 		      (let ((defaults (load-defaults)))
 			(when (null? eggs)
@@ -754,6 +764,10 @@ EOF
                         (unless (pair? (cdr args)) (usage 1))
                         (set! *username* (cadr args))
                         (loop (cddr args) eggs))
+		       ((string=? "-scan" arg)
+                        (unless (pair? (cdr args)) (usage 1))
+			(set! scan (cadr args))
+			(loop (cddr args) eggs))
 		       ((string=? "-trunk" arg)
 			(set! *trunk* #t)
 			(loop (cdr args) eggs))
diff --git a/setup-download.scm b/setup-download.scm
index 91ae67dd..f596d5bd 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -127,7 +127,7 @@
 		    sos)))
 	       (values src ver))))))
 
-  (define (gather-egg-information dir)	; used by salmonella
+  (define (gather-egg-information dir)	; used by salmonella (among others)
     (let ((ls (directory dir)))
       (filter-map
        (lambda (egg)