3 # Implementation of the bgerror procedure. It posts a dialog box with
4 # the error message and gives the user a chance to see a more detailed
5 # stack trace, and possible do something more interesting with that
6 # trace (like save it to a log). This is adapted from work done by
9 # Copyright (c) 1998-2000 by Ajuba Solutions.
10 # All rights reserved.
12 # RCS: @(#) $Id: bgerror.tcl,v 1.34 2007/05/30 06:34:18 das Exp $
13 # $Id: bgerror.tcl,v 1.34 2007/05/30 06:34:18 das Exp $
15 namespace eval ::tk::dialog::error {
16 namespace import
-force ::tk::msgcat::*
17 namespace export
bgerror
18 option add
*ErrorDialog.function.
text [mc
"Save To Log"] \
20 option add
*ErrorDialog.function.command
[namespace code SaveToLog
]
21 if {[tk windowingsystem
] eq
"aqua"} {
22 option add
*ErrorDialog
*background systemAlertBackgroundActive
\
24 option add
*ErrorDialog
*Button.highlightBackground
\
25 systemAlertBackgroundActive widgetDefault
29 proc ::tk::dialog::error::Return {} {
32 .bgerrorDialog.ok configure
-state active
-relief sunken
38 proc ::tk::dialog::error::Details {} {
40 set caption
[option get
$w.function
text {}]
41 set command
[option get
$w.function command
{}]
42 if { ($caption eq
"") ||
($command eq
"") } {
43 grid forget
$w.function
45 lappend command
[.bgerrorDialog.top.
info.
text get
1.0 end-1c
]
46 $w.function configure
-text $caption -command $command
47 grid $w.top.
info - -sticky nsew
-padx 3m
-pady 3m
50 proc ::tk::dialog::error::SaveToLog {text} {
51 if { $::tcl_platform(platform
) eq
"windows" } {
57 [list [mc
"Log Files"] .log
] \
58 [list [mc
"Text Files"] .txt
] \
59 [list [mc
"All Files"] $allFiles] \
61 set filename [tk_getSaveFile -title [mc
"Select Log File"] \
62 -filetypes $types -defaultextension .log
-parent .bgerrorDialog
]
63 if {![string length
$filename]} {
66 set f
[open $filename w
]
67 puts -nonewline $f $text
71 proc ::tk::dialog::error::Destroy {w
} {
72 if {$w eq
".bgerrorDialog"} {
78 # ::tk::dialog::error::bgerror --
79 # This is the default version of bgerror.
80 # It tries to execute tkerror, if that fails it posts a dialog box containing
81 # the error message and gives the user a chance to ask to see a stack
84 # err - The error message.
86 proc ::tk::dialog::error::bgerror err
{
87 global errorInfo tcl_platform
92 set ret
[catch {::tkerror $err} msg
];
93 if {$ret != 1} {return -code $ret $msg}
95 # Ok the application's tkerror either failed or was not found
96 # we use the default dialog then :
97 set windowingsystem
[tk windowingsystem
]
98 if {$windowingsystem eq
"aqua"} {
100 set messageFont system
105 set messageFont
{Times
-18}
106 set textRelief sunken
111 # Truncate the message if it is too wide (>maxLine characters) or
112 # too tall (>4 lines). Truncation occurs at the first point at
113 # which one of those conditions is met.
117 foreach line
[split $err \n] {
118 if { [string length
$line] > $maxLine } {
119 append displayedErr
"[string range $line 0 [expr {$maxLine-3}]]..."
123 append displayedErr
"..."
126 append displayedErr
"${line}\n"
132 set title
[mc
"Application Error"]
133 set text [mc
"Error: %1\$s" $displayedErr]
134 set buttons
[list ok
$ok dismiss
[mc
"Skip Messages"] \
135 function
[mc
"Details >>"]]
137 # 1. Create the top-level window and divide it into top
140 destroy .bgerrorDialog
141 toplevel .bgerrorDialog
-class ErrorDialog
142 wm withdraw .bgerrorDialog
143 wm title .bgerrorDialog
$title
144 wm iconname .bgerrorDialog ErrorDialog
145 wm protocol .bgerrorDialog WM_DELETE_WINDOW
{ }
147 if {$windowingsystem eq
"aqua"} {
148 ::tk::unsupported::MacWindowStyle style .bgerrorDialog moveableAlert
{}
151 frame .bgerrorDialog.bot
152 frame .bgerrorDialog.top
153 if {$windowingsystem eq
"x11"} {
154 .bgerrorDialog.bot configure
-relief raised
-bd 1
155 .bgerrorDialog.top configure
-relief raised
-bd 1
157 pack .bgerrorDialog.bot
-side bottom
-fill both
158 pack .bgerrorDialog.top
-side top
-fill both
-expand 1
160 set W
[frame $w.top.
info]
162 -yscrollcommand [list $W.scroll
set]\
167 -relief $textRelief \
168 -highlightthickness $textHilight \
170 if {$windowingsystem eq
"aqua"} {
171 $W.
text configure
-width 80 -background white
174 scrollbar $W.scroll
-command [list $W.
text yview
]
175 pack $W.scroll
-side right
-fill y
176 pack $W.
text -side left
-expand yes
-fill both
177 $W.
text insert
0.0 "$err\n$info"
178 $W.
text mark
set insert
0.0
179 bind $W.
text <ButtonPress-1
> { focus %W
}
180 $W.
text configure
-state disabled
182 # 2. Fill the top part with bitmap and message
184 # Max-width of message is the width of the screen...
185 set wrapwidth
[winfo screenwidth .bgerrorDialog
]
186 # ...minus the width of the icon, padding and a fudge factor for
187 # the window manager decorations and aesthetics.
188 set wrapwidth
[expr {$wrapwidth-60-[winfo pixels .bgerrorDialog
9m
]}]
189 label .bgerrorDialog.msg
-justify left
-text $text -font $messageFont \
190 -wraplength $wrapwidth
191 if {$windowingsystem eq
"aqua"} {
192 # On the Macintosh, use the stop bitmap
193 label .bgerrorDialog.
bitmap -bitmap stop
195 # On other platforms, make the error icon
196 canvas .bgerrorDialog.
bitmap -width 32 -height 32 -highlightthickness 0
197 .bgerrorDialog.
bitmap create oval
0 0 31 31 -fill red
-outline black
198 .bgerrorDialog.
bitmap create line
9 9 23 23 -fill white
-width 4
199 .bgerrorDialog.
bitmap create line
9 23 23 9 -fill white
-width 4
201 grid .bgerrorDialog.
bitmap .bgerrorDialog.msg
\
202 -in .bgerrorDialog.top
\
206 grid configure .bgerrorDialog.msg
-sticky nsw
-padx {0 3m
}
207 grid rowconfigure .bgerrorDialog.top
1 -weight 1
208 grid columnconfigure .bgerrorDialog.top
1 -weight 1
210 # 3. Create a row of buttons at the bottom of the dialog.
213 foreach {name caption
} $buttons {
214 button .bgerrorDialog.
$name \
217 -command [namespace code
[list set button $i]]
218 grid .bgerrorDialog.
$name \
219 -in .bgerrorDialog.bot
\
224 grid columnconfigure .bgerrorDialog.bot
$i -weight 1
225 # We boost the size of some Mac buttons for l&f
226 if {$windowingsystem eq
"aqua"} {
227 if {($name eq
"ok") ||
($name eq
"dismiss")} {
228 grid columnconfigure .bgerrorDialog.bot
$i -minsize 90
230 grid configure .bgerrorDialog.
$name -pady 7
234 # The "OK" button is the default for this dialog.
235 .bgerrorDialog.ok configure
-default active
237 bind .bgerrorDialog
<Return
> [namespace code Return
]
238 bind .bgerrorDialog
<Destroy
> [namespace code
[list Destroy
%W
]]
239 .bgerrorDialog.function configure
-command [namespace code Details
]
241 # 6. Place the window (centered in the display) and deiconify it.
243 ::tk::PlaceWindow .bgerrorDialog
245 # 7. Ensure that we are topmost.
248 if {$tcl_platform(platform
) eq
"windows"} {
249 # Place it topmost if we aren't at the top of the stacking
250 # order to ensure that it's seen
251 if {[lindex [wm stackorder .
] end
] ne
".bgerrorDialog"} {
252 wm attributes .bgerrorDialog
-topmost 1
256 # 8. Set a grab and claim the focus too.
258 ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.ok
260 # 9. Wait for the user to respond, then restore the focus and
261 # return the index of the selected button. Restore the focus
262 # before deleting the window, since otherwise the window manager
263 # may take the focus away so we can't redirect it. Finally,
264 # restore any grab that was in effect.
266 vwait [namespace which
-variable button]
267 set copy
$button; # Save a copy...
269 ::tk::RestoreFocusGrab .bgerrorDialog .bgerrorDialog.ok
destroy
280 namespace import
::tk::dialog::error::bgerror