diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2002-06-28 09:01:58 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2002-06-28 09:01:58 (GMT) |
commit | da078182266031aaeb5acd2eab0436adee96dbe8 (patch) | |
tree | 7c69a80f156cd34bde219ce0c3f6889f5929b9b0 /library/msgbox.tcl | |
parent | c5c4d6b20bbb557ad2e1a30c2a33f27458308b9a (diff) | |
download | tk-da078182266031aaeb5acd2eab0436adee96dbe8.zip tk-da078182266031aaeb5acd2eab0436adee96dbe8.tar.gz tk-da078182266031aaeb5acd2eab0436adee96dbe8.tar.bz2 |
Force the message box to have consistent background colours. [Bug#552515]
Diffstat (limited to 'library/msgbox.tcl')
-rw-r--r-- | library/msgbox.tcl | 24 |
1 files changed, 15 insertions, 9 deletions
diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 4208d2c..dce75a5 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.20 2002/06/13 06:17:21 mdejong Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.21 2002/06/28 09:01:58 dkf Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -195,7 +195,9 @@ proc ::tk::MessageBox {args} { set labels [list &Yes &No &Cancel] } default { - error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" + error "bad -type value \"$data(-type)\": must be\ + abortretryignore, ok, okcancel, retrycancel,\ + yesno, or yesnocancel" } } @@ -244,6 +246,8 @@ proc ::tk::MessageBox {args} { wm title $w $data(-title) wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW { } + # There is only one background colour for the whole dialog + set bg [$w cget -background] # Message boxes should be transient with respect to their parent so that # they always stay on top of the parent window. But some window managers @@ -260,9 +264,9 @@ proc ::tk::MessageBox {args} { unsupported::MacWindowStyle style $w dBoxProc } - frame $w.bot + frame $w.bot -background $bg pack $w.bot -side bottom -fill both - frame $w.top + frame $w.top -background $bg pack $w.top -side top -fill both -expand 1 if {[string compare $tcl_platform(platform) "macintosh"]} { $w.bot configure -relief raised -bd 1 @@ -280,13 +284,15 @@ proc ::tk::MessageBox {args} { option add *Dialog.msg.font {Times 18} widgetDefault } - label $w.msg -anchor nw -justify left -text $data(-message) + label $w.msg -anchor nw -justify left -text $data(-message) \ + -background $bg if {[string compare $data(-icon) ""]} { if {[string equal $tcl_platform(platform) "macintosh"] \ || ([winfo depth $w] < 4) || $tk_strictMotif} { - label $w.bitmap -bitmap $data(-icon) + label $w.bitmap -bitmap $data(-icon) -background $bg } else { - canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 + canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ + -background $bg switch $data(-icon) { error { $w.bitmap create oval 0 0 31 31 -fill red -outline black @@ -336,8 +342,8 @@ proc ::tk::MessageBox {args} { set opts [list -text $capName] } - eval tk::AmpWidget \ - button [list $w.$name] $opts [list -command [list set tk::Priv(button) $name]] + eval [list tk::AmpWidget button $w.$name] $opts \ + [list -command [list set tk::Priv(button) $name]] if {[string equal $name $data(-default)]} { $w.$name configure -default active |