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