summaryrefslogtreecommitdiffstats
path: root/library/msgbox.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-11-02 13:16:37 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-11-02 13:16:37 (GMT)
commit5bf841749cfda4a1e0f18683581bd0a95aafe684 (patch)
tree4bec72de7caa37e31616c89d0bd7377c1440d630 /library/msgbox.tcl
parentc0900bcedd02bc90832f164503daa12f47107c4b (diff)
downloadtk-5bf841749cfda4a1e0f18683581bd0a95aafe684.zip
tk-5bf841749cfda4a1e0f18683581bd0a95aafe684.tar.gz
tk-5bf841749cfda4a1e0f18683581bd0a95aafe684.tar.bz2
Tk (non-native) message box now uses Ttk widgets for better L&F.
Diffstat (limited to 'library/msgbox.tcl')
-rw-r--r--library/msgbox.tcl36
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]