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

improve checkbox in Unix/Windows message box, too, per Eli's suggestion

Browse Source 
svn: r3298
This commit is contained in:
Matthew Flatt 2006-06-09 15:28:09 +00:00
parent 7880355fdd
commit 8894dcb781
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mred/private/messagebox.ss
View File

@ -93,7 +93,7 @@
[(memq 'stop style) 'stop]
[(memq 'caution style) 'caution]
[else 'app])])
(let-values ([(msg-pnl btn-pnl extra-width btn-h-align msg-h-align msg-v-align)
(let-values ([(msg-pnl btn-pnl cb-pnl extra-width btn-h-align msg-h-align msg-v-align)
(case (system-type)
[(macosx) (let ([p (make-object horizontal-pane% f)])
(send f min-width 300)
@ -111,10 +111,11 @@
(send msg-pnl min-height 64)
(send msg-pnl min-width 350)
(send btn-pnl stretchable-height #f)
(values msg-pnl btn-pnl 96 'right 'left 'top)))]
[else (let ([p (instantiate horizontal-pane% (f) [alignment '(center top)])])
(values msg-pnl btn-pnl btn-pnl 96 'right 'left 'top)))]
[else (let ([p (new horizontal-pane% [parent f] [alignment '(center top)])])
(make-object message% icon-id p)
(values (make-object vertical-pane% p) f 0 'center 'center 'center))])])
(let ([msg-pnl (new vertical-pane% [parent p])])
(values msg-pnl f msg-pnl 0 'center 'center 'center)))])])
(if single?
(begin
(send msg-pnl set-alignment (if (= (length strings) 1) msg-h-align 'left) msg-v-align)
@ -148,10 +149,11 @@
(send msg-pnl delete-child c)
(loop #t)))))))
(let ([check (and check?
(let ([p (new horizontal-pane% [parent btn-pnl]
(let ([p (new horizontal-pane% [parent cb-pnl]
[stretchable-height #f]
[alignment '(left center)])])
(when (eq? 'macosx (system-type))
(when (and single?
(eq? 'macosx (system-type)))
(send p horiz-margin 8))
(new check-box%
[label check-message]