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