1# bgerror.tcl --
2#
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
7#	Donal K. Fellows.
8#
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>
12#
13# RCS: @(#) $Id$
14# $Id$
15
16namespace eval ::tk::dialog::error {
17    namespace import -force ::tk::msgcat::*
18    namespace export bgerror
19    option add *ErrorDialog.function.text [mc "Save To Log"] \
20	widgetDefault
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 \
25		widgetDefault
26	option add *ErrorDialog*info.text.background white widgetDefault
27	option add *ErrorDialog*Button.highlightBackground \
28		systemAlertBackgroundActive widgetDefault
29    }
30}
31
32proc ::tk::dialog::error::Return {} {
33    variable button
34
35    .bgerrorDialog.ok configure -state active -relief sunken
36    update idletasks
37    after 100
38    set button 0
39}
40
41proc ::tk::dialog::error::Details {} {
42    set w .bgerrorDialog
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
47    }
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
51}
52
53proc ::tk::dialog::error::SaveToLog {text} {
54    if { $::tcl_platform(platform) eq "windows" } {
55	set allFiles *.*
56    } else {
57	set allFiles *
58    }
59    set types [list	\
60	    [list [mc "Log Files"] .log]	\
61	    [list [mc "Text Files"] .txt]	\
62	    [list [mc "All Files"] $allFiles] \
63	    ]
64    set filename [tk_getSaveFile -title [mc "Select Log File"] \
65	    -filetypes $types -defaultextension .log -parent .bgerrorDialog]
66    if {![string length $filename]} {
67	return
68    }
69    set f [open $filename w]
70    puts -nonewline $f $text
71    close $f
72}
73
74proc ::tk::dialog::error::Destroy {w} {
75    if {$w eq ".bgerrorDialog"} {
76	variable button
77	set button -1
78    }
79}
80
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
85# trace.
86# Arguments:
87# err -			The error message.
88
89proc ::tk::dialog::error::bgerror err {
90    global errorInfo tcl_platform
91    variable button
92
93    set info $errorInfo
94
95    set ret [catch {::tkerror $err} msg];
96    if {$ret != 1} {return -code $ret $msg}
97
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"} {
102	set ok [mc Ok]
103    } else {
104	set ok [mc OK]
105    }
106
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.
110    set displayedErr ""
111    set lines 0
112    set maxLine 45
113    foreach line [split $err \n] {
114	if { [string length $line] > $maxLine } {
115	    append displayedErr "[string range $line 0 [expr {$maxLine-3}]]..."
116	    break
117	}
118	if { $lines > 4 } {
119	    append displayedErr "..."
120	    break
121	} else {
122	    append displayedErr "${line}\n"
123	}
124	incr lines
125    }
126
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 >>"]]
131
132    # 1. Create the top-level window and divide it into top
133    # and bottom parts.
134
135    set dlg .bgerrorDialog
136    destroy $dlg
137    toplevel $dlg -class ErrorDialog
138    wm withdraw $dlg
139    wm title $dlg $title
140    wm iconname $dlg ErrorDialog
141    wm protocol $dlg WM_DELETE_WINDOW { }
142
143    if {$windowingsystem eq "aqua"} {
144	::tk::unsupported::MacWindowStyle style $dlg moveableAlert {}
145    } elseif {$windowingsystem eq "x11"} {
146	wm attributes $dlg -type dialog
147    }
148
149    frame $dlg.bot
150    frame $dlg.top
151    if {$windowingsystem eq "x11"} {
152	$dlg.bot configure -relief raised -bd 1
153	$dlg.top configure -relief raised -bd 1
154    }
155    pack $dlg.bot -side bottom -fill both
156    pack $dlg.top -side top -fill both -expand 1
157
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
163    }
164
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
172
173    # 2. Fill the top part with bitmap and message
174
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
184    } else {
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
190    }
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
195
196    # 3. Create a row of buttons at the bottom of the dialog.
197
198    set i 0
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
208	    }
209	    grid configure $dlg.$name -pady 7
210	}
211	incr i
212    }
213    # The "OK" button is the default for this dialog.
214    $dlg.ok configure -default active
215
216    bind $dlg <Return>	[namespace code Return]
217    bind $dlg <Destroy>	[namespace code [list Destroy %W]]
218    $dlg.function configure -command [namespace code Details]
219
220    # 6. Place the window (centered in the display) and deiconify it.
221
222    ::tk::PlaceWindow $dlg
223
224    # 7. Ensure that we are topmost.
225
226    raise $dlg
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
232	}
233    }
234
235    # 8. Set a grab and claim the focus too.
236
237    ::tk::SetFocusGrab $dlg $dlg.ok
238
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.
244
245    vwait [namespace which -variable button]
246    set copy $button; # Save a copy...
247
248    ::tk::RestoreFocusGrab $dlg $dlg.ok destroy
249
250    if {$copy == 1} {
251	return -code break
252    }
253}
254
255namespace eval :: {
256    # Fool the indexer
257    proc bgerror err {}
258    rename bgerror {}
259    namespace import ::tk::dialog::error::bgerror
260}
261