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

Change 'bitmap' to use collection-file-path (with its new #:fail) argument,

Browse Source 
so that it picks up linked collections.

closes 12424

merge to the release branch, please
(cherry picked from commit d93818dd61)
This commit is contained in:
Robby Findler 2012-01-11 11:29:27 -06:00 committed by Ryan Culpepper
parent b7b273895a
commit e6285227f1
1 changed files with 12 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/2htdp/private/image-more.rkt
View File

@ -1271,25 +1271,18 @@
[(null? pieces) [(null? pieces)
(raise-syntax-error 'bitmap "expected a path with a / in it" stx)] (raise-syntax-error 'bitmap "expected a path with a / in it" stx)]
[else [else
(let loop ([cps (current-library-collection-paths)]) (define fn (last pieces))
(cond (define colls (reverse (cdr (reverse pieces))))
[(null? cps) (define candidate
(raise-syntax-error 'bitmap (apply collection-file-path fn colls
(format "could not find the ~a collection" (car pieces)) #:fail
stx)] (λ (msg) (raise-syntax-error 'bitmap msg stx))))
[else (unless (file-exists? candidate)
(if (and (directory-exists? (car cps)) (raise-syntax-error 'bitmap
(member (build-path (car pieces)) (format "could not find ~s, expected it to be in ~a"
(directory-list (car cps)))) arg candidate)
(let ([candidate (apply build-path (car cps) pieces)]) stx))
(if (file-exists? candidate) candidate]))]
candidate
(raise-syntax-error 'bitmap
(format "could not find ~a in the ~a collection"
(apply string-append (add-between (cdr pieces) "/"))
(car pieces))
stx)))
(loop (cdr cps)))]))]))]
[(string? arg) [(string? arg)
(path->complete-path (path->complete-path
arg arg