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

minor printf bug, relative planet paths

Browse Source 
svn: r10031
This commit is contained in:
Eli Barzilay 2008-05-30 07:03:01 +00:00
parent 66cb57f46d
commit 73f4a8dc74
2 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/setup/private/path-utils.ss
View File

@ -3,7 +3,8 @@
(require setup/dirs (require setup/dirs
setup/main-collects setup/main-collects
setup/path-relativize setup/path-relativize
scheme/list) scheme/list
(rename-in planet/config [CACHE-DIR planet-dir]))
(provide doc-path path->name) (provide doc-path path->name)
@ -32,17 +33,19 @@
path->rel)) path->rel))
path)) path))
(define (path->name path #:prefix [prefix #f] #:base [find-base #f]) (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 (not (complete-path? path))
(if (string? path) path (path->string path)) (->string)
(let loop ([rel (path->rel path find-base)] (or (try find-base prefix)
[prefix prefix]) ;; by default (both optionals missing) try the user
(if (pair? rel) ;; collections and planet too
(let* ([p (cdr (append-map (lambda (p) (list #"/" p)) (cdr rel)))] (and (not (or prefix find-base))
[p (bytes->string/utf-8 (apply bytes-append p))]) (or (try find-user-collects-dir 'user)
(if prefix (format "<~a>/~a" prefix p) p)) (try planet-dir 'planet)))
(if (or prefix find-base) (->string))))
(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))))))

2
collects/setup/setup-unit.ss
View File

@ -531,7 +531,7 @@
[dep (build-path dir mode-dir (path-add-suffix name #".dep"))]) [dep (build-path dir mode-dir (path-add-suffix name #".dep"))])
(when (and (file-exists? dep) (file-exists? zo)) (when (and (file-exists? dep) (file-exists? zo))
(set! did-something? #t) (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 zo dependencies)
(delete-file/record-dependency dep dependencies)))))) (delete-file/record-dependency dep dependencies))))))
(when did-something? (loop dependencies)))) (when did-something? (loop dependencies))))