From 83cde5c8fb7ba7dd6bd76a8cf239022f214182d9 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 25 Jul 2010 15:15:57 -0500 Subject: [PATCH] got rid of some uses of collection-path --- collects/drracket/installer.rkt | 38 +++++++++---------- collects/drracket/private/app.rkt | 9 +++-- .../drracket/private/bindings-browser.rkt | 8 ++-- collects/drracket/private/drracket-normal.rkt | 20 +++++----- collects/drracket/private/eb.rkt | 4 +- .../private/language-configuration.rkt | 12 ++---- collects/drracket/private/language.rkt | 8 ++-- collects/drracket/private/main.rkt | 9 +++-- collects/drracket/private/rep.rkt | 2 +- collects/drracket/private/stick-figures.rkt | 8 ++-- collects/drracket/private/tools-drs.rkt | 2 +- collects/drracket/private/tools.rkt | 4 +- collects/drracket/private/unit.rkt | 6 +-- .../drracket/syncheck-drracket-button.rkt | 2 +- collects/framework/splash.rkt | 2 +- collects/games/main.rkt | 15 ++++++-- .../games/paint-by-numbers/all-problems.rkt | 2 +- collects/games/slidey/slidey.rkt | 7 +--- 18 files changed, 77 insertions(+), 81 deletions(-) diff --git a/collects/drracket/installer.rkt b/collects/drracket/installer.rkt index 1ffaaf40da..25e8192bc8 100644 --- a/collects/drracket/installer.rkt +++ b/collects/drracket/installer.rkt @@ -1,21 +1,19 @@ #lang racket/base - (require mzlib/file - mzlib/etc - launcher) - (provide installer) - - (define (installer plthome) - (do-installation) - (set! do-installation void)) - - (define (do-installation) - (for-each install-variation (available-mred-variants))) - - (define (install-variation variant) - (parameterize ([current-launcher-variant variant]) - (make-mred-launcher - (list "-ZmvqL" "drracket.rkt" "drracket") - (mred-program-launcher-path "DrScheme") - (cons - `(exe-name . "DrRacket") - (build-aux-from-path (build-path (collection-path "drracket") "drracket")))))) +(require launcher) +(provide installer) + +(define (installer plthome) + (do-installation) + (set! do-installation void)) + +(define (do-installation) + (for-each install-variation (available-mred-variants))) + +(define (install-variation variant) + (parameterize ([current-launcher-variant variant]) + (make-mred-launcher + (list "-ZmvqL" "drracket.rkt" "drracket") + (mred-program-launcher-path "DrScheme") + (cons + `(exe-name . "DrRacket") + (build-aux-from-path (build-path (collection-path "drracket") "drracket")))))) diff --git a/collects/drracket/private/app.rkt b/collects/drracket/private/app.rkt index b6fe9acca8..566d187200 100644 --- a/collects/drracket/private/app.rkt +++ b/collects/drracket/private/app.rkt @@ -70,10 +70,11 @@ (define (get-plt-bitmap) (make-object bitmap% - (build-path (collection-path "icons") - (if (< (get-display-depth) 8) - "pltbw.gif" - "plt-logo-red-shiny.png")))) + (build-path (collection-file-path + (if (< (get-display-depth) 8) + "pltbw.gif" + "plt-logo-red-shiny.png") + "icons")))) diff --git a/collects/drracket/private/bindings-browser.rkt b/collects/drracket/private/bindings-browser.rkt index 07af7ddc00..855ae8b940 100644 --- a/collects/drracket/private/bindings-browser.rkt +++ b/collects/drracket/private/bindings-browser.rkt @@ -257,10 +257,10 @@ Marshalling (and hence the 'read' method of the snipclass omitted for fast proto (define (set-box/f! b v) (when (box? b) (set-box! b v))) - (define down-bitmap (make-object bitmap% (build-path (collection-path "icons") "turn-down.png"))) - (define up-bitmap (make-object bitmap% (build-path (collection-path "icons") "turn-up.png"))) - (define down-click-bitmap (make-object bitmap% (build-path (collection-path "icons") "turn-down-click.png"))) - (define up-click-bitmap (make-object bitmap% (build-path (collection-path "icons") "turn-up-click.png"))) + (define down-bitmap (make-object bitmap% (collection-file-path "turn-down.png" "icons"))) + (define up-bitmap (make-object bitmap% (collection-file-path "turn-up.png" "icons"))) + (define down-click-bitmap (make-object bitmap% (collection-file-path "turn-down-click.png" "icons"))) + (define up-click-bitmap (make-object bitmap% (collection-file-path "turn-up-click.png" "icons"))) (define arrow-snip-height (max 10 (send up-bitmap get-height) diff --git a/collects/drracket/private/drracket-normal.rkt b/collects/drracket/private/drracket-normal.rkt index 369bf84662..350d459a29 100644 --- a/collects/drracket/private/drracket-normal.rkt +++ b/collects/drracket/private/drracket-normal.rkt @@ -31,10 +31,8 @@ (define special-state #f) (define normal-bitmap #f) ; set by load-magic-images -(define icons-bitmap - (let ([icons (collection-path "icons")]) - (lambda (name) - (make-object bitmap% (build-path icons name))))) +(define (icons-bitmap name) + (make-object bitmap% (collection-file-path name "icons"))) (define-struct magic-image (chars filename [bitmap #:mutable])) @@ -100,7 +98,7 @@ (start-splash (cond [(and valentines-day? high-color?) - (build-path (collection-path "icons") "heart.png")] + (collection-file-path "heart.png" "icons")] [(and (or prince-kuhio-day? kamehameha-day?) high-color?) (set-splash-progress-bar? #f) (let ([size ((dynamic-require 'drracket/private/palaka 'palaka-pattern-size) 4)]) @@ -108,17 +106,17 @@ size size))] [texas-independence-day? - (build-path (collection-path "icons") "texas-plt-bw.gif")] + (collection-file-path "texas-plt-bw.gif" "icons")] [(and halloween? high-color?) - (build-path (collection-path "icons") "PLT-pumpkin.png")] + (collection-file-path "PLT-pumpkin.png" "icons")] [(and high-color? weekend?) - (build-path (collection-path "icons") "plt-logo-red-shiny.png")] + (collection-file-path "plt-logo-red-shiny.png" "icons")] [high-color? - (build-path (collection-path "icons") "plt-logo-red-diffuse.png")] + (collection-file-path "plt-logo-red-diffuse.png" "icons")] [(= (get-display-depth) 1) - (build-path (collection-path "icons") "pltbw.gif")] + (collection-file-path "pltbw.gif" "icons")] [else - (build-path (collection-path "icons") "plt-flat.gif")]) + (collection-file-path "plt-flat.gif" "icons")]) "DrRacket" 99) diff --git a/collects/drracket/private/eb.rkt b/collects/drracket/private/eb.rkt index 09e3c99a93..936245d2ce 100644 --- a/collects/drracket/private/eb.rkt +++ b/collects/drracket/private/eb.rkt @@ -8,7 +8,7 @@ (define main-size 260) (define pi (atan 0 -1)) - (define eli (make-object bitmap% (build-path (collection-path "icons") "eli-purple.jpg"))) + (define eli (make-object bitmap% (collection-file-path "eli-purple.jpg" "icons"))) (define bitmap (make-object bitmap% main-size main-size)) (define bdc (make-object bitmap-dc% bitmap)) @@ -56,7 +56,7 @@ (with-handlers ([exn:fail? (lambda (x) (printf "~s\n" (exn-message x)) #f)]) - (let ([b (make-object bitmap% (build-path (collection-path "icons") "recycle.gif"))]) + (let ([b (make-object bitmap% (collection-file-path "recycle.gif" "icons"))]) (cond [(send b ok?) (let ([gbdc (make-object bitmap-dc% b)] diff --git a/collects/drracket/private/language-configuration.rkt b/collects/drracket/private/language-configuration.rkt index ef538d275d..e89b8b7695 100644 --- a/collects/drracket/private/language-configuration.rkt +++ b/collects/drracket/private/language-configuration.rkt @@ -1030,12 +1030,10 @@ [outer-pb (make-object outer-pb%)] [bitmap (make-object bitmap% - (build-path (collection-path "icons") - "plt-small-shield.gif"))] + (build-path (collection-file-path "plt-small-shield.gif" "icons")))] [image-snip (make-object image-snip% - (build-path (collection-path "icons") - "plt-small-shield.gif"))] + (collection-file-path "plt-small-shield.gif" "icons"))] [before-text (make-object text%)] [before-snip (make-object editor-snip% before-text #f)] [before-ec% @@ -1794,8 +1792,7 @@ (string<=? (cadr x) (cadr y))]))))) (define plt-logo-shiny - (make-object bitmap% (build-path (collection-path "icons") - "plt-logo-red-shiny.png") + (make-object bitmap% (collection-file-path "plt-logo-red-shiny.png" "icons") 'png/mask)) (define (display-racketeer) @@ -1951,8 +1948,7 @@ (stretchable-height #f))] [msg (new message% (label (make-object bitmap% - (build-path (apply collection-path (cdr icon-lst)) - (car icon-lst)) + (apply collection-file-path icon-lst) 'unknown/mask)) (parent hp))] [vp (new vertical-pane% diff --git a/collects/drracket/private/language.rkt b/collects/drracket/private/language.rkt index b7ec95507e..1733a9b80b 100644 --- a/collects/drracket/private/language.rkt +++ b/collects/drracket/private/language.rkt @@ -1157,10 +1157,10 @@ ((if gui? make-mred-launcher make-mzscheme-launcher) (list (path->string - (build-path (collection-path "drracket" "private") - (if gui? - "launcher-mred-bootstrap.rkt" - "launcher-mz-bootstrap.rkt"))) + (collection-file-path (if gui? + "launcher-mred-bootstrap.rkt" + "launcher-mz-bootstrap.rkt") + "drracket" "private")) (condense-scheme-code-string (format "~s" init-code)) (path->string program-filename) (format "~s" module-language-spec) diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt index aeb2cfc929..3ef4885b3a 100644 --- a/collects/drracket/private/main.rkt +++ b/collects/drracket/private/main.rkt @@ -36,10 +36,11 @@ ;; avoid building the mask unless we use it (define todays-icon (make-object bitmap% - (build-path (collection-path "icons") - (case (date-week-day (seconds->date (current-seconds))) - [(6 0) "plt-logo-red-shiny.png"] - [else "plt-logo-red-diffuse.png"])) + (collection-file-path + (case (date-week-day (seconds->date (current-seconds))) + [(6 0) "plt-logo-red-shiny.png"] + [else "plt-logo-red-diffuse.png"]) + "icons") 'png/mask)) (define todays-icon-bw-mask diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index b80e5c2f44..bdebc68ff5 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -482,7 +482,7 @@ TODO (define file-icon (let ([bitmap (make-object bitmap% - (build-path (collection-path "icons") "file.gif"))]) + (collection-file-path "file.gif" "icons"))]) (if (send bitmap ok?) (make-object image-snip% bitmap) (make-object string-snip% "[open file]")))) diff --git a/collects/drracket/private/stick-figures.rkt b/collects/drracket/private/stick-figures.rkt index dbe81bc423..987f94367f 100644 --- a/collects/drracket/private/stick-figures.rkt +++ b/collects/drracket/private/stick-figures.rkt @@ -331,10 +331,10 @@ (new message% [label wb2] [parent right-column]) (new message% [label wb] [parent right-column]) (new grow-box-spacer-pane% [parent f]) - (send green-rb save-file (build-path (collection-path "icons") "run.png") 'png) - (send rb save-file (build-path (collection-path "icons") "b-run.png") 'png) - (send wb save-file (build-path (collection-path "icons") "b-wait.png") 'png) - (send wb2 save-file (build-path (collection-path "icons") "b-wait2.png") 'png) + (send green-rb save-file (collection-file-path "run.png" "icons") 'png) + (send rb save-file (collection-file-path "b-run.png" "icons") 'png) + (send wb save-file (collection-file-path "b-wait.png" "icons") 'png) + (send wb2 save-file (collection-file-path "b-wait2.png" "icons") 'png) (send f show #t)) #;(edit-points waiting-points/2) diff --git a/collects/drracket/private/tools-drs.rkt b/collects/drracket/private/tools-drs.rkt index c01b02bb6c..aba85e6150 100644 --- a/collects/drracket/private/tools-drs.rkt +++ b/collects/drracket/private/tools-drs.rkt @@ -42,7 +42,7 @@ This file sets up the right lexical environment to invoke the tools that want to (syntax-case stx () [(_ body tool-name) (let () - (define tool-lib-src (build-path (collection-path "drracket") "tool-lib.rkt")) + (define tool-lib-src (collection-file-path "tool-lib.rkt" "drracket")) (define full-sexp (call-with-input-file tool-lib-src (λ (port) diff --git a/collects/drracket/private/tools.rkt b/collects/drracket/private/tools.rkt index 65777a6858..38124c60c4 100644 --- a/collects/drracket/private/tools.rkt +++ b/collects/drracket/private/tools.rkt @@ -274,7 +274,7 @@ (build-path coll-dir icon-spec)] [(and (list? icon-spec) (andmap string? icon-spec)) - (build-path (apply collection-path (cdr icon-spec)) (car icon-spec))] + (apply collection-file-path icon-spec)] [else #f])] [tool-bitmap (and icon-path @@ -327,7 +327,7 @@ (syntax-case stx () [(_ body tool-name) (let () - (define tool-lib-src (build-path (collection-path "drracket") "tool-lib.rkt")) + (define tool-lib-src (collection-file-path "tool-lib.rkt" "drracket")) (define full-sexp (call-with-input-file tool-lib-src diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index bbac98daf2..221df67300 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -355,9 +355,9 @@ module browser threading seems wrong. frame program-filename)))]))) - (define execute-bitmap (make-object bitmap% (build-path (collection-path "icons") "run.png") 'png/mask)) - (define break-bitmap (make-object bitmap% (build-path (collection-path "icons") "break.png") 'png/mask)) - (define save-bitmap (make-object bitmap% (build-path (collection-path "icons") "save.png") 'png/mask)) + (define execute-bitmap (make-object bitmap% (collection-file-path "run.png" "icons") 'png/mask)) + (define break-bitmap (make-object bitmap% (collection-file-path "break.png" "icons") 'png/mask)) + (define save-bitmap (make-object bitmap% (collection-file-path "save.png" "icons") 'png/mask)) (define-values (get-program-editor-mixin add-to-program-editor-mixin) (let* ([program-editor-mixin diff --git a/collects/drracket/syncheck-drracket-button.rkt b/collects/drracket/syncheck-drracket-button.rkt index 59ca26373f..b12a742b55 100644 --- a/collects/drracket/syncheck-drracket-button.rkt +++ b/collects/drracket/syncheck-drracket-button.rkt @@ -8,7 +8,7 @@ (define-local-member-name syncheck:button-callback) -(define syncheck-bitmap (make-object bitmap% (build-path (collection-path "icons") "syncheck.png") 'png/mask)) +(define syncheck-bitmap (make-object bitmap% (collection-file-path "syncheck.png" "icons") 'png/mask)) (define syncheck-drracket-button (list diff --git a/collects/framework/splash.rkt b/collects/framework/splash.rkt index f2908f2501..affbc86943 100644 --- a/collects/framework/splash.rkt +++ b/collects/framework/splash.rkt @@ -226,7 +226,7 @@ (field [funny-value 0] [funny-bitmap - (make-object bitmap% (build-path (collection-path "icons") "touch.bmp"))] + (make-object bitmap% (collection-file-path "touch.bmp" "icons"))] [max-value 1]) (define/public (get-range) max-value) diff --git a/collects/games/main.rkt b/collects/games/main.rkt index 876967130f..0679dc8e19 100644 --- a/collects/games/main.rkt +++ b/collects/games/main.rkt @@ -1,12 +1,15 @@ -#lang scheme/gui +#lang racket/gui (require setup/getinfo mrlib/bitmap-label "show-help.ss") (define-struct game (file name set icon)) -(define gamedir (collection-path "games")) +(define gamedirs + (filter directory-exists? + (map (λ (x) (build-path x "games")) + (current-library-collection-paths)))) -(define (get-game game) +(define (get-game gamedir game) (let* ([game (path-element->string game)] [info (with-handlers ([exn:fail? (lambda (x) #f)]) (get-info (list "games" game)))] @@ -48,7 +51,11 @@ (run)))))) (define games - (filter values (map get-game (directory-list gamedir)))) + (apply + append + (for/list ([gamedir (in-list gamedirs)]) + (filter values (map (λ (x) (get-game gamedir x)) + (directory-list gamedir)))))) (define game-sets (let ([ht (make-hash)]) diff --git a/collects/games/paint-by-numbers/all-problems.rkt b/collects/games/paint-by-numbers/all-problems.rkt index 328a7b62ac..00d62541fe 100644 --- a/collects/games/paint-by-numbers/all-problems.rkt +++ b/collects/games/paint-by-numbers/all-problems.rkt @@ -16,7 +16,7 @@ [(_) (with-syntax ([(unit-names ...) - (let ([probdir (build-path (collection-path "games" "paint-by-numbers") "problems")]) + (let ([probdir (collection-file-path "problems" "games" "paint-by-numbers")]) (let loop ([files (call-with-input-file (build-path probdir "directory") read)]) diff --git a/collects/games/slidey/slidey.rkt b/collects/games/slidey/slidey.rkt index 5e28f5ffb7..dd77c0f7b5 100644 --- a/collects/games/slidey/slidey.rkt +++ b/collects/games/slidey/slidey.rkt @@ -80,11 +80,6 @@ (define-struct loc (x y)) ;; board = (vector-of (vector-of (union #f (make-loc n1 n2)))) -;; need to make sure that the bitmap divides nicely -;;(define bitmap (make-object bitmap% (build-path (collection-path "games" "slidey") "11.jpg"))) -;;(define board-width 6) -;;(define board-height 5) - (define (board-for-each board f) (let loop ([i (vector-length board)]) (unless (zero? i) @@ -287,7 +282,7 @@ (define slidey-canvas (make-object slidey-canvas% (make-object bitmap% - (build-path (collection-path "games" "slidey") "11.jpg")) + (build-path (collection-file-path "11.jpg" "games" "slidey"))) 6 6 p)) (define bp (make-object horizontal-panel% f)) (send bp stretchable-height #f)