Tk (non-native) message box now uses Ttk widgets for better L&F.

1 files changed, 20 insertions, 16 deletions

diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 4bbfc92..74d2bef 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.32 2007/10/30 01:57:54 hobbs Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.33 2007/11/02 13:16:38 dkf Exp $
 #
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 #
@@ -11,6 +11,8 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 
+package require Ttk
+
 # Ensure existence of ::tk::dialog namespace
 #
 namespace eval ::tk::dialog {}
@@ -244,16 +246,17 @@ proc ::tk::MessageBox {args} {
 	set w .__tk__messagebox
     }
 
+    # There is only one background colour for the whole dialog
+    set bg [ttk::style lookup $::ttk::currentTheme -background]
+
     # 3. Create the top-level window and divide it into top
     # and bottom parts.
 
     catch {destroy $w}
-    toplevel $w -class Dialog
+    toplevel $w -class Dialog -bg $bg
     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
@@ -270,14 +273,14 @@ proc ::tk::MessageBox {args} {
 	::tk::unsupported::MacWindowStyle style $w moveableModal {}
     }
 
-    frame $w.bot -background $bg
+    ttk::frame $w.bot;# -background $bg
     grid anchor $w.bot center
     pack $w.bot -side bottom -fill both
-    frame $w.top -background $bg
+    ttk::frame $w.top;# -background $bg
     pack $w.top -side top -fill both -expand 1
     if {$windowingsystem ne "aqua"} {
-	$w.bot configure -relief raised -bd 1
-	$w.top configure -relief raised -bd 1
+	#$w.bot configure -relief raised -bd 1
+	#$w.top configure -relief raised -bd 1
     }
 
     # 4. Fill the top part with bitmap, message and detail (use the
@@ -289,16 +292,16 @@ proc ::tk::MessageBox {args} {
     option add *Dialog.msg.font TkCaptionFont widgetDefault
     option add *Dialog.dtl.font TkDefaultFont widgetDefault
 
-    label $w.msg -anchor nw -justify left -text $data(-message) \
-	    -background $bg
+    ttk::label $w.msg -anchor nw -justify left -text $data(-message)
+    #-background $bg
     if {$data(-detail) ne ""} {
-	label $w.dtl -anchor nw -justify left -text $data(-detail) \
-		-background $bg
+	ttk::label $w.dtl -anchor nw -justify left -text $data(-detail)
+	#-background $bg
     }
     if {$data(-icon) ne ""} {
 	if {$windowingsystem eq "aqua"
 		|| ([winfo depth $w] < 4) || $tk_strictMotif} {
-	    label $w.bitmap -bitmap $data(-icon) -background $bg
+	    ttk::label $w.bitmap -bitmap $data(-icon) -background $bg
 	} else {
 	    canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
 		    -background $bg
@@ -356,8 +359,9 @@ proc ::tk::MessageBox {args} {
 	    set opts [list -text $capName]
 	}
 
-	eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \
+	eval [list tk::AmpWidget ttk::button $w.$name] $opts \
 		[list -command [list set tk::Priv(button) $name]]
+	# -padx 3m
 
 	if {$name eq $data(-default)} {
 	    $w.$name configure -default active
@@ -406,12 +410,12 @@ proc ::tk::MessageBox {args} {
 
     bind $w <Return> {
 	if {[winfo class %W] eq "Button"} {
-	    tk::ButtonInvoke %W
+	    %W invoke
 	}
     }
 
     # Invoke the designated cancelling operation
-    bind $w <Escape> [list tk::ButtonInvoke $w.$cancel]
+    bind $w <Escape> [list $w.$cancel invoke]
 
     # At <Destroy> the buttons have vanished, so must do this directly.
     bind $w.msg <Destroy> [list set tk::Priv(button) $cancel]