summaryrefslogtreecommitdiffstats
path: root/library/bgerror.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/bgerror.tcl')
-rw-r--r--library/bgerror.tcl292
1 files changed, 226 insertions, 66 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 398e140..d3bb58c 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -1,17 +1,77 @@
# bgerror.tcl --
#
-# This file contains a default version 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.
+# 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.
#
-# RCS: @(#) $Id: bgerror.tcl,v 1.8 2000/04/18 02:18:33 ericm Exp $
-#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id: bgerror.tcl,v 1.9 2000/05/31 23:28:46 ericm Exp $
+# $Id: bgerror.tcl,v 1.9 2000/05/31 23:28:46 ericm Exp $
+
+option add *ErrorDialog.message.wrapLength 3.5i widgetDefault
+option add *ErrorDialog.function.text "Save To Log" widgetDefault
+option add *ErrorDialog.function.command "::tk::dialog::error::saveToLog"
+
+namespace eval ::tk {}
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::error {}
+
+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 { [string equal $caption ""] || [string equal $command ""] } {
+ grid forget $w.function
+ }
+ $w.function configure -text $caption \
+ -command [list ::tk::dialog::error::evalFunction $command]
+ grid $w.top.info - -sticky nsew -padx 3m -pady 3m
+}
+
+proc ::tk::dialog::error::evalFunction {cmd} {
+ uplevel \#0 [list $cmd [.bgerrorDialog.top.info.text get 1.0 end]]
+}
+
+proc ::tk::dialog::error::saveToLog {text} {
+ if { [string equal $::tcl_platform(platform) "windows"] } {
+ set allFiles "*.*"
+ } else {
+ set allFiles "*"
+ }
+ set types [list \
+ [list "Log Files" .log] \
+ [list "Text Files" .txt] \
+ [list "All Files" $allFiles] \
+ ]
+ set filename [tk_getSaveFile -title "Select Log File" \
+ -filetypes $types -defaultextension .log -parent .bgerrorDialog]
+ if {![string length $filename]} {
+ return
+ }
+ set f [open $filename w]
+ puts -nonewline $text
+ close $f
+}
+proc ::tk::dialog::error::Destroy {w} {
+ if {".bgerrorDialog" == "$w"} {
+ variable button
+ set button -1
+ }
+}
# bgerror --
# This is the default version of bgerror.
@@ -23,19 +83,9 @@
proc bgerror err {
global errorInfo tcl_platform
-
- # save errorInfo which would be erased in the catch below otherwise.
- set info $errorInfo ;
-
- # For backward compatibility :
- # Let's try to execute "tkerror" (using catch {tkerror ...}
- # instead of searching it with info procs so the application gets
- # a chance to auto load it using its favorite "unknown" mecanism.
- # (we do the default dialog only if we get a TCL_ERROR (=1) return
- # code from the tkerror trial, other ret codes are passed back
- # to our caller (tcl background error handler) so the called "tkerror"
- # can still use return -code break, to skip remaining messages
- # in the error queue for instance)
+ set butvar ::tk::dialog::error::button
+
+ set info $errorInfo
set ret [catch {tkerror $err} msg];
if {$ret != 1} {return -code $ret $msg}
@@ -43,58 +93,168 @@ proc bgerror err {
# Ok the application's tkerror either failed or was not found
# we use the default dialog then :
if {$tcl_platform(platform) == "macintosh"} {
- set ok Ok
+ set ok "Ok"
+ set messageFont system
+ set textRelief "flat"
+ set textHilight 0
} else {
- set ok OK
+ set ok "OK"
+ set messageFont {Times -18}
+ set textRelief "sunken"
+ set textHilight 1
}
- set button [tk_dialog .bgerrorDialog "Error in Tcl Script" \
- "Error: $err" error 0 $ok "Skip Messages" "Stack Trace"]
- if {$button == 0} {
- return
- } elseif {$button == 1} {
- return -code break
+
+ set w .bgerrorDialog
+ set title "Application Error"
+ set text "Error: $err"
+ set buttons [list ok $ok dismiss "Skip Messages" function "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 { }
+
+ # The following, though surprising, works.
+ wm transient .bgerrorDialog .bgerrorDialog
+
+ if {$tcl_platform(platform) == "macintosh"} {
+ unsupported1 style .bgerrorDialog dBoxProc
+ }
+
+ frame .bgerrorDialog.bot
+ frame .bgerrorDialog.top
+ if {$tcl_platform(platform) == "unix"} {
+ .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 "$W.scroll set" \
+ -setgrid true \
+ -width 40 \
+ -height 10 \
+ -state normal \
+ -relief $textRelief \
+ -highlightthickness $textHilight \
+ -wrap char
+
+ scrollbar $W.scroll -relief sunken -command "$W.text yview"
+ pack $W.scroll -side right -fill y
+ pack $W.text -side left -expand yes -fill both
+ $W.text insert 0.0 $info
+ $W.text mark set insert 0.0
+ $W.text configure -state disabled
+
+ # 2. Fill the top part with bitmap and message (use the option
+ # database for -wraplength so that it can be overridden by
+ # the caller).
- set w .bgerrorTrace
- catch {destroy $w}
- toplevel $w -class ErrorTrace
- wm minsize $w 1 1
- wm title $w "Stack Trace for Error"
- wm iconname $w "Stack Trace"
- button $w.ok -text OK -command "destroy $w" -default active
- if {![string compare $tcl_platform(platform) "macintosh"]} {
- text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \
- -yscrollcommand "$w.scroll set" -width 60 -height 20
+ label .bgerrorDialog.msg -justify left -text $text -font $messageFont
+ if { [string equal $tcl_platform(platform) "macintosh"] } {
+ # On the Macintosh, use the stop bitmap
+ label .bgerrorDialog.bitmap -bitmap stop
} else {
- text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
- -setgrid true -width 60 -height 20
+ # 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
}
- scrollbar $w.scroll -relief sunken -command "$w.text yview"
- pack $w.ok -side bottom -padx 3m -pady 2m
- pack $w.scroll -side right -fill y
- pack $w.text -side left -expand yes -fill both
- $w.text insert 0.0 $info
- $w.text mark set insert 0.0
+ grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
+ -in .bgerrorDialog.top \
+ -row 0 \
+ -padx 3m \
+ -pady 3m
+ grid configure .bgerrorDialog.msg -sticky nsw
+ grid rowconfigure .bgerrorDialog.top 1 -weight 1
+ grid columnconfigure .bgerrorDialog.top 1 -weight 1
- bind $w <Return> "destroy $w"
- bind $w.text <Return> "destroy $w; break"
+ # 3. Create a row of buttons at the bottom of the dialog.
- # Center the window on the screen.
+ set i 0
+ foreach {name caption} $buttons {
+ button .bgerrorDialog.$name \
+ -text $caption \
+ -default normal \
+ -command "set $butvar $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) == "macintosh"} {
+ if {($name == "ok") || ($name == "dismiss")} {
+ grid columnconfigure .bgerrorDialog.bot $i -minsize 79
+ }
+ }
+ incr i
+ }
+ # The "OK" button is the default for this dialog.
+ .bgerrorDialog.ok configure -default active
+
+ set ::tk::dialog::error::curh 0
+ bind .bgerrorDialog <Return> {::tk::dialog::error::Return}
+ bind .bgerrorDialog <Destroy> {::tk::dialog::error::Destroy %W}
+ .bgerrorDialog.function configure \
+ -command {::tk::dialog::error::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 $w
+ wm withdraw .bgerrorDialog
update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w +$x+$y
- wm deiconify $w
-
- # Be sure to release any grabs that might be present on the
- # screen, since they could make it impossible for the user
- # to interact with the stack trace.
-
- if {[string compare [grab current .] ""]} {
- grab release [grab current .]
+ 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.
+
+ tkwait variable $butvar
+ set button $::tk::dialog::error::button; # Save a copy...
+ catch {focus $oldFocus}
+ catch {destroy .bgerrorDialog}
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+
+ if {$button == 1} {
+ return -code break
}
}