home *** CD-ROM | disk | FTP | other *** search
/ AppleScript - The Beta Release / AppleScript - The Beta Release.iso / Documentation / develop / Better Apple Event Coding / Code Samples / UMAFailure.inc1.p < prev    next >
Encoding:
Text File  |  1992-10-16  |  3.7 KB  |  190 lines  |  [TEXT/MPS ]

  1. {$P}
  2. {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
  3. {UFailure.inc1.p}
  4. {Copyright © 1985-1990 Apple Computer, Inc.  All rights reserved.}
  5.  
  6. {$W+}
  7. {$R-}
  8. {$Init-}
  9. {$OV-}
  10.  
  11. PROCEDURE ApplicationBeep;
  12.     EXTERNAL;
  13.  
  14. PROCEDURE CatchFailures(VAR fi: FailInfo;
  15.                         PROCEDURE Handler(e: INTEGER;
  16.                                           m: LONGINT));
  17.     EXTERNAL;
  18.  
  19. PROCEDURE DoFailure(pf: FailInfoPtr);
  20.     EXTERNAL;
  21.  
  22. {--------------------------------------------------------------------------------------------------}
  23. {$S MAFailureRes}
  24.  
  25. PROCEDURE Assertion(condition: Boolean;
  26.                     description: StringPtr);
  27.  
  28.     BEGIN
  29.     IF NOT condition THEN
  30.         BEGIN
  31.         Failure(minErr, 0);            { ??? silent failure, but someday 0
  32.                                         messages need to be non-silent }
  33.         END;
  34.     END;
  35.  
  36. {--------------------------------------------------------------------------------------------------}
  37. {$S MAFailureRes}
  38.  
  39. PROCEDURE EachFailureHandlerDo(PROCEDURE DoToHandler(fiPtr: FailInfoPtr));
  40.  
  41.     VAR
  42.         pf:                 FailInfoPtr;
  43.  
  44.     BEGIN
  45.     pf := gTopHandler;
  46.  
  47.     WHILE (pf <> NIL) DO
  48.         BEGIN
  49.         DoToHandler(pf);
  50.         pf := pf^.nextInfo;
  51.         END;
  52.     END;
  53.  
  54. {--------------------------------------------------------------------------------------------------}
  55. {$S MAFailureRes}
  56.  
  57. PROCEDURE FailMemError;
  58.  
  59.     VAR
  60.         e:                    OSErr;
  61.  
  62.     BEGIN
  63.     e := MemError;
  64.  
  65.     IF e <> noErr THEN
  66.         Failure(e, 0);
  67.     END;
  68.  
  69. {--------------------------------------------------------------------------------------------------}
  70. {$S MAFailureRes}
  71.  
  72. PROCEDURE FailNewMessage(error: INTEGER;
  73.                          oldMessage, newMessage: LONGINT);
  74.  
  75.     BEGIN
  76.     IF oldMessage = 0 THEN
  77.         oldMessage := newMessage;
  78.     Failure(error, oldMessage);
  79.     END;
  80.  
  81. {--------------------------------------------------------------------------------------------------}
  82. {$S MAFailureRes}
  83.  
  84. PROCEDURE FailNIL(p: UNIV Ptr);
  85.  
  86.     BEGIN
  87.     { no check for gAskFailure here, since we do this when objects are created. }
  88.     IF p = NIL THEN
  89.         Failure(memFullErr, 0);
  90.     END;
  91.  
  92. {--------------------------------------------------------------------------------------------------}
  93. {$S MAFailureRes}
  94.  
  95. PROCEDURE FailNILResource(r: UNIV Handle);
  96.  
  97.     VAR
  98.         e:                    OSErr;
  99.  
  100.     BEGIN
  101.     IF r = NIL THEN
  102.         BEGIN
  103.         e := ResError;
  104.         IF e = noErr THEN
  105.             e := resNotFound;
  106.         Failure(e, 0);
  107.         END;
  108.     END;
  109.  
  110. {--------------------------------------------------------------------------------------------------}
  111. {$S MAFailureRes}
  112.  
  113. PROCEDURE FailOSErr(error: INTEGER);
  114.  
  115.     BEGIN
  116.     IF error <> noErr THEN
  117.         Failure(error, 0);
  118.     END;
  119.  
  120. {--------------------------------------------------------------------------------------------------}
  121. {$S MAFailureRes}
  122.  
  123. PROCEDURE FailResError;
  124.  
  125.     VAR
  126.         e:                    OSErr;
  127.  
  128.     BEGIN
  129.     e := ResError;
  130.  
  131.     IF e <> noErr THEN
  132.         Failure(e, 0);
  133.     END;
  134.  
  135. {--------------------------------------------------------------------------------------------------}
  136. {$S MAFailureRes}
  137.  
  138. PROCEDURE Failure(error: INTEGER;
  139.                   message: LONGINT);
  140.  
  141.     VAR
  142.         pf:                 FailInfoPtr;
  143.         pc:                 LONGINT;
  144.  
  145.     BEGIN
  146.     pf := gTopHandler;
  147.  
  148.     IF pf <> NIL THEN
  149.         BEGIN
  150.       {pop the stack first, because calling the handler is likely to
  151.        result in a call to Failure}
  152.         gTopHandler := pf^.nextInfo;
  153.  
  154.  
  155.         pf^.error := error;
  156.         pf^.message := message;
  157.         DoFailure(pf);                                    {Go execute the failure handler}
  158.         END
  159.     ELSE
  160.         BEGIN
  161.         DebugStr('Failure called, but no handler!');
  162.         END;
  163.     END;
  164.  
  165. {--------------------------------------------------------------------------------------------------}
  166. {$S MAFailureRes}
  167.  
  168. FUNCTION HandlerExists(testFailInfoPtr: FailInfoPtr): Boolean;
  169.  
  170.     PROCEDURE DoToHandler(pf: FailInfoPtr);
  171.  
  172.         BEGIN
  173.         IF pf = testFailInfoPtr THEN
  174.             HandlerExists := true;
  175.         END;
  176.  
  177.     BEGIN
  178.     HandlerExists := false;
  179.     EachFailureHandlerDo(DoToHandler);
  180.     END;
  181.  
  182. {--------------------------------------------------------------------------------------------------}
  183. {$S MAFailureRes}
  184.  
  185. PROCEDURE Success(VAR fi: FailInfo);
  186.  
  187.     BEGIN
  188.     gTopHandler := fi.nextInfo;
  189.     END;
  190.