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

Change basic-top-level-window% to support `set-icon', and use to set icon for splash screen.

Browse Source 
Closes 12241

Merge to 5.2
This commit is contained in:
Sam Tobin-Hochstadt 2011-10-01 11:20:27 -04:00 committed by Matthew Flatt
parent 8bd81f4806
commit 1b69d742bd
2 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/framework/splash.rkt
View File

@ -155,14 +155,13 @@
(send (get-gauge) set-range splash-max-width) (send (get-gauge) set-range splash-max-width)
(send splash-tlw set-label splash-title) (send splash-tlw set-label splash-title)
#; ;; commented out because dialogs don't accept set-icon
(when frame-icon (when frame-icon
(if (pair? frame-icon) (if (pair? frame-icon)
(let ([small (car icon)] (let ([small (car frame-icon)]
[large (cdr icon)]) [large (cdr frame-icon)])
(send splash-tlw set-icon small (send small get-loaded-mask) 'small) (send splash-tlw set-icon small (send small get-loaded-mask) 'small)
(send splash-tlw set-icon large (send large get-loaded-mask) 'large)) (send splash-tlw set-icon large (send large get-loaded-mask) 'large))
(send splash-tlw set-icon frame-icon (send icon get-loaded-mask) 'both))) (send splash-tlw set-icon frame-icon (send frame-icon get-loaded-mask) 'both)))
(cond (cond
[(or (path? splash-draw-spec) [(or (path? splash-draw-spec)

8
collects/mred/private/mrtop.rkt
View File

@ -85,6 +85,10 @@
[can-exit? (lambda () (can-close?))] [can-exit? (lambda () (can-close?))]
[on-exit (lambda () (on-close) (show #f))] [on-exit (lambda () (on-close) (show #f))]
[on-activate (lambda (x) (void))] [on-activate (lambda (x) (void))]
[set-icon (case-lambda
[(i) (send wx set-icon i)]
[(i b) (send wx set-icon i b)]
[(i b l?) (send wx set-icon i b l?)])]
[center (entry-point [center (entry-point
(case-lambda (case-lambda
[() (send wx center 'both)] [() (send wx center 'both)]
@ -186,10 +190,6 @@
[has-status-line? (lambda () status-line?)] [has-status-line? (lambda () status-line?)]
[iconize (entry-point (lambda (on?) (send wx iconize on?)))] [iconize (entry-point (lambda (on?) (send wx iconize on?)))]
[is-iconized? (entry-point (lambda () (send wx iconized?)))] [is-iconized? (entry-point (lambda () (send wx iconized?)))]
[set-icon (case-lambda
[(i) (send wx set-icon i)]
[(i b) (send wx set-icon i b)]
[(i b l?) (send wx set-icon i b l?)])]
[maximize (entry-point (lambda (on?) (send wx position-for-initial-show) (send wx maximize on?)))] [maximize (entry-point (lambda (on?) (send wx position-for-initial-show) (send wx maximize on?)))]
[is-maximized? (entry-point (lambda () (send wx is-maximized?)))] [is-maximized? (entry-point (lambda () (send wx is-maximized?)))]
[get-menu-bar (entry-point (lambda () (let ([mb (send wx get-the-menu-bar)]) [get-menu-bar (entry-point (lambda () (let ([mb (send wx get-the-menu-bar)])