home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / SCHWARTZ.ZIP / EXAMPLE2.PRG < prev    next >
Encoding:
Text File  |  1990-06-06  |  5.1 KB  |  150 lines
  1. /*********************************************************************
  2. *
  3. * Name:        EXAMPLE2.prg
  4. * Description:  ErrorBlock() Demo Program
  5. * Author:    Philip H. Schwartz
  6. * Audience:    Nantucket DEVCON '90
  7. * Written:      June 5, 1990
  8. * Compiler:    Clipper 5.0 V7.7 BETA
  9. * Comp Option:  /N
  10. * Linker:       RTLink Version 1.3 (Clipper)
  11. * Library:    clipper, extend
  12. * Obj Module:   MYERR.obj
  13. * Link input:   rtlink fi example2,myerr out example2 li clipper,extend
  14. * Headers:    STD.ch
  15. * Copyright:    (c) 1990 Philip H. Schwartz
  16. * Rights:    All Commercial & Publishing Rights Reserved
  17. *
  18. *********************************************************************/
  19.  
  20. /* Definitions for MEMORY() function */
  21. #define MEM_TOTAL        0
  22. #define MEM_BLOCK        1
  23. #define MEM_RUN            2            
  24.  
  25. PROCEDURE example2
  26. LOCAL bErrBlocks,nErrHandler,cErrBlocks,cEnvBlock,cSaveScreen
  27. PUBLIC bErrSave
  28.  
  29. cErrBlocks:={"BREAK to RECOVER statement",;
  30.              "You flat out of luck",;
  31.              "RUN debugger.exe",;
  32.              "Use SET ERRORBLOCK= in ENV",;
  33.              "LOCAL handler & pass to Default",;
  34.              "Default Error Block"}
  35.  
  36. bErrBlocks:={{|e| break(e)},;
  37.              {|e| qout("You flat out of luck."), break(e)},;
  38.              {|e| run(e),.f.}}
  39.  
  40. CLS
  41. bErrSave:=ERRORBLOCK()            // save the Default Error Block
  42.  
  43. /* Ask the user to select a code block to post */
  44. nErrHandler=6
  45. @ 1,0 to 8,33 DOUBLE
  46. nErrHandler=ACHOICE(2,1,7,32,cErrBlocks)
  47.  
  48. /* EXIT if nothing selected */
  49. IF nErrHandler=0
  50.   RETURN
  51. ENDIF
  52.  
  53. DO CASE
  54. /* Install one of the compiled code blocks */
  55. CASE nErrHandler>=1 .AND. nErrHandler<=3
  56.   ERRORBLOCK(bErrBlocks[nErrHandler])
  57.  
  58. /* Check to see if a code block was entered in ASCII via the
  59.    SET ERRORBLOCK feature of DOS.  If so, compile it with
  60.    the & operator and install it.  NOTE: We must strip the quote
  61.    delimiters from the code block before we compile it or we
  62.    will get an error.                                           */
  63. CASE nErrHandler=4 .AND. !EMPTY(cEnvBlock:=GETE("ERRORBLOCK"))
  64.   cEnvBlock=SUBSTR(cEnvBlock,2,LEN(cEnvBlock)-2)
  65.   ERRORBLOCK(&cEnvBlock)
  66.  
  67. /* This example shows how you can install a Local Error Handler to
  68.    trap selected situations.  You can then pass on the
  69.    error objects to the default Error Handler for further processing.  */   
  70. CASE nErrHandler=5
  71.   ERRORBLOCK({|e| LocErr(e)})
  72.  
  73. /* Otherwise, we assume Default Error Handler */
  74. OTHERWISE
  75.   ERRORBLOCK(bErrSave)
  76. ENDCASE
  77.  
  78. /* Display options in effect at the top of the screen */
  79. CLS
  80. @ 1,0 SAY REPLICATE("-",80)
  81. @ 2,0 SAY "Current Error Block ===> "+cErrBlocks[nErrHandler]
  82. IF nErrHandler=4
  83.   @ 3,0 SAY "SET ERRORBLOCK="+IIF(!EMPTY(cEnvBlock),cEnvBlock,;
  84.    "EMPTY  --- Default Error Block Substituted")
  85. ELSE
  86.   @ 3,0 SAY "Using Code Block created at Compile-time"
  87. ENDIF
  88. @ 4,0 SAY REPLICATE("-",80)
  89.  
  90. /* This code support demonstration of the BEGIN/RECOVER/BREAK
  91.    feature of Clipper 5.0.  We created a BREAK() UDF to issue
  92.    a BREAK statement so that RECOVER can get control with the
  93.    error object.                                               */
  94. BEGIN SEQUENCE
  95.   ? "DEBUG(MAIN)=> About to create an error."
  96.   ? 1*unkn                // Generate an error
  97.  
  98. RECOVER e
  99.   ? "DEBUG(MAIN)=> Now in RECOVER mode."
  100.   ? 'DEBUG(MAIN)=> e:description() is "'+e:description()+'"'
  101.   ? "DEBUG(MAIN)=> e:gencode() is "+ltrim(str(e:genCode()))
  102.   // additional RECOVERY statements
  103.   //  would follow
  104.   //   this line.
  105.  
  106. END SEQUENCE
  107. ? "DEBUG(MAIN)=> This line follows the END SEQUENCE."
  108. // rest of program would follow this line
  109.  
  110. ERRORBLOCK(bErrSave)            // Restore original error handler
  111. RETURN                    // RETURN to DOS
  112.  
  113.  
  114. /* This function shows how a local error handler can pass
  115.    control to the default error block after taking stock of the
  116.    situation.                                                 */
  117. STATIC FUNCTION locerr(e)
  118. ? "DEBUG(LOCERR)=> Error GenCode is "+LTRIM(STR(e:gencode()))
  119. ? 'DEBUG(LOCERR)=> Error Description is "'+e:description()+'"'
  120. ? "DEBUG(LOCERR)=> Now passing control to Default Error Block"
  121. RETURN(EVAL(bErrSave,e))
  122.  
  123. /* Since a BREAK can't be issued directly from a code block,
  124.    we create this UDF to issue a BREAK for us.  Of course, we
  125.    want the object error to pass on to the RECOVER statement so
  126.    we include the (e) operand on the BREAK line.                 */
  127. STATIC FUNCTION break(e)
  128. ? "DEBUG(BREAK)=> Now in BREAK(e) routine."
  129. BREAK e
  130. RETURN NIL
  131.  
  132. /* This routine allows us to RUN an external .EXE module directly
  133.    from recovery mode.  This is only meant to show the flexibility
  134.    of the Error System.  Obviously, the environment may be
  135.    too damaged at this point to successfuly execute a program.     */
  136. STATIC FUNCTION RUN(e)
  137. ? "DEBUG(RUN)=> Now in RUN(e) routine."
  138. ? "DEBUG(RUN)=> RUN MEMORY available is "+LTRIM(STR(MEMORY(MEM_RUN)))+'K'
  139. IF FILE('debugger.exe')
  140.   ? "DEBUG(RUN)=> About to call DEBUGGER.EXE"
  141.   cSaveScreen=SAVESCREEN(0,0,24,79)
  142.   RUN debugger
  143.   RESTSCREEN(0,0,24,79,cSaveScreen)
  144.   ? "DEBUG(RUN)=> RETURNing from DEBUGGER.EXE"
  145. ELSE
  146.   ? "DEBUG(RUN)=> Can't find DEBUGGER.EXE"
  147. ENDIF
  148. RETURN(EVAL(bErrSave,e))
  149. /*EOF*/
  150.