Themed the bgerror dialog and make use of our PNG support to improve the icon.

1 files changed, 77 insertions, 41 deletions

diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index a169e8c..029f44c 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -9,9 +9,10 @@
 # Copyright (c) 1998-2000 by Ajuba Solutions.
 # Copyright (c) 2007 by ActiveState Software Inc.
 # Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
 # 
-# RCS: @(#) $Id: bgerror.tcl,v 1.38 2007/12/13 15:26:26 dgp Exp $
-# $Id: bgerror.tcl,v 1.38 2007/12/13 15:26:26 dgp Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.39 2009/01/08 16:31:03 patthoyts Exp $
+#
 
 namespace eval ::tk::dialog::error {
     namespace import -force ::tk::msgcat::*
@@ -29,6 +30,46 @@ namespace eval ::tk::dialog::error {
     }
 }
 
+image create photo ::tk::dialog::error::image::stop -data {
+    iVBORw0KGgoAAAANSUhEUgAAAB4AAAAgCAYAAAAFQMh/AAAABHNCSVQICAgI
+    fAhkiAAAAAlwSFlzAAAJbAAACWwBxlKDcgAAABl0RVh0U29mdHdhcmUAd3d3
+    Lmlua3NjYXBlLm9yZ5vuPBoAAAXrSURBVEiJlZdNjBtFFsf/r6q73d0ex/Z8
+    KpMZJsmyImImCQixe8gIBOFDEI0EF1gFiQsbTtwiLhxAWpS9cOCyuUTZA1qx
+    J4RWawlBQAKhhOTAhwiQrJIsJMMwkw9nPB5/dLe7qx4Ht+22x55JWnrq6tfV
+    7/d/5ap6ZWJmbHUViCSAeVfKv1ppd5+5LZu2clmbtUZYLvthpVJr1Orn60qd
+    BHB6gVltFZM2AxeIHFuINzM7Jl+a2rc3Pzq1YyhlmEAUAUGj2SllAlLCDwIU
+    l5erS9//UKpev/G+r/XfFpi9uwafkvIld2T477MHH9uey2RNFIuA5/ft247g
+    2EAug9Lt1fDC2XMr3u3SG08p9f4dgQtE5Ej5j51/eujw7tm5HN0sAo3GYFjc
+    bsVhAGyZoLSNn/9/ZW3xm/P/9rV+baEH1AUuEFE6lTo19/ij82O5vI1SeSAI
+    PbBuEfFDLoNiedW/+MWZ014QPJWEi6QK1zCOzz1yYH7Mdm2Uys0gCdPMXcYA
+    dPsdoLh517Ffr1WQd4bsPY/8ed6W8niS1QZ/KuXLOx964PCoYdrs+X1h3SI6
+    pjghAAwGQ7es7iOXydlTD84e/kTKl7vABSLXGckfmxkdybJuwtQdZtUUkoQl
+    MmYGM0NXPExOTWXt4dyxApHbBttCvHnfg/snuOongnVnpXkQqAlTLSEtwdzj
+    rzWw+4H7Jywh3gIAUSCS7vjYX7aZlsm2vQHUbwhVn6w4AevrZyBtpEx3bPjF
+    ApEUAOa377pnmIOw7xAOyqo9KkQda31HBC1Ex4jARFD1AKMzk8MA5g1HyiMj
+    +VyGIwEmAESd5QKKG9wO2FoyXX50f4eEOABg0ZzDnHKwzVKZlBBHDNN15izT
+    hOZEwCcOAgcOxA+dgNRzB3Wv4X6XOn0a4WefNfsZBoTHMNLOnCFdx1XcUcwA
+    aGICNDvb/pj6x2y+Y0Cz7jwTgajzhbp8GSxEc7SYwUpDOinXkI7taM0gKTtg
+    2gzVubTW0Fpv8BMRhBAgoiZUiM5v3wgh7ZRjgBkwDCjd2cQ0EeQmQGaG1hqD
+    CgwzQykFIoKqVKCYQXHWoVcHg2FEnu9pHYFFqj155CaDOyjLQQLCYhH1M2dg
+    TO6AVhFE2oCq+54R1b26Vg3AcNsTRa8sg779Dp1JzWDfR1StgpVqV4HNJlbr
+    XXjpElQUIbp2FQBg778XkRfUjbDunfcawX7j5iLkzAwYBH32HKKz56DrNURL
+    S4iWl6Hj0siJwNxU1Wlv4QeA0JQIveC8EWh9Ym1t/bns9WImXFkBDQ8DUQRV
+    q0OVVruDtdrJ2jvA30+EyLiorlcrkdYnDABf3br2Wyn/h5lM46cr4PX1O1bf
+    tUncgThregw3ri6XAHwlFpi1f2v1vaolQ22n2ltmqzpp3lhx2tWr1bfX37Nn
+    a2YgZaKRMkK/WH5vgbm5hkLmY0s/XFox9sz0hSVFqAH+rcRZe6Zx48efVxTz
+    MSAuiwvMQVBaP3qrVC7Jndu3VL8BluzbR5w5M45yuVoKyrWjC8xBGwwAz2j9
+    wc0fr5z0Mq4nxvN3N7R9sm2ZHM8hyrre6oWrJw9p/UGLt+GU+bFl/mfHw7NP
+    Wus1N/hl5a5mba/fnhmHyrn1G19f+vTZMHouyel7rv5IiHdG7t/1Sj6XyXv/
+    W4T2gu7Ag2Zza9k4Fpw906iWq6XSxcV/HtL69V7GwAP9f4V43skOvTs+u2vS
+    DCMzWLyJqFwbmC0AyGwa1vQolCnDWxeuXf+1XHvjVeBDAB5vdq4GACIyAQwB
+    SOeA7NtER3bnMy/kpsczmWx6iCIN7QVQfgMMQNomyLagDYFKuVpbWyrWLpSq
+    hbeZ/1UD1gHUErbO3KyhXWBq1sOhHssAGDoE7D1I9PSEafzRcizbdFImM1PD
+    byjfawTLYXTtFPOXnwMXAVRjq/S0V5k5HJQxAXAAZGOwCyAd3x0ANoAUABOA
+    ROssCDQABAB8AF6cYT2GrgKoMnO05W8cixAAjBjkxHcrthZYA4gAhAm4FwsI
+    ecBf1t8Bael4x3h6yMUAAAAASUVORK5CYII=
+}
+
 proc ::tk::dialog::error::Return {} {
     variable button
 
@@ -56,19 +97,19 @@ proc ::tk::dialog::error::SaveToLog {text} {
     } else {
 	set allFiles *
     }
-    set types [list	\
-	    [list [mc "Log Files"] .log]	\
-	    [list [mc "Text Files"] .txt]	\
+    set types [list \
+	    [list [mc "Log Files"] .log]      \
+	    [list [mc "Text Files"] .txt]     \
 	    [list [mc "All Files"] $allFiles] \
 	    ]
     set filename [tk_getSaveFile -title [mc "Select Log File"] \
 	    -filetypes $types -defaultextension .log -parent .bgerrorDialog]
-    if {![string length $filename]} {
-	return
+    if {$filename ne {}} {
+        set f [open $filename w]
+        puts -nonewline $f $text
+        close $f
     }
-    set f [open $filename w]
-    puts -nonewline $f $text
-    close $f
+    return
 }
 
 proc ::tk::dialog::error::Destroy {w} {
@@ -79,13 +120,15 @@ proc ::tk::dialog::error::Destroy {w} {
 }
 
 # ::tk::dialog::error::bgerror --
-# This is the default version of bgerror.
-# It tries to execute tkerror, if that fails it posts a dialog box containing
-# the error message and gives the user a chance to ask to see a stack
-# trace.
+#
+#	This is the default version of bgerror.
+#	It tries to execute tkerror, if that fails it posts a dialog box
+#	containing the error message and gives the user a chance to ask
+#	to see a stack trace.
+#
 # Arguments:
-# err -			The error message.
-
+#	err - The error message.
+#
 proc ::tk::dialog::error::bgerror err {
     global errorInfo tcl_platform
     variable button
@@ -133,8 +176,9 @@ proc ::tk::dialog::error::bgerror err {
     # and bottom parts.
 
     set dlg .bgerrorDialog
+    set bg [ttk::style lookup . -background]
     destroy $dlg
-    toplevel $dlg -class ErrorDialog
+    toplevel $dlg -class ErrorDialog -background $bg
     wm withdraw $dlg
     wm title $dlg $title
     wm iconname $dlg ErrorDialog
@@ -144,23 +188,23 @@ proc ::tk::dialog::error::bgerror err {
 	::tk::unsupported::MacWindowStyle style $dlg moveableAlert {}
     }
 
-    frame $dlg.bot
-    frame $dlg.top
+    ttk::frame $dlg.bot
+    ttk::frame $dlg.top
     if {$windowingsystem eq "x11"} {
-	$dlg.bot configure -relief raised -bd 1
-	$dlg.top configure -relief raised -bd 1
+	#$dlg.bot configure -relief raised -border 1
+	#$dlg.top configure -relief raised -border 1
     }
     pack $dlg.bot -side bottom -fill both
     pack $dlg.top -side top -fill both -expand 1
 
-    set W [frame $dlg.top.info]
+    set W [ttk::frame $dlg.top.info]
     text $W.text -setgrid true -height 10 -wrap char \
 	-yscrollcommand [list $W.scroll set]
     if {$windowingsystem ne "aqua"} {
 	$W.text configure -width 40
     }
 
-    scrollbar $W.scroll -command [list $W.text yview]
+    ttk::scrollbar $W.scroll -command [list $W.text yview]
     pack $W.scroll -side right -fill y
     pack $W.text -side left -expand yes -fill both
     $W.text insert 0.0 "$err\n$info"
@@ -175,17 +219,9 @@ proc ::tk::dialog::error::bgerror err {
     # ...minus the width of the icon, padding and a fudge factor for
     # the window manager decorations and aesthetics.
     set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}]
-    label $dlg.msg -justify left -text $text -wraplength $wrapwidth
-    if {$windowingsystem eq "aqua"} {
-	# On the Macintosh, use the stop bitmap
-	label $dlg.bitmap -bitmap stop
-    } else {
-	# On other platforms, make the error icon
-	canvas $dlg.bitmap -width 32 -height 32 -highlightthickness 0
-	$dlg.bitmap create oval 0 0 31 31 -fill red -outline black
-	$dlg.bitmap create line 9 9 23 23 -fill white -width 4
-	$dlg.bitmap create line 9 23 23 9 -fill white -width 4
-    }
+    ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth
+    ttk::label $dlg.bitmap -image ::tk::dialog::error::image::stop
+
     grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m
     grid configure	 $dlg.msg -sticky nsw -padx {0 3m}
     grid rowconfigure	 $dlg.top 1 -weight 1
@@ -195,7 +231,7 @@ proc ::tk::dialog::error::bgerror err {
 
     set i 0
     foreach {name caption} $buttons {
-	button $dlg.$name -text $caption -default normal \
+	ttk::button $dlg.$name -text $caption -default normal \
 	    -command [namespace code [list set button $i]]
 	grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10
 	grid columnconfigure $dlg.bot $i -weight 1
@@ -219,7 +255,11 @@ proc ::tk::dialog::error::bgerror err {
 
     ::tk::PlaceWindow $dlg
 
-    # 7. Ensure that we are topmost.
+    # 7. Set a grab and claim the focus too.
+
+    ::tk::SetFocusGrab $dlg $dlg.ok
+
+    # 8. Ensure that we are topmost.
 
     raise $dlg
     if {$tcl_platform(platform) eq "windows"} {
@@ -227,13 +267,9 @@ proc ::tk::dialog::error::bgerror err {
 	# order to ensure that it's seen
 	if {[lindex [wm stackorder .] end] ne "$dlg"} {
 	    wm attributes $dlg -topmost 1
-	}
+        }
     }
 
-    # 8. Set a grab and claim the focus too.
-
-    ::tk::SetFocusGrab $dlg $dlg.ok
-
     # 9. Wait for the user to respond, then restore the focus and
     # return the index of the selected button.  Restore the focus
     # before deleting the window, since otherwise the window manager