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

uses the new icon for alt-tab and windows under linux now

Browse Source 
svn: r17360
This commit is contained in:
Robby Findler 2009-12-20 01:58:17 +00:00
parent fb85388288
commit 1ccca26676
1 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/drscheme/private/unit.ss
View File

@ -48,6 +48,14 @@ module browser threading seems wrong.
(define show-planet-paths (string-constant module-browser-show-planet-paths/short)) (define show-planet-paths (string-constant module-browser-show-planet-paths/short))
(define refresh (string-constant module-browser-refresh)) (define refresh (string-constant module-browser-refresh))
(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"]))
'png/mask))
(define-unit unit@ (define-unit unit@
(import [prefix help-desk: drscheme:help-desk^] (import [prefix help-desk: drscheme:help-desk^]
[prefix drscheme:app: drscheme:app^] [prefix drscheme:app: drscheme:app^]
@ -4099,6 +4107,12 @@ module browser threading seems wrong.
(set-label-prefix (string-constant drscheme)) (set-label-prefix (string-constant drscheme))
(set! newest-frame this) (set! newest-frame this)
(inherit set-icon)
(when (send todays-icon ok?)
(case (system-type)
[(unix) (set-icon todays-icon #f #;(send todays-icon get-loaded-mask))]))
(send definitions-canvas focus))) (send definitions-canvas focus)))
(define execute-warning-canvas% (define execute-warning-canvas%