From e6285227f1fec8be6e4080eb6991dfe3ace6d6b4 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 11 Jan 2012 11:29:27 -0600 Subject: [PATCH] Change 'bitmap' to use collection-file-path (with its new #:fail) argument, so that it picks up linked collections. closes 12424 merge to the release branch, please (cherry picked from commit d93818dd613942eda80244497fdc139fb1b2bbd3) --- collects/2htdp/private/image-more.rkt | 31 +++++++++++---------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index 3941f60585..2ffd94835d 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/collects/2htdp/private/image-more.rkt @@ -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