summaryrefslogtreecommitdiffstats
path: root/library/msgbox.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/msgbox.tcl')
-rw-r--r--library/msgbox.tcl78
1 files changed, 48 insertions, 30 deletions
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 2a22d54..ed1f4fe 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -143,6 +143,7 @@ proc ::tk::MessageBox {args} {
#
set specs {
{-default "" "" ""}
+ {-detail "" "" ""}
{-icon "" "" "info"}
{-message "" "" ""}
{-parent "" "" .}
@@ -156,7 +157,7 @@ proc ::tk::MessageBox {args} {
error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
}
set windowingsystem [tk windowingsystem]
- if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} {
+ if {$windowingsystem eq "aqua"} {
switch -- $data(-icon) {
"error" {set data(-icon) "stop"}
"warning" {set data(-icon) "caution"}
@@ -241,16 +242,17 @@ proc ::tk::MessageBox {args} {
set w .__tk__messagebox
}
+ # There is only one background colour for the whole dialog
+ set bg [ttk::style lookup . -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 [list $w.$cancel invoke]
- # 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
@@ -263,38 +265,42 @@ proc ::tk::MessageBox {args} {
wm transient $w $data(-parent)
}
- if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} {
+ if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
} elseif {$windowingsystem eq "x11"} {
wm attributes $w -type dialog
}
- 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 "classic" && $windowingsystem ne "aqua"} {
- $w.bot configure -relief raised -bd 1
- $w.top configure -relief raised -bd 1
+ if {$windowingsystem ne "aqua"} {
+ #$w.bot configure -relief raised -bd 1
+ #$w.top configure -relief raised -bd 1
}
- # 4. Fill the top part with bitmap and message (use the option
- # database for -wraplength and -font so that they can be
+ # 4. Fill the top part with bitmap, message and detail (use the
+ # option database for -wraplength and -font so that they can be
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} {
- option add *Dialog.msg.font system widgetDefault
- } else {
- option add *Dialog.msg.font {Times 14} widgetDefault
+ option add *Dialog.dtl.wrapLength 3i widgetDefault
+ option add *Dialog.msg.font TkCaptionFont widgetDefault
+ option add *Dialog.dtl.font TkDefaultFont widgetDefault
+
+ ttk::label $w.msg -anchor nw -justify left -text $data(-message)
+ #-background $bg
+ if {$data(-detail) ne ""} {
+ ttk::label $w.dtl -anchor nw -justify left -text $data(-detail)
+ #-background $bg
}
-
- label $w.msg -anchor nw -justify left -text $data(-message) \
- -background $bg
if {$data(-icon) ne ""} {
- if {($windowingsystem eq "classic" || $windowingsystem eq "aqua")
+ if {$windowingsystem eq "aqua"
|| ([winfo depth $w] < 4) || $tk_strictMotif} {
- label $w.bitmap -bitmap $data(-icon) -background $bg
+ # ttk::label has no -bitmap option
+ label $w.bitmap -bitmap $data(-icon);# -background $bg
} else {
canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
-background $bg
@@ -333,7 +339,12 @@ proc ::tk::MessageBox {args} {
}
grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
grid columnconfigure $w.top 1 -weight 1
- grid rowconfigure $w.top 0 -weight 1
+ if {$data(-detail) ne ""} {
+ grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m}
+ grid rowconfigure $w.top 1 -weight 1
+ } else {
+ grid rowconfigure $w.top 0 -weight 1
+ }
# 5. Create a row of buttons at the bottom of the dialog.
@@ -347,8 +358,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
@@ -358,7 +370,7 @@ proc ::tk::MessageBox {args} {
grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew
grid columnconfigure $w.bot $i -uniform buttons
# We boost the size of some Mac buttons for l&f
- if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} {
+ if {$windowingsystem eq "aqua"} {
set tmp [string tolower $name]
if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" ||
$tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" ||
@@ -382,28 +394,31 @@ proc ::tk::MessageBox {args} {
if {$data(-default) ne ""} {
bind $w <FocusIn> {
- if {"Button" eq [winfo class %W]} {
+ if {[winfo class %W] in "Button TButton"} {
%W configure -default active
}
}
bind $w <FocusOut> {
- if {"Button" eq [winfo class %W]} {
+ if {[winfo class %W] in "Button TButton"} {
%W configure -default normal
}
}
}
- # 6. Create bindings for <Return> and <Escape> on the dialog
+ # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
bind $w <Return> {
- if {"Button" eq [winfo class %W]} {
- tk::ButtonInvoke %W
+ if {[winfo class %W] in "Button TButton"} {
+ %W invoke
}
}
# Invoke the designated cancelling operation
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]
+
# 7. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display and de-iconify it.
@@ -426,8 +441,11 @@ proc ::tk::MessageBox {args} {
# restore any grab that was in effect.
vwait ::tk::Priv(button)
+ # Copy the result now so any <Destroy> that happens won't cause
+ # trouble
+ set result $Priv(button)
::tk::RestoreFocusGrab $w $focus
- return $Priv(button)
+ return $result
}