home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / bgerror.tcl < prev    next >
Text File  |  2003-09-01  |  9KB  |  293 lines
  1. # bgerror.tcl --
  2. #
  3. #    Implementation of the bgerror procedure.  It posts a dialog box with
  4. #    the error message and gives the user a chance to see a more detailed
  5. #    stack trace, and possible do something more interesting with that
  6. #    trace (like save it to a log).  This is adapted from work done by
  7. #    Donal K. Fellows.
  8. #
  9. # Copyright (c) 1998-2000 by Ajuba Solutions.
  10. # All rights reserved.
  11. # 
  12. # RCS: @(#) $Id: bgerror.tcl,v 1.23 2002/08/31 06:12:28 das Exp $
  13. # $Id: bgerror.tcl,v 1.23 2002/08/31 06:12:28 das Exp $
  14.  
  15. namespace eval ::tk {
  16.     namespace eval dialog {
  17.     namespace eval error {
  18.         namespace import ::tk::msgcat::*
  19.         namespace export bgerror
  20.         option add *ErrorDialog.function.text [mc "Save To Log"] \
  21.             widgetDefault
  22.         option add *ErrorDialog.function.command [namespace code SaveToLog]
  23.     }
  24.     }
  25. }
  26.  
  27. proc ::tk::dialog::error::Return {} {
  28.     variable button
  29.     
  30.     .bgerrorDialog.ok configure -state active -relief sunken
  31.     update idletasks
  32.     after 100
  33.     set button 0
  34. }
  35.  
  36. proc ::tk::dialog::error::Details {} {
  37.     set w .bgerrorDialog
  38.     set caption [option get $w.function text {}]
  39.     set command [option get $w.function command {}]
  40.     if { ($caption eq "") || ($command eq "") } {
  41.     grid forget $w.function
  42.     }
  43.     $w.function configure -text $caption -command \
  44.     "$command [list [.bgerrorDialog.top.info.text get 1.0 end]]"
  45.     grid $w.top.info - -sticky nsew -padx 3m -pady 3m
  46. }
  47.  
  48. proc ::tk::dialog::error::SaveToLog {text} {
  49.     if { $::tcl_platform(platform) eq "windows" } {
  50.     set allFiles *.*
  51.     } else {
  52.     set allFiles *
  53.     }
  54.     set types [list    \
  55.         [list [mc "Log Files"] .log]    \
  56.         [list [mc "Text Files"] .txt]    \
  57.         [list [mc "All Files"] $allFiles] \
  58.         ]
  59.     set filename [tk_getSaveFile -title [mc "Select Log File"] \
  60.         -filetypes $types -defaultextension .log -parent .bgerrorDialog]
  61.     if {![string length $filename]} {
  62.     return
  63.     }
  64.     set f [open $filename w]
  65.     puts -nonewline $f $text
  66.     close $f
  67. }
  68.  
  69. proc ::tk::dialog::error::Destroy {w} {
  70.     if {$w eq ".bgerrorDialog"} {
  71.     variable button
  72.     set button -1
  73.     }
  74. }
  75.  
  76. # ::tk::dialog::error::bgerror --
  77. # This is the default version of bgerror. 
  78. # It tries to execute tkerror, if that fails it posts a dialog box containing
  79. # the error message and gives the user a chance to ask to see a stack
  80. # trace.
  81. # Arguments:
  82. # err -            The error message.
  83.  
  84. proc ::tk::dialog::error::bgerror err {
  85.     global errorInfo tcl_platform
  86.     variable button
  87.  
  88.     set info $errorInfo
  89.  
  90.     set ret [catch {::tkerror $err} msg];
  91.     if {$ret != 1} {return -code $ret $msg}
  92.  
  93.     # Ok the application's tkerror either failed or was not found
  94.     # we use the default dialog then :
  95.     if {($tcl_platform(platform) eq "macintosh")
  96.              || ([tk windowingsystem] eq "aqua")} {
  97.     set ok        [mc Ok]
  98.     set messageFont    system
  99.     set textRelief    flat
  100.     set textHilight    0
  101.     } else {
  102.     set ok        [mc OK]
  103.     set messageFont    {Times -18}
  104.     set textRelief    sunken
  105.     set textHilight    1
  106.     }
  107.  
  108.  
  109.     # Truncate the message if it is too wide (longer than 30 characacters) or
  110.     # too tall (more than 4 newlines).  Truncation occurs at the first point at
  111.     # which one of those conditions is met.
  112.     set displayedErr ""
  113.     set lines 0
  114.     foreach line [split $err \n] {
  115.     if { [string length $line] > 30 } {
  116.         append displayedErr "[string range $line 0 29]..."
  117.         break
  118.     }
  119.     if { $lines > 4 } {
  120.         append displayedErr "..."
  121.         break
  122.     } else {
  123.         append displayedErr "${line}\n"
  124.     }
  125.     incr lines
  126.     }
  127.  
  128.     set w .bgerrorDialog
  129.     set title [mc "Application Error"]
  130.     set text [mc {Error: %1$s} $err]
  131.     set buttons [list ok $ok dismiss [mc "Skip Messages"] \
  132.         function [mc "Details >>"]]
  133.  
  134.     # 1. Create the top-level window and divide it into top
  135.     # and bottom parts.
  136.  
  137.     catch {destroy .bgerrorDialog}
  138.     toplevel .bgerrorDialog -class ErrorDialog
  139.     wm title .bgerrorDialog $title
  140.     wm iconname .bgerrorDialog ErrorDialog
  141.     wm protocol .bgerrorDialog WM_DELETE_WINDOW { }
  142.  
  143.     if {($tcl_platform(platform) eq "macintosh") 
  144.             || ([tk windowingsystem] eq "aqua")} {
  145.     ::tk::unsupported::MacWindowStyle style .bgerrorDialog dBoxProc
  146.     }
  147.  
  148.     frame .bgerrorDialog.bot
  149.     frame .bgerrorDialog.top
  150.     if {[tk windowingsystem] eq "x11"} {
  151.     .bgerrorDialog.bot configure -relief raised -bd 1
  152.     .bgerrorDialog.top configure -relief raised -bd 1
  153.     }
  154.     pack .bgerrorDialog.bot -side bottom -fill both
  155.     pack .bgerrorDialog.top -side top -fill both -expand 1
  156.  
  157.     set W [frame $w.top.info]
  158.     text $W.text                \
  159.         -bd 2                \
  160.         -yscrollcommand [list $W.scroll set]\
  161.         -setgrid true            \
  162.         -width 40                \
  163.         -height 10                \
  164.         -state normal            \
  165.         -relief $textRelief            \
  166.         -highlightthickness $textHilight    \
  167.         -wrap char
  168.  
  169.     scrollbar $W.scroll -relief sunken -command [list $W.text yview]
  170.     pack $W.scroll -side right -fill y
  171.     pack $W.text -side left -expand yes -fill both
  172.     $W.text insert 0.0 "$err\n$info"
  173.     $W.text mark set insert 0.0
  174.     bind $W.text <ButtonPress-1> { focus %W }
  175.     $W.text configure -state disabled
  176.  
  177.     # 2. Fill the top part with bitmap and message
  178.  
  179.     # Max-width of message is the width of the screen...
  180.     set wrapwidth [winfo screenwidth .bgerrorDialog]
  181.     # ...minus the width of the icon, padding and a fudge factor for
  182.     # the window manager decorations and aesthetics.
  183.     set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
  184.     label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
  185.         -wraplength $wrapwidth
  186.     if {($tcl_platform(platform) eq "macintosh")
  187.             || ([tk windowingsystem] eq "aqua")} {
  188.     # On the Macintosh, use the stop bitmap
  189.     label .bgerrorDialog.bitmap -bitmap stop
  190.     } else {
  191.     # On other platforms, make the error icon
  192.     canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
  193.     .bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
  194.     .bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4
  195.     .bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4
  196.     }
  197.     grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
  198.         -in .bgerrorDialog.top    \
  199.         -row 0            \
  200.         -padx 3m            \
  201.         -pady 3m
  202.     grid configure     .bgerrorDialog.msg -sticky nsw -padx {0 3m}
  203.     grid rowconfigure     .bgerrorDialog.top 1 -weight 1
  204.     grid columnconfigure .bgerrorDialog.top 1 -weight 1
  205.  
  206.     # 3. Create a row of buttons at the bottom of the dialog.
  207.  
  208.     set i 0
  209.     foreach {name caption} $buttons {
  210.     button .bgerrorDialog.$name    \
  211.         -text $caption        \
  212.         -default normal        \
  213.         -command [namespace code "set button $i"]
  214.     grid .bgerrorDialog.$name    \
  215.         -in .bgerrorDialog.bot    \
  216.         -column $i        \
  217.         -row 0            \
  218.         -sticky ew        \
  219.         -padx 10
  220.     grid columnconfigure .bgerrorDialog.bot $i -weight 1
  221.     # We boost the size of some Mac buttons for l&f
  222.     if {($tcl_platform(platform) eq "macintosh")
  223.         || ([tk windowingsystem] eq "aqua")} {
  224.         if {($name eq "ok") || ($name eq "dismiss")} {
  225.         grid columnconfigure .bgerrorDialog.bot $i -minsize 79
  226.         }
  227.     }
  228.     incr i
  229.     }
  230.     # The "OK" button is the default for this dialog.
  231.     .bgerrorDialog.ok configure -default active
  232.  
  233.     bind .bgerrorDialog <Return>    [namespace code Return]
  234.     bind .bgerrorDialog <Destroy>    [namespace code [list Destroy %W]]
  235.     .bgerrorDialog.function configure -command [namespace code Details]
  236.  
  237.     # 6. Withdraw the window, then update all the geometry information
  238.     # so we know how big it wants to be, then center the window in the
  239.     # display and de-iconify it.
  240.  
  241.     wm withdraw .bgerrorDialog
  242.     update idletasks
  243.     set parent [winfo parent    .bgerrorDialog]
  244.     set width  [winfo reqwidth    .bgerrorDialog]
  245.     set height [winfo reqheight    .bgerrorDialog]
  246.     set x [expr {([winfo screenwidth .bgerrorDialog]  - $width )/2 - \
  247.         [winfo vrootx $parent]}]
  248.     set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \
  249.         [winfo vrooty $parent]}]
  250.     .bgerrorDialog configure -width $width
  251.     wm geometry .bgerrorDialog +$x+$y
  252.     wm deiconify .bgerrorDialog
  253.  
  254.     # 7. Set a grab and claim the focus too.
  255.  
  256.     set oldFocus [focus]
  257.     set oldGrab [grab current .bgerrorDialog]
  258.     if {$oldGrab != ""} {
  259.     set grabStatus [grab status $oldGrab]
  260.     }
  261.     grab .bgerrorDialog
  262.     focus .bgerrorDialog.ok
  263.  
  264.     # 8. Wait for the user to respond, then restore the focus and
  265.     # return the index of the selected button.  Restore the focus
  266.     # before deleting the window, since otherwise the window manager
  267.     # may take the focus away so we can't redirect it.  Finally,
  268.     # restore any grab that was in effect.
  269.  
  270.     vwait [namespace which -variable button]
  271.     set copy $button; # Save a copy...
  272.     catch {focus $oldFocus}
  273.     catch {destroy .bgerrorDialog}
  274.     if {$oldGrab ne ""} {
  275.     if {$grabStatus eq "global"} {
  276.         grab -global $oldGrab
  277.     } else {
  278.         grab $oldGrab
  279.     }
  280.     }
  281.  
  282.     if {$copy == 1} {
  283.     return -code break
  284.     }
  285. }
  286.  
  287. namespace eval :: {
  288.     # Fool the indexer
  289.     proc bgerror err {}
  290.     rename bgerror {}
  291.     namespace import ::tk::dialog::error::bgerror
  292. }
  293.