From a360616c4e590d5e44b25d2f6d4ada0f29d2591e Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sat, 16 Jan 2016 16:57:22 +0100
Subject: [PATCH 2/3] Add -prefix support to chicken-{uninstall,status}

This can be helpful when managing deployed programs.
---
 NEWS                  |  6 ++++++
 chicken-status.scm    | 10 ++++++++++
 chicken-uninstall.scm | 10 ++++++++++
 manual/Extensions     |  2 ++
 setup-api.scm         |  6 +++++-
 5 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/NEWS b/NEWS
index 188e06d..e17aba0 100644
--- a/NEWS
+++ b/NEWS
@@ -89,6 +89,12 @@
     has been lifted for platforms which had no apply hack.
   - Increased the "binary compatibility version" to 8.
 
+- Tools
+  - "chicken-uninstall"
+    - A -prefix option was added, matching chicken-install's -prefix.
+  - "chicken-status"
+    - A -prefix option was added, matching chicken-install's -prefix.
+
 4.10.0
 
 - Security fixes
diff --git a/chicken-status.scm b/chicken-status.scm
index e6f6c72..435c9fe 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -143,6 +143,7 @@ usage: chicken-status [OPTION | PATTERN] ...
        -exact                   treat PATTERN as exact match (not a pattern)
        -host                    when cross-compiling, show status of host extensions only
        -target                  when cross-compiling, show status of target extensions only
+  -p   -prefix PREFIX           change installation prefix to PREFIX
        -list                    dump installed extensions and their versions in "override" format
   -e   -eggs                    list installed eggs
 EOF
@@ -199,6 +200,15 @@ EOF
 		    ((string=? arg "-target")
 		     (set! *host-extensions* #f)
 		     (loop (cdr args) pats))
+		    ((or (string=? arg "-p") (string=? arg "-prefix"))
+		     (unless (pair? (cdr args)) (usage 1))
+		     (repository-path
+		      (let ((p (cadr args)))
+			(if (absolute-pathname? p)
+			    p
+			    (normalize-pathname 
+			     (make-pathname (current-directory) p) ) ) ) )
+		     (loop (cddr args) pats))
 		    ((string=? arg "-exact")
 		     (set! exact #t)
 		     (loop (cdr args) pats))
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index fbee0f2..be092a2 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -110,6 +110,7 @@ usage: chicken-uninstall [OPTION | PATTERN] ...
        -force                   don't ask, delete whatever matches
        -exact                   treat PATTERN as exact match (not a pattern)
   -s   -sudo                    use sudo(1) for deleting files
+  -p   -prefix PREFIX           change installation prefix to PREFIX
        -host                    when cross-compiling, uninstall host extensions only
        -target                  when cross-compiling, uninstall target extensions only
 EOF
@@ -155,6 +156,15 @@ EOF
 		       ((or (string=? arg "-s") (string=? arg "-sudo"))
 			(sudo-install #t)
 			(loop (cdr args) pats))
+		       ((or (string=? arg "-p") (string=? arg "-prefix"))
+			(unless (pair? (cdr args)) (usage 1))
+			(repository-path
+			 (let ((p (cadr args)))
+			   (if (absolute-pathname? p)
+			       p
+			       (normalize-pathname 
+				(make-pathname (current-directory) p) ) ) ) )
+			(loop (cddr args) pats))
 		       ((and (positive? (string-length arg))
 			     (char=? #\- (string-ref arg 0)))
 			(if (> (string-length arg) 2)
diff --git a/manual/Extensions b/manual/Extensions
index 55cd124..5ca1935 100644
--- a/manual/Extensions
+++ b/manual/Extensions
@@ -589,6 +589,7 @@ Available options:
 ; {{-version}} : show version and exit
 ; {{-force}} : don't ask, delete whatever matches
 ; {{-s   -sudo}} : use {{sudo(1)}} for deleting files
+; {{-p   -prefix PREFIX}} : change installation prefix to {{PREFIX}}
 ; {{-host}} : when cross-compiling, remove extensions for host system only
 ; {{-target}} : when cross-compiling, remove extensions for target system only
 ; {{-exact}} : match extension-name exactly (do not match as pattern)
@@ -600,6 +601,7 @@ Available options:
 ; {{-f   -files}} : list installed files
 ; {{-host}} : when cross-compiling, show extensions for host system only
 ; {{-target}} : when cross-compiling, show extensions for target system only
+; {{-p   -prefix PREFIX}} : change installation prefix to {{PREFIX}}
 ; {{-exact}} : match extension-name exactly (do not match as pattern)
 ; {{-list}} : list installed egg version in format suitable for {{chicken-install -override}}
 
diff --git a/setup-api.scm b/setup-api.scm
index 4c679ba..b770416 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -637,7 +637,11 @@
 
 (define (remove-extension egg #!optional (repo (repository-path)))
   (and-let* ((files (assq 'files (read-info egg repo))))
-    (for-each remove-file* (cdr files)))
+    (for-each
+     (lambda (f)
+       (let ((p (if (absolute-pathname? f) f (make-pathname repo f))))
+	 (remove-file* p)))
+     (cdr files)))
   (remove-file* (make-pathname repo egg setup-file-extension)))
 
 (define ($system str)
-- 
2.1.4