home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tk42r2x.zip / TclTk / lib / tk4.2 / bgerror.tcl next >
Text File  |  1999-07-27  |  2KB  |  75 lines
  1. # bgerror.tcl --
  2. #
  3. # This file contains a default version of the bgerror procedure.  It
  4. # posts a dialog box with the error message and gives the user a chance
  5. # to see a more detailed stack trace.
  6. #
  7. # SCCS: @(#) bgerror.tcl 1.9 96/05/02 10:17:11
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14.  
  15. # The following declaration servers no purpose other than to generate
  16. # a tclIndex entry for "tkerror".  Since tkerror and bgerror are hard-wired
  17. # by the Tcl interpreter to be synonyms, the definition of tkerror is
  18. # immediately overridden when bgerror is defined.
  19.  
  20. proc tkerror {} {}
  21.  
  22. # bgerror --
  23. # This is the default version of bgerror.  It posts a dialog box containing
  24. # the error message and gives the user a chance to ask to see a stack
  25. # trace.
  26. # Arguments:
  27. # err -            The error message.
  28.  
  29. proc bgerror err {
  30.     global errorInfo
  31.     set info $errorInfo
  32.     set button [tk_dialog .bgerrorDialog "Error in Tcl Script" \
  33.         "Error: $err" error 0 OK "Skip Messages" "Stack Trace"]
  34.     if {$button == 0} {
  35.     return
  36.     } elseif {$button == 1} {
  37.     return -code break
  38.     }
  39.  
  40.     set w .bgerrorTrace
  41.     catch {destroy $w}
  42.     toplevel $w -class ErrorTrace
  43.     wm minsize $w 1 1
  44.     wm title $w "Stack Trace for Error"
  45.     wm iconname $w "Stack Trace"
  46.     button $w.ok -text OK -command "destroy $w"
  47.     text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
  48.         -setgrid true -width 60 -height 20
  49.     scrollbar $w.scroll -relief sunken -command "$w.text yview"
  50.     pack $w.ok -side bottom -padx 3m -pady 2m
  51.     pack $w.scroll -side right -fill y
  52.     pack $w.text -side left -expand yes -fill both
  53.     $w.text insert 0.0 $info
  54.     $w.text mark set insert 0.0
  55.  
  56.     # Center the window on the screen.
  57.  
  58.     wm withdraw $w
  59.     update idletasks
  60.     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  61.         - [winfo vrootx [winfo parent $w]]]
  62.     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  63.         - [winfo vrooty [winfo parent $w]]]
  64.     wm geom $w +$x+$y
  65.     wm deiconify $w
  66.  
  67.     # Be sure to release any grabs that might be present on the
  68.     # screen, since they could make it impossible for the user
  69.     # to interact with the stack trace.
  70.  
  71.     if {[grab current .] != ""} {
  72.     grab release [grab current .]
  73.     }
  74. }
  75.