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.23.2.6 2006/06/22 00:37:01 hobbs Exp $
13 # $Id: bgerror.tcl,v 1.23.2.6 2006/06/22 00:37:01 hobbs 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
]
23 proc ::tk::dialog::error::Return {} {
26 .bgerrorDialog.ok configure
-state active
-relief sunken
32 proc ::tk::dialog::error::Details {} {
34 set caption
[option get
$w.function
text {}]
35 set command
[option get
$w.function command
{}]
36 if { ($caption eq
"") ||
($command eq
"") } {
37 grid forget
$w.function
39 lappend command
[.bgerrorDialog.top.
info.
text get
1.0 end-1c
]
40 $w.function configure
-text $caption -command $command
41 grid $w.top.
info - -sticky nsew
-padx 3m
-pady 3m
44 proc ::tk::dialog::error::SaveToLog {text} {
45 if { $::tcl_platform(platform
) eq
"windows" } {
51 [list [mc
"Log Files"] .log
] \
52 [list [mc
"Text Files"] .txt
] \
53 [list [mc
"All Files"] $allFiles] \
55 set filename [tk_getSaveFile -title [mc
"Select Log File"] \
56 -filetypes $types -defaultextension .log
-parent .bgerrorDialog
]
57 if {![string length
$filename]} {
60 set f
[open $filename w
]
61 puts -nonewline $f $text
65 proc ::tk::dialog::error::Destroy {w
} {
66 if {$w eq
".bgerrorDialog"} {
72 # ::tk::dialog::error::bgerror --
73 # This is the default version of bgerror.
74 # It tries to execute tkerror, if that fails it posts a dialog box containing
75 # the error message and gives the user a chance to ask to see a stack
78 # err - The error message.
80 proc ::tk::dialog::error::bgerror err
{
81 global errorInfo tcl_platform
86 set ret
[catch {::tkerror $err} msg
];
87 if {$ret != 1} {return -code $ret $msg}
89 # Ok the application's tkerror either failed or was not found
90 # we use the default dialog then :
91 set windowingsystem
[tk windowingsystem
]
93 if {($tcl_platform(platform
) eq
"macintosh")
94 ||
($windowingsystem eq
"aqua")} {
96 set messageFont system
101 set messageFont
{Times
-18}
102 set textRelief sunken
107 # Truncate the message if it is too wide (longer than 30 characacters) or
108 # too tall (more than 4 newlines). Truncation occurs at the first point at
109 # which one of those conditions is met.
112 foreach line
[split $err \n] {
113 if { [string length
$line] > 30 } {
114 append displayedErr
"[string range $line 0 29]..."
118 append displayedErr
"..."
121 append displayedErr
"${line}\n"
127 set title
[mc
"Application Error"]
128 set text [mc
{Error
: %1$s} $displayedErr]
129 set buttons
[list ok
$ok dismiss
[mc
"Skip Messages"] \
130 function
[mc
"Details >>"]]
132 # 1. Create the top-level window and divide it into top
135 destroy .bgerrorDialog
136 toplevel .bgerrorDialog
-class ErrorDialog
137 wm withdraw .bgerrorDialog
138 wm title .bgerrorDialog
$title
139 wm iconname .bgerrorDialog ErrorDialog
140 wm protocol .bgerrorDialog WM_DELETE_WINDOW
{ }
142 if {($tcl_platform(platform
) eq
"macintosh")
143 ||
($windowingsystem eq
"aqua")} {
144 ::tk::unsupported::MacWindowStyle style .bgerrorDialog zoomDocProc
147 frame .bgerrorDialog.bot
148 frame .bgerrorDialog.top
149 if {$windowingsystem eq
"x11"} {
150 .bgerrorDialog.bot configure
-relief raised
-bd 1
151 .bgerrorDialog.top configure
-relief raised
-bd 1
153 pack .bgerrorDialog.bot
-side bottom
-fill both
154 pack .bgerrorDialog.top
-side top
-fill both
-expand 1
156 set W
[frame $w.top.
info]
158 -yscrollcommand [list $W.scroll
set]\
163 -relief $textRelief \
164 -highlightthickness $textHilight \
167 scrollbar $W.scroll
-command [list $W.
text yview
]
168 pack $W.scroll
-side right
-fill y
169 pack $W.
text -side left
-expand yes
-fill both
170 $W.
text insert
0.0 "$err\n$info"
171 $W.
text mark
set insert
0.0
172 bind $W.
text <ButtonPress-1
> { focus %W
}
173 $W.
text configure
-state disabled
175 # 2. Fill the top part with bitmap and message
177 # Max-width of message is the width of the screen...
178 set wrapwidth
[winfo screenwidth .bgerrorDialog
]
179 # ...minus the width of the icon, padding and a fudge factor for
180 # the window manager decorations and aesthetics.
181 set wrapwidth
[expr {$wrapwidth-60-[winfo pixels .bgerrorDialog
9m
]}]
182 label .bgerrorDialog.msg
-justify left
-text $text -font $messageFont \
183 -wraplength $wrapwidth
184 if {($tcl_platform(platform
) eq
"macintosh")
185 ||
($windowingsystem eq
"aqua")} {
186 # On the Macintosh, use the stop bitmap
187 label .bgerrorDialog.
bitmap -bitmap stop
189 # On other platforms, make the error icon
190 canvas .bgerrorDialog.
bitmap -width 32 -height 32 -highlightthickness 0
191 .bgerrorDialog.
bitmap create oval
0 0 31 31 -fill red
-outline black
192 .bgerrorDialog.
bitmap create line
9 9 23 23 -fill white
-width 4
193 .bgerrorDialog.
bitmap create line
9 23 23 9 -fill white
-width 4
195 grid .bgerrorDialog.
bitmap .bgerrorDialog.msg
\
196 -in .bgerrorDialog.top
\
200 grid configure .bgerrorDialog.msg
-sticky nsw
-padx {0 3m
}
201 grid rowconfigure .bgerrorDialog.top
1 -weight 1
202 grid columnconfigure .bgerrorDialog.top
1 -weight 1
204 # 3. Create a row of buttons at the bottom of the dialog.
207 foreach {name caption
} $buttons {
208 button .bgerrorDialog.
$name \
211 -command [namespace code
[list set button $i]]
212 grid .bgerrorDialog.
$name \
213 -in .bgerrorDialog.bot
\
218 grid columnconfigure .bgerrorDialog.bot
$i -weight 1
219 # We boost the size of some Mac buttons for l&f
220 if {($tcl_platform(platform
) eq
"macintosh")
221 ||
($windowingsystem eq
"aqua")} {
222 if {($name eq
"ok") ||
($name eq
"dismiss")} {
223 grid columnconfigure .bgerrorDialog.bot
$i -minsize 79
228 # The "OK" button is the default for this dialog.
229 .bgerrorDialog.ok configure
-default active
231 bind .bgerrorDialog
<Return
> [namespace code Return
]
232 bind .bgerrorDialog
<Destroy
> [namespace code
[list Destroy
%W
]]
233 .bgerrorDialog.function configure
-command [namespace code Details
]
235 # 6. Update all the geometry information so we know how big it wants
236 # to be, then center the window in the display and deiconify it.
238 ::tk::PlaceWindow .bgerrorDialog
240 # 7. Ensure that we are topmost.
243 if {$tcl_platform(platform
) eq
"windows"} {
244 # Place it topmost if we aren't at the top of the stacking
245 # order to ensure that it's seen
246 if {[lindex [wm stackorder .
] end
] ne
".bgerrorDialog"} {
247 wm attributes .bgerrorDialog
-topmost 1
251 # 8. Set a grab and claim the focus too.
253 ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.ok
255 # 9. Wait for the user to respond, then restore the focus and
256 # return the index of the selected button. Restore the focus
257 # before deleting the window, since otherwise the window manager
258 # may take the focus away so we can't redirect it. Finally,
259 # restore any grab that was in effect.
261 vwait [namespace which
-variable button]
262 set copy
$button; # Save a copy...
264 ::tk::RestoreFocusGrab .bgerrorDialog .bgerrorDialog.ok
destroy
275 namespace import
::tk::dialog::error::bgerror