summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2002-06-28 09:01:58 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2002-06-28 09:01:58 (GMT)
commitda078182266031aaeb5acd2eab0436adee96dbe8 (patch)
tree7c69a80f156cd34bde219ce0c3f6889f5929b9b0 /library
parentc5c4d6b20bbb557ad2e1a30c2a33f27458308b9a (diff)
downloadtk-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')
-rw-r--r--library/msgbox.tcl24
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