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

adjust weekend logo setting code so that it works on non-mac os x platforms

Browse Source
This commit is contained in:
Robby Findler 2011-11-28 14:49:06 -06:00
parent f210692a20
commit 031b7b18be
2 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/drracket/private/dock-icon.rkt
View File

@ -9,14 +9,13 @@
NSImageView) NSImageView)
(define (set-dock-tile-bitmap bm) (define (set-dock-tile-bitmap bm)
(when (eq? (system-type) 'macosx) (unless old-cocoa?
(unless old-cocoa? (define dock-tile (tell (tell NSApplication sharedApplication) dockTile))
(define dock-tile (tell (tell NSApplication sharedApplication) dockTile)) (start-atomic)
(start-atomic) (define view (tell (tell NSImageView alloc) init))
(define view (tell (tell NSImageView alloc) init)) (tellv view setImage: (bitmap->image bm))
(tellv view setImage: (bitmap->image bm))
(tellv dock-tile setContentView: view)
(tellv dock-tile setContentView: view) (tellv dock-tile display)
(tellv dock-tile display) (tellv view release)
(tellv view release) (end-atomic)))
(end-atomic))))

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

@ -6,11 +6,13 @@
racket/list racket/list
framework/private/bday framework/private/bday
framework/splash framework/splash
racket/runtime-path
racket/file racket/file
"dock-icon.rkt"
"frame-icon.rkt" "frame-icon.rkt"
"eb.rkt") "eb.rkt")
(define-runtime-path doc-icon.rkt "dock-icon.rkt")
(define files-to-open (command-line #:args filenames filenames)) (define files-to-open (command-line #:args filenames filenames))
;; updates the command-line-arguments with only the files ;; updates the command-line-arguments with only the files
@ -95,6 +97,8 @@
(when (eb-bday?) (install-eb)) (when (eb-bday?) (install-eb))
(define weekend-bitmap-spec (collection-file-path "plt-logo-red-shiny.png" "icons"))
(define normal-bitmap-spec (define normal-bitmap-spec
(cond (cond
[(and valentines-day? high-color?) [(and valentines-day? high-color?)
@ -110,7 +114,7 @@
[(and halloween? high-color?) [(and halloween? high-color?)
(collection-file-path "PLT-pumpkin.png" "icons")] (collection-file-path "PLT-pumpkin.png" "icons")]
[(and high-color? weekend?) [(and high-color? weekend?)
(collection-file-path "plt-logo-red-shiny.png" "icons")] weekend-bitmap-spec]
[high-color? [high-color?
(collection-file-path "plt-logo-red-diffuse.png" "icons")] (collection-file-path "plt-logo-red-diffuse.png" "icons")]
[(= (get-display-depth) 1) [(= (get-display-depth) 1)
@ -119,8 +123,10 @@
(collection-file-path "plt-flat.gif" "icons")])) (collection-file-path "plt-flat.gif" "icons")]))
(define normal-bitmap (read-bitmap normal-bitmap-spec)) (define normal-bitmap (read-bitmap normal-bitmap-spec))
(set-splash-char-observer drracket-splash-char-observer) (set-splash-char-observer drracket-splash-char-observer)
(when (and high-color? weekend?) (when (eq? (system-type) 'macosx)
(set-dock-tile-bitmap normal-bitmap)) (when (equal? normal-bitmap-spec weekend-bitmap-spec)
(define set-doc-tile-bitmap (dynamic-require doc-icon.rkt 'set-dock-tile-bitmap))
(set-doc-tile-bitmap normal-bitmap)))
(start-splash normal-bitmap (start-splash normal-bitmap
"DrRacket" "DrRacket"
700 700