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