From 37fc00153a9ac8302e97fd63fd746ae3038d6863 Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts@users.sourceforge.net>
Date: Thu, 8 Jan 2009 16:31:03 +0000
Subject: Themed the bgerror dialog and make use of our PNG support to improve
the icon.
---
ChangeLog | 5 +++
library/bgerror.tcl | 118 ++++++++++++++++++++++++++++++++++------------------
2 files changed, 82 insertions(+), 41 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index bf127f1..2d9b82e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-01-08 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/bgerror.tcl: Theme the bgerror dialog and make use of
+ our PNG support to improve the icon.
+
2009-01-07 Pat Thoyts <patthoyts@users.sourceforge.net>
* library/tkfbox.tcl: [Bug 2473120] mis-ordered messagebox args.
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
--
cgit v0.12