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 # Copyright (c) 2007 by ActiveState Software Inc.
11 # Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
13 # RCS: @(#) $Id: bgerror.tcl,v 1.38.2.1 2010/01/20 23:43:50 patthoyts Exp $
14 # $Id: bgerror.tcl,v 1.38.2.1 2010/01/20 23:43:50 patthoyts Exp $
16 namespace eval ::tk::dialog::error {
17 namespace import
-force ::tk::msgcat::*
18 namespace export
bgerror
19 option add
*ErrorDialog.function.
text [mc
"Save To Log"] \
21 option add
*ErrorDialog.function.command
[namespace code SaveToLog
]
22 option add
*ErrorDialog
*Label.
font TkCaptionFont widgetDefault
23 if {[tk windowingsystem
] eq
"aqua"} {
24 option add
*ErrorDialog
*background systemAlertBackgroundActive
\
26 option add
*ErrorDialog
*info.
text.background white widgetDefault
27 option add
*ErrorDialog
*Button.highlightBackground
\
28 systemAlertBackgroundActive widgetDefault
32 proc ::tk::dialog::error::Return {} {
35 .bgerrorDialog.ok configure
-state active
-relief sunken
41 proc ::tk::dialog::error::Details {} {
43 set caption
[option get
$w.function
text {}]
44 set command
[option get
$w.function command
{}]
45 if { ($caption eq
"") ||
($command eq
"") } {
46 grid forget
$w.function
48 lappend command
[$w.top.
info.
text get
1.0 end-1c
]
49 $w.function configure
-text $caption -command $command
50 grid $w.top.
info - -sticky nsew
-padx 3m
-pady 3m
53 proc ::tk::dialog::error::SaveToLog {text} {
54 if { $::tcl_platform(platform
) eq
"windows" } {
60 [list [mc
"Log Files"] .log
] \
61 [list [mc
"Text Files"] .txt
] \
62 [list [mc
"All Files"] $allFiles] \
64 set filename [tk_getSaveFile -title [mc
"Select Log File"] \
65 -filetypes $types -defaultextension .log
-parent .bgerrorDialog
]
66 if {![string length
$filename]} {
69 set f
[open $filename w
]
70 puts -nonewline $f $text
74 proc ::tk::dialog::error::Destroy {w
} {
75 if {$w eq
".bgerrorDialog"} {
81 # ::tk::dialog::error::bgerror --
82 # This is the default version of bgerror.
83 # It tries to execute tkerror, if that fails it posts a dialog box containing
84 # the error message and gives the user a chance to ask to see a stack
87 # err - The error message.
89 proc ::tk::dialog::error::bgerror err
{
90 global errorInfo tcl_platform
95 set ret
[catch {::tkerror $err} msg
];
96 if {$ret != 1} {return -code $ret $msg}
98 # Ok the application's tkerror either failed or was not found
99 # we use the default dialog then :
100 set windowingsystem
[tk windowingsystem
]
101 if {$windowingsystem eq
"aqua"} {
107 # Truncate the message if it is too wide (>maxLine characters) or
108 # too tall (>4 lines). Truncation occurs at the first point at
109 # which one of those conditions is met.
113 foreach line
[split $err \n] {
114 if { [string length
$line] > $maxLine } {
115 append displayedErr
"[string range $line 0 [expr {$maxLine-3}]]..."
119 append displayedErr
"..."
122 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 set dlg .bgerrorDialog
137 toplevel $dlg -class ErrorDialog
140 wm iconname
$dlg ErrorDialog
141 wm protocol
$dlg WM_DELETE_WINDOW
{ }
143 if {$windowingsystem eq
"aqua"} {
144 ::tk::unsupported::MacWindowStyle style
$dlg moveableAlert
{}
145 } elseif
{$windowingsystem eq
"x11"} {
146 wm attributes
$dlg -type dialog
151 if {$windowingsystem eq
"x11"} {
152 $dlg.bot configure
-relief raised
-bd 1
153 $dlg.top configure
-relief raised
-bd 1
155 pack $dlg.bot
-side bottom
-fill both
156 pack $dlg.top
-side top
-fill both
-expand 1
158 set W
[frame $dlg.top.
info]
159 text $W.
text -setgrid true
-height 10 -wrap char
\
160 -yscrollcommand [list $W.scroll
set]
161 if {$windowingsystem ne
"aqua"} {
162 $W.
text configure
-width 40
165 scrollbar $W.scroll
-command [list $W.
text yview
]
166 pack $W.scroll
-side right
-fill y
167 pack $W.
text -side left
-expand yes
-fill both
168 $W.
text insert
0.0 "$err\n$info"
169 $W.
text mark
set insert
0.0
170 bind $W.
text <ButtonPress-1
> { focus %W
}
171 $W.
text configure
-state disabled
173 # 2. Fill the top part with bitmap and message
175 # Max-width of message is the width of the screen...
176 set wrapwidth
[winfo screenwidth
$dlg]
177 # ...minus the width of the icon, padding and a fudge factor for
178 # the window manager decorations and aesthetics.
179 set wrapwidth
[expr {$wrapwidth-60-[winfo pixels
$dlg 9m
]}]
180 label $dlg.msg
-justify left
-text $text -wraplength $wrapwidth
181 if {$windowingsystem eq
"aqua"} {
182 # On the Macintosh, use the stop bitmap
183 label $dlg.
bitmap -bitmap stop
185 # On other platforms, make the error icon
186 canvas $dlg.
bitmap -width 32 -height 32 -highlightthickness 0
187 $dlg.
bitmap create oval
0 0 31 31 -fill red
-outline black
188 $dlg.
bitmap create line
9 9 23 23 -fill white
-width 4
189 $dlg.
bitmap create line
9 23 23 9 -fill white
-width 4
191 grid $dlg.
bitmap $dlg.msg
-in $dlg.top
-row 0 -padx 3m
-pady 3m
192 grid configure
$dlg.msg
-sticky nsw
-padx {0 3m
}
193 grid rowconfigure
$dlg.top
1 -weight 1
194 grid columnconfigure
$dlg.top
1 -weight 1
196 # 3. Create a row of buttons at the bottom of the dialog.
199 foreach {name caption
} $buttons {
200 button $dlg.
$name -text $caption -default normal
\
201 -command [namespace code
[list set button $i]]
202 grid $dlg.
$name -in $dlg.bot
-column $i -row 0 -sticky ew
-padx 10
203 grid columnconfigure
$dlg.bot
$i -weight 1
204 # We boost the size of some Mac buttons for l&f
205 if {$windowingsystem eq
"aqua"} {
206 if {($name eq
"ok") ||
($name eq
"dismiss")} {
207 grid columnconfigure
$dlg.bot
$i -minsize 90
209 grid configure
$dlg.
$name -pady 7
213 # The "OK" button is the default for this dialog.
214 $dlg.ok configure
-default active
216 bind $dlg <Return
> [namespace code Return
]
217 bind $dlg <Destroy
> [namespace code
[list Destroy
%W
]]
218 $dlg.function configure
-command [namespace code Details
]
220 # 6. Place the window (centered in the display) and deiconify it.
222 ::tk::PlaceWindow $dlg
224 # 7. Ensure that we are topmost.
227 if {$tcl_platform(platform
) eq
"windows"} {
228 # Place it topmost if we aren't at the top of the stacking
229 # order to ensure that it's seen
230 if {[lindex [wm stackorder .
] end
] ne
"$dlg"} {
231 wm attributes
$dlg -topmost 1
235 # 8. Set a grab and claim the focus too.
237 ::tk::SetFocusGrab $dlg $dlg.ok
239 # 9. Wait for the user to respond, then restore the focus and
240 # return the index of the selected button. Restore the focus
241 # before deleting the window, since otherwise the window manager
242 # may take the focus away so we can't redirect it. Finally,
243 # restore any grab that was in effect.
245 vwait [namespace which
-variable button]
246 set copy
$button; # Save a copy...
248 ::tk::RestoreFocusGrab $dlg $dlg.ok
destroy
259 namespace import
::tk::dialog::error::bgerror