suzanne.soy/gui
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

original commit: 1b69d742bd7b895ce44c8ed21ffcbaa7caeebf93
This commit is contained in:
Sam Tobin-Hochstadt 2011-10-01 11:20:27 -04:00 committed by Matthew Flatt
parent b6e39a74f2
commit 8f9254d569
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 splash-tlw set-label splash-title)
#; ;; commented out because dialogs don't accept set-icon
(when frame-icon
(if (pair? frame-icon)
(let ([small (car icon)]
[large (cdr icon)])
(let ([small (car frame-icon)]
[large (cdr frame-icon)])
(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 frame-icon (send icon get-loaded-mask) 'both)))
(send splash-tlw set-icon frame-icon (send frame-icon get-loaded-mask) 'both)))
(cond
[(or (path? splash-draw-spec)

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

@ -85,6 +85,10 @@
[can-exit? (lambda () (can-close?))]
[on-exit (lambda () (on-close) (show #f))]
[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
(case-lambda
[() (send wx center 'both)]
@ -185,11 +189,7 @@
[set-status-text (lambda (s) (do-set-status-text s))]
[has-status-line? (lambda () status-line?)]
[iconize (entry-point (lambda (on?) (send wx iconize on?)))]
[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?)])]
[is-iconized? (entry-point (lambda () (send wx iconized?)))]
[maximize (entry-point (lambda (on?) (send wx position-for-initial-show) (send wx maximize on?)))]
[is-maximized? (entry-point (lambda () (send wx is-maximized?)))]
[get-menu-bar (entry-point (lambda () (let ([mb (send wx get-the-menu-bar)])