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