diff options
Diffstat (limited to 'tcl/library/bgerror.tcl')
| -rw-r--r-- | tcl/library/bgerror.tcl | 292 |
1 files changed, 0 insertions, 292 deletions
diff --git a/tcl/library/bgerror.tcl b/tcl/library/bgerror.tcl deleted file mode 100644 index 1407b55c4bf..00000000000 --- a/tcl/library/bgerror.tcl +++ /dev/null @@ -1,292 +0,0 @@ -# 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$ -# $Id$ - -namespace eval ::tk { - namespace eval dialog { - namespace eval error { - namespace import ::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 {} { - 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 - } - $w.function configure -text $caption -command \ - "$command [list [.bgerrorDialog.top.info.text get 1.0 end]]" - 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 : - 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 {Times -18} - 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 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 dBoxProc - } - - 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 40 \ - -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 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 - .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 "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. Withdraw the window, then update all the geometry information - # so we know how big it wants to be, then center the window in the - # display and de-iconify it. - - wm withdraw .bgerrorDialog - update idletasks - set parent [winfo parent .bgerrorDialog] - set width [winfo reqwidth .bgerrorDialog] - set height [winfo reqheight .bgerrorDialog] - set x [expr {([winfo screenwidth .bgerrorDialog] - $width )/2 - \ - [winfo vrootx $parent]}] - set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \ - [winfo vrooty $parent]}] - .bgerrorDialog configure -width $width - wm geometry .bgerrorDialog +$x+$y - wm deiconify .bgerrorDialog - - # 7. Set a grab and claim the focus too. - - set oldFocus [focus] - set oldGrab [grab current .bgerrorDialog] - if {$oldGrab != ""} { - set grabStatus [grab status $oldGrab] - } - grab .bgerrorDialog - focus .bgerrorDialog.ok - - # 8. 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... - catch {focus $oldFocus} - catch {destroy .bgerrorDialog} - if {$oldGrab ne ""} { - if {$grabStatus eq "global"} { - grab -global $oldGrab - } else { - grab $oldGrab - } - } - - if {$copy == 1} { - return -code break - } -} - -namespace eval :: { - # Fool the indexer - proc bgerror err {} - rename bgerror {} - namespace import ::tk::dialog::error::bgerror -} |