suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ignore same in paths

Browse Source 
svn: r2995
This commit is contained in:
Eli Barzilay 2006-05-21 08:44:13 +00:00
parent a4c9f75399
commit 0517952105
1 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/setup/unpack.ss
View File

@ -4,6 +4,7 @@
(require (lib "etc.ss") (require (lib "etc.ss")
(lib "inflate.ss") (lib "inflate.ss")
(lib "file.ss") (lib "file.ss")
(lib "list.ss")
(lib "unit.ss") (lib "unit.ss")
(lib "base64.ss" "net") (lib "base64.ss" "net")
(lib "getinfo.ss" "setup") (lib "getinfo.ss" "setup")
@ -38,22 +39,21 @@
(define (shuffle-path parent-dir get-dir shuffle? v) (define (shuffle-path parent-dir get-dir shuffle? v)
(if shuffle? (if shuffle?
;; Re-arrange for "collects', etc. ;; Re-arrange for "collects', etc.
(let ([v (remq* '(same) v)])
(if (null? v) (if (null? v)
(values #f 'same) (values #f 'same)
(let ([dir (cond [(string=? (car v) "collects") (let ([dir
(get-dir find-collects-dir find-user-collects-dir)] (case (string->symbol (car v))
[(string=? (car v) "doc") [(collects) (get-dir find-collects-dir find-user-collects-dir)]
(get-dir find-doc-dir find-user-doc-dir)] [(doc) (get-dir find-doc-dir find-user-doc-dir)]
[(string=? (car v) "lib") [(lib) (get-dir find-lib-dir find-user-lib-dir)]
(get-dir find-lib-dir find-user-lib-dir)] [(include) (get-dir find-include-dir find-user-include-dir)]
[(string=? (car v) "include")
(get-dir find-include-dir find-user-include-dir)]
[else #f])]) [else #f])])
(if dir (if dir
(if (null? (cdr v)) (if (null? (cdr v))
(values dir 'same) (values dir 'same)
(values dir (apply build-path (cdr v)))) (values dir (apply build-path (cdr v))))
(values parent-dir (apply build-path v))))) (values parent-dir (apply build-path v))))))
(values parent-dir (if (null? v) 'same (apply build-path v))))) (values parent-dir (if (null? v) 'same (apply build-path v)))))
(define (unmztar p filter parent-dir get-dir shuffle? print-status) (define (unmztar p filter parent-dir get-dir shuffle? print-status)