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

got rid of some uses of collection-path

Browse Source
This commit is contained in:
Robby Findler 2010-07-25 15:15:57 -05:00
parent 5f1aa418f3
commit 83cde5c8fb
18 changed files with 77 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/drracket/installer.rkt
View File

@ -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"))))))

9
collects/drracket/private/app.rkt
View File

@ -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"))))

8
collects/drracket/private/bindings-browser.rkt
View File

@ -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)

20
collects/drracket/private/drracket-normal.rkt
View File

@ -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)

4
collects/drracket/private/eb.rkt
View File

@ -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)]

12
collects/drracket/private/language-configuration.rkt
View File

@ -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%

8
collects/drracket/private/language.rkt
View File

@ -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)

9
collects/drracket/private/main.rkt
View File

@ -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

2
collects/drracket/private/rep.rkt
View File

@ -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]"))))

8
collects/drracket/private/stick-figures.rkt
View File

@ -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)

2
collects/drracket/private/tools-drs.rkt
View File

@ -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)

4
collects/drracket/private/tools.rkt
View File

@ -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

6
collects/drracket/private/unit.rkt
View File

@ -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

2
collects/drracket/syncheck-drracket-button.rkt
View File

@ -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

2
collects/framework/splash.rkt
View File

@ -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)

15
collects/games/main.rkt
View File

@ -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)])

2
collects/games/paint-by-numbers/all-problems.rkt
View File

@ -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)])

7
collects/games/slidey/slidey.rkt
View File

@ -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)