~ chicken-core (chicken-5) 09ce2d5a44633c1ab86f4a04aa72ee4abf315752
commit 09ce2d5a44633c1ab86f4a04aa72ee4abf315752
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Jun 10 00:18:51 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Jun 10 00:18:51 2010 +0200
-target options for chicken-status and -uninstall
diff --git a/chicken-install.scm b/chicken-install.scm
index fe6ac867..d835916b 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -457,7 +457,11 @@
(current-directory "tests")
(command "~a -s run.scm ~a ~a" *csi* (car e+d+v) (caddr e+d+v))
(set! *running-test* #f))))))
- (setup eggdir)
+ (if (and *target-extension* *host-extension*)
+ (fluid-let ((*deploy* #f)
+ (*prefix* #f))
+ (setup eggdir))
+ (setup eggdir))
(when (and *target-extension* *host-extension*)
(print "installing for target ...")
(fluid-let ((*host-extension* #f))
diff --git a/chicken-status.scm b/chicken-status.scm
index 7cd96797..6ff31bbf 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -36,10 +36,12 @@
(define-foreign-variable C_TARGET_LIB_HOME c-string)
(define-foreign-variable C_BINARY_VERSION int)
- (define *host-extensions* #f)
+ (define *cross-chicken* (feature? #:cross-chicken))
+ (define *host-extensions* *cross-chicken*)
+ (define *target-extensions* *cross-chicken*)
(define (repo-path)
- (if (and (feature? #:cross-chicken) (not *host-extensions*))
+ (if (and *cross-chicken* (not *host-extensions*))
(make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION))
(repository-path)))
@@ -102,7 +104,8 @@ usage: chicken-status [OPTION | PATTERN] ...
-h -help show this message
-v -version show version and exit
-f -files list installed files
- -host when cross-compiling, show status of host extensions
+ -host when cross-compiling, show status of host extensions only
+ -target when cross-compiling, show status of target extensions only
EOF
);|
(exit code))
@@ -113,7 +116,15 @@ EOF
(let ((files #f))
(let loop ((args args) (pats '()))
(if (null? args)
- (let ((eggs (gather-eggs (if (null? pats) '(".*") pats))))
+ (let* ((patterns (if (null? pats) '(".*") pats))
+ (eggs1 (gather-eggs patterns))
+ (eggs
+ (if (and *host-extensions* *target-extensions*)
+ (append
+ eggs1
+ (fluid-let ((*host-extensions* #f))
+ (gather-eggs patterns)))
+ eggs1)))
(if (null? eggs)
(print "(none)")
((if files list-installed-files list-installed-eggs)
@@ -124,7 +135,10 @@ EOF
(string=? arg "--help"))
(usage 0))
((string=? arg "-host")
- (set! *host-extensions* #t)
+ (set! *target-extensions* #f)
+ (loop (cdr args) pats))
+ ((string=? arg "-target")
+ (set! *host-extensions* #f)
(loop (cdr args) pats))
((or (string=? arg "-f") (string=? arg "-files"))
(set! files #t)
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index 7bd1366d..268ff9c3 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -38,10 +38,12 @@
(define-foreign-variable C_TARGET_LIB_HOME c-string)
(define-foreign-variable C_BINARY_VERSION int)
- (define *host-extensions* #f)
+ (define *cross-chicken* (feature? #:cross-chicken))
+ (define *host-extensions* *cross-chicken*)
+ (define *target-extensions* *cross-chicken*)
(define (repo-path)
- (if (and (feature? #:cross-chicken) (not *host-extensions*))
+ (if (and *cross-chicken* (not *host-extensions*))
(make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION))
(repository-path)))
@@ -80,7 +82,11 @@
(for-each
(lambda (e)
(print "removing " e)
- (remove-extension e) )
+ (when *host-extensions*
+ (remove-extension e))
+ (when *target-extensions*
+ (fluid-let ((*host-extensions* #f))
+ (remove-extension e (repo-path)) )))
eggs)))))
(define (usage code)
@@ -91,7 +97,8 @@ usage: chicken-uninstall [OPTION | PATTERN] ...
-v -version show version and exit
-force don't ask, delete whatever matches
-s -sudo use sudo(1) for deleting files
- -host when cross-compiling, uninstall host extensions
+ -host when cross-compiling, uninstall host extensions only
+ -target when cross-compiling, uninstall target extensions only
EOF
);|
(exit code))
@@ -110,8 +117,11 @@ EOF
((or (string=? arg "-v") (string=? arg "-version"))
(print (chicken-version))
(exit 0))
+ ((string=? arg "-target")
+ (set! *host-extensions* #f)
+ (loop (cdr args) pats))
((string=? arg "-host")
- (set! *host-extensions* #t)
+ (set! *target-extensions* #f)
(loop (cdr args) pats))
((string=? arg "-force")
(set! *force* #t)
diff --git a/setup-api.scm b/setup-api.scm
index 243e2eff..1fb8e744 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -771,10 +771,10 @@
files)
(delete-directory dir)))) ))
-(define (remove-extension egg)
+(define (remove-extension egg #!optional (repo (repository-path)))
(and-let* ((files (assq 'files (read-info egg))))
(for-each remove-file* (cdr files)))
- (remove-file* (make-pathname (repository-path) egg "setup-info")))
+ (remove-file* (make-pathname repo egg "setup-info")))
(define ($system str)
(let ((r (system
Trap