home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / text / ncclib.zip / NCCDEMO.ZIP / ERRORSYS.PRG next >
Text File  |  1993-05-01  |  3KB  |  207 lines
  1. /***
  2. *    Errorsys.prg
  3. *    Standard Clipper 5.0 error handler
  4. *    Copyright (c) 1990 Nantucket Corp.  All rights reserved.
  5. *
  6. *    Compile:  /m/n/w
  7. */
  8.  
  9. #include "error.ch"
  10.  
  11.  
  12. // put messages to STDERR
  13. #command ? <list,...>   =>  ?? Chr(13) + Chr(10) ; ?? <list>
  14. #command ?? <list,...>  =>  OutErr(<list>)
  15.  
  16.  
  17. // used below
  18. #define NTRIM(n)        ( LTrim(Str(n)) )
  19.  
  20.  
  21.  
  22. /***
  23. *    ErrorSys()
  24. *
  25. *    Note:  automatically executes at startup
  26. */
  27.  
  28. proc ErrorSys()
  29.  
  30. Local errorsys
  31.  
  32.     errorsys := 9876543210
  33.  
  34.     ErrorBlock( {|e| DefError(e)} )
  35.  
  36. return
  37.  
  38.  
  39.  
  40.  
  41. /***
  42. *    DefError()
  43. */
  44. static func DefError(e)
  45. local i, cMessage, aOptions, nChoice, xDevice := Set(_SET_DEVICE), ;
  46.       xPrinter := Set(_SET_PRINTER), xRow := row(), xCol := Col()
  47.  
  48.  
  49.  
  50.     // by default, division by zero yields zero
  51.     if ( e:genCode == EG_ZERODIV )
  52.         return (0)
  53.     end
  54.  
  55.  
  56.     // for network open error, set NETERR() and subsystem default
  57.         if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
  58.                 NetErr(.t.)
  59.         return (.f.)                                    // NOTE
  60.  
  61.     end
  62.  
  63.         if e:genCode == EG_CORRUPTION
  64.               NccPopUp('\nUnable to Open File\nPress any key to continue...\n', ;
  65.                        Popup_Color(), 5 )
  66.  
  67.               Break(e)
  68.  
  69.         endif
  70.  
  71.  
  72.     // for lock error during APPEND BLANK, set NETERR() and subsystem default
  73.     if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
  74.  
  75.         NetErr(.t.)
  76.         return (.f.)                                    // NOTE
  77.  
  78.     end
  79.  
  80.     // build error message
  81.     cMessage := ErrorMessage(e)
  82.  
  83.  
  84.     // build options array
  85.     // aOptions := {"Break", "Quit"}
  86.     aOptions := {"Quit"}
  87.  
  88.     if (e:canRetry)
  89.         AAdd(aOptions, "Retry")
  90.     end
  91.  
  92.     if (e:canDefault)
  93.         AAdd(aOptions, "Default")
  94.     end
  95.  
  96.  
  97.     // put up alert box
  98.     nChoice := 0
  99.     while ( nChoice == 0 )
  100.  
  101.         if ( Empty(e:osCode) )
  102.             nChoice := Alert( cMessage, aOptions )
  103.  
  104.         else
  105.             nChoice := Alert( cMessage + ;
  106.                             ";(DOS Error " + NTRIM(e:osCode) + ")", ;
  107.                             aOptions )
  108.         end
  109.  
  110.  
  111.         if ( nChoice == NIL )
  112.             exit
  113.         end
  114.  
  115.     end
  116.  
  117.  
  118.     if ( !Empty(nChoice) )
  119.  
  120.         // do as instructed
  121.         if ( aOptions[nChoice] == "Break" )
  122.             Break(e)
  123.  
  124.         elseif ( aOptions[nChoice] == "Retry" )
  125.             return (.t.)
  126.  
  127.         elseif ( aOptions[nChoice] == "Default" )
  128.             return (.f.)
  129.  
  130.         end
  131.  
  132.     end
  133.  
  134.  
  135.     // display message and traceback
  136.     if ( !Empty(e:osCode) )
  137.         cMessage += " (DOS Error " + NTRIM(e:osCode) + ") "
  138.     end
  139.  
  140.         scroll()
  141.         setpos(0,0)
  142.         ? cMessage
  143.     i := 2
  144.     while ( !Empty(ProcName(i)) )
  145.         ? "Called from", Trim(ProcName(i)) + ;
  146.             "(" + NTRIM(ProcLine(i)) + ")  "
  147.  
  148.         i++
  149.     end
  150.  
  151.  
  152.     // give up
  153.     ErrorLevel(1)
  154.         Bailout()
  155.     QUIT
  156.  
  157. return (.f.)
  158.  
  159.  
  160.  
  161.  
  162. /***
  163. *    ErrorMessage()
  164. */
  165. static func ErrorMessage(e)
  166. local cMessage
  167.  
  168.  
  169.     // start error message
  170.     cMessage := if( e:severity > ES_WARNING, "Error ", "Warning " )
  171.  
  172.  
  173.     // add subsystem name if available
  174.     if ( ValType(e:subsystem) == "C" )
  175.         cMessage += e:subsystem()
  176.     else
  177.         cMessage += "???"
  178.     end
  179.  
  180.  
  181.     // add subsystem's error code if available
  182.     if ( ValType(e:subCode) == "N" )
  183.         cMessage += ("/" + NTRIM(e:subCode))
  184.     else
  185.         cMessage += "/???"
  186.     end
  187.  
  188.  
  189.     // add error description if available
  190.     if ( ValType(e:description) == "C" )
  191.         cMessage += ("  " + e:description)
  192.     end
  193.  
  194.  
  195.     // add either filename or operation
  196.     if ( !Empty(e:filename) )
  197.         cMessage += (": " + e:filename)
  198.  
  199.     elseif ( !Empty(e:operation) )
  200.         cMessage += (": " + e:operation)
  201.  
  202.     end
  203.  
  204.  
  205. return (cMessage)
  206.  
  207.