home *** CD-ROM | disk | FTP | other *** search
/ Freesoft 1999 February / Freesoft_1999-02_cd.bin / Recenz / Utility / DisplayDoctorLinux / scitech-display-doctor-1.0beta-3.i386.rpm / scitech-display-doctor-1.0beta.3.cpio.gz / scitech-display-doctor-1.0beta.3.cpio / usr / lib / nucleus / XF86Setup / tcllib / tkerror.tcl < prev    next >
Text File  |  1998-09-19  |  3KB  |  86 lines
  1. # $XConsortium: tkerror.tcl /main/1 1996/09/21 14:15:45 kaleb $
  2. #
  3. #
  4. #
  5. #
  6. # tkerror.tcl --
  7. #
  8. # $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/tkerror.tcl,v 3.4 1996/12/27 06:55:10 dawes Exp $
  9. #
  10. # This file contains a modified version of the tkError procedure.  It
  11. # posts a dialog box with the error message and gives the user a chance
  12. # to see a more detailed stack trace. It also saves a copy of the
  13. # stack trace to a file.
  14. #
  15. # Copyright 1996 by Joseph Moss,
  16. # based on the standard implementation which is:
  17. # Copyright (c) 1992-1994 The Regents of the University of California.
  18. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  19. #
  20. # See the file "license.terms" for information on usage and redistribution
  21. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  22.  
  23. if { $tk_version > 4.0 } {
  24.     set errprocname bgerror
  25. } else {
  26.     set errprocname tkerror
  27. }
  28.  
  29. proc $errprocname err {
  30.     global errorInfo
  31.     set info $errorInfo
  32.     set fd [open /tmp/XS[pid].err w]
  33.     puts $fd $errorInfo
  34.     close $fd
  35.     set button [tk_dialog .tkerrorDialog "Error in Tcl Script" \
  36.         "Error: $err\n\nA copy of the stack trace has been saved\
  37.         in the file /tmp/XS[pid].err\n\n\
  38.         If you think this error has not been reported before,\
  39.         please send a copy of that file, along with details of\
  40.         the problem you encountered, to joe@XFree86.org" \
  41.         error 0 OK "Skip Messages" "Stack Trace"]
  42.     if {$button == 0} {
  43.     return
  44.     } elseif {$button == 1} {
  45.     return -code break
  46.     }
  47.  
  48.     set w .tkerrorTrace
  49.     catch {destroy $w}
  50.     toplevel $w -class ErrorTrace
  51.     wm minsize $w 1 1
  52.     wm title $w "Stack Trace for Error"
  53.     wm iconname $w "Stack Trace"
  54.     button $w.ok -text OK -command "destroy $w"
  55.     text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
  56.         -setgrid true -width 60 -height 20
  57.     scrollbar $w.scroll -relief sunken -command "$w.text yview"
  58.     pack $w.ok -side bottom -padx 3m -pady 2m
  59.     pack $w.scroll -side right -fill y
  60.     pack $w.text -side left -expand yes -fill both
  61.     $w.text insert 0.0 $info
  62.     $w.text mark set insert 0.0
  63.  
  64.     # Center the window on the screen.
  65.  
  66.     wm withdraw $w
  67.     update idletasks
  68.     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  69.         - [winfo vrootx [winfo parent $w]]]
  70.     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  71.         - [winfo vrooty [winfo parent $w]]]
  72.     wm geom $w +$x+$y
  73.     wm deiconify $w
  74.  
  75.     # Be sure to release any grabs that might be present on the
  76.     # screen, since they could make it impossible for the user
  77.     # to interact with the stack trace.
  78.  
  79.     if {[grab current .] != ""} {
  80.     grab release [grab current .]
  81.     }
  82. }
  83.  
  84. unset errprocname
  85.  
  86.