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.