# 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.## SCCS: @(#) bgerror.tcl 1.16 97/08/06 09:19:50## 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.# 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 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)  -- dl    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) == "macintosh"} {	set ok Ok    } else {	set ok OK    }    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 .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 {$tcl_platform(platform) == "macintosh"} {      text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \	    -yscrollcommand "$w.scroll set" -width 60 -height 20    } else {      text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \	    -setgrid true -width 60 -height 20    }    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    bind $w <Return> "destroy $w"    bind $w.text <Return> "destroy $w; break"    # Center the window on the screen.    wm withdraw $w    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 {[grab current .] != ""} {	grab release [grab current .]    }}