diff options
Diffstat (limited to 'desiredata/src/bgerror.tcl')
-rw-r--r-- | desiredata/src/bgerror.tcl | 254 |
1 files changed, 254 insertions, 0 deletions
diff --git a/desiredata/src/bgerror.tcl b/desiredata/src/bgerror.tcl new file mode 100644 index 00000000..bff0dd2c --- /dev/null +++ b/desiredata/src/bgerror.tcl @@ -0,0 +1,254 @@ +# 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. +# All rights reserved. +# +# RCS: @(#) $Id: bgerror.tcl,v 1.1.2.2.2.2 2007-08-12 02:38:45 matju Exp $ +# $Id: bgerror.tcl,v 1.1.2.2.2.2 2007-08-12 02:38:45 matju Exp $ + +package provide bgerror 8.4 + +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] +} + +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 {} {if {[catch {Details2}]} {::error_dump}} +proc ::tk::dialog::error::Details2 {} { + 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 [.bgerrorDialog.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} {if {[catch { + global errorInfo tcl_platform + variable button + +# matju: use objective.tcl's +# set info $errorInfo + set info [::error_text] + + 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 : + if {($tcl_platform(platform) eq "macintosh") + || ([tk windowingsystem] eq "aqua")} { + set ok [mc Ok] + set messageFont system + set textRelief flat + set textHilight 0 + } else { + set ok [mc OK] + set messageFont {Helvetica -14 bold} + set textRelief sunken + set textHilight 1 + } + + # Truncate the message if it is too wide (longer than 30 characacters) or + # too tall (more than 4 newlines). Truncation occurs at the first point at + # which one of those conditions is met. + set displayedErr "" + set lines 0 + foreach line [split $err \n] { + if {[string length $line]>30} { + append displayedErr "[string range $line 0 29]..." + break + } + if {$lines>4} { + append displayedErr "..." + break + } else { + append displayedErr "${line}\n" + } + incr lines + } + + set w .bgerrorDialog + set title [mc "Application Error"] + set text [mc {Error: %1$s} $err] + 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. + + catch {destroy .bgerrorDialog} + toplevel .bgerrorDialog -class ErrorDialog + wm withdraw .bgerrorDialog + wm title .bgerrorDialog $title + wm iconname .bgerrorDialog ErrorDialog + wm protocol .bgerrorDialog WM_DELETE_WINDOW { } + + if {($tcl_platform(platform) eq "macintosh") + || ([tk windowingsystem] eq "aqua")} { + ::tk::unsupported::MacWindowStyle style .bgerrorDialog zoomDocProc + } + + frame .bgerrorDialog.bot + frame .bgerrorDialog.top + if {[tk windowingsystem] eq "x11"} { + .bgerrorDialog.bot configure -relief raised -bd 1 + .bgerrorDialog.top configure -relief raised -bd 1 + } + pack .bgerrorDialog.bot -side bottom -fill both + pack .bgerrorDialog.top -side top -fill both -expand 1 + + set W [frame $w.top.info] + text $W.text -bd 2 -yscrollcommand [list $W.scroll set] -setgrid true \ + -width 80 -height 10 -state normal -relief $textRelief -highlightthickness $textHilight -wrap char + + scrollbar $W.scroll -relief sunken -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 insert 0.0 $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 .bgerrorDialog] + # ...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 .bgerrorDialog 9m]}] + label .bgerrorDialog.msg -justify left -text $text -font $messageFont \ + -wraplength $wrapwidth + if {($tcl_platform(platform) eq "macintosh") + || ([tk windowingsystem] eq "aqua")} { + # On the Macintosh, use the stop bitmap + label .bgerrorDialog.bitmap -bitmap stop + } else { + # On other platforms, make the error icon + canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0 -bd 0 + .bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black + .bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4 + .bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4 + } + grid .bgerrorDialog.bitmap .bgerrorDialog.msg \ + -in .bgerrorDialog.top \ + -row 0 \ + -padx 3m \ + -pady 3m + grid configure .bgerrorDialog.msg -sticky nsw -padx {0 3m} + grid rowconfigure .bgerrorDialog.top 1 -weight 1 + grid columnconfigure .bgerrorDialog.top 1 -weight 1 + + # 3. Create a row of buttons at the bottom of the dialog. + set i 0 + foreach {name caption} $buttons { + button .bgerrorDialog.$name -text $caption -default normal -command [namespace code [list set button $i]] + grid .bgerrorDialog.$name -in .bgerrorDialog.bot -column $i -row 0 -sticky ew -padx 10 + grid columnconfigure .bgerrorDialog.bot $i -weight 1 + # We boost the size of some Mac buttons for l&f + if {($tcl_platform(platform) eq "macintosh") + || ([tk windowingsystem] eq "aqua")} { + if {($name eq "ok") || ($name eq "dismiss")} { + grid columnconfigure .bgerrorDialog.bot $i -minsize 79 + } + } + incr i + } + # The "OK" button is the default for this dialog. + .bgerrorDialog.ok configure -default active + + bind .bgerrorDialog <Return> [namespace code Return] + bind .bgerrorDialog <Destroy> [namespace code [list Destroy %W]] + .bgerrorDialog.function configure -command [namespace code Details] + + # 6. Update all the geometry information so we know how big it wants + # to be, then center the window in the display and deiconify it. + ::tk::PlaceWindow .bgerrorDialog + + # 7. Ensure that we are topmost. + raise .bgerrorDialog + 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 ".bgerrorDialog"} { + wm attributes .bgerrorDialog -topmost 1 + } + } + + # 8. Set a grab and claim the focus too. + ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.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 .bgerrorDialog .bgerrorDialog.ok destroy + if {$copy == 1} {return -code break} +}]} { + ::error_dump +}} + +namespace eval :: { + # Fool the indexer + proc bgerror err {} + rename bgerror {} + namespace import ::tk::dialog::error::bgerror +} |