From da078182266031aaeb5acd2eab0436adee96dbe8 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 28 Jun 2002 09:01:58 +0000 Subject: Force the message box to have consistent background colours. [Bug#552515] --- ChangeLog | 5 +++++ library/msgbox.tcl | 24 +++++++++++++++--------- 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/ChangeLog b/ChangeLog index a30c4e1..02f43a9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-06-28 Donal K. Fellows + + * library/msgbox.tcl (MessageBox): Force all non-button widgets to + have the same background as the containing toplevel. [Bug #552515] + 2002-06-27 Andreas Kupries * win/Makefile.in (install-binaries): Fix of troubled Makefile 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 -- cgit v0.12