From 7eccaa84f5e75e30e38efe8de25a099ef2195be2 Mon Sep 17 00:00:00 2001
From: nijtmans <nijtmans@noemail.net>
Date: Thu, 13 Jan 2011 11:32:09 +0000
Subject: [Patch #3154705] Close button has no effect. Add <Escape> binding as
well (backported from Tcl 8.5)
FossilOrigin-Name: 3f19aab7fc28c9b630688794eb00c94d429361b7
---
ChangeLog | 5 +++++
library/msgbox.tcl | 21 ++++++++++++++-------
2 files changed, 19 insertions(+), 7 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index ed194c1..1872bfb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/msgbox.tcl: [Patch #3154705] Close button has no
+ effect. Add <Escape> binding as well (backported from Tcl 8.5)
+
2010-10-31 Jan Nijtmans <nijtmans@users.sf.net>
* win/tcl.m4 Add -D_CRT_SECURE_NO_DEPRECATE and
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.
--
cgit v0.12