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 Daniel A. Steffen <das@users.sourceforge.net>
11#
12# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.9 2007/11/09 06:26:54 das Exp $
13# $Id: bgerror.tcl,v 1.23.2.9 2007/11/09 06:26:54 das Exp $
14
15namespace eval ::tk::dialog::error {
16    namespace import -force ::tk::msgcat::*
17    namespace export bgerror
18    option add *ErrorDialog.function.text [mc "Save To Log"] \
19	widgetDefault
20    option add *ErrorDialog.function.command [namespace code SaveToLog]
21    if {[tk windowingsystem] eq "aqua"} {
22	option add *ErrorDialog*background systemAlertBackgroundActive \
23		widgetDefault
24	option add *ErrorDialog*info.text.background white widgetDefault
25	option add *ErrorDialog*Button.highlightBackground \
26		systemAlertBackgroundActive widgetDefault
27    }
28}
29
30proc ::tk::dialog::error::Return {} {
31    variable button
32
33    .bgerrorDialog.ok configure -state active -relief sunken
34    update idletasks
35    after 100
36    set button 0
37}
38
39proc ::tk::dialog::error::Details {} {
40    set w .bgerrorDialog
41    set caption [option get $w.function text {}]
42    set command [option get $w.function command {}]
43    if { ($caption eq "") || ($command eq "") } {
44	grid forget $w.function
45    }
46    lappend command [.bgerrorDialog.top.info.text get 1.0 end-1c]
47    $w.function configure -text $caption -command $command
48    grid $w.top.info - -sticky nsew -padx 3m -pady 3m
49}
50
51proc ::tk::dialog::error::SaveToLog {text} {
52    if { $::tcl_platform(platform) eq "windows" } {
53	set allFiles *.*
54    } else {
55	set allFiles *
56    }
57    set types [list	\
58	    [list [mc "Log Files"] .log]	\
59	    [list [mc "Text Files"] .txt]	\
60	    [list [mc "All Files"] $allFiles] \
61	    ]
62    set filename [tk_getSaveFile -title [mc "Select Log File"] \
63	    -filetypes $types -defaultextension .log -parent .bgerrorDialog]
64    if {![string length $filename]} {
65	return
66    }
67    set f [open $filename w]
68    puts -nonewline $f $text
69    close $f
70}
71
72proc ::tk::dialog::error::Destroy {w} {
73    if {$w eq ".bgerrorDialog"} {
74	variable button
75	set button -1
76    }
77}
78
79# ::tk::dialog::error::bgerror --
80# This is the default version of bgerror.
81# It tries to execute tkerror, if that fails it posts a dialog box containing
82# the error message and gives the user a chance to ask to see a stack
83# trace.
84# Arguments:
85# err -			The error message.
86
87proc ::tk::dialog::error::bgerror err {
88    global errorInfo tcl_platform
89    variable button
90
91    set info $errorInfo
92
93    set ret [catch {::tkerror $err} msg];
94    if {$ret != 1} {return -code $ret $msg}
95
96    # Ok the application's tkerror either failed or was not found
97    # we use the default dialog then :
98    set windowingsystem [tk windowingsystem]
99
100    if {($tcl_platform(platform) eq "macintosh")
101             || ($windowingsystem eq "aqua")} {
102	set ok		[mc Ok]
103	set messageFont	system
104	set textRelief	flat
105	set textHilight	0
106    } else {
107	set ok		[mc OK]
108	set messageFont	{Times -18}
109	set textRelief	sunken
110	set textHilight	1
111    }
112
113
114    # Truncate the message if it is too wide (longer than 30 characacters) or
115    # too tall (more than 4 newlines).  Truncation occurs at the first point at
116    # which one of those conditions is met.
117    set displayedErr ""
118    set lines 0
119    foreach line [split $err \n] {
120	if { [string length $line] > 30 } {
121	    append displayedErr "[string range $line 0 29]..."
122	    break
123	}
124	if { $lines > 4 } {
125	    append displayedErr "..."
126	    break
127	} else {
128	    append displayedErr "${line}\n"
129	}
130	incr lines
131    }
132
133    set w .bgerrorDialog
134    set title [mc "Application Error"]
135    set text [mc {Error: %1$s} $displayedErr]
136    set buttons [list ok $ok dismiss [mc "Skip Messages"] \
137	    function [mc "Details >>"]]
138
139    # 1. Create the top-level window and divide it into top
140    # and bottom parts.
141
142    destroy .bgerrorDialog
143    toplevel .bgerrorDialog -class ErrorDialog
144    wm withdraw .bgerrorDialog
145    wm title .bgerrorDialog $title
146    wm iconname .bgerrorDialog ErrorDialog
147    wm protocol .bgerrorDialog WM_DELETE_WINDOW { }
148
149    if {($tcl_platform(platform) eq "macintosh")
150            || ($windowingsystem eq "aqua")} {
151	::tk::unsupported::MacWindowStyle style .bgerrorDialog moveableAlert {}
152    } elseif {$windowingsystem eq "x11"} {
153	wm attributes .bgerrorDialog -type dialog
154    }
155
156    frame .bgerrorDialog.bot
157    frame .bgerrorDialog.top
158    if {$windowingsystem eq "x11"} {
159	.bgerrorDialog.bot configure -relief raised -bd 1
160	.bgerrorDialog.top configure -relief raised -bd 1
161    }
162    pack .bgerrorDialog.bot -side bottom -fill both
163    pack .bgerrorDialog.top -side top -fill both -expand 1
164
165    set W [frame $w.top.info]
166    text $W.text				\
167	    -yscrollcommand [list $W.scroll set]\
168	    -setgrid true			\
169	    -width 40				\
170	    -height 10				\
171	    -state normal			\
172	    -relief $textRelief			\
173	    -highlightthickness $textHilight	\
174	    -wrap char
175    if {$windowingsystem eq "aqua"} {
176	$W.text configure -width 80 -background white
177    }
178
179    scrollbar $W.scroll -command [list $W.text yview]
180    pack $W.scroll -side right -fill y
181    pack $W.text -side left -expand yes -fill both
182    $W.text insert 0.0 "$err\n$info"
183    $W.text mark set insert 0.0
184    bind $W.text <ButtonPress-1> { focus %W }
185    $W.text configure -state disabled
186
187    # 2. Fill the top part with bitmap and message
188
189    # Max-width of message is the width of the screen...
190    set wrapwidth [winfo screenwidth .bgerrorDialog]
191    # ...minus the width of the icon, padding and a fudge factor for
192    # the window manager decorations and aesthetics.
193    set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
194    label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
195	    -wraplength $wrapwidth
196    if {($tcl_platform(platform) eq "macintosh")
197            || ($windowingsystem eq "aqua")} {
198	# On the Macintosh, use the stop bitmap
199	label .bgerrorDialog.bitmap -bitmap stop
200    } else {
201	# On other platforms, make the error icon
202	canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
203	.bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
204	.bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4
205	.bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4
206    }
207    grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
208	    -in .bgerrorDialog.top	\
209	    -row 0			\
210	    -padx 3m			\
211	    -pady 3m
212    grid configure	 .bgerrorDialog.msg -sticky nsw -padx {0 3m}
213    grid rowconfigure	 .bgerrorDialog.top 1 -weight 1
214    grid columnconfigure .bgerrorDialog.top 1 -weight 1
215
216    # 3. Create a row of buttons at the bottom of the dialog.
217
218    set i 0
219    foreach {name caption} $buttons {
220	button .bgerrorDialog.$name	\
221		-text $caption		\
222		-default normal		\
223		-command [namespace code [list set button $i]]
224	grid .bgerrorDialog.$name	\
225		-in .bgerrorDialog.bot	\
226		-column $i		\
227		-row 0			\
228		-sticky ew		\
229		-padx 10
230	grid columnconfigure .bgerrorDialog.bot $i -weight 1
231	# We boost the size of some Mac buttons for l&f
232	if {($tcl_platform(platform) eq "macintosh")
233	    || ($windowingsystem eq "aqua")} {
234	    if {($name eq "ok") || ($name eq "dismiss")} {
235		grid columnconfigure .bgerrorDialog.bot $i -minsize 90
236	    }
237	    grid configure .bgerrorDialog.$name -pady 7
238	}
239	incr i
240    }
241    # The "OK" button is the default for this dialog.
242    .bgerrorDialog.ok configure -default active
243
244    bind .bgerrorDialog <Return>	[namespace code Return]
245    bind .bgerrorDialog <Destroy>	[namespace code [list Destroy %W]]
246    .bgerrorDialog.function configure -command [namespace code Details]
247
248    # 6. Update all the geometry information so we know how big it wants
249    # to be, then center the window in the display and deiconify it.
250
251    ::tk::PlaceWindow .bgerrorDialog
252
253    # 7. Ensure that we are topmost.
254
255    raise .bgerrorDialog
256    if {$tcl_platform(platform) eq "windows"} {
257	# Place it topmost if we aren't at the top of the stacking
258	# order to ensure that it's seen
259	if {[lindex [wm stackorder .] end] ne ".bgerrorDialog"} {
260	    wm attributes .bgerrorDialog -topmost 1
261	}
262    }
263
264    # 8. Set a grab and claim the focus too.
265
266    ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.ok
267
268    # 9. Wait for the user to respond, then restore the focus and
269    # return the index of the selected button.  Restore the focus
270    # before deleting the window, since otherwise the window manager
271    # may take the focus away so we can't redirect it.  Finally,
272    # restore any grab that was in effect.
273
274    vwait [namespace which -variable button]
275    set copy $button; # Save a copy...
276
277    ::tk::RestoreFocusGrab .bgerrorDialog .bgerrorDialog.ok destroy
278
279    if {$copy == 1} {
280	return -code break
281    }
282}
283
284namespace eval :: {
285    # Fool the indexer
286    proc bgerror err {}
287    rename bgerror {}
288    namespace import ::tk::dialog::error::bgerror
289}
290