From fc7f6bbe0fe7a6a3dd29fb42075d6e27a99367ee Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 25 Apr 2012 19:16:36 -0600 Subject: [PATCH] racket/gui: add a 'no-icon style for `message-box' --- collects/mred/private/messagebox.rkt | 19 ++++++++++------ collects/scribblings/gui/dialog-funcs.scrbl | 25 +++++++++++---------- 2 files changed, 25 insertions(+), 19 deletions(-) diff --git a/collects/mred/private/messagebox.rkt b/collects/mred/private/messagebox.rkt index 56b9c430c1..5a24be0faf 100644 --- a/collects/mred/private/messagebox.rkt +++ b/collects/mred/private/messagebox.rkt @@ -35,7 +35,7 @@ (check-top-level-parent/false who parent) (check-style who '(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? (cons 'checked l) l)) @@ -115,6 +115,7 @@ (super-init title parent box-width)))))] [result close-result] [icon-id (cond + [(memq 'no-icon style) #f] [(memq 'stop style) 'stop] [(memq 'caution style) 'caution] [else 'app])]) @@ -123,9 +124,10 @@ [(macosx) (let ([p (make-object horizontal-pane% f)]) (send f min-width 300) (send p set-alignment 'center 'top) - (let ([m (make-object message% icon-id p)]) - (send m horiz-margin 16) - (send m vert-margin 16)) + (when icon-id + (let ([m (make-object message% icon-id p)]) + (send m horiz-margin 16) + (send m vert-margin 16))) (let* ([rhs-pnl (make-object vertical-pane% p)] [msg-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) (values msg-pnl btn-pnl btn-pnl 96 'right 'left '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])]) (values (if (= 1 (length strings)) (new horizontal-pane% [parent msg-pnl] [alignment '(center top)] - [min-height (send icon-msg min-height)]) + [min-height (if icon-msg + (send icon-msg min-height) + 1)]) msg-pnl) f msg-pnl 0 'center 'center 'center)))])]) (if single? @@ -249,7 +253,7 @@ (check-top-level-parent/false who parent) (check-style who '(ok ok-cancel yes-no) - (let ([l '(caution stop)]) + (let ([l '(caution stop no-icon)]) (if check? (cons 'checked l) l)) @@ -273,6 +277,7 @@ [(memq 'checked style) '(checked)] [else null]) (cond + [(memq 'no-icon style) '(no-icon)] [(memq 'stop style) '(stop)] [(memq 'caution style) '(caution)] [else null]) diff --git a/collects/scribblings/gui/dialog-funcs.scrbl b/collects/scribblings/gui/dialog-funcs.scrbl index 504a016519..08d54765ee 100644 --- a/collects/scribblings/gui/dialog-funcs.scrbl +++ b/collects/scribblings/gui/dialog-funcs.scrbl @@ -196,7 +196,9 @@ See also @racket[path-dialog%] for a richer interface. @defproc[(message-box [title label-string?] [message string?] [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]) (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 dialog use a caution icon instead of the application (or generic - ``info'') icon. Alternately, it can contain @racket['stop] to make the - dialog use a stop icon. If @racket[style] contains both @racket['caution] - and @racket['stop], then @racket['caution] is ignored. + ``info'') icon, @racket['stop] to make the dialog use a stop icon, or + @racket['no-icon] to suppress the icon. If @racket[style] contains + 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] 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)] [button3-label (or/c label-string? (is-a?/c bitmap%) #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 'default=1 'default=2 'default=3)) '(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 @racket['no-default]. -In addition, @racket[style] can contain @racket['caution] to make the - dialog use a caution icon instead of the application (or generic - ``info'') icon. Alternately, it can contain @racket['stop] to make the - dialog use a stop icon. If @racket[style] contains both @racket['caution] - and @racket['stop], then @racket['caution] is ignored. +In addition, @racket[style] can contain @racket['caution], + @racket['stop], or @racket['no-icon] to adjust the icon that appears + n the dialog, the same for @racket[message-box]. The class that implements the dialog provides a @racket[get-message] 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?] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f] [style (listof (or/c 'ok 'ok-cancel 'yes-no - 'caution 'stop 'checked)) + 'caution 'stop 'no-icon 'checked)) '(ok)] [#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values]) (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)] [button3-label (or/c label-string? (is-a?/c bitmap%) #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 'default=1 'default=2 'default=3)) '(no-default)]