diff options
author | nijtmans <nijtmans> | 2011-01-13 11:32:09 (GMT) |
---|---|---|
committer | nijtmans <nijtmans> | 2011-01-13 11:32:09 (GMT) |
commit | 31f8fbbd1d658b3474895271c7c3525112097d7e (patch) | |
tree | fa77ba941a3e1288d9353670fd8d3f25fb668315 /library/msgbox.tcl | |
parent | ee4a642fd43dde2d79f0175ab24e3a12a420387c (diff) | |
download | tk-31f8fbbd1d658b3474895271c7c3525112097d7e.zip tk-31f8fbbd1d658b3474895271c7c3525112097d7e.tar.gz tk-31f8fbbd1d658b3474895271c7c3525112097d7e.tar.bz2 |
[Patch #3154705] Close button has no effect.
Add <Escape> binding as well (backported from Tcl 8.5)
Diffstat (limited to 'library/msgbox.tcl')
-rw-r--r-- | library/msgbox.tcl | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 045a433..d8b04bf 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.24.2.5 2010/01/23 01:36:03 patthoyts Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.24.2.6 2011/01/13 11:32:09 nijtmans Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -157,8 +157,6 @@ proc ::tk::MessageBox {args} { if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } - - # Store tk windowingsystem to avoid too many calls set windowingsystem [tk windowingsystem] if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { switch -- $data(-icon) { @@ -179,26 +177,32 @@ proc ::tk::MessageBox {args} { abortretryignore { set names [list abort retry ignore] set labels [list &Abort &Retry &Ignore] + set cancel abort } ok { set names [list ok] set labels {&OK} + set cancel ok } okcancel { set names [list ok cancel] set labels [list &OK &Cancel] + set cancel cancel } retrycancel { set names [list retry cancel] set labels [list &Retry &Cancel] + set cancel cancel } yesno { set names [list yes no] set labels [list &Yes &No] + set cancel no } yesnocancel { set names [list yes no cancel] set labels [list &Yes &No &Cancel] + set cancel cancel } default { error "bad -type value \"$data(-type)\": must be\ @@ -242,11 +246,11 @@ proc ::tk::MessageBox {args} { # 3. Create the top-level window and divide it into top # and bottom parts. - destroy $w + catch {destroy $w} toplevel $w -class Dialog wm title $w $data(-title) wm iconname $w Dialog - wm protocol $w WM_DELETE_WINDOW { } + 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] @@ -259,7 +263,7 @@ proc ::tk::MessageBox {args} { # if {[winfo viewable [winfo toplevel $data(-parent)]] } { wm transient $w $data(-parent) - } + } if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w moveableModal {} @@ -391,7 +395,7 @@ proc ::tk::MessageBox {args} { } } - # 6. Create a binding for <Return> on the dialog + # 6. Create bindings for <Return> and <Escape> on the dialog bind $w <Return> { if {"Button" eq [winfo class %W]} { @@ -399,6 +403,9 @@ proc ::tk::MessageBox {args} { } } + # Invoke the designated cancelling operation + bind $w <Escape> [list $w.$cancel invoke] + # 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. |