home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / messagehdl.tcl < prev    next >
Text File  |  1996-11-11  |  6KB  |  244 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1994
  4. #
  5. #      File:           @(#)messagehdl.tcl    /main/hindenburg/4
  6. #      Author:         frmo
  7. #      Description:    Generic Message Handling.
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)messagehdl.tcl    /main/hindenburg/4   11 Nov 1996 Copyright 1994 Westmount Technology
  10.  
  11. # Start user added include file section
  12.  
  13. require procs.tcl
  14.  
  15. # End user added include file section
  16.  
  17.  
  18. # Format a message stack.
  19. #
  20. proc formatMessage {msgVarName} {
  21.     global errorCode
  22.     upvar $msgVarName msg
  23.     if {[lindex [get errorCode] 0] != "ErrorStack"} {
  24.         return
  25.     }
  26.     set errorStack [lindex $errorCode 1]
  27.     set msg ""
  28.     set nl ""
  29.     foreach error $errorStack {
  30.         append msg "$nl[lindex $error 1] [lindex $error 2]"
  31.         set nl "\n"
  32.     }
  33. }
  34.  
  35. # Reset error variables. This prevents "old" errors from showing up in
  36. # "new" errors when wmtkerror is called directly.
  37. #
  38. proc resetErrorVars {} {
  39.     global errorInfo errorCode
  40.  
  41.     if [info exists errorInfo] {
  42.         unset errorInfo
  43.     }
  44.     if [info exists errorCode] {
  45.         unset errorCode
  46.     }
  47. }
  48.  
  49. # Display a fatal error. Exits on "ok".
  50. #
  51. proc wmtkfatal {msg} {
  52.     formatMessage msg
  53.     if [isCommand .main.fatal] {
  54.         .main.fatal message "$msg\n[.main.fatal message]"
  55.         return
  56.     }
  57.     if {(! [isCommand MainWindow]) || (! [isCommand ErrorDialog])} {
  58.         puts "$msg"
  59.         exit
  60.     }
  61.     if {![isCommand .main]} {
  62.         MainWindow new .main -closed exit
  63.     }
  64.     ErrorDialog new .main.fatal \
  65.         -message $msg \
  66.         -title "Fatal" \
  67.         -okPressed {exit}
  68.     .main.fatal delHelpButton
  69.     .main.fatal popUp
  70. }
  71.  
  72. # Give details of the error.
  73. #
  74. proc errorHelp {} {
  75.     if [isCommand .main.errorInfo] {
  76.         return
  77.     }
  78.     interface TemplateDialog .main.errorInfo {
  79.         modal 1
  80.         okPressed {
  81.             %this delete
  82.         }
  83.         title "Error Info"
  84.         DlgColumn c {
  85.             Label l {
  86.                 text "Tcl Traceback:"
  87.             }
  88.             MultiLineText text {
  89.                 editable 0
  90.                 rowCount 24
  91.                 columnCount 80
  92.             }
  93.         }
  94.         PushButton print {
  95.             label "Print"
  96.             default 0
  97.             activated printErrorInfo
  98.         }
  99.         PushButton save {
  100.             label "Save..."
  101.             default 0
  102.             activated saveErrorInfo
  103.         }
  104.     }
  105.     .main.errorInfo.c.text text $errorInfo
  106.     .main.errorInfo delCancelButton
  107.     .main.errorInfo delHelpButton
  108.     .main.errorInfo popUp
  109. }
  110.  
  111. proc printErrorInfo {} {
  112.     set printer [m4_var get M4_a_printer]
  113.     set printfile [args_file [list [.main.errorInfo.c.text text]]]
  114.     .main startCommand extern \
  115.         "$printer $printfile" [list BasicFS::removeFile $printfile] \
  116.         "Sending output to $printer..." \
  117.         {0 0} 0
  118. }
  119.  
  120. proc saveErrorInfo {} {
  121.     set box .main.saveErrorInfo
  122.     if {! [isCommand $box]} {
  123.         EntryDialog new $box \
  124.             -title "Save Error Info" \
  125.             -message "File:" \
  126.             -modal yes \
  127.             -entry "[path_name concat [pwd] errorInfo.[pid]]" \
  128.             -okPressed {
  129.                 set logFile [%this entry]
  130.                 if [catch {set fid [open $logFile w]} msg] {
  131.                     set box .main.saveErrorInfoError
  132.                     ErrorDialog new $box \
  133.                         -message $msg \
  134.                         -title "Save Error Info Error" \
  135.                         -okPressed "$box delete"
  136.                     $box delHelpButton
  137.                     $box popUp
  138.                     return
  139.                 }
  140.                 puts $fid "[.main.errorInfo.c.text text]"
  141.                 close $fid
  142.             }
  143.         $box delHelpButton
  144.     }
  145.     $box popUp
  146. }
  147.  
  148. # Display an error message. Exits if the interface was not yet set-up properly.
  149. #
  150. proc wmtkerror {msg} {
  151.     if {[lindex [get errorCode] 0] == "ErrorStack"} {
  152.         set msgStack [lindex $errorCode 1]
  153.         if {[llength $msgStack] == 1 &&
  154.             [lindex [lindex $msgStack 0] 0] == "MESSAGE"} {
  155.             wmtkmessage [lindex [lindex $msgStack 0] 2]
  156.             return
  157.         }
  158.     }
  159.     formatMessage msg
  160.     if [isCommand .main.error] {
  161.         global errorInfo
  162.         set errorInfo "First Error:\n$errorInfo\n\nSecond Error:\n$oldErrorInfo"
  163.         .main.error message "$msg\n[.main.error message]"
  164.         return
  165.     }
  166.     if {(! [isCommand MainWindow]) || (! [isCommand ErrorDialog])} {
  167.         puts "$msg"
  168.         return
  169.     }
  170.     if {![isCommand .main]} {
  171.         MainWindow new .main -closed exit
  172.     }
  173.     # Exit on "ok" if the interface has not been set up properly.
  174.     # We use the existence of the menubar as a test for that.
  175.     if {[.main menuBar] == ""} {
  176.         set exitCmd exit
  177.     } else {
  178.         set exitCmd resetErrorVars
  179.     }
  180.     global errorInfo
  181.     if {![info exists errorInfo]} {
  182.         set errorInfo $msg
  183.     }
  184.     global oldErrorInfo
  185.     set oldErrorInfo $errorInfo
  186.     ErrorDialog new .main.error \
  187.         -message $msg \
  188.         -title "Error" \
  189.         -okPressed "%this delete; $exitCmd" \
  190.         -helpPressed errorHelp
  191.     .main.error popUp
  192. }
  193.  
  194. # Display a warning.
  195. #
  196. proc wmtkwarning {msg} {
  197.     formatMessage msg
  198.     if [isCommand .main.warning] {
  199.         .main.warning message "$msg\n[.main.warning message]"
  200.         return
  201.     }
  202.     if {(! [isCommand MainWindow]) || (! [isCommand WarningDialog])} {
  203.         puts "$msg"
  204.         return
  205.     }
  206.     if {![isCommand .main]} {
  207.         MainWindow new .main -closed exit
  208.     }
  209.     WarningDialog new .main.warning \
  210.         -message $msg \
  211.         -title "Warning" \
  212.         -okPressed {%this delete; resetErrorVars}
  213.     .main.warning delCancelButton
  214.     .main.warning delHelpButton
  215.     .main.warning popUp
  216. }
  217.  
  218. # Display a message, if there is a message area. Else the message is ignored.
  219. #
  220. proc wmtkmessage {msg} {
  221.     if {![isCommand .main]} {
  222.         return
  223.     }
  224.     set messageArea [.main messageArea]
  225.     if {$messageArea != ""} {
  226.         $messageArea message $msg
  227.     }
  228. }
  229.  
  230. # Display info in an InfoDialog
  231. #
  232. proc wmtkinfo {msg} {
  233.     if {![isCommand .main]} {
  234.         return
  235.     }
  236.     set box .main.wmtkinfo
  237.     InfoDialog new $box \
  238.         -title "Info" \
  239.         -message $msg \
  240.         -okPressed {%this delete}
  241.     $box delHelpButton
  242.     $box popUp
  243. }
  244.