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

racket/gui: add a 'no-icon style for `message-box'

Browse Source
This commit is contained in:
Matthew Flatt 2012-04-25 19:16:36 -06:00
parent d6a57e073c
commit fc7f6bbe0f
2 changed files with 25 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mred/private/messagebox.rkt
View File

@ -35,7 +35,7 @@
(check-top-level-parent/false who parent) (check-top-level-parent/false who parent)
(check-style who (check-style who
'(default=1 default=2 default=3 no-default) '(default=1 default=2 default=3 no-default)
(let ([l '(disallow-close number-order caution stop)]) (let ([l '(disallow-close number-order caution stop no-icon)])
(if check? (if check?
(cons 'checked l) (cons 'checked l)
l)) l))
@ -115,6 +115,7 @@
(super-init title parent box-width)))))] (super-init title parent box-width)))))]
[result close-result] [result close-result]
[icon-id (cond [icon-id (cond
[(memq 'no-icon style) #f]
[(memq 'stop style) 'stop] [(memq 'stop style) 'stop]
[(memq 'caution style) 'caution] [(memq 'caution style) 'caution]
[else 'app])]) [else 'app])])
@ -123,9 +124,10 @@
[(macosx) (let ([p (make-object horizontal-pane% f)]) [(macosx) (let ([p (make-object horizontal-pane% f)])
(send f min-width 300) (send f min-width 300)
(send p set-alignment 'center 'top) (send p set-alignment 'center 'top)
(let ([m (make-object message% icon-id p)]) (when icon-id
(send m horiz-margin 16) (let ([m (make-object message% icon-id p)])
(send m vert-margin 16)) (send m horiz-margin 16)
(send m vert-margin 16)))
(let* ([rhs-pnl (make-object vertical-pane% p)] (let* ([rhs-pnl (make-object vertical-pane% p)]
[msg-pnl (make-object vertical-pane% rhs-pnl)] [msg-pnl (make-object vertical-pane% rhs-pnl)]
[btn-pnl (make-object vertical-pane% rhs-pnl)]) [btn-pnl (make-object vertical-pane% rhs-pnl)])
@ -138,13 +140,15 @@
(send btn-pnl stretchable-height #f) (send btn-pnl stretchable-height #f)
(values msg-pnl btn-pnl btn-pnl 96 'right 'left 'top)))] (values msg-pnl btn-pnl btn-pnl 96 'right 'left 'top)))]
[else (let ([p (new horizontal-pane% [parent f] [alignment '(center top)])]) [else (let ([p (new horizontal-pane% [parent f] [alignment '(center top)])])
(let ([icon-msg (make-object message% icon-id p)] (let ([icon-msg (and icon-id (make-object message% icon-id p))]
[msg-pnl (new vertical-pane% [parent p])]) [msg-pnl (new vertical-pane% [parent p])])
(values (if (= 1 (length strings)) (values (if (= 1 (length strings))
(new horizontal-pane% (new horizontal-pane%
[parent msg-pnl] [parent msg-pnl]
[alignment '(center top)] [alignment '(center top)]
[min-height (send icon-msg min-height)]) [min-height (if icon-msg
(send icon-msg min-height)
1)])
msg-pnl) msg-pnl)
f msg-pnl 0 'center 'center 'center)))])]) f msg-pnl 0 'center 'center 'center)))])])
(if single? (if single?
@ -249,7 +253,7 @@
(check-top-level-parent/false who parent) (check-top-level-parent/false who parent)
(check-style who (check-style who
'(ok ok-cancel yes-no) '(ok ok-cancel yes-no)
(let ([l '(caution stop)]) (let ([l '(caution stop no-icon)])
(if check? (if check?
(cons 'checked l) (cons 'checked l)
l)) l))
@ -273,6 +277,7 @@
[(memq 'checked style) '(checked)] [(memq 'checked style) '(checked)]
[else null]) [else null])
(cond (cond
[(memq 'no-icon style) '(no-icon)]
[(memq 'stop style) '(stop)] [(memq 'stop style) '(stop)]
[(memq 'caution style) '(caution)] [(memq 'caution style) '(caution)]
[else null]) [else null])

25
collects/scribblings/gui/dialog-funcs.scrbl
View File

@ -196,7 +196,9 @@ See also @racket[path-dialog%] for a richer interface.
@defproc[(message-box [title label-string?] @defproc[(message-box [title label-string?]
[message string?] [message string?]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[style (listof (or/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)] [style (listof (or/c 'ok 'ok-cancel 'yes-no
'caution 'stop 'no-icon))
'(ok)]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values]) [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(or/c 'ok 'cancel 'yes 'no)]{ (or/c 'ok 'cancel 'yes 'no)]{
@ -231,9 +233,10 @@ The style must include exactly one of the following:
In addition, @racket[style] can contain @racket['caution] to make the In addition, @racket[style] can contain @racket['caution] to make the
dialog use a caution icon instead of the application (or generic dialog use a caution icon instead of the application (or generic
``info'') icon. Alternately, it can contain @racket['stop] to make the ``info'') icon, @racket['stop] to make the dialog use a stop icon, or
dialog use a stop icon. If @racket[style] contains both @racket['caution] @racket['no-icon] to suppress the icon. If @racket[style] contains
and @racket['stop], then @racket['caution] is ignored. multiple of @racket['caution], @racket['stop], and @racket['no-icon],
then @racket['no-icon] takes precedence followed by @racket['stop].
The class that implements the dialog provides a @racket[get-message] The class that implements the dialog provides a @racket[get-message]
method that takes no arguments and returns the text of the message as method that takes no arguments and returns the text of the message as
@ -255,7 +258,7 @@ before the dialog is created.
[button2-label (or/c label-string? (is-a?/c bitmap%) #f)] [button2-label (or/c label-string? (is-a?/c bitmap%) #f)]
[button3-label (or/c label-string? (is-a?/c bitmap%) #f)] [button3-label (or/c label-string? (is-a?/c bitmap%) #f)]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[style (listof (or/c 'stop 'caution 'number-order [style (listof (or/c 'stop 'caution 'no-icon 'number-order
'disallow-close 'no-default 'disallow-close 'no-default
'default=1 'default=2 'default=3)) 'default=1 'default=2 'default=3))
'(no-default)] '(no-default)]
@ -319,11 +322,9 @@ The @racket[style] list must contain exactly one of @racket['default=1],
is supplied but button @racket[n] has no label, then it is equivalent to is supplied but button @racket[n] has no label, then it is equivalent to
@racket['no-default]. @racket['no-default].
In addition, @racket[style] can contain @racket['caution] to make the In addition, @racket[style] can contain @racket['caution],
dialog use a caution icon instead of the application (or generic @racket['stop], or @racket['no-icon] to adjust the icon that appears
``info'') icon. Alternately, it can contain @racket['stop] to make the n the dialog, the same for @racket[message-box].
dialog use a stop icon. If @racket[style] contains both @racket['caution]
and @racket['stop], then @racket['caution] is ignored.
The class that implements the dialog provides a @racket[get-message] The class that implements the dialog provides a @racket[get-message]
method that takes no arguments and returns the text of the message as method that takes no arguments and returns the text of the message as
@ -344,7 +345,7 @@ before the dialog is created.
[check-label label-string?] [check-label label-string?]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[style (listof (or/c 'ok 'ok-cancel 'yes-no [style (listof (or/c 'ok 'ok-cancel 'yes-no
'caution 'stop 'checked)) 'caution 'stop 'no-icon 'checked))
'(ok)] '(ok)]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values]) [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(values (or/c 'ok 'cancel 'yes 'no) boolean?)]{ (values (or/c 'ok 'cancel 'yes 'no) boolean?)]{
@ -368,7 +369,7 @@ Like @racket[message-box], except that
[button2-label (or/c label-string? (is-a?/c bitmap%) #f)] [button2-label (or/c label-string? (is-a?/c bitmap%) #f)]
[button3-label (or/c label-string? (is-a?/c bitmap%) #f)] [button3-label (or/c label-string? (is-a?/c bitmap%) #f)]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[style (listof (or/c 'stop 'caution 'number-order [style (listof (or/c 'stop 'caution 'no-icon 'number-order
'disallow-close 'no-default 'disallow-close 'no-default
'default=1 'default=2 'default=3)) 'default=1 'default=2 'default=3))
'(no-default)] '(no-default)]