Use ::tk::Priv.*(button) instead of ::tk::Priv(button) in ::tk::MessageBox - see Tk ticket e2cec2fa41.

1 files changed, 31 insertions, 7 deletions

diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index cb69c69..3757019 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -123,8 +123,8 @@ static unsigned char w3_bits[] = {
 #	Color icons are used on Unix displays that have a color
 #	depth of 4 or more and $tk_strictMotif is not on.
 #
-#	Uses ::tk::PrivButton instead of ::tk::Priv(button).
-#	See ticket e2cec2fa41.
+#	Uses ::tk::Priv.${disp}(button) instead of ::tk::Priv(button) to
+#	avoid adverse effects of [::tk::ScreenChanged]. Bug [e2cec2fa41].
 #
 #	This procedure is a private procedure shouldn't be called
 #	directly. Call tk_messageBox instead.
@@ -133,7 +133,7 @@ static unsigned char w3_bits[] = {
 #
 proc ::tk::MessageBox {args} {
     global tk_strictMotif
-    variable ::tk::PrivButton
+    variable ::tk::Priv
 
     set w ::tk::PrivMsgBox
     upvar $w data
@@ -174,6 +174,30 @@ proc ::tk::MessageBox {args} {
 	    "bad window path name \"$data(-parent)\""
     }
 
+    # Select the vwait variable carefully.
+    set oldScreen $Priv(screen)
+    set screen [winfo screen $data(-parent)]
+
+    # Extract the display name (cf. ScreenChanged, including [Bug 2912473] fix).
+    set disp [string range $screen 0 [string last . $screen]-1]
+
+    # Ensure that namespace separators never occur in the display name (as
+    # they cause problems in variable names). Double-colons exist in some VNC
+    # display names. [Bug 2912473]
+    set disp [string map {:: _doublecolon_} $disp]
+
+    if {![info exists ::tk::Priv.${disp}]} {
+	# Use ScreenChanged to create ::tk::Priv.${disp}, then change back to old
+	# screen to avoid interfering with Tk expectations for bindings.
+	ScreenChanged $screen
+	ScreenChanged $oldScreen
+    }
+
+    variable ::tk::Priv.${disp}
+    # Now in place of ::tk::Priv(button), use ::tk::Priv.${disp}(button) which
+    # is the intended target variable of upvar and will not be redefined when
+    # ::tk::ScreenChanged is called.
+
     switch -- $data(-type) {
 	abortretryignore {
 	    set names [list abort retry ignore]
@@ -339,7 +363,7 @@ proc ::tk::MessageBox {args} {
 	}
 
 	eval [list tk::AmpWidget ttk::button $w.$name] $opts \
-		[list -command [list set tk::PrivButton $name]]
+		[list -command [list set tk::Priv.${disp}(button) $name]]
 
 	if {$name eq $data(-default)} {
 	    $w.$name configure -default active
@@ -396,7 +420,7 @@ proc ::tk::MessageBox {args} {
     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::PrivButton $cancel]
+    bind $w.msg <Destroy> [list set tk::Priv.${disp}(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
@@ -419,10 +443,10 @@ proc ::tk::MessageBox {args} {
     # may take the focus away so we can't redirect it.  Finally,
     # restore any grab that was in effect.
 
-    vwait ::tk::PrivButton
+    vwait ::tk::Priv.${disp}(button)
     # Copy the result now so any <Destroy> that happens won't cause
     # trouble
-    set result $PrivButton
+    set result [set Priv.${disp}(button)]
 
     ::tk::RestoreFocusGrab $w $focus