fixes to level-of and cp

svn: r3462

collects/setup/unixstyle-install.ss

@@ -46,23 +46,28 @@
   ;; encounter a directory that does not already exist.  #f means that we never
   ;; own directories, only files.
   (define (level-of dir)
-    (cond [(equal? dir "bin")      #f]
+    (let ([dir (string->symbol (->string (basename dir)))])
-          [(equal? dir "collects") 1]
+      (case dir
-          [(equal? dir "doc")      1]
+        [(bin)      #f]
-          [(equal? dir "include")  1]
+        [(collects) 1]
+        [(doc)      1]
+        [(include)  1]
         ;; if shared libraries are used, then these files should be moved
         ;; independently, as if they had a level of #f
-          [(equal? dir "lib")      1]
+        [(dir)      1]
-          [(equal? dir "man")      #f]
+        [(man)      #f]
-          [(equal? dir "src")      1]
+        [(src)      1]
-          [(equal? dir "readme.txt") #f] ; moved last
+        [(readme.txt) #f] ; moved last
-          [else (error 'level-of "internal-error: unknown dir ~e" dir)]))
+        [else (error 'level-of "internal-error: unknown dir ~e" dir)])))
 
   (define (->string x)
     (if (path? x) (path->string x) x))
 
+  (define (basename path)
+    (let-values ([(dir name dir?) (split-path path)]) name))
+
   (define (dirname path)
-    (let-values ([(base name dir?) (split-path path)]) base))
+    (let-values ([(dir name dir?) (split-path path)]) dir))
 
   ;; convenient wrapper for a simple subprocess
   (define (run cmd . args)
@@ -94,7 +99,7 @@
       (let ([time! (lambda ()
                      (file-or-directory-modify-seconds
                       dst (file-or-directory-modify-seconds src)))])
-        (cond [(copy-skip-filter (if (path? src) (path->string src) src)) 'skip]
+        (cond [(copy-skip-filter (->string (basename src))) 'skip]
               [(link-exists? src)
                ;; symlinks are impossible to do in Scheme now: can't make
                ;; arbitrary ones