From 73f4a8dc74e042da45c3d98a24d65f8eedcad72e Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Fri, 30 May 2008 07:03:01 +0000
Subject: [PATCH] minor printf bug, relative planet paths

svn: r10031
---
 collects/setup/private/path-utils.ss | 31 +++++++++++++++-------------
 collects/setup/setup-unit.ss         |  2 +-
 2 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/collects/setup/private/path-utils.ss b/collects/setup/private/path-utils.ss
index 10fb945b0b..da8fe3387b 100644
--- a/collects/setup/private/path-utils.ss
+++ b/collects/setup/private/path-utils.ss
@@ -3,7 +3,8 @@
 (require setup/dirs
          setup/main-collects
          setup/path-relativize
-         scheme/list)
+         scheme/list
+         (rename-in planet/config [CACHE-DIR planet-dir]))
 
 (provide doc-path path->name)
 
@@ -32,17 +33,19 @@
        path->rel))
    path))
 (define (path->name path #:prefix [prefix #f] #:base [find-base #f])
+  (define (try find-base prefix)
+    (define rel (path->rel path find-base))
+    (and (pair? rel)
+         (let* ([p (cdr (append-map (lambda (p) (list #"/" p)) (cdr rel)))]
+                [p (bytes->string/utf-8 (apply bytes-append p))])
+           (if prefix (format "<~a>/~a" prefix p) p))))
+  (define (->string) (if (string? path) path (path->string path)))
   (if (not (complete-path? path))
-    (if (string? path) path (path->string path))
-    (let loop ([rel (path->rel path find-base)]
-               [prefix prefix])
-      (if (pair? rel)
-        (let* ([p (cdr (append-map (lambda (p) (list #"/" p)) (cdr rel)))]
-               [p (bytes->string/utf-8 (apply bytes-append p))])
-          (if prefix (format "<~a>/~a" prefix p) p))
-        (if (or prefix find-base)
-          (path->string rel)
-          ;; by default (both optionals missing) try the user
-          ;; collections too looping with a prefix avoids trying this
-          ;; again
-          (loop (path->rel path find-user-collects-dir) 'user))))))
+    (->string)
+    (or (try find-base prefix)
+        ;; by default (both optionals missing) try the user
+        ;; collections and planet too
+        (and (not (or prefix find-base))
+             (or (try find-user-collects-dir 'user)
+                 (try planet-dir 'planet)))
+        (->string))))
diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss
index e6f9108a97..3081aa963a 100644
--- a/collects/setup/setup-unit.ss
+++ b/collects/setup/setup-unit.ss
@@ -531,7 +531,7 @@
                         [dep (build-path dir mode-dir (path-add-suffix name #".dep"))])
                    (when (and (file-exists? dep) (file-exists? zo))
                      (set! did-something? #t)
-                     (setup-printf " deleting ~a" (path->name zo))
+                     (setup-printf "deleting" "~a" (path->name zo))
                      (delete-file/record-dependency zo dependencies)
                      (delete-file/record-dependency dep dependencies))))))
             (when did-something? (loop dependencies))))