gef/src/GEFE.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE GEFE EXPORTS GEF, GEFInternal;

IMPORT Fmt, GEFClass, GEFError, Thread;

<* PRAGMA LL *>

<* FATAL Fatal *>
EXCEPTION Fatal;

TYPE
  ParseObject = GEFClass.ParseObject;

TYPE
  EventPO = ParseObject OBJECT
            OVERRIDES
              create  := EventCreate;
              getId   := EventGetId;
              setElem := EventSetElem;
              finish  := EventFinish;
              isType  := EventIsType;
            END;

TYPE
  EventFieldType = {Actions};

  Actions = REF ARRAY OF GEFClass.S_exp;
  Event = OBJECT
            id     : INTEGER;
            actions: Actions;
          END;

PROCEDURE EventCreate (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                                    id: INTEGER      ): REFANY =
  BEGIN
    RETURN NEW(Event, id := id);
  END EventCreate;

PROCEDURE EventGetId (<* UNUSED *> po  : ParseObject;
                      <* UNUSED *> t   : T;
                                   elem: REFANY       ): INTEGER =
  BEGIN
    RETURN NARROW(elem, Event).id
  END EventGetId;

PROCEDURE EventFinish (<* UNUSED *> po  : ParseObject;
                       <* UNUSED *> t   : T;
                       <* UNUSED *> elem: REFANY       )
  RAISES {GEFError.T, Thread.Alerted} =
  BEGIN
  END EventFinish;

PROCEDURE EventIsType (<* UNUSED *> po: ParseObject; elem: REFANY):
  BOOLEAN =
  BEGIN
    RETURN ISTYPE(elem, Event);
  END EventIsType;

PROCEDURE EventSetElem (<* UNUSED *> po    : ParseObject;
                        <* UNUSED *> t     : T;
                                     elem  : REFANY;
                                     field : INTEGER;
                                     values: GEFClass.Elems)
  RAISES {GEFError.T} =
  VAR event := NARROW(elem, Event);
  BEGIN
    CASE VAL(field, EventFieldType) OF
    | EventFieldType.Actions =>
        event.actions := NEW(Actions, NUMBER(values^));
        event.actions^ := values^;
    ELSE
      RAISE Fatal;
    END;
  END EventSetElem;

TYPE
  InvokePO = ParseObject OBJECT
            OVERRIDES
              create  := InvokeCreate;
              getId   := InvokeGetId;
              setElem := InvokeSetElem;
              finish  := InvokeFinish;
              isType  := InvokeIsType;
            END;

TYPE
  InvokeFieldType = {Event, Args};

  Invoke = OBJECT
             id   : INTEGER;
             event: Event;
             args : GEFClass.S_exp;
           END;

PROCEDURE InvokeCreate (<* UNUSED *> po: ParseObject;
                        <* UNUSED *> t : T;
                                     id: INTEGER      ): REFANY =
  BEGIN
    RETURN NEW(Invoke, id := id);
  END InvokeCreate;

PROCEDURE InvokeGetId (<* UNUSED *> po  : ParseObject;
                       <* UNUSED *> t   : T;
                                    elem: REFANY       ): INTEGER =
  BEGIN
    RETURN NARROW(elem, Invoke).id
  END InvokeGetId;

PROCEDURE InvokeFinish (<* UNUSED *> po: ParseObject; t: T; elem: REFANY)
  RAISES {GEFError.T, Thread.Alerted} =
  VAR invoke := NARROW(elem, Invoke);
  BEGIN
    GEFClass.IncrementalParse(t, invoke.event.actions);
  END InvokeFinish;

PROCEDURE InvokeIsType (<* UNUSED *> po: ParseObject; elem: REFANY):
  BOOLEAN =
  BEGIN
    RETURN ISTYPE(elem, Invoke);
  END InvokeIsType;

PROCEDURE InvokeSetElem (<* UNUSED *> po    : ParseObject;
                         <* UNUSED *> t     : T;
                                      elem  : REFANY;
                                      field : INTEGER;
                                      values: GEFClass.Elems)
  RAISES {GEFError.T} =
  VAR invoke := NARROW(elem, Invoke);
  BEGIN
    CASE VAL(field, InvokeFieldType) OF
    | InvokeFieldType.Event =>
        TYPECASE values[0] OF
        | NULL => RAISE GEFError.T("No \"Event\" given for \"Invoke\"");
        | Event (ev) => invoke.event := ev;
        ELSE
          RAISE GEFError.T("\"Invoke\" requires an \"Event\"");
        END;
    | InvokeFieldType.Args => invoke.args := values[0]
    ELSE
      RAISE Fatal;
    END;
  END InvokeSetElem;

PROCEDURE InvokeEvent (t: T; event: TEXT; <* UNUSED *> args: S_exp)
  RAISES {GEFError.T, Thread.Alerted} =
  BEGIN
    TYPECASE GEFClass.ElemFromName(t, event) OF
    | NULL => RAISE Fatal;
    | Event (event) =>
        FOR i := 0 TO LAST(event.actions^) DO
          GEFClass.IncrementalParse(t, event.actions[i]);
        END;
    ELSE
      RAISE GEFError.T("\"Invoke\" requires an \"Event\"");
    END;
  END InvokeEvent;

BEGIN
  GEFClass.RegisterParseObject(
    NEW(EventPO, args := "((Name Event)"
                           & Fmt.F("(Field %s Actions Sx Infinity () ()))",
                                   Fmt.Int(ORD(EventFieldType.Actions)))));
  GEFClass.RegisterParseObject(
    NEW(InvokePO, args := "((Name Invoke)"
     & Fmt.F("(Field %s Event Elem 1 () ())",
                                   Fmt.Int(ORD(InvokeFieldType.Event)))
     & Fmt.F("(Field %s Args Sx 1 () ()))",
                                   Fmt.Int(ORD(InvokeFieldType.Args)))));
END GEFE.