import tk 8.4.0TK_8_4_0

1 files changed, 83 insertions, 76 deletions

diff --git a/tk/library/msgbox.tcl b/tk/library/msgbox.tcl
index 1e6744f629f..20862b5b117 100644
--- a/tk/library/msgbox.tcl
+++ b/tk/library/msgbox.tcl
@@ -114,7 +114,7 @@ static unsigned char w3_bits[] = {
    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
 
-# tkMessageBox --
+# ::tk::MessageBox --
 #
 #	Pops up a messagebox with an application-supplied message with
 #	an icon and a list of buttons. This procedure will be called
@@ -130,11 +130,12 @@ static unsigned char w3_bits[] = {
 #
 #	See the user documentation for details on what tk_messageBox does.
 #
-proc tkMessageBox {args} {
-    global tkPriv tcl_platform tk_strictMotif
+proc ::tk::MessageBox {args} {
+    global tcl_platform tk_strictMotif
+    variable ::tk::Priv
 
-    set w tkPrivMsgBox
-    upvar #0 $w data
+    set w ::tk::PrivMsgBox
+    upvar $w data
 
     #
     # The default value of the title is space (" ") not the empty string
@@ -146,7 +147,6 @@ proc tkMessageBox {args} {
 	{-default "" "" ""}
         {-icon "" "" "info"}
         {-message "" "" ""}
-        {-modal "" "" ""}
         {-parent "" "" .}
         {-title "" "" " "}
         {-type "" "" "ok"}
@@ -157,7 +157,8 @@ proc tkMessageBox {args} {
     if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
 	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
     }
-    if {[string equal $tcl_platform(platform) "macintosh"]} {
+    if {[string equal [tk windowingsystem] "classic"]
+	    || [string equal [tk windowingsystem] "aqua"]} {
 	switch -- $data(-icon) {
 	    "error"     {set data(-icon) "stop"}
 	    "warning"   {set data(-icon) "caution"}
@@ -170,63 +171,64 @@ proc tkMessageBox {args} {
     }
 
     switch -- $data(-type) {
-	abortretryignore {
-	    set buttons {
-		{abort  -width 6 -text Abort -under 0}
-		{retry  -width 6 -text Retry -under 0}
-		{ignore -width 6 -text Ignore -under 0}
-	    }
+	abortretryignore { 
+	    set names [list abort retry ignore]
+	    set labels [list &Abort &Retry &Ignore]
 	}
 	ok {
-	    set buttons {
-		{ok -width 6 -text OK -under 0}
-	    }
-	    if {[string equal $data(-default) ""]} {
-		set data(-default) "ok"
-	    }
+	    set names [list ok]
+	    set labels {&OK}
 	}
 	okcancel {
-	    set buttons {
-		{ok     -width 6 -text OK     -under 0}
-		{cancel -width 6 -text Cancel -under 0}
-	    }
+	    set names [list ok cancel]
+	    set labels [list &OK &Cancel]
 	}
 	retrycancel {
-	    set buttons {
-		{retry  -width 6 -text Retry  -under 0}
-		{cancel -width 6 -text Cancel -under 0}
-	    }
+	    set names [list retry cancel]
+	    set labels [list &Retry &Cancel]
 	}
 	yesno {
-	    set buttons {
-		{yes    -width 6 -text Yes -under 0}
-		{no     -width 6 -text No  -under 0}
-	    }
+	    set names [list yes no]
+	    set labels [list &Yes &No]
 	}
 	yesnocancel {
-	    set buttons {
-		{yes    -width 6 -text Yes -under 0}
-		{no     -width 6 -text No  -under 0}
-		{cancel -width 6 -text Cancel -under 0}
-	    }
+	    set names [list yes no cancel]
+	    set labels [list &Yes &No &Cancel]
 	}
 	default {
-	    error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
+	    error "bad -type value \"$data(-type)\": must be\
+		    abortretryignore, ok, okcancel, retrycancel,\
+		    yesno, or yesnocancel"
 	}
     }
+    
+    set maxWidth [eval mcmaxamp $labels]
+    if {$maxWidth <6} {
+	set maxWidth 6
+    }
 
-    if {[string compare $data(-default) ""]} {
-	set valid 0
-	foreach btn $buttons {
-	    if {[string equal [lindex $btn 0] $data(-default)]} {
-		set valid 1
-		break
-	    }
-	}
-	if {!$valid} {
-	    error "invalid default button \"$data(-default)\""
+    set buttons {}
+    foreach name $names lab $labels {
+	lappend buttons [list $name -width $maxWidth -text [mc $lab]]
+    }
+
+    # If no default button was specified, the default default is the 
+    # first button (Bug: 2218).
+
+    if {$data(-default) == ""} {
+	set data(-default) [lindex [lindex $buttons 0] 0]
+    }
+
+    set valid 0
+    foreach btn $buttons {
+	if {[string equal [lindex $btn 0] $data(-default)]} {
+	    set valid 1
+	    break
 	}
     }
+    if {!$valid} {
+	error "invalid default button \"$data(-default)\""
+    }
 
     # 2. Set the dialog to be a child window of $parent
     #
@@ -245,6 +247,8 @@ proc tkMessageBox {args} {
     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
@@ -253,19 +257,21 @@ proc tkMessageBox {args} {
     # "grab"bed windows.  So only make the message box transient if the parent
     # is viewable.
     #
-    if { [winfo viewable [winfo toplevel $data(-parent)]] } {
+    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
 	wm transient $w $data(-parent)
     }    
 
-    if {[string equal $tcl_platform(platform) "macintosh"]} {
-	unsupported1 style $w dBoxProc
+    if {[string equal [tk windowingsystem] "classic"]
+	    || [string equal [tk windowingsystem] "aqua"]} {
+	unsupported::MacWindowStyle style $w dBoxProc
     }
 
-    frame $w.bot
+    frame $w.bot -background $bg
     pack $w.bot -side bottom -fill both
-    frame $w.top
+    frame $w.top -background $bg
     pack $w.top -side top -fill both -expand 1
-    if {[string compare $tcl_platform(platform) "macintosh"]} {
+    if {![string equal [tk windowingsystem] "classic"]
+	    && ![string equal [tk windowingsystem] "aqua"]} {
 	$w.bot configure -relief raised -bd 1
 	$w.top configure -relief raised -bd 1
     }
@@ -275,19 +281,23 @@ proc tkMessageBox {args} {
     # overridden by the caller).
 
     option add *Dialog.msg.wrapLength 3i widgetDefault
-    if {[string equal $tcl_platform(platform) "macintosh"]} {
+    if {[string equal [tk windowingsystem] "classic"]
+	    || [string equal [tk windowingsystem] "aqua"]} {
 	option add *Dialog.msg.font system widgetDefault
     } else {
 	option add *Dialog.msg.font {Times 18} widgetDefault
     }
 
-    label $w.msg -anchor nw -justify left -text $data(-message)
+    label $w.msg -anchor nw -justify left -text $data(-message) \
+	    -background $bg
     if {[string compare $data(-icon) ""]} {
-	if {[string equal $tcl_platform(platform) "macintosh"] \
+	if {([string equal [tk windowingsystem] "classic"]
+		|| [string equal [tk windowingsystem] "aqua"])
 		|| ([winfo depth $w] < 4) || $tk_strictMotif} {
-	    label $w.bitmap -bitmap $data(-icon)
+	    label $w.bitmap -bitmap $data(-icon) -background $bg
 	} else {
-	    canvas $w.bitmap -width 32 -height 32 -highlightthickness 0
+	    canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
+		    -background $bg
 	    switch $data(-icon) {
 		error {
 		    $w.bitmap create oval 0 0 31 31 -fill red -outline black
@@ -337,28 +347,27 @@ proc tkMessageBox {args} {
 	    set opts [list -text $capName]
 	}
 
-	eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
+	eval [list tk::AmpWidget button $w.$name] $opts \
+		[list -command [list set tk::Priv(button) $name]]
 
 	if {[string equal $name $data(-default)]} {
 	    $w.$name configure -default active
+	} else {
+	    $w.$name configure -default normal
 	}
 	pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
 
 	# create the binding for the key accelerator, based on the underline
 	#
-	set underIdx [$w.$name cget -under]
-	if {$underIdx >= 0} {
-	    set key [string index [$w.$name cget -text] $underIdx]
-	    bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
-	    bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
-	}
-
-        # CYGNUS LOCAL - bind all buttons so that <Return>
-        # activates them
-        bind $w.$name <Return> "$w.$name invoke"
-
-	incr i
+        # set underIdx [$w.$name cget -under]
+        # if {$underIdx >= 0} {
+        #     set key [string index [$w.$name cget -text] $underIdx]
+        #     bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
+        #     bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
+        # }
+        # incr i
     }
+    bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
 
     if {[string compare {} $data(-default)]} {
 	bind $w <FocusIn> {
@@ -377,7 +386,7 @@ proc tkMessageBox {args} {
 
     bind $w <Return> {
 	if {[string equal Button [winfo class %W]]} {
-	    tkButtonInvoke %W
+	    tk::ButtonInvoke %W
 	}
     }
 
@@ -402,11 +411,9 @@ proc tkMessageBox {args} {
     # may take the focus away so we can't redirect it.  Finally,
     # restore any grab that was in effect.
 
-    tkwait variable tkPriv(button)
+    vwait ::tk::Priv(button)
 
     ::tk::RestoreFocusGrab $w $focus
 
-    return $tkPriv(button)
+    return $Priv(button)
 }
-
-