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