packages feed

language-oberon 0.1 → 0.1.1

raw patch · 29 files changed

+8302/−11 lines, 29 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -2,4 +2,8 @@  ## 0.1  -- 2018-04-08 -* First version, but complete enough to be released on an unsuspecting world.+* First version, but complete enough to be released on an unsuspecting world...++## 0.1.1  -- 2018-04-08++* except for the missing Oberon module examples the test suite depends on.
+ examples/AGRS/AGRS.Mod view
@@ -0,0 +1,1033 @@+MODULE AGRS;
+(*
+      Modul AGRS - Attributed Graph Rewriting System
+
+      Najnizi modul. Ovde su implementirani 
+      apstraktni tipovi podataka (ADT) koji cine graf izraza.
+*)
+
+CONST
+   MaxStack= 6495;
+   Fixed*= MAX(INTEGER);
+   Unique*= 0;
+TYPE
+   Term*= POINTER TO TermDesc;            (* ADT Term - korenska klasa *)
+
+   TermDesc*= RECORD
+      indirection-: Term;
+   END;
+
+   SubTerm*= POINTER TO SubTermDesc;      (* ADT SubTerm *)
+   SubTermDesc*= RECORD(TermDesc)
+      query-: Term;
+   END;
+
+   FieldTail= POINTER TO RECORD(TermDesc)
+   END;
+
+   Field*= POINTER TO RECORD(SubTermDesc) (* ADT Field *)
+      tail: FieldTail;
+   END;
+
+   Name*= POINTER TO NameDesc;            (* ADT Name *)
+   NameDesc*= RECORD(TermDesc)
+      age-: INTEGER;
+   END;
+
+   Equation= POINTER TO RECORD(TermDesc)
+      param: Name;
+      next: Equation;
+   END;
+   
+   Tree*= POINTER TO TreeDesc;            (* ADT Tree *)
+   TreeDesc*= RECORD(TermDesc)
+      attributes: Equation;
+      constant: BOOLEAN;
+   END;
+
+   Atomic*= POINTER TO AtomicDesc;        (* ADT Atomic *)
+   AtomicDesc*= RECORD(TermDesc)
+   END;
+
+   OpenTree*= POINTER TO RECORD(TreeDesc) (* ADT OpenTree *)
+   END;
+
+   Class*= POINTER TO ClassDesc;          (* ADT Class *)
+   ClassDesc*= RECORD(TreeDesc)
+   END;
+
+   ClosedClass*= POINTER TO ClosedClassDesc;   (* ADT ClosedClass *)
+   ClosedClassDesc*= RECORD(ClassDesc)
+   END;
+
+   Block*= POINTER TO RECORD(TreeDesc)
+   END;
+
+   HandlerType*= PROCEDURE;
+
+   SystemTerm*= POINTER TO RECORD(TermDesc)   (* ADT SystemTerm *)
+      handler: HandlerType;
+   END;
+
+   Disjunction*= POINTER TO RECORD(TermDesc)       (* ADT Disjunction *)
+      alternative-: Term;
+   END;
+
+   TermBackup= NameDesc;
+   
+   TermStack*= POINTER TO TermStackDesc;
+   TermStackDesc= RECORD
+      top-: Term;
+      rest-: TermStack;
+   END;
+VAR
+   stack: POINTER TO ARRAY MaxStack OF TermBackup;
+   continuation-,paramStack*: TermStack;
+   sp, eldestAsked*: INTEGER;
+   allConstant: BOOLEAN;
+
+   otherwise*: Name;
+   lastResult-, lastAtom-, Failure*, result*: Term;
+   failName*: Name;
+   Undefined-, Variable-: SystemTerm;
+   LocalRestore, StackRestore, FunctionResult: SystemTerm;
+   GuardTrap*, MatchTrap: SystemTerm;
+
+PROCEDURE Push*(t: Term);
+VAR
+   newStack: TermStack;
+BEGIN
+   IF t#NIL THEN
+      NEW(newStack);
+      newStack.top:= t;
+      newStack.rest:= continuation;
+      continuation:= newStack;
+   END;
+END Push;
+
+
+PROCEDURE (t: Term) Init*(ind: Term);
+BEGIN
+   t.indirection:= ind;
+END Init;
+
+PROCEDURE (t: Term) Reduce*;
+BEGIN
+   t.indirection.Reduce;
+END Reduce;
+
+PROCEDURE (t: Term) Value*(): Term;
+VAR
+   spOld,spNew: INTEGER;
+   contOld: TermStack;
+BEGIN
+   spOld:= sp;
+   contOld:= continuation;
+   Push(FunctionResult);
+   t.Reduce;
+   spNew:= sp;
+   ASSERT((sp=spOld) & (continuation=contOld));
+   RETURN result
+END Value;
+
+PROCEDURE (t: Term) Evaluate*(query: Term): Term;
+VAR
+   spOld,spNew: INTEGER;
+   contOld,contNew: TermStack;
+BEGIN
+   spOld:= sp;
+   contOld:= continuation;
+   Push(FunctionResult);
+   Push(query);
+   t.Reduce;
+   spNew:= sp;
+   contNew:= continuation;
+   ASSERT((sp=spOld) & (continuation=contOld));
+   RETURN result
+END Evaluate;
+
+PROCEDURE (t: Term) Actual*(): Term;
+BEGIN
+   RETURN t
+END Actual;
+
+PROCEDURE Continue*;
+VAR
+   spOld,spNew: INTEGER;
+   next: Term;
+   newTop: TermStack;
+BEGIN
+   spOld:= sp;
+   next:= continuation.top;
+   continuation:= continuation.rest;
+   IF lastResult IS Atomic THEN
+      NEW(newTop);
+      newTop.top:= lastResult;
+      newTop.rest:= paramStack;
+      paramStack:= newTop;
+      next.Reduce;
+      paramStack:= paramStack.rest;
+   ELSE
+      next.Reduce;
+   END;
+   spNew:= sp;
+   ASSERT(spNew=spOld, 255);
+END Continue;
+
+PROCEDURE Continued*(): BOOLEAN;
+BEGIN
+   IF continuation.top=FunctionResult THEN
+      continuation:= continuation.rest;
+      RETURN FALSE
+   ELSE
+      Continue;
+      RETURN TRUE
+   END;
+END Continued;
+
+PROCEDURE ResultHandler*;
+BEGIN
+   result:= lastResult;
+END ResultHandler;
+
+PROCEDURE Fail*;
+VAR
+   spOld: INTEGER;
+BEGIN
+   WHILE continuation.top#FunctionResult DO
+      continuation:= continuation.rest;
+   END;
+   continuation:= continuation.rest;
+   result:= Failure;
+END Fail;
+
+
+PROCEDURE (t: Name) Init*(contents: Term);
+BEGIN
+   t.Init^(contents);
+   t.age:= 0;
+END Init;
+
+PROCEDURE (t: Name) Actual*(): Term;
+BEGIN
+   IF t.indirection IS SystemTerm THEN
+      RETURN t
+   ELSIF t.indirection IS Name THEN
+      ASSERT(t.indirection#t);
+      RETURN t.indirection.Actual()
+   ELSE
+      RETURN t.indirection
+   END;
+END Actual;
+
+PROCEDURE (t: Name) Assign*(contents: Term);
+BEGIN
+(*   ASSERT(contents#t); *)
+   INC(sp);
+   stack[sp].indirection:= t.indirection;
+   stack[sp].age:= t.age;
+   t.indirection:= contents;
+   t.age:= sp;
+END Assign;
+
+PROCEDURE (t: Name) Restore*();
+BEGIN
+   ASSERT(sp>0);
+   ASSERT(t.age=sp);
+   t.indirection:= stack[sp].indirection;
+   t.age:= stack[sp].age;
+   DEC(sp);
+END Restore;
+
+PROCEDURE (t: Name) Reduce*;
+VAR
+   saveLastName: Term;
+   spOld,spNew: INTEGER;
+BEGIN
+   spOld:= sp;
+   saveLastName:= lastResult;
+   lastResult:= t;
+   t.indirection.Reduce;
+   lastResult:= saveLastName;
+   IF t.age<eldestAsked THEN
+      eldestAsked:= t.age;
+   END;
+   spNew:= sp;
+   ASSERT(spOld=spNew);
+END Reduce;
+
+
+PROCEDURE (t: SubTerm) Reduce*;
+BEGIN
+   IF t.query=NIL THEN
+      t.Reduce^;
+   ELSE
+      Push(t.query);
+      t.indirection.Reduce;
+   END;
+END Reduce;
+
+PROCEDURE (t: SubTerm) Actual*(): Term;
+VAR
+   newTerm: SubTerm;
+BEGIN
+   IF t.query=NIL THEN
+      RETURN t
+   END;
+   result:= t.query.Actual();
+   IF result=t.query THEN
+      RETURN t
+   ELSE
+      NEW(newTerm);
+      newTerm.indirection:= t.indirection;
+      newTerm.query:= result;
+      RETURN newTerm
+   END;
+END Actual;
+
+PROCEDURE (t: SubTerm) InitQuery*(query: Term);
+BEGIN
+   t.query:= query;
+END InitQuery;
+
+
+PROCEDURE (t: Field) Actual*(): Term;
+VAR
+   spOld: INTEGER;
+BEGIN
+   spOld:= sp;
+   RETURN t.indirection.Evaluate(t.tail)
+END Actual;
+
+PROCEDURE (t: Field) InitQuery*(query: Term);
+VAR
+   newTerm: FieldTail;
+BEGIN
+   NEW(newTerm);
+   newTerm.indirection:= query;
+   t.query:= query;
+   t.tail:= newTerm;
+END InitQuery;
+
+
+PROCEDURE (t: FieldTail) Reduce*;
+BEGIN
+   IF ~Continued() THEN
+      result:= t.indirection.Actual();
+   ELSE
+      HALT(255);
+   END;
+END Reduce;
+
+
+PROCEDURE (t: Equation) Association(param: Name): Term;
+BEGIN
+   WHILE (t#NIL) & (t.param#param) DO
+      t:= t.next;
+   END;
+   IF t=NIL THEN
+      RETURN NIL
+   ELSE
+      RETURN t.indirection.Actual()
+   END;
+END Association;
+
+PROCEDURE (t: Equation) Unfold();
+VAR
+   follow: Equation;
+BEGIN
+   follow:= t;
+   REPEAT
+      follow.param.Assign(follow.indirection);
+      follow:= follow.next;
+   UNTIL follow=NIL;
+END Unfold;
+
+PROCEDURE (t: Equation) UnfoldActual();
+VAR
+   spStart: INTEGER;
+   swap: Term;
+   follow: Equation;
+BEGIN
+   spStart:= sp;
+   follow:= t;
+   REPEAT
+      INC(sp);
+      stack[sp].indirection:= follow.indirection.Actual();
+      follow:= follow.next;
+   UNTIL follow=NIL;
+   REPEAT
+      INC(spStart);
+      swap:= t.param.indirection;
+      t.param.indirection:= stack[spStart].indirection;
+      stack[spStart].indirection:= swap;
+      stack[spStart].age:= t.param.age;
+      t.param.age:= spStart;
+      t:= t.next;
+   UNTIL t=NIL;
+END UnfoldActual;
+
+PROCEDURE (t: Equation) Restore();
+BEGIN
+   sp:= t.param.age-1;
+   REPEAT
+      t.param.indirection:= stack[t.param.age].indirection;
+      t.param.age:= stack[t.param.age].age;
+      t:= t.next;
+   UNTIL t=NIL;
+END Restore;
+
+PROCEDURE (t: Equation) Enrich(VAR base: Term);
+VAR
+   oldEdges, newEdges: Equation;
+   spStart: INTEGER;
+   newTerm: OpenTree;
+BEGIN
+   WITH base: OpenTree DO
+      oldEdges:= base.attributes;
+      newEdges:= oldEdges;
+      spStart:= t.param.age;
+      WHILE oldEdges#NIL DO
+         IF oldEdges.param.age>=spStart THEN
+            oldEdges.param.age:= -oldEdges.param.age;
+         END;
+         oldEdges:= oldEdges.next;
+      END;
+      WHILE t#NIL DO
+         IF t.param.age<0 THEN
+            t.param.age:= -t.param.age;
+         ELSE
+            oldEdges:= newEdges;
+            NEW(newEdges);
+            newEdges.param:= t.param;
+            newEdges.indirection:= t.param.indirection;
+            newEdges.next:= oldEdges;
+         END;
+         t:= t.next;
+      END;
+      base.attributes:= newEdges;
+      base.constant:= FALSE;
+   ELSE
+      IF base IS Name THEN
+         NEW(newTerm);
+         newTerm.indirection:= base;
+         newTerm.constant:= FALSE;
+         newTerm.attributes:= NIL;
+         oldEdges:= t;
+         WHILE oldEdges#NIL DO
+            NEW(newEdges);
+            newEdges.param:= oldEdges.param;
+            newEdges.indirection:= oldEdges.param.indirection;
+            newEdges.next:= newTerm.attributes;
+            newTerm.attributes:= newEdges;
+            oldEdges:= oldEdges.next;
+         END;
+         base:= newTerm;
+      END;
+   END;
+END Enrich;
+
+PROCEDURE (t: Equation) ActualizeUsing(base: Equation);
+VAR
+   follow: Equation;
+   link: Name;
+   spStart: INTEGER;
+BEGIN
+   spStart:= sp;
+   follow:= t;
+   WHILE follow#NIL DO
+      IF follow.indirection IS Name THEN
+         link:= follow.indirection(Name);
+         link.age:= -link.age-1;
+      END;
+      follow:= follow.next;
+   END;
+   WHILE base#NIL DO
+      IF base.param.age<0 THEN
+         base.param.Assign(base.indirection);
+      END;
+      base:= base.next;
+   END;
+   follow:= t;
+   WHILE follow#NIL DO
+      IF follow.indirection IS Name THEN
+         link:= follow.indirection(Name);
+         IF link.age<0 THEN
+            link.age:= -link.age-1;
+         ELSE
+            follow.param.indirection:= link.indirection;
+            follow.indirection:= link.indirection;
+            link.indirection:= stack[link.age].indirection;
+            link.age:= -stack[link.age].age-1;
+         END;
+      END;
+      follow:= follow.next;
+   END;
+   sp:= spStart;
+END ActualizeUsing;
+
+PROCEDURE (t: Equation) Actual(): Term;
+VAR
+   newEdge: Equation;
+   newMeaning,actualRest: Term;
+BEGIN
+   newMeaning:= t.indirection.Actual();
+   IF newMeaning=t.indirection THEN
+      IF t.next#NIL THEN
+         actualRest:= t.next.Actual();
+         IF actualRest#t.next THEN
+            NEW(newEdge);
+            newEdge.param:= t.param;
+            newEdge.indirection:= newMeaning;
+            newEdge.next:= actualRest(Equation);
+            RETURN newEdge
+         END;
+      END;
+      IF t.indirection IS Name THEN
+         allConstant:= FALSE;
+      END;
+      RETURN t
+   ELSE
+      NEW(newEdge);
+      newEdge.param:= t.param;
+      newEdge.indirection:= newMeaning;
+      IF t.next=NIL THEN
+         newEdge.next:= NIL;
+      ELSE
+         actualRest:= t.next.Actual();
+         newEdge.next:= actualRest(Equation);
+      END;
+      RETURN newEdge
+   END;
+END Actual;
+
+
+PROCEDURE (t: Tree) AddProperty*(param: Name; meaning: Term);
+VAR
+   newEdge: Equation;
+BEGIN
+   newEdge:= t.attributes;
+   WHILE (newEdge#NIL) & (newEdge.param#param) DO
+      newEdge:= newEdge.next;
+   END;
+   IF newEdge=NIL THEN
+      NEW(newEdge);
+      newEdge.param:= param;
+      newEdge.next:= t.attributes;
+      t.attributes:= newEdge;
+   END;
+   newEdge.indirection:= meaning;
+END AddProperty;
+
+PROCEDURE (t: Tree) RemoveProperty*(param: Name);
+VAR
+   follow,oldEdge: Equation;
+BEGIN
+   oldEdge:= t.attributes;
+   WHILE (oldEdge#NIL) & (oldEdge.param#param) DO
+      follow:= oldEdge;
+      oldEdge:= oldEdge.next;
+   END;
+   IF oldEdge#NIL THEN
+      IF oldEdge=t.attributes THEN
+         t.attributes:= oldEdge.next;
+      ELSE
+         follow.next:= oldEdge.next;
+      END;
+   END;
+END RemoveProperty;
+
+PROCEDURE Attributed(VAR root: Term; prop: Name; value: Term);
+VAR
+   newTerm: OpenTree;
+BEGIN
+   NEW(newTerm);
+   IF root IS Name THEN
+      newTerm.indirection:= root;
+      newTerm.constant:= FALSE;
+      newTerm.attributes:= NIL;
+   ELSIF root IS OpenTree THEN
+      newTerm^:= root(OpenTree)^;
+   ELSE
+      RETURN
+   END;
+   newTerm.AddProperty(prop,value);
+   root:= newTerm;
+END Attributed;
+
+PROCEDURE (t: Tree) Reduce*;
+VAR
+   spOld,spNew: INTEGER;
+   attr,follow,newEq: Equation;
+   newTerm: OpenTree;
+BEGIN
+   spOld:= sp;
+   attr:= t.attributes;
+   IF attr=NIL THEN
+      t.Reduce^;
+   ELSE
+      attr.UnfoldActual();
+      t.indirection.Reduce;
+      attr.Enrich(result);
+      attr.Restore();
+   END;
+   spNew:= sp;
+   ASSERT(spOld=spNew);
+END Reduce;
+
+PROCEDURE (t: Tree) Actual*(): Term;
+VAR
+   newTerm: Tree;
+   newAttributes: Term;
+BEGIN
+   IF t.constant OR (t.attributes=NIL) THEN
+      t.constant:= TRUE;
+      RETURN t
+   END;
+   allConstant:= TRUE;
+   newAttributes:= t.attributes.Actual();
+   IF allConstant & (newAttributes=t.attributes) THEN
+      t.constant:= TRUE;
+      RETURN t
+   ELSE
+      NEW(newTerm);
+      newTerm.indirection:= t.indirection;
+      newTerm.attributes:= newAttributes(Equation);
+(*      newTerm.constant:= TRUE; *)
+      RETURN newTerm
+   END;
+END Actual;
+
+PROCEDURE (t: Tree) Init*(ind: Term);
+BEGIN
+   t.indirection:= ind;
+   t.attributes:= NIL;
+   t.constant:= FALSE;
+END Init;
+
+PROCEDURE (t: Tree) ProcessAttributes*(proc: PROCEDURE(attr: Name; VAR meaning: Term));
+VAR
+   follow: Equation;
+BEGIN
+   follow:= t.attributes;
+   WHILE follow#NIL DO
+      proc(follow.param,follow.indirection);
+      follow:= follow.next;
+   END;
+END ProcessAttributes;
+
+
+PROCEDURE (t: Class) Reduce*;
+VAR
+   spOld: INTEGER;
+   attr: Equation;
+BEGIN
+   spOld:= sp;
+   attr:= t.attributes;
+   IF attr=NIL THEN
+      t.Reduce^;
+   ELSE
+      attr.Unfold();
+      Continue;
+      attr.Restore();
+   END;
+   ASSERT(spOld=sp);
+END Reduce;
+
+PROCEDURE (t: Class) Actual*(): Term;
+BEGIN
+   RETURN t
+END Actual;
+
+
+PROCEDURE (t: ClosedClass) Reduce*;
+VAR
+   query,root: Term;
+BEGIN
+   query:= continuation.top;
+   root:= query;
+   WHILE ~(root IS Name) DO
+      root:= root.indirection;
+   END;
+   WITH root: Name DO
+      result:= t.attributes.Association(root);
+      IF result=NIL THEN
+         result:= t.attributes.Association(otherwise);
+         IF result=NIL THEN
+            Continue;
+            RETURN
+         END;
+      END;
+      root.Assign(Undefined);
+      continuation:= continuation.rest;
+      Push(result);
+      query.Reduce();
+      root.Restore();
+   END;
+END Reduce;
+
+
+PROCEDURE (t: SystemTerm) Reduce*;
+BEGIN
+   t.handler;
+END Reduce;
+
+PROCEDURE (t: SystemTerm) InitHandler*(h: HandlerType);
+BEGIN
+   t.handler:= h;
+END InitHandler;
+
+
+PROCEDURE (t: Atomic) Reduce*;
+VAR
+   saveLastAtom: Term;
+BEGIN
+   saveLastAtom:= lastAtom;
+   lastAtom:= t;
+   t.indirection.Reduce;
+   lastAtom:= saveLastAtom;
+END Reduce;
+
+
+PROCEDURE (t: Atomic) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+   lessEq:= (t.indirection=reference.indirection);
+   grEq:= lessEq;
+END Compare;
+
+
+PROCEDURE AtomicHandler*;
+VAR
+   saveLastResult: Term;
+BEGIN
+   eldestAsked:= Fixed;
+   saveLastResult:= lastResult;
+   lastResult:= lastAtom;
+   Continue;
+   lastResult:= saveLastResult;
+END AtomicHandler;
+
+
+PROCEDURE Equal*(t1,t2: Term): BOOLEAN;
+VAR
+   lessEq,greaterEq: BOOLEAN;
+
+   PROCEDURE AttrEqual(attr1,attr2: Equation): BOOLEAN;
+   VAR
+      oldSp: INTEGER;
+      copy: Equation;
+   BEGIN
+      copy:= attr1;
+      oldSp:= sp;
+      copy.Unfold();
+      WHILE (attr1#attr2) & (attr2#NIL) & (attr2.param.age>oldSp) &
+            Equal(attr2.indirection,attr2.param.indirection) DO
+         attr1:= attr1.next;
+         attr2:= attr2.next;
+      END;
+      copy.Restore();
+      RETURN attr1=attr2
+   END AttrEqual;
+
+BEGIN
+   IF t1=t2 THEN
+      RETURN TRUE
+   END;
+   IF t1.indirection#t2.indirection THEN
+      RETURN FALSE
+   END;
+   WITH t1: Tree DO
+      WITH t2: Tree DO
+         IF t1.attributes#NIL THEN
+            RETURN AttrEqual(t1.attributes,t2.attributes)
+         END;
+      ELSE
+         RETURN FALSE
+      END;
+   ELSE
+      WITH t1: Atomic DO
+         t1.Compare(t2,lessEq,greaterEq);
+         RETURN lessEq&greaterEq
+      ELSE
+         RETURN TRUE
+      END;
+   END;
+END Equal;
+
+
+PROCEDURE EnvironmentPath*(t: Name): SubTerm;
+VAR
+   result,previous: SubTerm;
+   position: INTEGER;
+BEGIN
+   NEW(result);
+   result.Init(t.indirection);
+   position:= t.age;
+   WHILE position#0 DO
+      previous:= result;
+      NEW(result);
+      result.indirection:= stack[position].indirection;
+      result.query:= previous;
+      position:= stack[position].age;
+   END;
+   RETURN result
+END EnvironmentPath;
+
+
+PROCEDURE RestoreReversed(list: Equation);
+BEGIN
+   IF list#NIL THEN
+      RestoreReversed(list.next);
+      list.param.Assign(continuation.top);
+      continuation:= continuation.rest;
+   END;
+END RestoreReversed;
+
+PROCEDURE RestoreLocals;
+VAR
+   locals: Equation;
+BEGIN
+   locals:= continuation.top(Equation);
+   continuation:= continuation.rest;
+   RestoreReversed(locals);
+   Continue;
+   WHILE locals#NIL DO
+      locals.param.Restore();
+      locals:= locals.next;
+   END;
+END RestoreLocals;
+
+PROCEDURE RestoreLocal;
+VAR
+   local: Name;
+BEGIN
+   local:= continuation.top(Name);
+   continuation:= continuation.rest;
+   local.Assign(continuation.top);
+   continuation:= continuation.rest;
+   Continue;
+   local.Restore();
+END RestoreLocal;
+
+PROCEDURE PushLocal*(t: Name);
+BEGIN
+   Push(t.indirection);
+   Push(t);
+   Push(LocalRestore);
+END PushLocal;
+
+
+PROCEDURE (t: Block) Reduce*;
+VAR
+   follow: Equation;
+   newTerm: Name;
+BEGIN
+   follow:= t.attributes;
+   IF follow#NIL THEN
+      REPEAT
+         Push(follow.param.indirection);
+         IF follow.indirection=Variable THEN
+            NEW(newTerm);
+            newTerm.Init(Variable);
+            follow.param.Assign(newTerm);
+         ELSE
+            follow.param.Assign(follow.indirection.Actual());
+         END;
+         follow:= follow.next;
+      UNTIL follow=NIL;
+      Push(t.attributes);
+      Push(StackRestore);
+      t.indirection.Reduce;
+      IF result IS Tree THEN
+         t.attributes.ActualizeUsing(result(Tree).attributes);
+      END;
+      t.attributes.Enrich(result);
+      t.attributes.Restore;
+   ELSE
+      t.indirection.Reduce;
+   END;
+END Reduce;
+
+
+PROCEDURE GuardHandler*;
+VAR
+   follow: Equation;
+   pattern: Term;
+   newTerm: OpenTree;
+BEGIN
+   pattern:= continuation.top;
+   continuation:= continuation.rest;
+   IF lastResult=pattern.indirection THEN
+      IF pattern IS Tree THEN
+         follow:= pattern(Tree).attributes;
+         WHILE follow#NIL DO
+            Push(follow.indirection);
+            Push(follow.param.indirection);
+            Push(MatchTrap);
+            follow:= follow.next;
+         END;
+      END;
+      Continue;
+   ELSIF (lastResult IS Name) & 
+         (lastResult.indirection=Variable) THEN
+      WITH lastResult: Name DO
+         lastResult.Assign(pattern.Actual());
+         Continue;
+         Attributed(result,lastResult,lastResult.indirection);
+         lastResult.Restore();
+      END;
+   ELSIF (pattern IS Atomic) & Equal(pattern,lastResult) THEN
+      Continue;
+   ELSE
+      Fail;
+   END;
+END GuardHandler;
+
+
+PROCEDURE MatchHandler;
+VAR
+   lhs,pattern: Term;
+   r: TermStack;
+BEGIN
+   lhs:= continuation.top;
+   r:= continuation;
+   continuation:= continuation.rest;
+   pattern:= continuation.top;
+   IF pattern IS Name THEN
+      continuation:= continuation.rest;
+      pattern:= pattern.Value();
+      IF (pattern IS Name) & (pattern.indirection=Variable) THEN
+         WITH pattern: Name DO
+            pattern.Assign(lhs);
+            Continue;
+            pattern.Restore();
+            Attributed(result,pattern,lhs);
+         END;
+         RETURN
+      ELSE
+         Push(pattern);
+      END;
+   END;
+   Push(GuardTrap);
+   lhs.Reduce;
+END MatchHandler;
+
+
+PROCEDURE (t: Disjunction) Reduce*;
+VAR
+   oldCont: TermStack;
+BEGIN
+   oldCont:= continuation;
+   t.indirection.Reduce;
+   IF result=Failure THEN
+      continuation:= oldCont;
+      t.alternative.Reduce;
+   END;
+END Reduce;
+
+PROCEDURE (t: Disjunction) InitAlternative*(alt: Term);
+BEGIN
+   t.alternative:= alt;
+END InitAlternative;
+
+PROCEDURE Unify*(t1,t2: Term);
+BEGIN
+   Push(t2);
+   Push(t1);
+   MatchHandler;
+END Unify;
+
+PROCEDURE MakeLocalBlock*(locals,body: Term): Term;
+VAR
+   newTerm: Block;
+BEGIN
+   IF locals=NIL THEN
+      RETURN body
+   END;
+   NEW(newTerm);
+   newTerm.Init(body);
+   IF locals IS Tree THEN
+      locals:= locals(Tree).attributes;
+   END;
+   newTerm.attributes:= locals(Equation);
+   RETURN newTerm
+END MakeLocalBlock;
+
+
+PROCEDURE MakeAlternative*(pattern,ifMatch: Term): Term;
+VAR
+   sub1,sub2: SubTerm;
+(*   newDis: Disjunction; *)
+   acc: Equation;
+
+   PROCEDURE  Locals(t: Equation);
+   VAR
+      newEq: Equation;
+   BEGIN
+      IF t#NIL THEN
+         IF t.indirection IS Name THEN
+            IF (acc=NIL) OR (acc.Association(t.indirection(Name))=NIL) THEN
+               NEW(newEq);
+               newEq.param:= t.indirection(Name);
+               newEq.indirection:= Variable;
+               newEq.next:= acc;
+               acc:= newEq;
+            END;
+         ELSIF t.indirection IS Tree THEN
+            Locals(t.indirection(Tree).attributes);
+         END;
+         Locals(t.next);
+      END;
+   END Locals;
+BEGIN
+   WITH pattern: Tree DO
+      NEW(sub1);
+      NEW(sub2);
+      sub1.query:= ifMatch;
+      sub2.query:= pattern;
+      sub2.indirection:= GuardTrap;
+      sub1.indirection:= sub2;
+      acc:= NIL;
+      Locals(pattern.attributes);
+(*      IF noMatch=NIL THEN *)
+         RETURN MakeLocalBlock(acc,sub1)
+(*      END;
+      NEW(newDis);
+      newDis.indirection:= MakeLocalBlock(acc,sub1);
+      newDis.alternative:= noMatch;
+      RETURN newDis *)
+   ELSE
+      RETURN ifMatch
+   END;
+END MakeAlternative;
+
+BEGIN
+   NEW(stack);
+   sp:= 0;
+   continuation:= NIL;
+   NEW(FunctionResult);
+   FunctionResult.Init(NIL);
+   FunctionResult.InitHandler(ResultHandler);
+   lastAtom:= NIL;
+   NEW(lastResult);
+   lastResult.Init(NIL);
+   NEW(Variable);
+   Variable.Init(NIL);
+   Variable.InitHandler(Continue);
+   NEW(Undefined);
+   Undefined.Init(NIL);
+   Undefined.InitHandler(Continue);
+   NEW(LocalRestore);
+   LocalRestore.Init(NIL);
+   LocalRestore.InitHandler(RestoreLocal);
+   NEW(StackRestore);
+   StackRestore.Init(NIL);
+   StackRestore.InitHandler(RestoreLocals);
+   NEW(GuardTrap);
+   GuardTrap.Init(NIL);
+   GuardTrap.InitHandler(GuardHandler);
+   NEW(MatchTrap);
+   MatchTrap.Init(NIL);
+   MatchTrap.InitHandler(MatchHandler);
+END AGRS.
+
+ examples/AGRS/Attributes.Def view
@@ -0,0 +1,208 @@+(*+https://web.archive.org/web/20041223052353/http://www.oberon.ethz.ch:80/ethoberon/defs/Attributes.Def.html+*)+DEFINITION Attributes; (* portable *)++(*Module Attributes manages the attribute lists of the gadgets, provides an+improved scanner with macro substitution facilities for executing commands,+and supplies type conversion routines.+*)+ IMPORT+  Objects, Texts, Files;++ CONST+  (* Scanner symbol classes. *)+  Inval = Texts.Inval;           (* Invalid symbol. *)+  Name = Texts.Name;        (* Name. *)+  String = Texts.String;        (* Literal string. *)+  Int = Texts.Int;             (* Integer i. *)+  Real = Texts.Real;          (* Real number x. *)+  LongReal = Texts.LongReal;  (* Long real number y. *)+  Char = Texts.Char;          (* Special character c. *)+  Obj = Texts.Object;      (* Object o. *)++ TYPE+  Reader = POINTER TO ReaderDesc;  (* Macro substituting reader. *)+  ReaderDesc = RECORD+   substitute: BOOLEAN;  (* Is substitution on or off? *)+   text: Texts.Text;  (* Current text read. *)+   eot: BOOLEAN;  (* End of text reached? *)+   lib: Objects.Library; (* Library of last character/object read. *)+  END;++(* Upcall for macro substitution. Ch is the character to be substituted, res+is the substitution text and beg is the starting position inside of the text.*)+  MacroHandler = PROCEDURE (ch: CHAR; VAR T: Reader; VAR res: Texts.Text; VAR beg: LONGINT);+  Scanner = RECORD (* Macro substituting scanner *)+   R: Reader;  (* Scanner operates with this reader. *)+   eot: BOOLEAN; (* End of text reached? *)+   nextCh: CHAR; (* Character located immediately after scanned token. *)+   class: INTEGER;  (* Scanner classes. Scanned tokens are returned in the+record fields below. *)+   i: LONGINT;+   x: REAL;+   y: LONGREAL;+   c: CHAR;+   len: SHORTINT;+   s: ARRAY  128 OF CHAR;+   o: Objects.Object;+  END;++ (* Data structures for storing attribute lists. *)+  Attr = POINTER TO AttrDesc;+  AttrDesc = RECORD+   next: Attr;+   name: Objects.Name+  END;++  BoolAttr = POINTER TO BoolDesc;+  BoolDesc = RECORD ( AttrDesc ) +   b: BOOLEAN END;++  CharAttr = POINTER TO CharDesc;+  CharDesc = RECORD ( AttrDesc ) +   c: CHAR END;++  IntAttr = POINTER TO IntDesc;+  IntDesc = RECORD ( AttrDesc ) +   i: LONGINT END;++  RealAttr = POINTER TO RealDesc;+  RealDesc = RECORD ( AttrDesc ) +   r: LONGREAL END;++  StringAttr = POINTER TO StringDesc;+  StringDesc = RECORD ( AttrDesc ) +   s: ARRAY 64 OF CHAR; END;++(* Convert a string to a text. *)+ PROCEDURE StrToTxt (s: ARRAY OF CHAR; VAR T: Texts.Text);++(* Convert a text to a string. The string might be terminated early if the text+is too long to fit. *)+ PROCEDURE TxtToStr (T: Texts.Text; VAR s: ARRAY OF CHAR);++(* Read character ch from the Reader. Registered character macros are automatically+substituted by making upcalls to the installed macro handlers. *)+ PROCEDURE Read (VAR R: Reader; VAR ch: CHAR);++(* Open reader R at position pos in text. *)+ PROCEDURE OpenReader (VAR R: Reader; text: Texts.Text; pos: LONGINT);++(* Return current position of Reader R in text R.text. Note that R.text may+change as macro characters are being substituted. *)+ PROCEDURE Pos (VAR R: Reader): LONGINT;++(* Open Scanner S at position pos in text T. *)+ PROCEDURE OpenScanner (VAR S: Scanner; T: Texts.Text; pos: LONGINT);++(* Read the next symbol or object in the text. White space is ignored. *)+ PROCEDURE Scan (VAR S: Scanner);++(* Register a macro handler for a character. This handler is called when character+ch is read using the reader/scanner, and must return a text with the substitution.+*)+ PROCEDURE AddMacro (ch: CHAR; handler: MacroHandler);++(* Store the atttribute list A. *)+ PROCEDURE StoreAttributes (VAR R: Files.Rider; A: Attr);++(* Load attribute list resulting in a list A. *)+ PROCEDURE LoadAttributes (VAR R: Files.Rider; VAR A: Attr);++(* Copy an attribute list. *)+ PROCEDURE CopyAttributes (in: Attr; VAR out: Attr);++(* Insert an attribute in a list. An existing attribute with the same name is+discarded. *)+ PROCEDURE InsertAttr (VAR list: Attr; name: ARRAY OF CHAR; val: Attr);++(* Search for an attribute name in list. *)+ PROCEDURE FindAttr (name: ARRAY OF CHAR; list: Attr): Attr;++(* Delete an attribute. *)+ PROCEDURE DeleteAttr (VAR list: Attr; name: ARRAY OF CHAR);++(* Write the attribute attr of object obj to the writer W. Format conversion+to strings are automatic.*)+ PROCEDURE WriteAttr (obj: Objects.Object; attr: ARRAY OF CHAR; VAR W: Texts.Writer);++(* GetXXX(obj: Objects.Object; name: ARRAY OF CHAR; VAR x: T);+  Retrieve object attribute name and convert it to type T.+  The following conversions are done by GetType:+ Type T Attribute classes converted++ Bool BOOLEAN Bool, String, Char+ Int LONGINT Int, String, Real, LongReal+ Real REAL Real, String, LongReal, Int+ LongReal LONGREAL LongReal, String, Real, Int+ String ARRAY OF CHAR String, Int, Bool, Real, LongReal, Bool+*)+ PROCEDURE GetBool (obj: Objects.Object; name: ARRAY OF CHAR; VAR b: BOOLEAN);+ PROCEDURE GetInt (obj: Objects.Object; name: ARRAY OF CHAR; VAR i: LONGINT);+ PROCEDURE GetReal (obj: Objects.Object; name: ARRAY OF CHAR; VAR x: REAL);+ PROCEDURE GetLongReal (obj: Objects.Object; name: ARRAY OF CHAR; VAR y: LONGREAL);+ PROCEDURE GetString (obj: Objects.Object; name: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);++(* SetXXX(obj: Objects.Object; name: ARRAY OF CHAR; x: T);+  Set object attribute name and convert it to the the attribute class understood+by obj.+  The following conversions are done by SetType:+ Type T Attribute classes converted++ Bool BOOLEAN Bool, String, Char+ Int LONGINT Int, String, Real, LongReal+ Real REAL Real, String, LongReal, Int+ LongReal LONGREAL LongReal, String, Real, Int+ String ARRAY OF CHAR String, Int, Bool, Real, LongReal, Bool+*)+ PROCEDURE SetBool (obj: Objects.Object; name: ARRAY OF CHAR; b: BOOLEAN);+ PROCEDURE SetInt (obj: Objects.Object; name: ARRAY OF CHAR; i: LONGINT);+ PROCEDURE SetReal (obj: Objects.Object; name: ARRAY OF CHAR; x: REAL);+ PROCEDURE SetLongReal (obj: Objects.Object; name: ARRAY OF CHAR; y: LONGREAL);+ PROCEDURE SetString (obj: Objects.Object; name, s: ARRAY OF CHAR);++(* Write all parameters of command. *)+ PROCEDURE Echo;++END Attributes.++(*+Remarks:++1. Reader and Scanner+The reader and scanner operate in the same fashion as that of the Text module.+There are however a few exceptions. First, the reader does macro substitution+as texts are read. Some macros are predefined, and the programmer has the capability+to add his or her own macros by identifying special symbols for macros and a+handler for that macro symbol. While reading or scanning a text, upcalls are+made to the registered macro handler to return a substitution text for the macro+symbol. New macros are registered with the AddMacro procedure. The macro handler+has to return a text and a position in the text where reading/scanning should+continue. Reading/scanning will continue in the original text after the end+of the substitution text is reached. The macro might take parameters (letters+that follow immediately after the macro symbol), which are read by the macro+handler using the passed Reader. Note that no substitution is made when no text+(= NIL) is returned. By default, the up arrow ("^"), which expands to the current+selection, is installed as a macro in the Attributes module. In contrast to+the Texts.Scanner, the Attributes.Scanner scan words containing letters like+ä, ü, ö, – etc, and (non-character) objects embedded inside of the text.++2. Attribute Message and Attribute Storage+Most gadgets employ two strategies for storing attribute values. The first is+by allocating own storage space for the attributes in the object definition+and by responding on the Objects.AttrMsg when these attributes are accessed.+The second way is having the default message handlers of module Gadgets take+care of attributes. This is called the default or standard handling of attributes.+The default message handlers manage lists of gadgets with the types defined+in module Attributes. Such an attribute list is always identified by its first+component, which might change when attributes are inserted or deleted. Many+gadgets uses a hybrid approach to attribute handling, where own attributes are+handled in a special way, and all other attributes are handled by the default+message handlers. For example, the "Name" of a gadget is typically handled by+the default message handlers. This has the advantage that storage space is only+used when the attribute has a value (remember that many gadgets don't have names,+and allocating space inside your own gadget record descriptor for a name, makes+you pay the storage price for each gadget, even if it is not named).++*)
+ examples/AGRS/Directories.Def view
@@ -0,0 +1,48 @@+(*+https://web.archive.org/web/20041224144144/http://www.oberon.ethz.ch:80/ethoberon/defs/Directories.Def.html+*)+DEFINITION Directories; (* portable *)++ IMPORT+  Objects,+  Gadgets, ListRiders;++ TYPE+  Model = POINTER TO ModelDesc;+  ModelDesc = RECORD ( Gadgets.ObjDesc ) +  END;++  Rider = POINTER TO RiderDesc;+  RiderDesc = RECORD ( ListRiders.RiderDesc ) +  END;++ TYPE FileProc = PROCEDURE (d: Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);++(* Update the model (not yet implemented) *)+ PROCEDURE UpdateModel (obj: Model);++(* Standard handler for directory models *)+ PROCEDURE ModelHandler (obj: Objects.Object; VAR M: Objects.ObjMsg);++(* Initialize a directory model *)+ PROCEDURE InitModel (obj: Model; rootDir, mask: ARRAY OF CHAR);++(* Generator for directory models *)+ PROCEDURE New;+ PROCEDURE NewDirList;+ PROCEDURE NewDrv;++(* Finds all the filenames in the search path that match a specified pattern+and inserts them+ into a list model gadget (ListModel, Tree or Dag) named <Objname> in the current+context. + If the option p is specified, the filenames are prefixed with their relative+path in the current+ working directory.+ Usage: Directories.Directory [p] "<pattern>" <Objname> ~+*)+ PROCEDURE Directory;++ PROCEDURE Enumerate (dir: Directory; fileProc: FileProc);+ PROCEDURE This (path: ARRAY OF CHAR): Directory;+END Directories.
+ examples/AGRS/Display.Def view
@@ -0,0 +1,403 @@+(*+https://web.archive.org/web/20050306075112/http://www.oberon.ethz.ch:80/ethoberon/defs/Display.Def.html+*)+DEFINITION Display; (* portable, except where noted *)++(*+Module Display provides the display drawing primitives and the base type of+the visual objects, called Frames.+*)+ IMPORT Objects;++ CONST+  BG = 0; FG = 15; (* Background, foreground color palette indices *)++ (* Drawing operation modes. *)+  replace = 0; (* replace destination. *)+  paint = 1; (* paint over destination.  *)+  invert = 2; (* invert destination. *)++ (* Message ids. *)+  remove = 0; suspend = 1; restore = 2; newprinter = 3; (* ControlMsg id.+*)+  reduce = 0; extend = 1; move = 2; (* ModifyMsg id. *)+  display = 0; state = 1; (* ModifyMsg mode. *)+  screen = 0; printer = 1; (* DisplayMsg device *)+  full = 0; area = 1; contents = 2; (* DisplayMsg id. *)+  get = 0; set = 1; reset = 2; (* SelectMsg id. *)+  drop = 0; integrate = 1; (* ConsumeMsg id. *)++ (* TransferFormat() return values.  value DIV 8 = bytes per pixel.  portable,+release >= 2.4*)+  unknown = 0; index8 = 8; color555 = 16; color565 = 17; color664 = 18; color888 = 24; color8888 = 32;++ TYPE+  Color = LONGINT; (* portable, release >= 2.4 *)+  Pattern = LONGINT;+  Frame = POINTER TO FrameDesc; (* Base type of all displayable objects. *)+  FrameDesc = RECORD ( Objects.ObjDesc ) +   next, dsc: Frame; (* Sibling, child pointers. *)+   X, Y, W, H: INTEGER (* Coordinates. *)+  END;++  FrameMsg = RECORD ( Objects.ObjMsg )  (* Base type of messages sent to frames.+*)+   F: Frame; (* Message target, NIL for broadcast. *)+   x, y: INTEGER; (* Message origin. *)+   res: INTEGER (* Result code: <0 = error or no response, >=0 response. *)+  END;++  ControlMsg = RECORD ( FrameMsg ) +   id: INTEGER (* remove, suspend, restore. *)+  END;++  ModifyMsg = RECORD ( FrameMsg )  (* Change coordinates in container frame.+*)+   id: INTEGER; (* reduce, extend, move. *)+   mode: INTEGER; (* Modes display, state. *)+   dX, dY, dW, dH: INTEGER; (* Change from old coordinates (delta). *)+   X, Y, W, H: INTEGER (* New coordinates. *)+  END;++  DisplayMsg = RECORD ( FrameMsg )  (* Display a frame, a part of it or its+contents. *)+   device: INTEGER; (* screen, printer *)+   id: INTEGER; (* full, area, contents. *)+   u, v, w, h: INTEGER (* Area to be restored. *)+  END;++  LocateMsg = RECORD ( FrameMsg )  (* Locate frame in display space. *)+   loc: Frame; (* Result. *)+   X, Y: INTEGER; (* Absolute location. *)+   u, v: INTEGER (* Relative coordinates in loc. *)+  END;++  SelectMsg = RECORD ( FrameMsg )  (* Selection control. *)+   id: INTEGER; (* get, set, reset. *)+   time: LONGINT; (* Time of selection. *)+   sel: Frame; (* Parent of selection. *)+   obj: Objects.Object (* List of objects involved, linked with slink. *)+  END;++  ConsumeMsg = RECORD ( FrameMsg )  (* Drop, integrate frames. *)+   id: INTEGER; (* drop, integrate. *)+   u, v: INTEGER; (* Relative coordinates in destination when drop. *)+   obj: Objects.Object (* List of objects to be consumed, linked with slink.+*)+  END;++  MsgProc = PROCEDURE (VAR M: FrameMsg);++ VAR +  Unit: LONGINT; (* RasterUnit = Unit/36000 mm *)+  Left, (* Left margin of black-and-white screen. *)+  ColLeft, (* Left margin of secondary display, often same as Left. *)+  Bottom, (* Bottom of primary map. *)+  UBottom, (* Bottom of offscreen area (negative), 0 if not supported. *)+  Width, (* Display width. *)+  Height: INTEGER; (* Display height. *)+  arrow,  (* Oberon cursor. *)+  star,  (* Star marker to mark documents and viewers. *)+  cross,  (* Insertion marker. *)+  downArrow,  (* Marker to indicate disk operation. *)+  hook, (* Text caret pattern. *)+  grey0, grey1, grey2, ticks, solid: Pattern; (* Simulated grey levels.+*)+  Broadcast: MsgProc; (* Message broadcast to all frames in the display space.+*)++(* Change color palette entry. 0 <= col, red, green, blue < 256. *)+ PROCEDURE SetColor (col: Color; red, green, blue: LONGINT);++(* Retrieve color palette entry or color components of a true color value. 0+<= red, green, blue < 256. *)+ PROCEDURE GetColor (col: Color; VAR red, green, blue: INTEGER);++(* Return true color with specified components. 0 <= red, green, blue < 256.+ Not all display regions support true color values, see TrueColor(). *)+ PROCEDURE RGB (red, green, blue: LONGINT): Color; (* portable, release >=+2.4 *)++(* Returns the color palette depth for the specified display region. Typical+values are 1, 4 and 8 (not larger). *)+ PROCEDURE Depth (x: LONGINT): INTEGER;++(* Returns TRUE iff the specified display region supports true color values.+*)+ PROCEDURE TrueColor (x: LONGINT): BOOLEAN; (* portable, release >= 2.4 *)++(* Get the current clip rectangle. *)+ PROCEDURE GetClip (VAR x, y, w, h: INTEGER);++(* Set the new clipping rectangle. *)+ PROCEDURE SetClip (x, y, w, h: LONGINT);++(* Intersect with current clip rectangle resulting in a new clip rectangle.+*)+ PROCEDURE AdjustClip (x, y, w, h: LONGINT);++(* Reset the current clipping rectangle to the whole display, including offscreen+area. *)+ PROCEDURE ResetClip;++(* Copy source block sx, sy, w, h to destination dx, dy using operation mode.+A block is given by its lower left corner sx, sy and its dimension w, h. Some+drivers only implement mode = replace. *)+ PROCEDURE CopyBlock (sx, sy, w, h, dx, dy, mode: LONGINT);++(* Copy pattern pat in color col to x, y using operation mode. *)+ PROCEDURE CopyPattern (col: Color; pat: Pattern; x, y, mode: LONGINT);++(* Replicate pattern pat in color col into block x, y, w, h using operation+mode, proceeding from left to right and from bottom to top, starting at lower+left corner. The pattern origin is placed at px, py. *)+ PROCEDURE FillPattern (col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT);++(* Like FillPattern, but the pattern origin is placed at 0, 0. *)+ PROCEDURE ReplPattern (col: Color; pat: Pattern; x, y, w, h, mode: LONGINT);++(* Block fill in color col and operation mode.  mode paint and replace are equivalent.+*)+ PROCEDURE ReplConst (col: Color; x, y, w, h, mode: LONGINT);++(* Place a dot of color col in operation mode at x, y. Effect equivalent to+ReplConst with a block of size 1, 1. *)+ PROCEDURE Dot (col: Color; x, y, mode: LONGINT);++(* Returns the dimensions of a pattern. *)+ PROCEDURE GetDim (pat: Pattern; VAR w, h: INTEGER);++(* Define a new pattern. *)+ PROCEDURE NewPattern (w, h: LONGINT; VAR image: ARRAY OF SET): Pattern;++(* Return the TransferBlock format of a display region. *)+ PROCEDURE TransferFormat (x: LONGINT): LONGINT; (* portable, release >= 2.4+*)++(* Transfer a block of pixels in display format to (mode = set) or from (mode+= get)  the display.  Pixels in the rectangular area are transferred from bottom+to top and left to right.  The pixels are transferred to or from buf, starting+at ofs, and with line increment stride, which may be < 0. *)+ PROCEDURE TransferBlock (VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT); (*+portable, release >= 2.4 *)++(* Change display mode. s is driver-specific. *)+ PROCEDURE SetMode (x: LONGINT; s: SET); (* non-portable *)++(* Display a picture.  Used internally by Pictures module only. *)+ PROCEDURE DisplayBlock (adr, dx, dy, w, h, sx, sy, mode: LONGINT); (* non-portable+*)++(* Return address of display located at x, or 0 if not supported. *)+ PROCEDURE Map (x: LONGINT): LONGINT; (* non-portable *)+END Display.++(* Remarks:++1. Background and Foreground colors+Oberon can either be used with white text on a black background, or inverted+with black text on a white background (the so-called paper model). To reduce+confusion you should use the FG and BG constants in your code.++2. Screen Organization+Oberon supports multiple displays that are placed next to each other in increasing+X coordinates. The X coordinate thus uniquely determines the screen, hence the+single parameter of the Depth and TransferFormat procedures. Each screen contains+a set of nested frames. Historically, the first screen (at Left) is the black+and white screen, and the second screen is the color screen (at ColLeft). Today+Left and ColLeft are typically set to 0 (for compatability with older applications),+as only a few computers still use black and white displays. Only the color map+is supported, and it now exists at the display origin.  The screen origin is+located at the bottom-left corner of the display (i.e. Y decrease from the top+to the bottom of the display).++3. The Frames and the Frame messages+Frames are the visual entities of Oberon. The frames are placed in the display+space to make them visible. This involves inserting frames using the dsc and+next fields into a container already located in the display space. All frames+of a container are linked together in priority sequence using the next field.+The dsc field points to the first child frame of a container. Note that this+is only a convention and certain frames might decide to manage their contents+in different ways. The frame messages are used to manipulate Frames.  Frames+also respond to the object message defined in module Objects. ++4. Target or Destination frames+The Frame messages are often broadcast into the display space rather than sending+them directly to a frame. This is useful when many frames are to be informed+of an event. It is also a means to determine the exact location (in coordinates+and nesting) of a frame in the display space by following the message thread+from the display root object to the frame itself (see module Objects). It is+also possible to address a broadcast message to a certain frame. This is called+a directed broadcast, because the message is still broadcast, but is intended+for a specific target only.  The target or destination of a broadcast message+is identified by the F field in the FrameMsg. It is set to NIL when all frames+are to receive the message (true broadcast) and to a specific frame if only+that frame is interested in the message (directed broadcast).  The exact location,+in coordinates and nesting, of a frame in the display space can be determined+by tracing the message thread from the display root object to the frame itself.+ See module Objects.++5. Frame Coordinates and Message origin+The coordinates of a frame are specified relative to its container or parent+frame. The frame messages pass the absolute position of the top-left corner+of the parent frame to their children in the x and y fields (called the message+origin). Thus the absolute display position of a frame F is determined when+it receives a frame message M:++ M.x + F.X, M.y + F.Y, F.W, F.H++M.x and M.y are set by the container to its absolute coordinates. refer to sections+5.5-5.7 of The Oberon Companion (in Book.Tool).++6. Invalidating Messages+Often a frame knows that a broadcast need not pass through the remainder of+display space because it has already been handled. In such cases the res field+of the frame message is set to zero or positive to indicate that an action has+been completed and that the message is invalidated. Setting the res field in+this way is called "invalidating a message" and will terminate the broadcast.++7. Broadcasting Frame Messages+The Broadcast procedure broadcasts a message through the display space. The+procedure initializes fields in the frame message. The message origin is set+to (0, 0), the message is time stamped, the res field is set to a negative value,+and the dlink field (defined in the base type Objects.ObjMsg) is initialized+to NIL. In addition, the clipping rectangle is set to the whole display area.+ Refer to section 5.7 of The Oberon Companion (in Book.Tool) for a description+of dlink.++8. Clipping+To prevent the clipping rectangle clipping the wrong display primitives, it+is reset on each message broadcast or when a trap occurs. Clipping does not+affect the drawing of cursors. The Gadget system uses "display masks" that hide+the management of the clipping rectangle from the programmer.++9. NewPattern+The NewPattern procedure allows you to define patterns in a machine portable+way. The sets contain 32 bits, each specifying a single pixel, with {0} the+left-most pixel of the pattern. Each pattern line must be filled with empty+bits so that it is a multiple of 32 pixels long. The first SET of the array+contains the bottom line of the pattern.++10. ControlMsg+The ControlMsg is primarily used to remove a frame from the display space. When+id is set to remove, the destination frame should be removed from its current+location. This done by the container of the frame and is thus a slight misinterpretation+of F as a destination frame. More than one frame is removed if the destination+is a list of frames connected by the slink field. In this case, they should+all belong to the same parent. This message should always be broadcast.+When the message id is set to suspend or restore it indicates that all frames+from the destination downwards in the display space will be temporarily removed+from the display space, or will be restored to the display space. This allows+frames to update their internal data structures as they may have missed messages+while suspended. This is because only those frames located in the display space+receive message broadcasts. This message is sent to the top-most frame of that+part of the display space involved with the destination set to NIL.++11. ModifyMsg+The ModifyMsg broadcasts a resize request to the destination frame. This allows+moving the relative position or changing the size of a child in a container.+When the mode is set to state, the frame should not display itself immediately+but should only update its size and position and possibly indicate changes to+its children. It is then the task of the sender to send a follow up Display+message to the frame. The latter way of using the ModifyMsg allows a container+to influence its children without having them draw themselves for each change+made. This message must never be invalidated; i.e. it must travel throughout+the whole display space. The dX, dY, dW, dH coordinates should always be set+correctly to indicate the change in position and size from the original position+and size. The id field of the ModifyMsg is ignored by most frames in the system.++12. DisplayMsg+The DisplayMsg sends either a redraw request or a print request to a destination+frame, according to whether the value of device is screen or printer. When the+destination is NIL, a whole DAG of gadgets is implied. When id is set to area,+the area u, v, w, h inside the destination frame should be redrawn. Gadgets+assumes that these coordinates are relative to the top left-most corner of the+destination gadget. Thus v is negative.++When printing, the x, y coordinates indicate the absolute printer coordinates+of the left-bottom corner of the frame on paper and not the left-bottom corner+of the container. When the id is set to full, the frame must print itself as+it appears on the display. When the id is set to contents the frame must print+its complete contents. For example, a multi-page text can be displayed and printed.+The frame can assume that the printer driver has already been initialized. Readying+the printer is the task of the sender and is done by calling Printer.Open.++13. LocateMsg+This message is broadcast to locate the frame positioned at the absolute coordinates+X, Y on the display. The result, if any, is found in the loc field. The frame+should return the relative position u, v of X, Y inside itself. Gadgets return+these coordinates relative to their top-left corner (i.e. v is typically negative).+By convention, the message is invalidated when the loc field is set.++14. SelectMsg+When id is set to get, the message is used to return the current object selection,+a list, in obj. The parent of the selected objects is returned in the sel field.+This message is broadcast with the destination set to NIL. The time of the selection+is returned in the time field. Each container frame in the display space typically+compares the time of its selection with the time field in the message, updating+the returned selection when it is after the time set in the message field. When+id is set to set or reset, the destination frame should select or unselect itself.+It should never draw itself at this point. This is the task of the message sender.++15. ConsumeMsg+When the id is set to drop, the destination frame is requested to consume the+list of objects found in the obj field. In this way objects can be dynamically+ added to a container. The relative u, v coordinates indicate the location inside+the container. +Typically v is negative.  When id is set to integrate, the message is broadcast+and indicates that the frame owning the focus (caret) should consume the list+of objects.++16. The Broadcast procedure is installed by module Viewers to the default message+broadcasting procedure found in that module.++17. TransferBlock+TransferBlock is a fast way to read or write the display in a format as close+as possible to the native format of the driver.  If the driver does not directly+use one of the supported formats (defined below), it must select one and translate+on-the-fly.  The caller must be prepared to handle any of the supported return+formats.  The value returned by TransferFormat is constant, unless the display+mode is changed.  TransferBlock performs clipping using the normal clipping+rectangle.  When reading from the display, the pixels falling outside the clipping+rectangle have undefined values.++18. TransferFormat returns+ unknown - TransferBlock not supported+ index8 - 8 bits per pixel indexed+ color555 - 16 bits per pixel XRGB 1x5x5x5+ color565 - 16 bits per pixel RGB 5x6x5+ color664 - 16 bits per pixel RGB 6x6x4+ color888 - 24 bits per pixel RGB 8x8x8+ color8888 - 32 bits per pixel XRGB 8x8x8x8+color components: R = red, G = green, B = blue, X = undefined.+multibyte values are stored in little-endian order in buf (least-significant+byte first).+color components are stored in XRGB bit order (B in least-significant bits).+ +19. Color+There are two types of display drivers.  "Minimal" drivers that support only+indexed color, and "full-featured" drivers that support indexed color and true+color.  Monochrome drivers should emulate one of the two options.  The TrueColor()+function can be used to determine what kind of driver is active in a display+region.  A minimal driver only supports color values from 0 to 255 (0 to 0FFH),+which are entries into the palette, and color values outside this range produce+undefined results (e.g. garbage, index out of range trap).  A full-featured+driver also supports 24-bit true color values that range from MIN(LONGINT) to+MIN(LONGINT)+2^24-1 (80000000H to 80FFFFFFH).  The driver translates the color+values to the internal format of the display buffer on-the-fly.++20. The RGB() function can be used to construct true color values.  The RGB+components are defined as:+ R = ASH(col, -16) MOD 256, G = ASH(col, -8) MOD 256, B = col MOD 256, and+ col = MIN(LONGINT) + ASH(R, 16) + ASH(G, 8) + B, where 0 <= R,G,B <= 255+The RGB function can be used to compose color values, and GetColor can be used+to decompose them, as well as to read from the palette.++21. Depth() returns the depth of the color palette.+ 1 - recommend use of color indices BG and FG only.+ 4 - color indices 0 to 16 supported.+ 8 - color indices 0 to 255 supported.+No driver will support a color palette larger than 8 bits.  Instead it might+support true color values generated by function RGB().  The TrueColor() function+can be used to check if a driver supports such values.+*)
+ examples/AGRS/Display3.Def view
@@ -0,0 +1,240 @@+(*+https://web.archive.org/web/20041103105402/http://www.oberon.ethz.ch:80/ethoberon/defs/Display3.Def.html+*)+DEFINITION Display3; (* portable *) (* jm 17.1.95 / tk 7.12.95*)++(*Module Display3 implements the clipped graphic primitives used by the Gadget+system. It has a twin module called Printer3 that implements the same primitives+for the printer.+*)+ IMPORT+  Display, Fonts, Pictures;++ CONST+  replace = Display.replace; paint = Display.paint; invert = Display.invert;  (*+Standard display modes. *)++ (* Display styles *)+  filled = 1;  (* Filled *)++ TYPE+  Mask = POINTER TO MaskDesc; (* Clipping Mask. *)++ (* Informs a frame of a new mask. This message is always sent directly. *)+  OverlapMsg = RECORD ( Display.FrameMsg ) +   M: Mask;  (* Use NIL to indicate to a frame that its current mask is invalid.+*)+  END;++ (* Message broadcast by a frame (identified by the F field) to indicate that+it has an invalid mask and now requires+ its parent, to calculate a new mask for it and to inform it through the OverlapMsg.+*)+  UpdateMaskMsg = RECORD ( Display.FrameMsg ) +  END;++  MaskDesc = RECORD (* Clipping mask descriptor. *)+   x, y: INTEGER;  (* Relative mask origin or offset. *)+   X, Y, W, H: INTEGER;  (* Current clipping port in absolute coordinates.+*)+  END;++ (* Enumerate the set of rectangles in a mask. The clipping port is not enumerated.+*)+  EnumProc = PROCEDURE (X, Y, W, H: INTEGER);++ VAR +  selectpat: Display.Pattern; (* Pattern used to draw gadgets when in a selected+state. *)++ (* Colors *)+  FG, BG: INTEGER;  (* Foreground (black) and background (white) color indexes.+*)+  red, green, blue: INTEGER; (* Primary color indexes. *)+  black, white: INTEGER; (* True black and white. *)+  topC: INTEGER; (* Top shadow color. *)+  bottomC: INTEGER; (* Bottom shadow color. *)+  upC: INTEGER; (* Color of a button. *)+  downC: INTEGER; (* Color of the pushed  button *)+  groupC: INTEGER; (* Color of containers, i.e. gadgets that have a grouping+function like panels. *)+  invertC: INTEGER; (* Best color for doing inverts.. *)+  textC: INTEGER; (* Default text color. *)+  textbackC: INTEGER; (* Default text background. *)+  textmode: INTEGER; (* Best CopyPattern mode for this display card. *)++(* Initialize the Mask to the empty region, i.e. everything will be clipped+away. *)+ PROCEDURE Open (M: Mask);++(* Enumerate all the visible areas of a mask. The clipping port is not enumerated.+The mask translation vector is taken into account.*)+ PROCEDURE Enum (M: Mask; enum: EnumProc);++(* Enumerate all the invisible areas of a mask. The clipping port is not enumerated.+Note that you might obtain coordinates outside of the normal screen area, bounded+by approximately -/+ 8192. The mask translation vector is taken into account.*)+ PROCEDURE EnumInvert (M: Mask; enum: EnumProc);++(* Enumerate all the visible areas in the given rectangular region. The clipping+port is not taken into account. *)+ PROCEDURE EnumRect (M: Mask; X, Y, W, H: INTEGER; enum: EnumProc);++(* Make a copy of a mask. *)+ PROCEDURE Copy (from: Mask; VAR to: Mask);++(* Add the rectangle X, Y, W, H as a visible/drawable area to the mask. *)+ PROCEDURE Add (M: Mask; X, Y, W, H: INTEGER);++(* Clip the current clipping port of the mask to the rectangle X, Y, W, H. The+result is an updated clipping port. *)+ PROCEDURE AdjustMask (M: Mask; X, Y, W, H: INTEGER);++(* Remove area X, Y, W, H from the mask i.e. make area undrawable.  *)+ PROCEDURE Subtract (M: Mask; X, Y, W, H: INTEGER);++(* Interset the mask with the rectangle X, Y, W, H. The visible areas are restricted+to this rectangle. *)+ PROCEDURE Intersect (M: Mask; X, Y, W, H: INTEGER);++(* Intersect the masks A and B resulting in R. *)+ PROCEDURE IntersectMasks (A, B: Mask; VAR R: Mask);  (* R is an out parameter+only *)++(* Subtracts the visible areas of B from A to give mask R. *)+ PROCEDURE SubtractMasks (A, B: Mask; VAR R: Mask);++(* Translate the mask so that the resulting origin/offset is 0, 0. This is done+by "adding in" the translation vector. *)+ PROCEDURE Shift (M: Mask);++(* Returns TRUE if the visible areas of the mask form a single rectangle. The+result, when TRUE, is returned. The clipping port is not taken into account.+*)+ PROCEDURE Rectangular (M: Mask; VAR X, Y, W, H: INTEGER): BOOLEAN;++(* Using Display.CopyBlock, copy the area M to position X, Y. The point M.x,+M.y is copied to screen coordinates X, Y. *)+ PROCEDURE CopyMask (M: Mask; X, Y: INTEGER; mode: INTEGER);++(* Display.ReplConst through a mask. *)+ PROCEDURE ReplConst (M: Mask; col: Display.Color; X, Y, W, H, mode: INTEGER);++(* Is this rectangle completely visible? The clipping port is taken into acount.+*)+ PROCEDURE Visible (M: Mask; X, Y, W, H: INTEGER): BOOLEAN;++(* Display.Dot through a clipping mask. *)+ PROCEDURE Dot (M: Mask; col: Display.Color; X, Y, mode: INTEGER);++(* Display.FillPattern through a clipping mask. pX, pY is the pattern pin-point.+*)+ PROCEDURE FillPattern (M: Mask; col: Display.Color; pat: Display.Pattern; pX, pY, X, Y, W, H, mode: INTEGER);++(* Same as Display.CopyPattern, but through a clipping mask. *)+ PROCEDURE CopyPattern (M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, mode: INTEGER);++(* Draw rectangle outline in the specified size, line width and pattern. *)+ PROCEDURE Rect (M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, W, H, width, mode: INTEGER);++(* Draw rectangle outline in width using top and bottom shadow (3D effects ).*)+ PROCEDURE Rect3D (M: Mask; topcol, botcol: Display.Color; X, Y, W, H, width, mode: INTEGER);++(* Fill rectangle with 3D shadow effects. incol specifies the "inside" color.+*)+ PROCEDURE FilledRect3D (M: Mask; topcol, botcol, incol: Display.Color; X, Y, W, H, width, mode: INTEGER);++(* Draw a line in the specified pattern and width. Round brushes are used to+draw thick lines. *)+ PROCEDURE Line (M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, X1, Y1, width, mode: INTEGER);++(* Draw a polygon in pattern pat. n specifies the number of vertices listed+in the arrays X and Y. Style may be {filled}. *)+ PROCEDURE Poly (M: Mask; col: Display.Color; pat: Display.Pattern; VAR X, Y: ARRAY OF INTEGER; n, width: INTEGER; style: SET; mode: INTEGER);++(* Draw an ellipse. Implementation restriction: cannot fill an ellipse or draw+an ellipse with line width > 1 *)+ PROCEDURE Ellipse (M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, a, b, width: INTEGER; style: SET; mode: INTEGER);++(* Draw a circle in radius r using pattern pat at position X, Y. Thick line+widths are allowed. *)+ PROCEDURE Circle (M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, r, width: INTEGER; style: SET; mode: INTEGER);++(* Draw string s in font fnt and color col at position X, Y. *)+ PROCEDURE String (M: Mask; col: Display.Color; X, Y: INTEGER; fnt: Fonts.Font; s: ARRAY OF CHAR; mode: INTEGER);++(* Draw a string s in font fnt centered in the rectangle X, Y, W, H. Line breaks+will be inserted as needed. *)+ PROCEDURE CenterString (M: Mask; col: Display.Color; X, Y, W, H: INTEGER; fnt: Fonts.Font; s: ARRAY OF CHAR; mode: INTEGER);++(* Return the size of a string in width w and height h. dsr returns the baseline+offset as a positive value. *)+ PROCEDURE StringSize (s: ARRAY OF CHAR; fnt: Fonts.Font; VAR w, h, dsr: INTEGER);++(* Draw the area X, Y, W, H of picture P at position DX, DY on the display.+*)+ PROCEDURE Pict (M: Mask; P: Pictures.Picture; X, Y, W, H, DX, DY, mode: INTEGER);++(* Replicate a picture filling area X, Y, W, H on the display. px, py is the+picture pin-point. *)+ PROCEDURE ReplPict (M: Mask; P: Pictures.Picture; px, py, X, Y, W, H, mode: INTEGER);+END Display3.++(* Remarks:++1. Clipping Masks+Built on top of the Display module, the Display3 module is the basis of the+gadgets imaging model. It extends the Display module with more advanced clipped+drawing primitives like lines, polygonal lines, ellipses, circles etc. A clipping+mask indicates which areas on the display can be drawn in. You can imagine the+mask to be a sheet of paper, possibly full of holes, and a display primitive+being a spray can. The holes are all rectangular, and may overlap (i.e. only+rectangular holes can be cut out of the paper). Just as you can move the piece+of paper to spray an image at a new location, the mask can be translated by+a translation vector (also refered to as the mask origin). By default, the holes+of a mask are always defined relative to the origin (0, 0). The origin can be+translated, efficiently moving the mask to a different position. In the MaskDesc,+the fields x, y specify the mask origin/translation vector. It can be changed+directly as needed. Internally masks are sets of non-overlapping rectangles,+where each rectangle has a flag to indicate if drawing is allowed in that area+or not. After each operation that changes the mask, the mask is checked to see+if it might be optimal, i.e. if it is a single rectangular visible area. The+latter case is handled separately, allowing more efficient drawing and masking+operations. The construction of a mask is more heavyweight in comparison to+drawing through a mask, mainly due to the latter checks. Masks should be generated+once, and then left unchanged for as long as possible.++2. Clipping Ports+Clipping ports are used to optimize masks operations. A clipping port is an+absolutely positioned rectangular area through which all display operations+are clipped (a clipping rectangle). The mask and clipping port form together+the clipped region, where drawing primitives are first clipped to the mask,+and then to the clipping port. This is an implementation of the following idea.+Each gadget on the display can be overlapped by other visual objects, and potentially+need to clip itself when displayed. Each gadget is thus allocated a static clipping+mask. In some cases however, only parts of a gadget need to be redisplayed,+for example when a gadget lying partially in front is removed. Rather than creating+a new clipping mask just for this simple case, the clipping port can manipulated+to indicate which "sub-area" of a gadget must be drawn. The key idea is thus+to restrict the clipping mask of a gadget without actually changing the mask+(a potentially expensive operation). The clipping port is set by the rectangle+X, Y, W, H in the MaskDesc. These are absolute display coordinates. Programmers+are allowed to manipulate the clipping port directly or use Display3.AdjustMask.++3. OverlapMsg and UpdateMaskMsg+Each gadget has a (cached) display mask associated with it, even if it is completely+visible. This mask is used when a gadget wants to draw on the display. Each+parent visual gadget (container) has to manage the display masks of its children.+The Display3 module provides messages for requesting a mask and for setting+a mask. The OverlapMsg informs a gadget of its display mask. It is sent directly+to a visual gadget by its parent. After some editing operations it may happen+that a gadgets' mask has become invalid, in which case it is set to nothing+(NIL). Should the gadget notice that it has no mask when it wants to draw itself,+it may broadcast an UpdateMaskMsg to indicate that the parent must create a+mask for it (the gadget itself is identified by the F field in the frame message).+The latter should then calculate the mask, and inform the gadget using the OverlapMsg.+In some cases, a parent can indicate to a child that its mask is not valid any+more, by sending an OverlapMsg with no mask (M.M = NIL).++*)+
+ examples/AGRS/Files.Def view
@@ -0,0 +1,135 @@+(*+https://web.archive.org/web/20050218154659/http://www.oberon.ethz.ch:80/ethoberon/defs/Files.Def.html+*)+DEFINITION Files;++ IMPORT SYSTEM, OFS;++ TYPE+  File = OFS.File;+  Rider = OFS.Rider;++(* Creates a new file with the specified name. *)+ PROCEDURE New (name: ARRAY OF CHAR): File;++(* Open an existing file. The same file descriptor is returned if a file is+opened multiple times. *)+ PROCEDURE Old (name: ARRAY OF CHAR): File;++(* Register a file created with New in the directory, replacing the previous+file in the +directory with the same name. The file is automatically closed. *)+ PROCEDURE Register (f: File);++(* Flushes the changes made to a file to disk. Register will automatically Close+a file. *)+ PROCEDURE Close (f: File);++(* Returns the current length of a file. *)+ PROCEDURE Length (f: File): LONGINT;++(* Returns the time (t) and date (d) when a file was last modified. *)+ PROCEDURE GetDate (f: File; VAR t, d: LONGINT);++(* Sets the modification time (t) and date (d) of a file. *)+ PROCEDURE SetDate (f: File; t, d: LONGINT);++(* Positions a Rider at a certain position in a file. Multiple Riders can be+positioned +at different locations in a file. A Rider cannot be positioned beyond the end+of a file. *)+ PROCEDURE Set (VAR r: Rider; f: File; pos: LONGINT);++(* Returns the offset of a Rider positioned on a file. *)+ PROCEDURE Pos (VAR r: Rider): LONGINT;++(* Returns the File a Rider is based on. *)+ PROCEDURE Base (VAR r: Rider): File;++(* Read a byte from a file, advancing the Rider one byte further. R.eof indicates+if the end +of the file has been passed. *)+ PROCEDURE Read (VAR r: Rider; VAR x: SYSTEM.BYTE);++(* Reads a sequence of length n bytes into the buffer x, advancing the Rider.+Less bytes +will be read when reading over the length of the file. r.res indicates the number+of unread bytes. +x must be big enough to hold n bytes. *)+ PROCEDURE ReadBytes (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);++(*+Portable routines to read the standard Oberon types.+*)+ PROCEDURE ReadInt (VAR r: Rider; VAR x: INTEGER);+ PROCEDURE ReadLInt (VAR r: Rider; VAR x: LONGINT);+ PROCEDURE ReadSet (VAR r: Rider; VAR x: SET);+ PROCEDURE ReadBool (VAR r: Rider; VAR x: BOOLEAN);+ PROCEDURE ReadReal (VAR r: Rider; VAR x: REAL);+ PROCEDURE ReadLReal (VAR r: Rider; VAR x: LONGREAL);+ PROCEDURE ReadString (VAR r: Rider; VAR x: ARRAY OF CHAR);++(* Reads a number in compressed variable length notation using the minimum amount+of bytes. *)+ PROCEDURE ReadNum (VAR r: Rider; VAR x: LONGINT);++(* Writes a byte into the file at the Rider position, advancing the Rider by+one. *)+ PROCEDURE Write (VAR r: Rider; x: SYSTEM.BYTE);++(* Writes the buffer x containing n bytes into a file at the Rider position.+*)+ PROCEDURE WriteBytes (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);++(*+Portable routines to write the standard Oberon types.+*)+ PROCEDURE WriteInt (VAR r: Rider; x: INTEGER);+ PROCEDURE WriteLInt (VAR r: Rider; x: LONGINT);+ PROCEDURE WriteSet (VAR r: Rider; x: SET);+ PROCEDURE WriteBool (VAR r: Rider; x: BOOLEAN);+ PROCEDURE WriteReal (VAR r: Rider; x: REAL);+ PROCEDURE WriteLReal (VAR r: Rider; x: LONGREAL);+ PROCEDURE WriteString (VAR r: Rider; x: ARRAY OF CHAR);++(* Writes a number in a compressed format. *)+ PROCEDURE WriteNum (VAR r: Rider; x: LONGINT);++(* Deletes a file. res = 0 indicates success. *)+ PROCEDURE Delete (name: ARRAY OF CHAR; VAR res: INTEGER);++(* Renames a file. res = 0 indicates success. *)+ PROCEDURE Rename (old, new: ARRAY OF CHAR; VAR res: INTEGER);++(* Returns the full name of a file. *)+ PROCEDURE GetName (f: File; VAR name: ARRAY OF CHAR);++END Files.++(* Remarks:++1. Oberon uses the little-endian byte ordering for exchanging files between+different Oberon platforms.++2. Files are separate entities from directory entries. Files may be anonymous+by having no name and not being registered in a+ directory. Files only become visible to other clients of the Files module by+explicitly passing a File descriptor or by registering+ a file and then opening it from the other client. Deleting a file of which+a file descriptor is still available, results in the file+ becoming anonymous. The deleted file may be re-registered at any time.++3. Files and their access mechanism (Riders) are separated. A file might have+more than one rider operating on it at different+ offsets in the file.++4. The garbage collector will automatically close files when they are not required+any more. File buffers will be discarded+ without flushing them to disk.  Use the Close procedure to update modified+files on disk.++5. Relative and absolute filenames written in the directory syntax of the host+operating system are used. By convention, Oberon+ filenames consists of the letters A..Z, a..z, 0..9, and ".". The directory+separator is typically / or :. Oberon filenames are+ case sensitive. *)
+ examples/AGRS/Fonts.Def view
@@ -0,0 +1,41 @@+(*+https://web.archive.org/web/20050219180020/http://www.oberon.ethz.ch:80/ethoberon/defs/Fonts.Def.html+*)+DEFINITION Fonts; (* portable *)++(*+The Module Fonts implement the Oberon font manager. Fonts are collections +of characters, each character being a pattern and and metric data.+*)+ IMPORT Objects, Display;++ CONST+  substitute = -1; font = 0; metric = 1; (* Font types. *)++ TYPE+  Char = POINTER TO CharDesc;+  Font = POINTER TO FontDesc;+  CharDesc = RECORD ( Objects.ObjDesc )  (* The objects in a font library.+*)+   dx, x, y, w, h: INTEGER; (* Character width, pattern offset (x, y),+pattern size (w, h). *)+   pat: Display.Pattern (* Character raster data. *)+  END;++  FontDesc = RECORD ( Objects.LibDesc ) +   type: SHORTINT; (* Substitute, font, or metric. *)+   height, minX, maxX, minY, maxY: INTEGER (* Font height, extremal values+of characters in font. *)+  END;++ VAR +  FontId: CHAR; (* Initial character of font files (.Fnt). *)+  Default: Font; (* Default system screen font (typically Oberon10.Scn.Fnt).+*)++(* Return the character and data of ch in a font. *)+ PROCEDURE GetChar (F: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR pat: Display.Pattern);++(* Load and cache a font. *)+ PROCEDURE This (name: ARRAY OF CHAR): Font;+END Fonts.
+ examples/AGRS/Gadgets.Def view
@@ -0,0 +1,538 @@+(*+https://web.archive.org/web/20050101093105/http://www.oberon.ethz.ch:80/ethoberon/defs/Gadgets.Def.html+*)+DEFINITION Gadgets; (* portable *)++(*The Gadgets module forms the basis of the Gadgets system. It defines the+most important types, provide default message handlers and often used utility+procedures. In addition, a few gadget specific messages are defined.+*)+ IMPORT+  Objects, Display, Display3, Oberon, Files,+  Attributes, Links;++ CONST+ (* Priority message id's. *)+  top = 0;  (* Move gadget to the front. *)+  bottom = 1;  (* Move gadget to the back. *)+  visible = 2;  (* Move gadget to the front if not completely visible. *)++ (* Gadget Frame states. *)+  selected = 0;  (* Selected or not. *)+  lockedsize = 2;  (* Gadget prefers a fixed W, H. *)+  transparent = 4;  (* Transparent or not. *)+  lockedcontents = 10;  (* All direct descendants are locked. *)++ TYPE+ (* Message broadcast in the display space to indicate that "obj" has changed.+Normally used for updating model gadgets, although obj can be a list of gadget+frames belonging to the same container. In this case all of the frames are to+be displayed. This message is used by the Inspector to indicate that an attribute+value has changed. *)+  UpdateMsg = RECORD ( Display.FrameMsg ) +   obj: Objects.Object;+  END;++ (* Message broadcast in the display space to indicate that the destination+frame F wants to change its overlapping  priority. *)+  PriorityMsg = RECORD ( Display.FrameMsg ) +   id: INTEGER; (* Top, bottom, visible. *)+   passon: BOOLEAN; (* Indication if a whole tree of containers should be changed+in priority. *)+  END;++  CmdMsg = RECORD ( Objects.ObjMsg ) +   cmd: ARRAY 128 OF CHAR;+   res: INTEGER;+  END;++ (* Base type of the Model gadgets *)+  Object = POINTER TO ObjDesc;+  ObjDesc = RECORD ( Objects.ObjDesc ) +   attr: Attributes.Attr; (* Attribute list. Private variable. *)+   link: Links.Link  (* Link list. Private variable. *)+  END;++ (* Base type of the visual gadgets *)+  Frame = POINTER TO FrameDesc;+  FrameDesc = RECORD ( Display.FrameDesc ) +   attr: Attributes.Attr; (* Attribute list. Private variable. *)+   link: Links.Link;  (* Link list. Private variable. *)+   state: SET;+   mask: Display3.Mask; (*  Cached display mask. Can be NIL to indicate no/invalid+mask. *)+   obj: Objects.Object (* Model object, if any. *)+  END;++ (* Base type of the camera-view gadgets. *)+  View = POINTER TO ViewDesc;+  ViewDesc = RECORD ( FrameDesc ) +   absX, absY: INTEGER; (* Absolute screen position at last message forward+to descendants. *)+   border: INTEGER; (* Border width for clipping. *)++  (* Install own clipping to display/printer mask here if view has an irregular+outline. Otherwise set to NIL. *)+   ClipMask: PROCEDURE (v: View; M: Display3.Mask; ondisplay: BOOLEAN);+  END;++ (* Calculate a mask for gadget G positioned at X, Y in the context dlink. *)+  MakeMaskHandler = PROCEDURE (G: Frame; X, Y: INTEGER; dlink: Objects.Object; VAR M: Display3.Mask);++ VAR +  framehandle: Objects.Handler; (* Default message handler for visual gadgets.+*)+  objecthandle: Objects.Handler; (* Default message handler for Model gadgets.+*)+  MakeMask: MakeMaskHandler; (* Calculates the current display mask of a visual+gadget. *)+  MakePrinterMask: MakeMaskHandler; (* Calculates the current printer mask+of a visual gadget. *)++ (* The following fields are used for parameter transfer during command execution.+*)+  context: Objects.Object; (* Context/parent of a gadget executing the command+*)+  executorObj: Objects.Object; (* Gadget executing the command. Same as Oberon.Par.obj.+*)+  senderObj: Objects.Object; (* Initiator of a drag and drop operation i.e.+the gadget being dropped. *)+  receiverObj: Objects.Object; (* Receiver of a dropped gadget. Often same+as executorObj.  *)++(* Is the context/parent of the frame F locked ? *)+ PROCEDURE IsLocked (F: Frame; dlink: Objects.Object): BOOLEAN;++(* Is the mouse located inside the work area of a gadget (i.e. excluding the+control areas)? *)+ PROCEDURE InActiveArea (F: Frame; VAR M: Oberon.InputMsg): BOOLEAN;++(* Returns the name of of obj. Sends an Objects.AttrMsg behind the scenes. *)+ PROCEDURE GetObjName (obj: Objects.Object; VAR name: ARRAY OF CHAR);++(* Name object obj. Sends an Objects.AttrMsg behind the scenes. *)+ PROCEDURE NameObj (obj: Objects.Object; name: ARRAY OF CHAR);++(* Search for the object "O" in the public library "L.Lib" wherename is specified+as "L.O". *)+ PROCEDURE FindPublicObj (name: ARRAY OF CHAR): Objects.Object;++(* Search for object named name in context. *)+ PROCEDURE FindObj (context: Objects.Object; name: ARRAY OF CHAR): Objects.Object;++(* Sets new W and H to (offscreen) frame F. *)+ PROCEDURE ModifySize (F: Display.Frame; W, H: INTEGER);++(* Inserts the frame f into container F at (u, v). (u, v) is relative to upper+left corner of F. *)+ PROCEDURE Consume (F, f: Frame; u, v: INTEGER);++(* Returns a deep or shallow copy of object obj, depending on parameter deep+*)+ PROCEDURE Clone (obj: Objects.Object; deep: BOOLEAN): Objects.Object;++(* Check if a message loop would be created should newchild be inserted in the+container parent. Sends a dummy message behind the scenes. *)+ PROCEDURE Recursive (parent, newchild: Objects.Object): BOOLEAN;++(* Broadcasts an Gadgets.UpdateMsg should obj be a model gadget, or a Display.DisplayMsg+if obj is a Display.Frame. *)+ PROCEDURE Update (obj: Objects.Object);++(* Make a copy of a pointer to an object. A shallow copy returns a reference+to obj. A deep copy results in M being forwarded to obj. *)+ PROCEDURE CopyPtr (VAR M: Objects.CopyMsg; obj: Objects.Object): Objects.Object;++(* Copy the record fields belonging to the base gadget type. Copies handle,+X, Y, W, H, state, attr and obj.*)+ PROCEDURE CopyFrame (VAR M: Objects.CopyMsg; F, F0: Frame);++(* Copy the record fields belonging to the base Model gadget type. Copies handle+and attr. *)+ PROCEDURE CopyObject (VAR M: Objects.CopyMsg; obj, obj0: Object);++(* Default handling of Display.ModifyMsg for visual gadgets. F.mask is invalidated+when the frame changes its location or size. Sends behind the scenes to F an+Display.OverlapMsg message to invalidate F.mask. Finally, a Display.DisplayMsg+is broadcast to update F on the display.*)+ PROCEDURE Adjust (F: Display.Frame; VAR M: Display.ModifyMsg);++(* Returns the frame that is located at X, Y on the display. U, v return the+relative coordinates of X, Y inside F. Behind the scenes a Display.LocateMsg+is broadcast. *)+ PROCEDURE ThisFrame (X, Y: INTEGER; VAR F: Display.Frame; VAR u, v: INTEGER);++(* Implements standard resize handling for frames. Rubber-bands the gadget size+and broadcasts a Display.ModifyMsg. *)+ PROCEDURE SizeFrame (F: Display.Frame; VAR M: Oberon.InputMsg);++(*  Implements standard move behaviour for frames. Tracks the gadget outline,+broadcasts a ConsumeMsg on a copy-over or consume interclick, or broadcast a+Display.ModifyMsg for a simple move operation.   *)+ PROCEDURE MoveFrame (F: Display.Frame; VAR M: Oberon.InputMsg);++(* Integrate obj at the caret position. A Display.ConsumeMsg is broadcast behind+the scenes. *)+ PROCEDURE Integrate (obj: Objects.Object);++(* Write an object POINTER to a file. Lib is the library of the object that+contains the pointer.*)+ PROCEDURE WriteRef (VAR r: Files.Rider; lib: Objects.Library; obj: Objects.Object);++(* Read an object POINTER from a file. Lib is the library of the object that+contains the pointer. Obj might be of type Objects.Dummy if a loading failure+occured. *)+ PROCEDURE ReadRef (VAR r: Files.Rider; lib: Objects.Library; VAR obj: Objects.Object);++(* Execute a string as an Oberon command. The parameters executor, dlink, sender,+receiver are copied to the global variables executorObj, context, senderObj,+receiverObj respectively. Dlink must be the parent of executor. If a '%' is+leading the command, no Oberon.Par is set up. *)+ PROCEDURE Execute (cmd: ARRAY OF CHAR; executor, dlink, sender, receiver: Objects.Object);++(* Forwards a message from a camera-view to its contents, inserting the camera-view+in the message thread. X, Y is the absolute screen coordinates of the bottom-left+corner of the camera-view. This is important for calculating the correct display+mask for the contents of the view. *)+ PROCEDURE Send (from: View; X, Y: INTEGER; to: Display.Frame; VAR M: Display.FrameMsg);++(* Bind an object to a library. Nothing happens if obj is already bound to a+public library, or is already bound to lib. This is the default behavior when+an object received the Objects.BindMsg. *)+ PROCEDURE BindObj (obj: Objects.Object; lib: Objects.Library);++(* Execute the attribute with name attr of F as an Oberon command. Sends a Objects.AttrMsg+to retrieve the attribute attr of F. The attributed must be of the string class.+*)+ PROCEDURE ExecuteAttr (F: Frame; attr: ARRAY OF CHAR; dlink, sender, receiver: Objects.Object);++(* Standard mouse tracking behavior of visual gadgets. Calls ExecuteAttr for+the "Cmd" attribute, calls MoveFrame and SizeFrame.*)+ PROCEDURE TrackFrame (F: Display.Frame; VAR M: Oberon.InputMsg);++(* Look up value of the name alias. Empty string is returned if name is not+aliased. *)+ PROCEDURE GetAlias (name: ARRAY OF CHAR; VAR value: ARRAY OF CHAR);++(* Create an object from the generator procedure or alias objname. *)+ PROCEDURE CreateObject (objname: ARRAY OF CHAR): Objects.Object;++(* Create a View/Model pair from the generator procedures viewnewproc and modelnewproc.+Aliasing is supported. *)+ PROCEDURE CreateViewModel (viewnewproc, modelnewproc: ARRAY OF CHAR): Display.Frame;++(* Adds a generator alias. *)+ PROCEDURE AddAlias (name, value: ARRAY OF CHAR);++(* Command to insert a newly allocated gadget at the caret. Used in the form:++ Gadgets.Insert <generatorproc> ~  for a single object+  or+ Gadgets.Insert <viewgeneratorproc> <modelgeneratorproc> ~ for a model-view+pair+ + Aliasing is supported.+*)+ PROCEDURE Insert;++(* Returns the latest object selection. Time < 0 indicates no selection. *)+ PROCEDURE GetSelection (VAR objs: Objects.Object; VAR time: LONGINT);++(* Search for the object "O" in the public library "L.Lib" where the name is+specified as "L.O" and return a deep copy or shallow copy. *)+ PROCEDURE CopyPublicObject (name: ARRAY OF CHAR; deep: BOOLEAN): Objects.Object;++(* Changes the selected frame into a new frame type. Used in the form++ Gadgets.Change <generatorproc>+ + Aliasing is supported.+*)+ PROCEDURE Change;++(* Make a deep copy of the object selection and insert the result at the caret.+*)+ PROCEDURE Copy;++(* Change the value(s) of (an) attribute(s) in the object selection. Used in+the form:++  Gadgets.ChangeAttr <AttributeName> <AttributeValue> ~+ + AttributeValue can take several forms, depending on the type of the attribute:++ names  For string attributes+ Yes/No      For boolean attributes  + 1234    For number attributes+ "strings" For string attributes+*)+ PROCEDURE ChangeAttr;++(* Set an attribute value of a named object. Used in the form:++ Gadgets.Set O.A <AttributeValue> ~  for attribute A of named object O in the+current context+*)+ PROCEDURE Set;++(* Create a new Model gadget and link it to all the visual objects in the current+selection. Used in the form:++ Gadgets.Link <modelgenerator> + + Aliasing is supported. An Objects.LinkMsg is sent behind the scenes.+*)+ PROCEDURE Link;+END Gadgets.++(* Remarks:++1. Objects+The type Gadgets.Object forms the base class of all model gadgets. Examples+of these are the Integer, Boolean, Real, String and Complex gadgets.++2. Frames+The Frame definition is the base type of all displayable gadgets (sometimes+called views when discussed in relation to the MVC model). The state variable+(a SET) plays an important role in controlling the gadget frame. It remembers+state information and controls editing abilities by setting flags. A flag is+represented by a small integer value (a flag is set if that number is a member+of the state set). The selected flag indicates if the gadget is selected or+not. The lockedsize flag prevents resizing of the gadget. The transparent flag+indicates that a gadget is transparent. It is possible to "see through" parts+of a transparent gadget to gadgets lying behind it. The lockchildren flag locks+the direct children of a container gadget. A locked gadget cannot be moved or+resized. The lockchildren flag is inspected by the IsLocked function and also+used by the InActiveArea function to determine if a gadget can be moved or resized.+This flag is normally visible to the outside world through a "Locked" attribute.+The obj field points to the model of the gadget (if it has one). The mask field+contains the gadget cached mask. This mask is calculated by the parent of a+gadget, and transfered from parent to child through the Display3.OverlapMsg.+During editing operations in the display space, the mask might become invalid+due to new gadgets overlapping the gadget. In this case, a parent will invalidate+the mask by setting no (i.e. NIL) mask. This results in the cached mask to be+set to NIL. However, as soon as a gadget wants to display itself, the MakeMask+procedure will notice the invalidated mask and request its parent to inform+it of the correct mask (using Display3.UpdateMaskMsg). The mask is located in+the fourth quadrant, with the top left corner of the gadget positioned at the+origin (0, 0) of the mask. Before displaying a visual gadget, the cached mask+is translated to the correct position on the display. This is done by a call+to Gadgets.MakeMask.++3. Views+The View type forms the base of a special class of gadgets called camera-views.+A camera-view displays other displayable gadgets. Different camera views may+display the same gadget, where each camera view may display a different part+of it. The View base type is used to calculate the actual visible area of the+object being viewed. This operation is hidden behind the secens in Gadgets.MakeMask.+The absX, absY pair indicate the absolute position of the camera view on the+display. This is set by the camera view itself when it forwards a message down+to its model (i.e. the thing it is displaying). The border field indicates how+wide the border of the camera view is (the border clips away parts of the model).+ The display mask generation of Gadgets.MakeMask is intimitely coupled with+the structure of the display space. The remainder of this paragraph is for those+curious about how mask calculation is done. The display space is organized in+a DAG-like structure. Messages travel through the DAG, possibly passing to the+same frame through different messages paths Conceptually, we take the DAG and+partition it into separate display groups. This is done by removing all the+edges in the DAG that connect a camera view with its model, and eliminating+all the non-visual gadgets and their corresponding edges. As no multiple views+of the same visual gadget through camera views are involved, the mask of each+gadget in a display group only takes into account the overlapping between gadgets+in the same display group. These masks remain static, and can be cached for+each gadget. This is under the assumption that the root object of a display-group+is completely visible. In practice, display groups corresponds to panels and+their contents.+ The display groups are used to determine the visibility of a gadget when it+calls Gadgets.MakeMask. Using the message thread, all camera-views from the+root of the display space to the displayed frame are visited. For each of these,+the camera-view can influence the visibility of its descendants. By intersecting+the cached mask of a gadget with all of the masks of the camera-views located+in the message path, we can determine exactly what area of a gadget is visible.++4. UpdateMsg+The Smalltalk MVC framework is supported with the UpdateMsg. This message must+always be broadcast to inform everybody of a change of a model gadget. It contains+a pointer to the object that has changed. All gadgets that have this object+as a model, has to update themselves. The object that changes need not always+be a model gadget; it can also be a frame (this indicates that the frame's parent+should redraw the frame). In the latter case, a whole list of frames may be+updated (the frames are linked through the slink field). By convention, all+the frames updated should belong to one single parent.++5. PriorityMsg+The Priority message allows the changing of the overlapping order of gadgets.+Each container gadget contains a list of children gadgets, where the position+in the dsc-next list specifies the overlapping priority (from back to front).+Changing the position of a child in the list has the affect of moving it to+the front or the back in the container. When the PriorityMsg is broadcast the+destination F indicates the child that wants to change its display priority.+The top, bottom and visible flags are used to move the child to the front, to+the back or to make it visible when not. The visible flag has the affect of+moving the child to the front only when it is overlapped by a sibling. Otherwise,+no action is undertaken. The passon flag indicates if the priority change should+be recursive, meaning that the parent of F and onwards should also change priority,+and thus bring a whole hierarchy to the front or back.++6. Default message handlers+To simplify programming, default handlers for model and visual gadgets are provided.+These may be called to handle messages a default way. The default frame handler+(framehandle) responds to the Objects.FileMsg (storing/loading X, Y, W, H, state,+obj and attr), Objects.CopyMsg (calls CopyFrame), BindMsg (calls BindObj), Objects.AttrMsg,+Objects.FindMsg (returning itself or the model), Display.DisplayMsg (simply+draws rectangle), Display3.OverlapMsg, Display.LocateMsg, Display.ModifyMsg+(calls Adjust), Display.SelectMsg (only flips the selected flag), Display.ConsumeMsg+(executes the ConsumeCmd attribute if the gadget has one), Display.ControlMsg+(forwards it to the gadgets model), and Oberon.InputMsg (calling TrackFrame+on a mouse track event). The default model gadget handler (objecthandle) respond+to the Objects.FileMsg (storing/loading attr), Objects.AttrMsg, Objects.BindMsg+(calls BindObj), Objects.CopyMsg (calling CopyObject), and Objects.FindMsg (returning+the model if the names match).++7. The Imaging Model+Two important relationships exist between gadgets: the view relationship and+parent-child relationship. A panel may display several gadgets contained inside+of it. This is the parent-child relationship, where the children are displayed+and managed by the parent. The parent does not assume anything about the type+of its children, and the children do not assume to be contained in an object+of a specified type. This allows a gadget to be integrated in all environments,+and for parents to manage children that are unknown to it. This is the principle+of complete integration and plays a central role in the gadgets system.+  The view relationship allows one gadget to display or view another gadget.+The first (the viewer) may either visualize the state of the viewed gadget (for+example, a slider representing an integer value), or display the viewed gadget.+In the first case, a model is viewed, while in the latter, a displayable object+is viewed (a camera-view). Models form the interface to the application, and+displayable models allow the same gadget to be displayed many times on the display.+Many different views of the same object (model or displayable) may be possible,+where each view can visualize the viewed object in a different manner. Views+may be nested to an arbitrary depth, as long as no recursive views are created.+Messages travel through the system informing views that a model has changed.+These Update messages indicate the model involved, which the views may check+to find out if it needs to redisplay or recalculate itself. The model-view framework+is open; it is also possible for one model gadget to be dependent on another+model gadget.You may have different representations of the same data, allow+objects to depend on others, and allow data or objects to be shared between+different documents.+ It is this flexible model-view framework combined with the ability to have+gadgets overlapping each other and edited-in-place, that complicates the imaging+model. A displayable gadget may be partially visible through one camera-view,+and partially visible through another. The same object, can be seen and edited+two or more times on different areas of the display. Also, some of these camera-views+may be partially overlapped by other displayable gadgets. The problem is compounded+when camera-views are nested inside camera-views, increasing the number of display+instances. Thus a gadget may potentially have to display itself in many different+ways. Clearly, with a single displayable gadget having so many different display+instances (one for each view, in the simplest case), the gadget cannot have+one unique display coordinate. The gadgets system uses relative coordinates,+where the coordinate of a gadget is always relative to its parent. All displayable+frame are connected to a data structure called the display root. Broadcasting+a message through the display space causes all displayable objects in the structure+to be reached. If we assume that views relay the message to the objects they+display, the display space forms a directed a-cyclic graph (DAG). There are+certain objects where two or more message paths converges. Such a convergence+point can occur when two or more camera-views display the same object. Thus+during a single message broadcast, the message may arrive twice or more times+at the same object. If this object is displayable, it receives the message exactly+once for each of its display instances. For each of these message arrivals,+the gadget should have different coordinates on the display.+ In practice, the coordinates of a gadget is determined by the path the message+follows to reach that gadget. Each message relay operation may change the coordinate+system. This is reflected in the origin stored in the message. The display coordinates+of a display instance of a gadget is thus the combination of the current origin+(in the message) and the relative coordinates of the gadget itself. A gadget+can be prompted into displaying itself on many different locations on the display+by varying the origin of the message. This is called the multiple view model+of the gadgets system.+ The main disadvantage of the multiple view model is that potentially each display+instance of a frame may have a different visible area. Theoretically, the visible+area of a display instance is a function of the message path to that instance.+A data structure is used to indicate what part of a gadget is visible. Such+a data structure is called a display mask. The mask can be constructed as the+message travels through the display space, continually being reduced and expanded+as the message travels. It consists of a set of non-overlapping rectangles which+indicate which areas of the gadget are visible. Drawing primitives are issued+through this mask, which has the effect of clipping them only to the visible+areas in the mask. Operations on masks are also provided. You can, for example,+calculate the intersection or union between masks, or enumerate all the visible+areas in a mask.+ Implementing the sketched procedure is inefficient. Masks may be calculated+that are not used at all (not all broadcasts are display related). Also, masks+should be cached for each display instance, rather being recalculated each time.+In practice, a imaging model is used that is based on these observations. The+following remarks give an idea of how things have actually been implemented.++8. Masks+Each gadget has a mask that shows which areas of it are visible. The mask field+can be set to NIL, to indicates that no mask exists. A gadget can only be displayed+once it becomes a mask. Should no mask exist, the Display3.UpdateMaskMsg is+broadcast, with F set the maskless gadget. The parent of F is responsible for+creating a new mask for F. The Display3.OverlapMsg is used to inform the gadget+of its new mask. It is sent directly from the parent to the gadget (the above+protocol is explained in the section about the Display3 module).+ The mask generation is hidden from gadget programmers. When displaying a gadget,+the mask's relative coordinates have to be converted into absolute screen coordinates,+or possibly even a new mask created (as described above). The whole process+is hidden behind the procedures MakeMask and MakePrinterMask. G is the frame+for which a mask is needed, X and Y indicate the absolute screen position of+the left-bottom corner of G, and dlink is the context of G. The context of G+can be found in the dlink field of the received frame message. The MakePrinterMask+procedure variable functions in the same way, except that a mask for the printer+is created. For the latter X, Y should be the absolute printer coordinates of+the gadget. The resulting masks are return in variable parameter M, and can+immediately be used for displaying or printing the gadget.+ +9. Mask Calculations+ Masks are calculated from the intersection of the cached mask of a gadget and+all the camera-views through which a message travels. We need a backward traversal+from the gadget through all the display groups. On receiving a frame message,+the dlink field in the message points to the first frame in the message thread.+The list can be traversed further backwards with the dlink field of the frame.+The backward traversal can continue by following the dlink fields through all+frames in the thread. Thus when masks are generated one should distinguish between+normal frames and camera-views, as we are only interested in camera-views when+generating masks. Broadcast messages travel from one display group to another+(through views) to reach a gadget. Thus the actual visible area of a gadget+is the intersection of its static/cached mask plus all the masks of views through+which the message travelled. This calculation only need to be made on demand.+For example, when a gadget decides to display itself, it calls MakeMask to build+it's visibility mask. MakeMask has to find out the path the message traveled+to reach the gadget, extract all the camera-views, and build the intersection+of the static mask plus all the masks of the views. This can be done by following+the message path back from the receiver gadget to the root of the display.+ Typically we don't want to modify the static mask of a gadget. However, this+mask will be changed by the intersection process during mask calculation. Observations+shows that the masks of views are mostly rectangular, i.e they are seldomly+partially overlapped. If we assume that this is always the case, the mask calculation+is nothing more than reducing the static mask by rectangular areas (clipping+windows or ports). For this situation, the mask is provided with a rectangular+clipping port, to which all output primitives are clipped after they have been+clipped by the mask itself. The simple structure of the clipping port means+that it can easily be saved, modified and restored, without affecting the static+portion of the mask. Of course, the latter condition fails when the views are+also partially obscured. In this case, the mask calculation has to be done in+the less efficient way.++10. Command Execution+Gadgets may execute Oberon commands (procedures Execute and ExecuteAttr) specified+by their command attributes. Commands can take their parameters from the user+interface. For this purpose, several global variables are exported from the+gadgets module. The variable context identifies the context, normally the parent,+of the gadget executing the command. The context of a gadget is found in the+dlink field of a Display.FrameMsg the gadget receives. The variable executorObj+identifies the gadget executing the command, which is always the same as Oberon.Par.obj.+The senderObj and receiverObj identifies the objects involved in consume operations,+and may be NIL.++11. Aliasing+The Gadgets module implements a simple aliasing feature. This allows the user+to give more meaningful abbreviations or names to the not so easy to remember+object generator procedures. The principle client of aliasing are the Gadgets.Insert+and Gadgets.Link commands. The aliases are found in the Oberon.Text/Registry+section called Aliases. The aliases are read into an internal lookup table when+the Gadgets module is loaded for the first time. The format of each line of+the Aliases section is:++   Alias=GeneratorProc++*)
+ examples/AGRS/Grammars.Mod view
@@ -0,0 +1,711 @@+MODULE Grammars;
+IMPORT AGRS, Names, Library, Parser, Texts;
+
+CONST
+   SetBits= MAX(SET)+1;
+   MaxStrLength*= 30;
+TYPE
+   ParserProc= PROCEDURE;
+   ParserTerm= POINTER TO RECORD(AGRS.TermDesc)
+      handler: ParserProc;
+   END;
+   BuilderTerm= POINTER TO RECORD(AGRS.TermDesc)
+      property: AGRS.Name;
+   END;
+   GenericBuilderTerm= POINTER TO RECORD(AGRS.TermDesc)
+   END;
+   SetLimitTerm= POINTER TO RECORD(AGRS.TermDesc)
+      limit: LONGINT;
+   END;
+   ReaderProc= PROCEDURE(VAR in: CHAR);
+VAR
+   Read*: ReaderProc;
+   BackSpace*: PROCEDURE;
+   input: Texts.Reader;
+   inputString: Names.CharPtr;
+   inputText: Texts.Text;
+   position,limit: LONGINT;
+   EmptyMarker: AGRS.Atomic;
+   spaceChars,idChars: Library.CharSet;
+   i: INTEGER;
+   temp: AGRS.SubTerm;
+   tempDis: AGRS.Disjunction;
+   disjunctionBuilder,continuationBuilder: AGRS.SystemTerm;
+   fieldBuilder,blockBuilder: AGRS.SystemTerm;
+   nameToTreeBuilder: AGRS.SystemTerm;
+   localConsName,classConsName: AGRS.Name;
+   grammarName*,followName: AGRS.Name;
+   treeName*,propertyName*,valueName*,rootName*: AGRS.Name;
+   sentenceName*,genericRootName,emptyName: AGRS.Name;
+   spaceCharsName,idCharsName: AGRS.Name;
+   genericAttrName*,disjunctionName*,continuationName*: AGRS.Name;
+   fieldName*,blockName*: AGRS.Name;
+   optionName*: AGRS.Name;
+   terminalName*,attrName*,constructName*,parseEndName: AGRS.Name;
+   parseName*,defaultGrammarName: AGRS.Name;
+   charParser*,stringParser*: AGRS.Name;
+   charTerminalParser*,stringTerminalParser*: AGRS.Name;
+   spaceParser,nameParser*,idParser*,recurrenceParser: AGRS.Name;
+
+PROCEDURE ReadFile(VAR ch: CHAR);
+BEGIN
+   REPEAT
+      Texts.Read(input, ch);
+      INC(position);
+   UNTIL input.elem=NIL;
+END ReadFile;
+
+PROCEDURE ReadString(VAR ch: CHAR);
+BEGIN
+   ch:= inputString[position];
+   INC(position);
+END ReadString;
+
+PROCEDURE BackSpaceFile;
+BEGIN
+   DEC(position);
+   Texts.OpenReader(input,inputText,position);
+END BackSpaceFile;
+
+PROCEDURE BackSpaceString;
+BEGIN
+   DEC(position);
+END BackSpaceString;
+
+PROCEDURE SkipSpaces;
+VAR
+   ch: CHAR;
+   spaces: AGRS.Term;
+BEGIN
+   spaces:= spaceCharsName.Value();
+   WITH spaces: Library.CharSet DO
+      REPEAT
+         Read(ch);
+      UNTIL ~(ORD(ch) MOD SetBits IN 
+               spaces.value[ORD(ch) DIV SetBits]) OR (position>limit);
+      BackSpace;
+   END;
+END SkipSpaces;
+
+PROCEDURE pSkipSpaces;
+BEGIN
+   SkipSpaces;
+   AGRS.Continue;
+END pSkipSpaces;
+
+PROCEDURE ParseConstruct;
+VAR
+   expect,skeleton: AGRS.Term;
+   newTerm: AGRS.Tree;
+BEGIN
+   expect:= treeName.indirection;
+   skeleton:= rootName.indirection;
+   IF expect=AGRS.Variable THEN
+      NEW(newTerm);
+      WITH skeleton: AGRS.Tree DO
+         newTerm^:= skeleton^;
+      ELSE
+         newTerm.Init(skeleton.indirection);
+      END;
+      treeName.Assign(newTerm);
+      AGRS.Continue;
+      treeName.Restore;
+   ELSIF AGRS.Equal(expect,skeleton) THEN
+      AGRS.Continue;
+   ELSE
+      AGRS.Fail;
+   END;
+END ParseConstruct;
+
+PROCEDURE ParseGenericSkeleton(builder: AGRS.Term; check: BOOLEAN);
+VAR
+   skeleton: AGRS.Class;
+BEGIN
+   IF check & (treeName.indirection#AGRS.Variable) THEN
+      AGRS.Fail;
+      RETURN
+   END;
+   AGRS.Push(builder);
+   AGRS.Push(treeName);
+   NEW(skeleton);
+   skeleton.Init(genericRootName);
+   treeName.Assign(skeleton);
+   grammarName.Reduce;
+   treeName.Restore;
+END ParseGenericSkeleton;
+
+PROCEDURE ParseDisjunctConstruct;
+BEGIN
+   ParseGenericSkeleton(disjunctionBuilder,TRUE);
+END ParseDisjunctConstruct;
+
+PROCEDURE ParseContinueConstruct;
+BEGIN
+   ParseGenericSkeleton(continuationBuilder,TRUE);
+END ParseContinueConstruct;
+
+PROCEDURE ParseFieldConstruct;
+BEGIN
+   ParseGenericSkeleton(fieldBuilder,TRUE);
+END ParseFieldConstruct;
+
+PROCEDURE ParseBlockConstruct;
+BEGIN
+   Names.LocalBlock;
+   ParseGenericSkeleton(blockBuilder,TRUE);
+   Names.EndBlock;
+END ParseBlockConstruct;
+
+PROCEDURE ParseGenericAttribute;
+VAR
+   builder: GenericBuilderTerm;
+BEGIN
+   NEW(builder);
+   builder.Init(treeName.indirection);
+   ParseGenericSkeleton(builder,FALSE);
+END ParseGenericAttribute;
+
+PROCEDURE LocalConstruct;
+VAR
+   newTerm: AGRS.Block;
+BEGIN
+   IF treeName.indirection IS AGRS.Tree THEN
+      NEW(newTerm);
+      newTerm.Init(treeName.indirection.indirection);
+      treeName.Assign(newTerm);
+      AGRS.Continue;
+      treeName.Restore();
+   ELSE
+      AGRS.Fail;
+   END;
+END LocalConstruct;
+
+PROCEDURE ClassConstruct;
+VAR
+   newTerm: AGRS.Class;
+BEGIN
+   IF treeName.indirection IS AGRS.Tree THEN
+      NEW(newTerm);
+      newTerm.Init(treeName.indirection.indirection);
+      treeName.Assign(newTerm);
+      AGRS.Continue;
+      treeName.Restore();
+   ELSE
+      AGRS.Fail;
+   END;
+END ClassConstruct;
+
+PROCEDURE ParseAttribute;
+VAR
+   prop,val: AGRS.Term;
+   root: AGRS.Name;
+   builder: BuilderTerm;
+BEGIN
+   prop:= propertyName.indirection;
+   IF ~(prop IS AGRS.Name) THEN
+      prop:= prop.indirection;
+   END;
+   WITH prop: AGRS.Name DO
+      root:= treeName.indirection.indirection(AGRS.Name);
+      root.Assign(AGRS.Variable);
+      prop.Assign(EmptyMarker);
+      val:= treeName.Evaluate(prop);
+      prop.Restore;
+      root.Restore;
+      IF val=EmptyMarker THEN
+         val:= AGRS.Variable;
+      END;
+      NEW(builder);
+      builder.Init(treeName.indirection);
+      builder.property:= prop;
+      AGRS.Push(builder);
+      treeName.Assign(val);
+      grammarName.Reduce;
+      treeName.Restore;
+   END;
+END ParseAttribute;
+
+PROCEDURE ParseTerminal;
+VAR
+   val: AGRS.Term;
+   builder: BuilderTerm;
+BEGIN
+   NEW(builder);
+   builder.Init(treeName.indirection);
+   builder.property:= NIL;
+   AGRS.Push(builder);
+   grammarName.Reduce;
+END ParseTerminal;
+
+PROCEDURE ParseCharTerminal;
+VAR
+   chRead: CHAR;
+   chTerm: AGRS.Term;
+BEGIN
+   Read(chRead);
+   chTerm:= grammarName.Value();
+   IF chRead=chTerm(Library.Character).value THEN
+      AGRS.Continue;
+   ELSE
+      AGRS.Fail;
+   END;
+END ParseCharTerminal;
+
+PROCEDURE ParseChar;
+VAR
+   chRead: CHAR;
+   chTerm: Library.Character;
+BEGIN
+   Read(chRead);
+   chTerm:= Library.NewChar(chRead);
+   AGRS.Unify(treeName,chTerm);
+END ParseChar;
+
+PROCEDURE ParseTheStringPrim(termExpect: AGRS.Term);
+VAR
+   strExpect: Names.CharPtr;
+   chRead: CHAR;
+   i: INTEGER;
+BEGIN
+   IF ~(termExpect IS Library.String) THEN
+      AGRS.Fail;
+      RETURN
+   END;
+   strExpect:= termExpect(Library.String).value;
+   i:= 0;
+   WHILE (i<LEN(strExpect^)) & (strExpect[i]#0X) DO
+      Read(chRead);
+      IF strExpect[i]#chRead THEN
+         AGRS.Fail;
+         RETURN
+      END;
+      INC(i);
+   END;
+   IF strExpect[i]=0X THEN
+      AGRS.Continue;
+   ELSE
+      AGRS.Fail;
+   END;
+END ParseTheStringPrim;
+
+PROCEDURE ParseTheString;
+BEGIN
+   ParseTheStringPrim(treeName.Value());
+END ParseTheString;
+
+PROCEDURE ParseStringTerminal;
+BEGIN
+   ParseTheStringPrim(grammarName.Value());
+END ParseStringTerminal;
+
+PROCEDURE ParseIdentifier;
+VAR
+   wd: AGRS.Name;
+   str: ARRAY MaxStrLength OF CHAR;
+   ch: CHAR;
+   i: INTEGER;
+   termExpect: AGRS.Term;
+BEGIN
+   i:= 0;
+   REPEAT
+      Read(ch);
+      str[i]:= ch;
+      INC(i);
+   UNTIL ~(ORD(ch) MOD SetBits IN 
+         idChars.value[ORD(ch) DIV SetBits]);
+   IF i=1 THEN
+      AGRS.Fail;
+      RETURN
+   END;
+   BackSpace;
+   str[i-1]:= 0X;
+   wd:= Names.FindPublicName(str);
+
+   termExpect:= treeName.indirection;
+   IF termExpect IS AGRS.Tree THEN
+      termExpect:= termExpect.indirection;
+   END;
+   IF termExpect=wd THEN
+      AGRS.Continue;
+   ELSIF (termExpect=AGRS.Variable) OR 
+         (termExpect=AGRS.Undefined) THEN
+      IF wd=NIL THEN
+         Names.AddArgument(wd,str);
+         treeName.Assign(wd);
+         AGRS.Continue;
+      ELSE
+         treeName.Assign(wd);
+(*         wd.Assign(AGRS.Undefined); *)
+         AGRS.Continue;
+(*         wd.Restore; *)
+      END;
+      treeName.Restore;
+   ELSE
+      AGRS.Fail;
+   END;
+END ParseIdentifier;
+
+PROCEDURE NameToTree;
+VAR
+   newTerm: AGRS.Tree;
+BEGIN
+   IF treeName.indirection IS AGRS.Name THEN
+      NEW(newTerm);
+      newTerm.Init(treeName.indirection);
+      treeName.Assign(newTerm);
+      AGRS.Continue;
+      treeName.Restore;
+   ELSE
+      AGRS.Continue;
+   END;
+END NameToTree;
+
+PROCEDURE (t: BuilderTerm) Reduce*;
+VAR
+   newTerm: AGRS.Tree;
+   newTerm2: AGRS.Class;
+   newTerm3: AGRS.Block;
+BEGIN
+(*
+   IF treeName.indirection=AGRS.Variable THEN
+      AGRS.Fail;
+      RETURN
+   END;
+*)
+   IF t.property=NIL THEN
+      treeName.Assign(t.indirection);
+   ELSE
+      IF t.indirection IS AGRS.Tree THEN
+         IF t.indirection IS AGRS.Class THEN
+            NEW(newTerm2);
+            newTerm2^:= t.indirection(AGRS.Class)^;
+            newTerm:= newTerm2;
+         ELSIF t.indirection IS AGRS.Block THEN
+            NEW(newTerm3);
+            newTerm3^:= t.indirection(AGRS.Block)^;
+            newTerm:= newTerm3;
+         ELSE
+            NEW(newTerm);
+            newTerm^:= t.indirection(AGRS.Tree)^;
+         END;
+      ELSE
+         ASSERT(t.indirection IS AGRS.Name);
+         newTerm.Init(t.indirection);
+      END;
+      newTerm.AddProperty(t.property,treeName.indirection);
+      treeName.Assign(newTerm);
+   END;
+   AGRS.Continue;
+   treeName.Restore;
+END Reduce;
+
+PROCEDURE (t: GenericBuilderTerm) Reduce*;
+VAR
+   newTerm: AGRS.Tree;
+   newTerm2: AGRS.Class;
+   newTerm3: AGRS.Block;
+   prop: AGRS.Term;
+BEGIN
+   NEW(newTerm);
+   IF t.indirection IS AGRS.Tree THEN
+      IF t.indirection IS AGRS.Class THEN
+         NEW(newTerm2);
+         newTerm2^:= t.indirection(AGRS.Class)^;
+         newTerm:= newTerm2;
+      ELSIF t.indirection IS AGRS.Block THEN
+         NEW(newTerm3);
+         newTerm3^:= t.indirection(AGRS.Block)^;
+         newTerm:= newTerm3;
+      ELSE
+         NEW(newTerm);
+         newTerm^:= t.indirection(AGRS.Tree)^;
+      END;
+   ELSE
+      ASSERT(t.indirection IS AGRS.Name);
+      newTerm.Init(t.indirection);
+   END;
+   prop:= propertyName.indirection;
+   IF ~(prop IS AGRS.Name) THEN
+      prop:= prop.indirection;
+   END;
+   newTerm.AddProperty(prop(AGRS.Name),valueName.indirection);
+   treeName.Assign(newTerm);
+   AGRS.Continue;
+   treeName.Restore;
+END Reduce;
+
+PROCEDURE BuildDisjunction;
+VAR
+   newTerm: AGRS.Disjunction;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(Library.argName1.indirection);
+   newTerm.InitAlternative(Library.argName2.indirection);
+   treeName.Assign(newTerm);
+   AGRS.Continue;
+   treeName.Restore;
+END BuildDisjunction;
+
+PROCEDURE BuildContinuation;
+VAR
+   newTerm: AGRS.SubTerm;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(Library.argName1.indirection);
+   newTerm.InitQuery(Library.argName2.indirection);
+   treeName.Assign(newTerm);
+   AGRS.Continue;
+   treeName.Restore;
+END BuildContinuation;
+
+PROCEDURE BuildField;
+VAR
+   newTerm: AGRS.Field;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(Library.argName1.indirection);
+   newTerm.InitQuery(Library.argName2.indirection);
+   treeName.Assign(newTerm);
+   AGRS.Continue;
+   treeName.Restore;
+END BuildField;
+
+PROCEDURE BuildBlock;
+VAR
+   newTerm: AGRS.Term;
+BEGIN
+   newTerm:= treeName.indirection;
+   newTerm(AGRS.Tree).RemoveProperty(rootName);
+   treeName.Assign(AGRS.MakeLocalBlock(newTerm,rootName.indirection));
+   AGRS.Continue;
+   treeName.Restore;
+END BuildBlock;
+
+PROCEDURE (t: SetLimitTerm) Reduce*;
+VAR
+   oldLimit: LONGINT;
+BEGIN
+   oldLimit:= limit;
+   limit:= t.limit;
+   t.indirection.Reduce;
+   limit:= oldLimit;
+END Reduce;
+
+PROCEDURE ParseRecurrence;
+VAR
+   oldLimit: LONGINT;
+   seeker: Texts.Reader;
+   expect: AGRS.Term;
+   chExpect,chRead: CHAR;
+   newTerm: AGRS.Tree;
+   restoreTerm: SetLimitTerm;
+BEGIN
+   oldLimit:= limit;
+   NEW(newTerm);
+   expect:= followName.Value();
+   IF expect IS Library.Character THEN
+      chExpect:= expect(Library.Character).value;
+      newTerm.Init(charTerminalParser);
+   ELSE
+      chExpect:= expect(Library.String).value[0];
+      newTerm.Init(stringTerminalParser);
+   END;
+   IF inputString=NIL THEN
+      REPEAT
+         DEC(limit);
+         Texts.OpenReader(seeker,inputText,limit);
+         Texts.Read(seeker,chRead);
+      UNTIL (chRead=chExpect) OR (limit<=position);
+   ELSE
+      REPEAT
+         DEC(limit);
+         chRead:= inputString[limit];
+      UNTIL (chRead=chExpect) OR (limit<=position);
+   END;
+   IF chRead=chExpect THEN
+      newTerm.AddProperty(grammarName,expect);
+      NEW(restoreTerm);
+      restoreTerm.Init(newTerm);
+      restoreTerm.limit:= oldLimit;
+      AGRS.Push(restoreTerm);
+      grammarName.Reduce;
+   ELSE
+      AGRS.Fail;
+   END;
+   limit:= oldLimit;
+END ParseRecurrence;
+
+PROCEDURE (t: ParserTerm) Reduce*;
+VAR
+   oldPos: LONGINT;
+   ch: CHAR;
+   spaces: AGRS.Term;
+BEGIN
+   oldPos:= position;
+   spaces:= spaceCharsName.Value();
+   WITH spaces: Library.CharSet DO
+      REPEAT
+         Read(ch);
+      UNTIL ~(ORD(ch) MOD SetBits IN 
+            spaces.value[ORD(ch) DIV SetBits]) 
+         OR (position>limit);
+      BackSpace;
+   END;
+   t.handler;
+   position:= oldPos;
+   IF inputString=NIL THEN
+      Texts.OpenReader(input,inputText,oldPos);
+   END;
+END Reduce;
+
+
+PROCEDURE pParse;
+VAR
+   txt,r: AGRS.Term;
+BEGIN
+   txt:= sentenceName.Value();
+   WITH txt: Library.Text DO
+      inputText:= txt.base;
+      inputString:= NIL;
+      position:= txt.startOffset;
+      Texts.OpenReader(input,txt.base,txt.startOffset);
+      limit:= txt.endOffset;
+      Read:= ReadFile;
+      BackSpace:= BackSpaceFile;
+   ELSE
+      WITH txt: Library.String DO
+         position:= 0;
+         inputString:= txt.value;
+         limit:= txt.Length();
+         Read:= ReadString;
+         BackSpace:= BackSpaceString;
+      END;
+   END;
+   treeName.Assign(AGRS.Variable);
+   r:= grammarName.Evaluate(parseEndName);
+   treeName.Restore;
+   IF r.indirection#AGRS.failName THEN
+      IF ~AGRS.Continued() THEN
+         AGRS.result:= r.indirection;
+      END;
+      RETURN
+   END;
+   r:= Library.NewError(Library.SyntaxError);
+   r.Reduce;
+END pParse;
+
+PROCEDURE ExtractTree;
+VAR
+   newTerm: AGRS.Term;
+BEGIN
+   SkipSpaces;
+   IF position<limit THEN
+      AGRS.Fail;
+   ELSE
+      AGRS.Continue;
+      NEW(newTerm);
+      newTerm.Init(treeName.indirection);
+      AGRS.result:= newTerm;
+   END;
+END ExtractTree;
+
+PROCEDURE ParseByDefault;
+VAR
+   r: AGRS.Term;
+BEGIN
+   Parser.sentenceName.Assign(sentenceName.indirection);
+   r:= Parser.parseName.Value();
+   Parser.sentenceName.Restore;
+   treeName.Assign(r);
+   AGRS.Continue;
+   treeName.Restore;
+END ParseByDefault;
+
+PROCEDURE DefineParser*(VAR parserName: AGRS.Name; 
+                    spelling: ARRAY OF CHAR; handlerProc: ParserProc);
+VAR
+   parser: ParserTerm;
+BEGIN
+   NEW(parser);
+   parser.Init(Names.SystemRoot);
+   parser.handler:= handlerProc;
+   Names.DefinePublicName(parserName,spelling,parser);
+END DefineParser;
+
+BEGIN
+   Names.AddArgument(rootName, 'Root');
+   Names.AddArgument(treeName, 'Tree');
+   Names.AddArgument(propertyName, 'Property');
+   Names.AddArgument(grammarName, 'Grammar');
+   Names.AddArgument(followName, 'Follow');
+   Names.AddArgument(genericRootName, 'GenericRoot');
+   Names.AddArgument(valueName, 'Value');
+   Names.AddArgument(sentenceName, 'TextSentence');
+   Names.AddSystemName(emptyName,'Empty',AGRS.AtomicHandler);
+   Names.AddSystemName(defaultGrammarName,'DefaultGrammar',ParseByDefault);
+   grammarName.Init(defaultGrammarName);
+   Names.AddSystemName(attrName,'Attr',ParseAttribute);
+   Names.AddSystemName(genericAttrName,'Attribute',ParseGenericAttribute);
+   Names.AddSystemName(constructName,'Construct',ParseConstruct);
+   Names.AddSystemName(disjunctionName,'Disjunction',
+      ParseDisjunctConstruct);
+   Names.AddSystemName(continuationName,'Continuation',
+      ParseContinueConstruct);
+   Names.AddSystemName(fieldName,'FieldConstruct',ParseFieldConstruct);
+   Names.AddSystemName(blockName,'BlockConstruct',ParseBlockConstruct);
+   Names.AddSystemName(localConsName,'LocalConstruct',LocalConstruct);
+   Names.AddSystemName(classConsName,'ClassConstruct',ClassConstruct);
+   Names.AddSystemName(parseEndName,'ParseEnding',ExtractTree);
+   Names.AddSystemName(terminalName,'Terminal',ParseTerminal);
+   NEW(EmptyMarker);
+   EmptyMarker.Init(emptyName);
+   DefineParser(charParser,'CharGrammar',ParseChar);
+   DefineParser(stringParser,'StringGrammar',ParseTheString);
+   DefineParser(charTerminalParser,'CharTerminal',ParseCharTerminal);
+   DefineParser(stringTerminalParser,'StringTerminal',ParseStringTerminal);
+   DefineParser(nameParser,'NameGrammar',ParseIdentifier);
+   DefineParser(spaceParser,'SpaceGrammar',pSkipSpaces);
+   DefineParser(recurrenceParser,'Recurrence',ParseRecurrence);
+   Names.AddSystemName(parseName,'GrammarParser',pParse);
+   NEW(disjunctionBuilder);
+   disjunctionBuilder.Init(Names.SystemRoot);
+   disjunctionBuilder.InitHandler(BuildDisjunction);
+   NEW(continuationBuilder);
+   continuationBuilder.Init(Names.SystemRoot);
+   continuationBuilder.InitHandler(BuildContinuation);
+   NEW(fieldBuilder);
+   fieldBuilder.Init(Names.SystemRoot);
+   fieldBuilder.InitHandler(BuildField);
+   NEW(blockBuilder);
+   blockBuilder.Init(Names.SystemRoot);
+   blockBuilder.InitHandler(BuildBlock);
+   NEW(nameToTreeBuilder);
+   nameToTreeBuilder.Init(Names.SystemRoot);
+   nameToTreeBuilder.InitHandler(NameToTree);
+   NEW(temp);
+   temp.Init(nameParser);
+   temp.InitQuery(nameToTreeBuilder);
+   Names.DefinePublicName(idParser,'IdentifierGrammar',temp);
+   NEW(tempDis);
+   tempDis.Init(grammarName);
+   tempDis.InitAlternative(AGRS.Undefined);
+   Names.DefinePublicName(optionName,'Option',tempDis);
+   spaceChars:= Library.NewCharSet();
+   spaceChars.Include(' ');
+   spaceChars.Include(0X);
+   spaceChars.Include(9X);
+   spaceChars.Include(0AX);
+   spaceChars.Include(0DX);
+   Names.DefinePublicName(spaceCharsName,'SpaceChars',spaceChars);
+   idChars:= Library.NewCharSet();
+   FOR i:= ORD('a') TO ORD('z') DO
+      idChars.Include(CHR(i));
+      idChars.Include(CAP(CHR(i)));
+   END;
+   FOR i:= ORD('0') TO ORD('9') DO
+      idChars.Include(CHR(i));
+   END;
+   idChars.Include('_');
+   Names.DefinePublicName(idCharsName,'IdentifierChars',idChars);
+END Grammars.
+
+ examples/AGRS/Library.Mod view
@@ -0,0 +1,677 @@+MODULE Library;
+IMPORT AGRS,Names,Texts,TextFrames;
+
+
+CONST 
+   (* Kodovi gresaka koji su sadrzani u tipu podataka Error. *)
+   NotLogicalType*= 0;
+   NotNumberType*= 1;
+   NotCharacterType*= 2;
+   NotStringType*= 3;
+   NotTextType*= 4;
+   NotFound*= 5;
+   SyntaxError*= 6;
+
+   CharSetLength= 256 DIV (MAX(SET)+1);
+
+TYPE
+   Term= AGRS.Term;
+   ErrorType= INTEGER;
+
+   NamesType= POINTER TO RECORD(AGRS.ClosedClassDesc)
+   END;
+
+   Number*= POINTER TO RECORD(AGRS.AtomicDesc)
+      value*: INTEGER;
+   END;
+
+   String*= POINTER TO RECORD(AGRS.AtomicDesc)
+      value-: Names.CharPtr;
+   END;
+
+   Text*= POINTER TO RECORD(AGRS.AtomicDesc)
+      base-: Texts.Text;
+      startOffset-,endOffset-: LONGINT;
+   END;
+
+   Character*= POINTER TO RECORD(AGRS.AtomicDesc)
+      value-: CHAR;
+   END;
+
+   CharSet*= POINTER TO RECORD( AGRS.AtomicDesc)
+      value-: ARRAY CharSetLength OF SET;
+   END;
+
+   Error*= POINTER TO RECORD(AGRS.AtomicDesc)
+      value-: ErrorType;
+   END;
+   
+   BinOp= POINTER TO RECORD(AGRS.TermDesc)
+   END;
+VAR
+   TrueDef: Term;
+
+   disTerm: AGRS.Disjunction;
+   NamesTerm: NamesType;
+
+   atomicName,numberName*,errorName*: AGRS.Name;
+   charName*,stringName*,textName*,charSetName*: AGRS.Name;
+   ifName,orName,andName,notName,testName,yesName,noName: AGRS.Name;
+   addName*,subName*,mulName*,divName,modName: AGRS.Name;
+   argName1*,argName2*: AGRS.Name;
+   equalName,lessName,greaterName,lessEqName,grEqName: AGRS.Name;
+   trueName*,disName,unifyName: AGRS.Name;
+   abortName*,findName,nameName: AGRS.Name;
+   carName,cdrName,consName,nilName: AGRS.Name;
+   namesName: AGRS.Name;
+   
+
+
+PROCEDURE NewNumber*(v: INTEGER): Number;
+VAR
+   result: Number;
+BEGIN
+   NEW(result);
+   result.Init(numberName);
+   result.value:= v;
+   AGRS.eldestAsked:= AGRS.Fixed;
+   RETURN result;
+END NewNumber;
+
+PROCEDURE NewString*(v: Names.CharPtr): String;
+VAR
+   result: String;
+BEGIN
+   NEW(result);
+   result.Init(stringName);
+   result.value:= v;
+   AGRS.eldestAsked:= AGRS.Fixed;
+   RETURN result;
+END NewString;
+
+PROCEDURE NewChar*(v: CHAR): Character;
+VAR
+   result: Character;
+BEGIN
+   NEW(result);
+   result.Init(charName);
+   result.value:= v;
+   AGRS.eldestAsked:= AGRS.Fixed;
+   RETURN result;
+END NewChar;
+
+PROCEDURE NewCharSet*(): CharSet;
+VAR
+   result: CharSet;
+   i: INTEGER;
+BEGIN
+   NEW(result);
+   result.Init(charSetName);
+   FOR i:= 0 TO CharSetLength-1 DO
+      result.value[i]:= {};
+   END;
+   AGRS.eldestAsked:= AGRS.Fixed;
+   RETURN result;
+END NewCharSet;
+
+   
+PROCEDURE (t: String) Length*(): LONGINT;
+VAR
+   i: LONGINT;
+   str: Names.CharPtr;
+BEGIN
+   i:= 0;
+   str:= t.value;
+   WHILE str[i]#0X DO
+      INC(i);
+   END;
+   RETURN i
+END Length;
+
+
+PROCEDURE (t: CharSet) Include*(ch: CHAR);
+BEGIN
+   INCL(t.value[ORD(ch) DIV (MAX(SET)+1)],ORD(ch) MOD (MAX(SET)+1));
+END Include;
+
+PROCEDURE (t: CharSet) Complement*();
+VAR
+   i: INTEGER;
+BEGIN
+   FOR i:= 0 TO CharSetLength-1 DO
+      t.value[i]:= -t.value[i];
+   END;
+END Complement;
+
+PROCEDURE NewError*(v: ErrorType): Error;
+VAR
+   result: Error;
+BEGIN
+   NEW(result);
+   result.Init(errorName);
+   AGRS.eldestAsked:= AGRS.Fixed;
+   result.value:= v;
+   RETURN result
+END NewError;
+
+PROCEDURE SubText*(txt: Texts.Text; startPos,endPos: LONGINT): Text;
+VAR
+   newTerm: Text;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(textName);
+   newTerm.base:= txt;
+   newTerm.startOffset:= startPos;
+   newTerm.endOffset:= endPos;
+   RETURN newTerm
+END SubText;
+
+
+PROCEDURE (t: Text) AppendText*(appendage: Text);
+VAR
+   temp: Texts.Buffer;
+   newText: Texts.Text;
+BEGIN
+   IF (t.base=appendage.base) & (t.endOffset=appendage.startOffset) THEN
+      t.endOffset:= appendage.endOffset;
+   ELSE
+      newText:= TextFrames.Text("");
+      NEW(temp);
+      Texts.OpenBuf(temp);
+      Texts.Save(t.base,t.startOffset,t.endOffset,temp);
+      Texts.Save(appendage.base,appendage.startOffset,appendage.endOffset,temp);
+      Texts.Append(newText,temp);
+      t.base:= newText;
+      t.startOffset:= 0;
+      t.endOffset:= newText.len;
+   END;
+END AppendText;
+
+PROCEDURE (t: Text) AppendBuffer*(appendage: Texts.Buffer);
+VAR
+   newText: Texts.Text;
+BEGIN
+   IF t.endOffset=t.base.len THEN
+      Texts.Append(t.base,appendage);
+      t.endOffset:= t.base.len;
+   ELSE
+      newText:= TextFrames.Text("");
+      Texts.Append(newText,appendage);
+      t.base:= newText;
+      t.startOffset:= 0;
+      t.endOffset:= newText.len;
+   END;
+END AppendBuffer;
+
+
+PROCEDURE (t: NamesType) Evaluate*(query: Term): Term;
+BEGIN
+   RETURN NewString(Names.NameSpelling(query.indirection))
+END Evaluate;
+
+
+PROCEDURE pType;
+VAR
+   newTerm: AGRS.OpenTree;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(AGRS.lastResult);
+   AGRS.result:= newTerm;
+END pType;
+
+
+PROCEDURE (t: Character) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+   WITH reference: Character DO
+      lessEq:= t.value<=reference.value;
+      grEq:= t.value>=reference.value;
+   ELSE
+      WITH reference: String DO
+         lessEq:= t.value<=reference.value[0];
+         grEq:= t.value>=reference.value[0];
+         IF lessEq & grEq THEN
+            grEq:= reference.value[1]=0X;
+         END;
+      ELSE
+         lessEq:= FALSE;
+         grEq:= FALSE;
+      END;
+   END;
+END Compare;
+
+PROCEDURE (t: String) Compare*(reference: AGRS.Term; VAR lessEq,grEq: BOOLEAN);
+VAR
+   i: INTEGER;
+BEGIN
+   WITH reference: Character DO
+      lessEq:= t.value[0]<=reference.value;
+      grEq:= t.value[0]>=reference.value;
+      IF lessEq & grEq THEN
+         lessEq:= t.value[1]=0X;
+      END;
+   ELSE
+      WITH reference: String DO
+         i:= 0;
+         WHILE (t.value[i]=reference.value[i]) & (t.value[i]#0X) DO
+            INC(i);
+         END;
+         lessEq:= (t.value[i]<=reference.value[i]);
+         grEq:= (t.value[i]>=reference.value[i]);
+      ELSE
+         lessEq:= FALSE;
+         grEq:= FALSE;
+      END;
+   END;
+END Compare;
+
+PROCEDURE (t: Number) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+   WITH reference: Number DO
+      lessEq:= t.value<=reference.value;
+      grEq:= t.value>=reference.value;
+   ELSE
+      lessEq:= FALSE;
+      grEq:= FALSE;
+   END;
+END Compare;
+
+PROCEDURE (t: CharSet) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+VAR
+   i: INTEGER;
+BEGIN
+   lessEq:= TRUE;
+   grEq:= TRUE;
+   WITH reference: CharSet DO
+      FOR i:= 0 TO CharSetLength-1 DO
+         IF t.value[i]-reference.value[i]#{} THEN
+            lessEq:= FALSE;
+         END;
+         IF reference.value[i]-t.value[i]#{} THEN
+            grEq:= FALSE;
+         END;
+      END;
+   ELSE
+   END;
+END Compare;
+
+PROCEDURE (t: Error) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+   WITH reference: Error DO
+      lessEq:= t.value<=reference.value;
+      grEq:= t.value>=reference.value;
+   ELSE
+      lessEq:= FALSE;
+      grEq:= FALSE;
+   END;
+END Compare;
+
+
+PROCEDURE pEqual;
+VAR
+   t1,t2: AGRS.Term;
+BEGIN
+   t1:= argName1.Value();
+   t2:= argName2.Value();
+   IF AGRS.Equal(t1,t2) THEN
+      TrueDef.Reduce;
+   ELSE
+      AGRS.Fail;
+   END;
+END pEqual;
+
+PROCEDURE pLess;
+VAR
+   t1,t2: AGRS.Term;
+   lessEq,grEq: BOOLEAN;
+BEGIN
+   t1:= argName1.Value();
+   WITH t1: AGRS.Atomic DO
+      t2:= argName2.Value();
+      t1.Compare(t2,lessEq,grEq);
+      IF lessEq & ~grEq THEN
+         TrueDef.Reduce;
+         RETURN
+      END;
+   END;
+   AGRS.Fail;
+END pLess;
+
+PROCEDURE pGreater;
+VAR
+   t1,t2: AGRS.Term;
+   lessEq,grEq: BOOLEAN;
+   oldStack: AGRS.TermStack;
+BEGIN
+   t1:= argName1.Value();
+   WITH t1: AGRS.Atomic DO
+      t2:= argName2.Value();
+      t1.Compare(t2,lessEq,grEq);
+      IF ~lessEq & grEq THEN
+         TrueDef.Reduce;
+         RETURN
+      END;
+   END;
+   AGRS.Fail;
+END pGreater;
+
+PROCEDURE pLessEq;
+VAR
+   t1,t2: AGRS.Term;
+   lessEq,grEq: BOOLEAN;
+BEGIN
+   t1:= argName1.Value();
+   WITH t1: AGRS.Atomic DO
+      t2:= argName2.Value();
+      t1.Compare(t2,lessEq,grEq);
+      IF lessEq THEN
+         TrueDef.Reduce;
+         RETURN
+      END;
+   END;
+   AGRS.Fail;
+END pLessEq;
+
+PROCEDURE pGrEq;
+VAR
+   t1,t2: AGRS.Term;
+   lessEq,grEq: BOOLEAN;
+BEGIN
+   t1:= argName1.Value();
+   WITH t1: AGRS.Atomic DO
+      t2:= argName2.Value();
+      t1.Compare(t2,lessEq,grEq);
+      IF grEq THEN
+         TrueDef.Reduce;
+         RETURN
+      END;
+   END;
+   AGRS.Fail;
+END pGrEq;
+
+PROCEDURE pNot;
+BEGIN
+   AGRS.result:= argName1.Value();
+   IF AGRS.result.indirection=trueName THEN
+      AGRS.result:= AGRS.Failure;
+   ELSIF AGRS.result.indirection=AGRS.failName THEN
+      AGRS.result:= TrueDef;
+   ELSE
+      AGRS.result:= NewError(NotLogicalType);
+   END;
+   AGRS.result.Reduce;
+END pNot;
+
+PROCEDURE pAnd;
+VAR
+   eldest1: INTEGER;
+BEGIN
+   AGRS.result:= argName1.Value();
+   IF AGRS.result.indirection=trueName THEN
+      eldest1:= AGRS.eldestAsked;
+      AGRS.result:= argName2.Value();
+      IF eldest1<AGRS.eldestAsked THEN
+         AGRS.eldestAsked:= eldest1;
+      END;
+   ELSIF AGRS.result.indirection#AGRS.failName THEN
+      AGRS.result:= NewError(NotLogicalType);
+   END;
+   AGRS.result.Reduce;
+END pAnd;
+
+PROCEDURE pOr;
+VAR
+   eldest1: INTEGER;
+BEGIN
+   AGRS.result:= argName1.Value();
+   IF AGRS.result.indirection=AGRS.failName THEN
+      eldest1:= AGRS.eldestAsked;
+      AGRS.result:= argName2.Value();
+      IF eldest1<AGRS.eldestAsked THEN
+         AGRS.eldestAsked:= eldest1;
+      END;
+   ELSIF AGRS.result.indirection#trueName THEN
+      AGRS.result:= NewError(NotLogicalType);
+   END;
+   AGRS.result.Reduce;
+END pOr;
+
+
+PROCEDURE pIf;
+VAR
+   eldest1: INTEGER;
+BEGIN
+   AGRS.result:= testName.Value();
+   eldest1:= AGRS.eldestAsked;
+   IF AGRS.result.indirection=trueName THEN
+      yesName.Reduce;
+   ELSIF AGRS.result.indirection=AGRS.failName THEN
+      noName.Reduce;
+   ELSE
+      AGRS.result:= NewError(NotLogicalType);
+      AGRS.result.Reduce;
+   END;
+   IF eldest1<AGRS.eldestAsked THEN
+      AGRS.eldestAsked:= eldest1;
+   END;
+END pIf;
+
+
+PROCEDURE ExtractNumbers(VAR x,y:INTEGER):BOOLEAN;
+VAR
+   eldest1: INTEGER;
+   arg: Term;
+BEGIN
+   arg:= argName1.Value();
+   WITH arg: Number DO
+      x:= arg.value;
+   ELSE
+      RETURN FALSE
+   END;
+   eldest1:= AGRS.eldestAsked;
+   arg:= argName2.Value();
+   WITH arg: Number DO
+      y:= arg.value;
+   ELSE
+      RETURN FALSE
+   END;
+   IF eldest1<AGRS.eldestAsked THEN
+      AGRS.eldestAsked:= eldest1;
+   END;
+   RETURN TRUE
+END ExtractNumbers;
+
+PROCEDURE ExtractNumbersFromStack(VAR x,y:INTEGER; VAR oldStack:AGRS.TermStack):BOOLEAN;
+VAR
+   arg: Term;
+BEGIN
+   IF (AGRS.paramStack=NIL) OR (AGRS.paramStack.rest=NIL) THEN
+      RETURN FALSE
+   END;
+   oldStack:= AGRS.paramStack;
+   arg:= AGRS.paramStack.top;
+   WITH arg: Number DO
+      x:= arg.value;
+   ELSE
+      RETURN FALSE
+   END;
+   AGRS.paramStack:= AGRS.paramStack.rest;
+   arg:= AGRS.paramStack.top;
+   WITH arg: Number DO
+      y:= arg.value;
+   ELSE
+      RETURN FALSE
+   END;
+   AGRS.paramStack:= AGRS.paramStack.rest;
+   RETURN TRUE
+END ExtractNumbersFromStack;
+
+PROCEDURE pAdd;
+VAR
+   x,y:INTEGER;
+   newTerm: Term;
+   oldStack: AGRS.TermStack;
+BEGIN
+   IF ExtractNumbers(x,y) THEN
+      newTerm:= NewNumber(x+y);
+      newTerm.Reduce;
+   ELSE
+      AGRS.Continue;
+   END;
+END pAdd;
+
+PROCEDURE pSub;
+VAR
+   x,y:INTEGER;
+   newTerm: Term;
+BEGIN
+   IF ExtractNumbers(x,y) THEN
+      newTerm:= NewNumber(x-y);
+      newTerm.Reduce;
+   ELSE
+      AGRS.Continue;
+   END;
+END pSub;
+
+PROCEDURE pMul;
+VAR
+   x,y:INTEGER;
+   newTerm: Term;
+BEGIN
+   IF ExtractNumbers(x,y) THEN
+      newTerm:= NewNumber(x*y);
+      newTerm.Reduce;
+   ELSE
+      AGRS.Continue;
+   END;
+END pMul;
+
+PROCEDURE pDiv;
+VAR
+   x,y:INTEGER;
+   newTerm: Term;
+BEGIN
+   IF ExtractNumbers(x,y) THEN
+      newTerm:= NewNumber(x DIV y);
+      newTerm.Reduce;
+   ELSE
+      AGRS.Continue;
+   END;
+END pDiv;
+
+PROCEDURE pMod;
+VAR
+   x,y:INTEGER;
+   newTerm: Term;
+BEGIN
+   IF ExtractNumbers(x,y) THEN
+      newTerm:= NewNumber(x MOD y);
+      newTerm.Reduce;
+   ELSE
+      AGRS.Continue;
+   END;
+END pMod;
+
+
+PROCEDURE pFind;
+VAR
+   s,n: Term;
+BEGIN
+   s:= nameName.Value();
+   WITH s: String DO
+      n:= Names.FindPublicName(s.value^);
+      IF n=NIL THEN
+         n:= NewError(NotFound);
+      END;
+   ELSE
+      n:= NewError(NotStringType);
+   END;
+   n.Reduce;
+END pFind;
+
+PROCEDURE pAbort;
+VAR
+   stack: AGRS.TermStack;
+BEGIN
+   stack:= AGRS.continuation;
+   HALT(255)
+END pAbort;
+
+PROCEDURE pUnify;
+BEGIN
+   AGRS.Push(trueName);
+   AGRS.Unify(argName1.indirection,argName2.Value());
+END pUnify;
+
+PROCEDURE (t: BinOp) Reduce*;
+BEGIN
+   AGRS.Push(t.indirection);
+   AGRS.Push(argName2.indirection);
+   argName1.Reduce;
+END Reduce;
+
+PROCEDURE AddBinOp(proc:AGRS.HandlerType; name,primName: ARRAY OF CHAR);
+VAR
+   newTerm: BinOp;
+   newName: AGRS.Name;
+BEGIN
+   Names.AddSystemName(newName,primName,proc);
+   NEW(newTerm);
+   newTerm.Init(newName);
+   Names.DefinePublicName(newName,name,newTerm);
+END AddBinOp;
+
+BEGIN
+   Names.AddSystemName(atomicName,'AtomSystemRoot',AGRS.AtomicHandler);
+   Names.DefinePublicName(textName,'TEXT',atomicName.indirection);
+   Names.DefinePublicName(stringName,'STRING',atomicName.indirection);
+   Names.DefinePublicName(charName,'CHAR',atomicName.indirection);
+   Names.DefinePublicName(charSetName,'CharSET',atomicName.indirection);
+   Names.DefinePublicName(errorName,'ERROR',atomicName.indirection);
+   Names.DefinePublicName(numberName,'NUMBER',atomicName.indirection);
+
+   Names.AddArgument(carName, 'Car');
+   Names.AddArgument(cdrName, 'Cdr');
+   Names.AddArgument(nilName, 'Nil');
+   Names.AddArgument(consName, 'Cons');
+
+   Names.AddArgument(trueName, 'True');
+   NEW(TrueDef);
+   TrueDef.Init(trueName);
+   Names.AddSystemName(andName, 'And', pAnd);
+   Names.AddSystemName(orName, 'Or', pOr);
+   Names.AddSystemName(notName, 'Not', pNot);
+   Names.AddSystemName(ifName, 'If', pIf);
+   Names.AddArgument(testName, 'Test');
+   Names.AddArgument(yesName, 'Yes');
+   Names.AddArgument(noName, 'No');
+
+   argName1:= Names.FindOrdinalName(1);
+   argName2:= Names.FindOrdinalName(2);
+
+   NEW(disTerm);
+   disTerm.Init(argName1);
+   disTerm.InitAlternative(argName2);
+   Names.DefinePublicName(disName, 'Dis', disTerm);
+
+   Names.AddSystemName(AGRS.failName,'Fail',AGRS.Fail);
+   Names.AddSystemName(unifyName, 'Unify', pUnify);
+   Names.AddSystemName(equalName, 'Equal', pEqual);
+   Names.AddSystemName(lessName, 'Less', pLess);
+   Names.AddSystemName(greaterName, 'Greater', pGreater);
+   Names.AddSystemName(lessEqName, 'LessEq', pLessEq);
+   Names.AddSystemName(grEqName, 'GrEq', pGrEq);
+   NEW(AGRS.Failure);
+   AGRS.Failure.Init(AGRS.failName);
+
+   Names.AddSystemName(addName, 'Add', pAdd);
+   Names.AddSystemName(subName, 'Sub', pSub);
+   Names.AddSystemName(mulName, 'Mul', pMul);
+   Names.AddSystemName(divName, 'Div', pDiv);
+   Names.AddSystemName(modName, 'Mod', pMod);
+   Names.AddSystemName(findName, 'Find', pFind);
+   Names.AddSystemName(abortName, 'Abort', pAbort);
+
+   NEW(NamesTerm);
+   NamesTerm.Init(Names.SystemRoot);
+   Names.DefinePublicName(namesName,'Names',NamesTerm);
+END Library.
+ examples/AGRS/Links.Def view
@@ -0,0 +1,64 @@+(*+https://web.archive.org/web/20041226015509/http://www.oberon.ethz.ch:80/ethoberon/defs/Links.Def.html+*)+DEFINITION Links; (* portable *)++(*The Links module manage a set of named references to objects for the gadgets.+*)+ IMPORT+  Files, Objects;++ TYPE+  Link = POINTER TO LinkDesc;+  LinkDesc = RECORD+   next: Link;+   name: ARRAY 32 OF CHAR;+   obj: Objects.Object+  END;++(* Store links to a file. Only (ref, lib) references to links are written. *)+ PROCEDURE StoreLinks (VAR R: Files.Rider; lib: Objects.Library; list: Link);++(* Load links from a file. *)+ PROCEDURE LoadLinks (VAR R: Files.Rider; lib: Objects.Library; VAR list: Link);++(* Copy links.  Both shallow and deep copies are supported. *)+ PROCEDURE CopyLinks (VAR M: Objects.CopyMsg; in: Link; VAR out: Link);++(* Bind all linked objects. *)+ PROCEDURE BindLinks (list: Link; VAR M: Objects.BindMsg);++(* Insert a link in a list. An existing link with the same name is discarded.+*)+ PROCEDURE InsertLink (VAR list: Link; name: ARRAY OF CHAR; val: Link);++(* Link Locate. *)+ PROCEDURE FindLink (name: ARRAY OF CHAR; list: Link): Link;++(* Delete a link. *)+ PROCEDURE DeleteLink (VAR list: Link; name: ARRAY OF CHAR);++(* Default handling of setting, retrieving and enumerating a list of links.+Parameter list might be modified+during a set operation. *)+ PROCEDURE HandleLinkMsg (VAR list: Link; VAR M: Objects.LinkMsg);++(* Forward a message to all linked objects in the list. USE WITH CARE, MESSAGE+CYCLES! *)+ PROCEDURE Broadcast (list: Link; VAR M: Objects.ObjMsg);++(* Get the named link of obj. *)+ PROCEDURE GetLink (obj: Objects.Object; name: ARRAY OF CHAR; VAR ob1: Objects.Object);++(* Set the named link of obj. *)+ PROCEDURE SetLink (obj: Objects.Object; name: ARRAY OF CHAR; ob1: Objects.Object);++END Links.++(* Remarks:++1. The links of gadgets (both Gadgets.Object and Gadgets.Frame) are managed+by module Gadgets. Module Gadgets use the utility procedures defined in module+Links.++*)
+ examples/AGRS/ListRiders.Def view
@@ -0,0 +1,90 @@+(*+https://web.archive.org/web/20041226023712/http://www.oberon.ethz.ch:80/ethoberon/defs/ListRiders.Def.html+*)+DEFINITION ListRiders; (* portable *)  (* ps, based on Rider by rv,  *)++ IMPORT Objects, Gadgets;++ CONST+ (* id for UpdateMsg *)+  insert = 0; delete = 1; state = 2;++ TYPE+  Data = POINTER TO DataDesc;+  DataDesc = RECORD+  END;++  Bool = POINTER TO BoolDesc;+  BoolDesc = RECORD ( DataDesc ) +   b: BOOLEAN END;++  Char = POINTER TO CharDesc;+  CharDesc = RECORD ( DataDesc ) +   c: CHAR END;++  String = POINTER TO StringDesc;+  StringDesc = RECORD ( DataDesc ) +   s: ARRAY 64 OF CHAR END;++  Int = POINTER TO IntDesc;+  IntDesc = RECORD ( DataDesc ) +   i: LONGINT END;++  Real = POINTER TO RealDesc;+  RealDesc = RECORD ( DataDesc ) +   x: REAL END;++  LReal = POINTER TO LRealDesc;+  LRealDesc = RECORD ( DataDesc ) +   x: LONGREAL END;++  Method = POINTER TO MethodDesc;+  Rider = POINTER TO RiderDesc;+  RiderDesc = RECORD+   d: Data; (* Data of the current item *)+   do: Method; (* Method block *)+   base: Objects.Object; (* Model object on which the rider is working *)+   dsc, eol: BOOLEAN (* Has-descendant, End-of-list *)+  END;++  MethodDesc = RECORD+   Key: PROCEDURE (R: Rider): LONGINT; (* Get the current item's key *)+   Seek: PROCEDURE (R: Rider; key: LONGINT); (* Position rider R on the item+having the given key *)+   Pos: PROCEDURE (R: Rider): LONGINT; (* Get current position of the rider+*)+   Set: PROCEDURE (R: Rider; pos: LONGINT); (* Position rider R on the item+having the given pos *)+   Write: PROCEDURE (R: Rider; d: Data); (* Insert data at the current position+of R *)+   WriteLink: PROCEDURE (R, linkR: Rider); (* Link the item at the position+of linkR to the current position of R *)+   DeleteLink: PROCEDURE (R, linkR: Rider); (* Delete link from R to linkR+*)+   State: PROCEDURE (R: Rider): LONGINT; (* Get the state of the current item+*)+   SetState: PROCEDURE (R: Rider; s: LONGINT); (* Set the state of the current+item *)+  (* Get a rider working on the descendants of the item on the position of R.+If old is NIL, then a new rider+  is allocated. old is recycled if not NIL *)+   Desc: PROCEDURE (R, old: Rider): Rider;+   GetStamp: PROCEDURE (R: Rider): LONGINT; (* Get stamp value of the item+at the current position of R *)+   SetStamp: PROCEDURE (R: Rider; stamp: LONGINT) (* Set stamp value of the+item at the current position of R *)+  END;++ (* Get a new initialized rider from a model gadget. Sent by a client to a model+gadget. *)+  ConnectMsg = RECORD ( Objects.ObjMsg ) +   R: Rider+  END;++ (* Message broadcast to indicate that a model object changed *)+  UpdateMsg = RECORD ( Gadgets.UpdateMsg ) +   id: INTEGER (* insert, delete or state *)+  END;+ PROCEDURE Stamp (): LONGINT;++END ListRiders.
+ examples/AGRS/Main.Mod view
@@ -0,0 +1,108 @@+MODULE Main;
+IMPORT AGRS,Names,Library,Parser,Speller,Parser2,
+   Grammars,Permanence,Oberon,Texts;
+
+
+VAR
+   rd: Texts.Reader;
+   wr: Texts.Writer;
+
+
+PROCEDURE InputText(limit: CHAR): Library.Text;
+VAR
+   text: Texts.Text;
+   ch: CHAR;
+   first,last,time: LONGINT;
+BEGIN
+   text:= Oberon.Par.text;
+   Texts.OpenReader(rd,text,Oberon.Par.pos);
+   Texts.Read(rd,ch);
+   WHILE (ch=' ') OR (ch=9X) DO
+      Texts.Read(rd,ch);
+   END;
+   IF ch='^' THEN
+      Oberon.GetSelection(text,first,last,time);
+      IF (time=0) OR (text=NIL) THEN
+         RETURN NIL
+      END;
+   ELSE
+      first:= Texts.Pos(rd)-1;
+      WHILE (ch#limit) & ~rd.eot DO
+         Texts.Read(rd,ch);
+      END;
+      last:= Texts.Pos(rd)-1;
+   END;
+   RETURN Library.SubText(text,first,last)
+END InputText;
+
+PROCEDURE InputValue(): AGRS.Term;
+VAR
+   textTerm: Library.Text;
+   t: AGRS.Term;
+BEGIN
+   textTerm:= InputText(0DX);
+   IF textTerm=NIL THEN
+      RETURN NIL
+   END;
+   Grammars.sentenceName.Assign(textTerm);
+   t:= Grammars.parseName.Value();
+(*   t:= Names.IsolateSymbols(Parser.parseName); *)
+   Grammars.sentenceName.Restore();
+(* RETURN t; *)
+   RETURN Permanence.environmentName.Evaluate(t)
+(*   RETURN t.Value() *)
+END InputValue;
+
+   
+PROCEDURE Evaluate*;
+VAR
+   t,s: AGRS.Term;
+BEGIN
+   t:= InputValue();
+   IF t=NIL THEN
+      RETURN
+   END;
+   Speller.thoughtName.Assign(t);
+   s:= Speller.spellingName.Value();
+   Speller.thoughtName.Restore;
+   WITH s: Library.Text DO
+      Texts.Save(s.base,s.startOffset,s.endOffset,wr.buf);
+   END;
+   Texts.WriteLn(wr);
+   Texts.Append(Oberon.Log,wr.buf);
+END Evaluate;
+
+
+PROCEDURE AssignDefinition(param: AGRS.Name; VAR meaning: AGRS.Term);
+BEGIN
+   param.Init(meaning);
+END AssignDefinition;
+
+
+PROCEDURE Define*;
+VAR
+   textTerm: Library.Text;
+   definition: AGRS.Term;
+BEGIN
+   textTerm:= InputText(';');
+   IF textTerm=NIL THEN
+      RETURN
+   END;
+   Parser.sentenceName.Assign(textTerm);
+   Parser.buildingName.Assign(Names.SystemRoot);
+   definition:= Parser.attributeParser.Value();
+   Parser.buildingName.Restore();
+   Parser.sentenceName.Restore();
+   IF definition.indirection=AGRS.failName THEN
+      Texts.WriteString(wr,'Syntax error!');
+   ELSE
+      definition(AGRS.Tree).ProcessAttributes(AssignDefinition);
+      Texts.WriteString(wr,'Assigned.');
+   END;
+   Texts.WriteLn(wr);
+   Texts.Append(Oberon.Log,wr.buf);
+END Define;
+
+BEGIN
+   Texts.OpenWriter(wr);
+END Main.
+ examples/AGRS/Names.Mod view
@@ -0,0 +1,371 @@+MODULE Names;
+IMPORT AGRS,SYSTEM;
+
+
+CONST
+   MaxEntries=64;             (* Broj ulaza u hash tabeli *)
+   LastEntry=MaxEntries-1;
+TYPE
+   CharPtr*= POINTER TO ARRAY OF CHAR;
+   PublicName= POINTER TO RECORD(AGRS.NameDesc)    (* Imenovani parametar *)
+      spelling: CharPtr;
+      next: PublicName;
+   END;
+   OrdinalName= POINTER TO RECORD(AGRS.NameDesc)   (* Genericki parametar sa imenom 'nth' *)
+      number: INTEGER;
+      next: OrdinalName;
+   END;
+   Dictionary= POINTER TO DictRec;     (* Tabela simbola *)
+   DictRec= RECORD
+      entries: ARRAY MaxEntries OF PublicName;
+      next: Dictionary;
+   END;
+VAR
+   top: Dictionary;
+   ordinalList: OrdinalName;
+
+   SystemRoot*,VariableRoot*: AGRS.Name;
+   localName*, bodyName*: AGRS.Name;
+
+   UndefinedTerm: AGRS.SystemTerm;
+
+   temp: AGRS.Term;
+   temp1: AGRS.SubTerm;
+   temp2: AGRS.SystemTerm;
+   
+   systemSpelling: CharPtr;
+   systemHash: INTEGER;
+
+   i: INTEGER;
+   search: BOOLEAN;
+
+
+
+PROCEDURE IsolateSymbols*(query: AGRS.Term): AGRS.Term;
+VAR
+   d: Dictionary;
+   i: INTEGER;
+   result: AGRS.Term;
+BEGIN
+   NEW(d);
+   FOR i:= 0 TO LastEntry DO
+      d.entries[i]:=top.entries[i];
+   END;
+   d.next:= top;
+   top:= d;
+   result:= query.Value();
+   top:= top.next;
+   RETURN result
+END IsolateSymbols;
+
+
+PROCEDURE LocalBlock*;
+VAR
+   d: Dictionary;
+   i: INTEGER;
+BEGIN
+   NEW(d);
+   FOR i:= 0 TO LastEntry DO
+      d.entries[i]:=top.entries[i];
+   END;
+   d.next:= top;
+   top:= d;
+END LocalBlock;
+
+PROCEDURE EndBlock*;
+BEGIN
+   top:= top.next;
+END EndBlock;
+
+PROCEDURE LocalNames;
+BEGIN
+   search:= FALSE;
+   bodyName.Reduce;
+END LocalNames;
+
+PROCEDURE EndLocalNames;
+BEGIN
+   search:= TRUE;
+   AGRS.Continue;
+END EndLocalNames;
+
+
+PROCEDURE NewStringCopy*(str: ARRAY OF CHAR): CharPtr;
+VAR
+   result: CharPtr;
+   i,length: INTEGER;
+BEGIN
+   length:= 0;
+   WHILE (length#LEN(str)) & (str[length]#0X) DO
+      INC(length);
+   END;
+   NEW(result,length+1);
+   FOR i:= 0 TO length-1 DO
+      result[i]:= str[i];
+   END;
+   result[length]:= 0X;
+   AGRS.eldestAsked:= AGRS.Fixed;
+   RETURN result;
+END NewStringCopy;
+
+
+
+PROCEDURE HashString(VAR str: ARRAY OF CHAR; module: INTEGER): INTEGER;
+VAR
+   i,result: INTEGER;
+BEGIN
+   i:= 0;
+   result:= 0;
+   WHILE (i<LEN(str)) & (str[i]#0X) DO
+      result:= result+ORD(CAP(str[i]));
+      INC(i);
+   END;
+   RETURN result MOD module;
+END HashString;
+
+
+PROCEDURE DefinePublicName*(VAR result: AGRS.Name; spelling: ARRAY OF CHAR; meaning: AGRS.Term);
+VAR
+   newName: PublicName;
+   hash: INTEGER;
+   spellingCopy: CharPtr;
+BEGIN
+   spellingCopy:= NewStringCopy(spelling);
+   NEW(newName);
+   result:= newName;
+   IF meaning#UndefinedTerm THEN
+      newName.Init(meaning);
+      newName.spelling:= spellingCopy;
+      newName.next:= top.entries[systemHash];
+      meaning:= newName;
+      top.entries[systemHash]:= newName;
+      NEW(newName);
+   END;
+   hash:= HashString(spelling,MaxEntries);
+   newName.Init(meaning);
+   newName.spelling:= NewStringCopy(spelling);
+   newName.next:= top.entries[hash];
+   top.entries[hash]:= newName;
+END DefinePublicName;
+
+PROCEDURE AddSystemName*(VAR result: AGRS.Name; spelling: ARRAY OF CHAR; handler: AGRS.HandlerType);
+VAR
+   newTerm: AGRS.SystemTerm;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(SystemRoot);
+   newTerm.InitHandler(handler);
+   DefinePublicName(result,spelling,newTerm);
+END AddSystemName;
+
+
+PROCEDURE AddArgument*(VAR result: AGRS.Name; spelling: ARRAY OF CHAR);
+BEGIN
+   DefinePublicName(result,spelling,UndefinedTerm);
+END AddArgument;
+
+
+PROCEDURE AddAtom*(VAR name: AGRS.Name; spelling: ARRAY OF CHAR): AGRS.Term;
+VAR
+   newTerm: AGRS.Atomic;
+BEGIN
+   AddSystemName(name,spelling,AGRS.AtomicHandler);
+   NEW(newTerm);
+   newTerm.Init(name);
+   RETURN newTerm
+END AddAtom;
+
+
+PROCEDURE FindOrdinalName*(ordinalNumber: INTEGER): AGRS.Name;
+VAR
+   newName,seek,follow: OrdinalName;
+BEGIN
+   seek:= ordinalList;
+   WHILE (seek#NIL) & (seek.number<ordinalNumber) DO
+      follow:= seek;
+      seek:= seek.next;
+   END;
+   IF (seek=NIL) OR (seek.number>ordinalNumber) THEN
+      NEW(newName);
+      newName.Init(UndefinedTerm);
+      newName.number:= ordinalNumber;
+      newName.next:= seek;
+      follow.next:= newName;
+      RETURN newName
+   ELSE
+      RETURN seek
+   END;
+END FindOrdinalName;
+
+
+PROCEDURE FindPublicName*(wd: ARRAY OF CHAR): AGRS.Name;
+VAR
+   follow: PublicName;
+   letter: INTEGER;
+   ordinal: INTEGER;
+BEGIN
+   IF ~search THEN
+      RETURN NIL
+   END;
+   follow:= top.entries[HashString(wd,MaxEntries)];
+   WHILE follow#NIL DO
+      IF follow.spelling[0]=wd[0] THEN
+         letter:=1;
+         WHILE (wd[letter]=follow.spelling[letter]) & (follow.spelling[letter]#0X) DO
+            INC(letter);
+         END;
+         IF wd[letter]=follow.spelling[letter] THEN
+            RETURN follow
+         END;
+      END;
+      follow:=follow.next;
+   END;
+   letter:= 0;
+   ordinal:= 0;
+   WHILE (wd[letter]>='0') & (wd[letter]<='9') DO
+      ordinal:= 10*ordinal+ORD(wd[letter])-ORD('0');
+      INC(letter);
+   END;
+   IF (ordinal=0) OR (wd[letter+2]#0X) THEN
+      RETURN NIL
+   END;
+   CASE wd[letter-1] OF
+      |'1': IF (wd[letter]#'s') OR (wd[letter+1]#'t') THEN RETURN NIL END;
+      |'2': IF (wd[letter]#'n') OR (wd[letter+1]#'d') THEN RETURN NIL END;
+      |'3': IF (wd[letter]#'r') OR (wd[letter+1]#'d') THEN RETURN NIL END;
+   ELSE
+      IF (wd[letter]#'t') OR (wd[letter+1]#'h') THEN RETURN NIL END;
+   END;
+   RETURN FindOrdinalName(ordinal)
+END FindPublicName;
+
+
+PROCEDURE FindPublicNameNoCase*(wd: ARRAY OF CHAR): AGRS.Name;
+VAR
+   follow: PublicName;
+   letter: LONGINT;
+BEGIN
+   letter:= 0;
+   WHILE (wd[letter]#0X) & (letter<LEN(wd)) DO
+      wd[letter]:= CAP(wd[letter]);
+      INC(letter);
+   END;
+   follow:=top.entries[HashString(wd,MaxEntries)];
+   WHILE follow#NIL DO
+      IF CAP(follow.spelling[0])=wd[0] THEN
+         letter:=1;
+         WHILE (wd[letter]=CAP(follow.spelling[letter])) & (follow.spelling[letter]#0X) DO
+            INC(letter);
+         END;
+         IF wd[letter]=follow.spelling[letter] THEN
+            RETURN follow
+         END;
+      END;
+      follow:=follow.next
+   END;
+   RETURN NIL
+END FindPublicNameNoCase;
+
+
+PROCEDURE NameSpelling*(t: AGRS.Term): CharPtr;
+VAR
+   nameSpelling: CharPtr;
+   size,rest: INTEGER;
+   addr: LONGINT;
+BEGIN
+   WITH t: PublicName DO
+      RETURN t.spelling
+   ELSE
+      WITH t: OrdinalName DO
+         size:= 3;
+         rest:= t.number;
+         REPEAT
+            rest:= rest DIV 10;
+            INC(size);
+         UNTIL rest=0;
+         NEW(nameSpelling,size);
+         nameSpelling[size-1]:= 0X;
+         rest:= t.number;
+         IF (rest DIV 10) MOD 10 = 1 THEN
+            nameSpelling[size-3]:= 't';
+            nameSpelling[size-2]:= 'h';
+         ELSE
+            CASE rest MOD 10 OF
+               |1:
+                  nameSpelling[size-3]:= 's';
+                  nameSpelling[size-2]:= 't';
+               |2:
+                  nameSpelling[size-3]:= 'n';
+                  nameSpelling[size-2]:= 'd';
+               |3:
+                  nameSpelling[size-3]:= 'r';
+                  nameSpelling[size-2]:= 'd';
+               ELSE
+                  nameSpelling[size-3]:= 't';
+                  nameSpelling[size-2]:= 'h';
+            END;
+         END;
+         size:= size-4;
+         REPEAT
+            nameSpelling[size]:= CHR(ORD('0') + rest MOD 10);
+            rest:= rest DIV 10;
+            DEC(size);
+         UNTIL size<0;
+         RETURN nameSpelling
+      ELSE
+         IF t IS AGRS.Name THEN
+            NEW(nameSpelling,12);
+            nameSpelling[0]:= '_';
+            size:= 1;
+            addr:= SYSTEM.VAL(LONGINT,t);
+            REPEAT
+               nameSpelling[size]:= CHR(ORD('0') + addr MOD 10);
+               addr:= addr DIV 10;
+               INC(size);
+            UNTIL addr=0;
+            nameSpelling[size]:= 0X;
+            RETURN nameSpelling;
+         END;
+         RETURN NewStringCopy('!@#')
+      END;
+   END;
+END NameSpelling;
+
+BEGIN
+   search:= TRUE;
+   NEW(top);
+   top.next:= NIL;
+   FOR i:= 0 TO LastEntry DO
+      top.entries[i]:= NIL
+   END;
+   NEW(UndefinedTerm);
+   AddArgument(SystemRoot,'#System#');
+   UndefinedTerm.Init(SystemRoot);
+   UndefinedTerm.InitHandler(AGRS.Continue);
+   AddArgument(VariableRoot,'#System#');
+   AGRS.Variable.Init(VariableRoot);
+   AGRS.Variable.InitHandler(AGRS.Continue);
+   NEW(ordinalList);
+   ordinalList.Init(UndefinedTerm);
+   ordinalList.number:= 1;
+   ordinalList.next:= NIL;
+   AddArgument(AGRS.otherwise,'Otherwise');
+   AddArgument(bodyName, 'LocalBody');
+   NEW(temp1);
+   NEW(temp2);
+   temp1.Init(bodyName);
+   temp1.InitQuery(temp2);
+   temp2.Init(SystemRoot);
+   temp2.InitHandler(EndLocalNames);
+   temp:= temp1;
+   NEW(temp1);
+   NEW(temp2);
+   temp2.Init(SystemRoot);
+   temp2.InitHandler(LocalNames);
+   temp1.Init(temp2);
+   temp1.InitQuery(temp);
+   DefinePublicName(localName,'LocalNames',temp);
+   systemSpelling:= NewStringCopy('#');
+   systemHash:= HashString(systemSpelling^, MaxEntries);
+END Names.
+
+ examples/AGRS/OFS.Def view
@@ -0,0 +1,3 @@+DEFINITION OFS;++END OFS.
+ examples/AGRS/Oberon.Def view
@@ -0,0 +1,415 @@+(*+https://web.archive.org/web/20041226165258/http://www.oberon.ethz.ch:80/ethoberon/defs/Oberon.Def.html+*)+DEFINITION Oberon; (* portable, except where noted *)++(* Oberon system manager for dispatch of keyboard and mouse input, +scheduling of tasks, cursor handling and command execution.+*)+ IMPORT Display, Objects, Viewers, Fonts, Texts;++ CONST++    (* Message ids: *)+  defocus = 0; neutralize = 1; mark = 2; (* ControlMsg*)+  consume = 0; track = 1; (* InputMsg*)+  get = 0; set = 1; reset = 2; (* CaretMsg id, SelectMsg id*)++ TYPE+  Painter = PROCEDURE (x, y: INTEGER);+  Marker = RECORD+   Fade, Draw: Painter (* Remove and draw marker. *)+  END;++  Cursor = RECORD+   marker: Marker; (* Cursor marker. *)+   on: BOOLEAN; (* Is cursor shown? *)+   X, Y: INTEGER (* Absolute cursor position. *)+  END;++  ParList = POINTER TO ParRec;+  ParRec = RECORD (* Area for passing command parameters. *)+   vwr: Viewers.Viewer; (* Viewer in which command is executed. *)+   frame: Display.Frame; (* Frame of vwr from where command is executed. *)+   obj: Objects.Object; (* Object in vwr executing command. *)+   text: Texts.Text; (* Text parameter to be passed to command. *)+   pos: LONGINT (* Starting position in text of parameter. *)+  END;++  ControlMsg = RECORD ( Display.FrameMsg ) +   id: INTEGER; (* defocus, neutralize, mark *)+   X, Y: INTEGER (* Absolute mark position. *)+  END;++  InputMsg = RECORD ( Display.FrameMsg ) +   id: INTEGER; (* consume, track *)+   keys: SET; (* Mouse buttons. *)+   X, Y: INTEGER; (* Mouse position. *)+   ch: CHAR; (* Character typed. *)+   fnt: Fonts.Font; (* Font of typed character. *)+   col, voff: SHORTINT (* Color and vertical offset of typed character. *)+  END;++  CaretMsg = RECORD ( Display.FrameMsg )  (* Text caret handling. *)+   id: INTEGER; (* get, set, reset *)+   car: Display.Frame; (* Destination frame, returned frame. *)+   text: Texts.Text; (* Text represented by car. *)+   pos: LONGINT (* Caret position. *)+  END;++  SelectMsg = RECORD ( Display.FrameMsg )  (* Text selection handling. *)+   id: INTEGER; (* get, set, reset *)+   time: LONGINT; (* Time of the selection. *)+   sel: Display.Frame; (* Destination frame, returned frame. *)+   text: Texts.Text; (* Text represented by sel. *)+   beg, end: LONGINT (* Text stretch of the selection. *)+  END;++  ConsumeMsg = RECORD ( Display.FrameMsg )  (* Drag and drop control of text.+*)+   text: Texts.Text; (* Text to be inserted. *)+   beg, end: LONGINT (* Text stretch to be inserted. *)+  END;++  RecallMsg = RECORD ( Display.FrameMsg ) +  END;++  Task = POINTER TO TaskDesc;+  Handler = PROCEDURE (me: Task);+  TaskDesc = RECORD+   next: Task; (* for internal use. *)+   time: LONGINT; (* Earliest time to schedule task. *)+   safe: BOOLEAN; (* Don't remove from task queue when a trap occurs. *)+   handle: Handler (* Task handler. *)+  END;++ VAR +  Arrow, Star: Marker; (* Normal Oberon arrow, and the star marker. *)+  Mouse, Pointer: Cursor; (* Normal Oberon mouse, and the star pointer. *)+  Log: Texts.Text; (* The Oberon log. *)+  Par: ParList; (* Actual parameters of executed command. *)+  CurFnt: Fonts.Font; (* Current input font when typing. *)+  CurCol, CurOff: SHORTINT; (* Current color and offset when typing. *)+  OptionChar: CHAR; (* Option character "/" or "" *)+  OpenText: PROCEDURE (title: ARRAY OF CHAR; T: Texts.Text; W, H: INTEGER);+  NextTask: Task; (* non-portable, for internal use. *)+  New: BOOLEAN; (* enable new style mouse handling suitable for two-button+mice *)++(* Get time (t) and date (d).  day = d MOD 32, month = d DIV 32 MOD 16, year+= 1900+d DIV 512,+ hour = t DIV 4096 MOD 32, minute = t DIV 64 MOD 64, second = t MOD 64 *)+ PROCEDURE GetClock (VAR t, d: LONGINT);++ (* Set time (t) and date (d). *)+ PROCEDURE SetClock (t, d: LONGINT);++ (* Return the number of timer ticks since Oberon startup. (See module Input+for frequency) *)+ PROCEDURE Time (): LONGINT;++ (* Initialize a cursor, setting it to off, and at position 0, 0. *)+ PROCEDURE OpenCursor (VAR c: Cursor);++ (* Fade cursor if visible. *)+ PROCEDURE FadeCursor (VAR c: Cursor);++ (* Draw cursor c using marker m at position X, Y. *)+ PROCEDURE DrawCursor (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);++(* Remove the caret by broadcasting a ControlMsg into the display space. +Afterwards, no visual object should own either a caret for inserting text or+objects. *)+ PROCEDURE Defocus;++(* Fade the mouse and pointer cursors if located inside the screen area X, Y,+W, H. +This is required before drawing inside the area X, Y, W, H. *)+ PROCEDURE RemoveMarks (X, Y, W, H: INTEGER);++(* Initialize a new display with user track width UW, system track width SW,++and height H. The display is appended to the display space starting at X position++Viewers.curW. Normally this procedure is only called once to configure the +default layout of the Oberon screen. *)+ PROCEDURE OpenDisplay (UW, SW, H: INTEGER); (* non-portable *)++(* Returns the width in pixels of the display that contains the X coordinate.+*)+ PROCEDURE DisplayWidth (X: INTEGER): INTEGER;++(* Returns the height in pixels of the display that contains the X coordinate.+*)+ PROCEDURE DisplayHeight (X: INTEGER): INTEGER;++(* Open a new track of width W at X. *)+ PROCEDURE OpenTrack (X, W: INTEGER);++(* Get left margin of user track on display X. *)+ PROCEDURE UserTrack (X: INTEGER): INTEGER;++(* Get left margin of the system track on display X. *)+ PROCEDURE SystemTrack (X: INTEGER): INTEGER;++(* Allocate a new user viewer within the display located at DX. (X, Y) +returns the suggested position. *)+ PROCEDURE AllocateUserViewer (DX: INTEGER; VAR X, Y: INTEGER);++(* Allocate a new system viewer within the display located at DX. +(X, Y) returns the suggested position. *)+ PROCEDURE AllocateSystemViewer (DX: INTEGER; VAR X, Y: INTEGER);++(* Returns the star-marked viewer. *)+ PROCEDURE MarkedViewer (): Viewers.Viewer;++(* Returns the star-marked frame. *)+ PROCEDURE MarkedFrame (): Display.Frame;++(* Returns the text of the star-marked frame. *)+ PROCEDURE MarkedText (): Texts.Text;++(* Execute an Oberon command. Name should be a string of the form +"M.P", where M is the module and P is the procedure of the command. +Par is the command parameter record; it will be assigned to Oberon.Par +so that the command can pick up its parameters. The new flag indicates +if the module M should be reloaded from disk (obly possible if M is a "top"++module, i.e. it has no clients. Res indicates success (res = 0) or failure (res+# 0). +Modules.resMsg contains an explanation of what went wrong when res # 0. *)+ PROCEDURE Call (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);++(* Returns the selected stretch [beg, end[ of the current selected text T. +Time indicates the time of selection; time = -1 indicates that no text is currently+selected. *)+ PROCEDURE GetSelection (VAR text: Texts.Text; VAR beg, end, time: LONGINT);++(* Install a background task. The background task is periodically activated++by calling its handler when the system has nothing else to do. *)+ PROCEDURE Install (T: Task);++(* Remove a background task. *)+ PROCEDURE Remove (T: Task);++(* Request a garbage collection to be done. The GC will take place immediately.+*)+ PROCEDURE Collect;++(* Set the default font used when typing characters. *)+ PROCEDURE SetFont (fnt: Fonts.Font);++(* Set the color of typed characters. *)+ PROCEDURE SetColor (col: SHORTINT);++(* Set the vertical offset of typed characters. *)+ PROCEDURE SetOffset (voff: SHORTINT);++(* Open a scanner at a specific section of the Oberon Text.  Scans the first+symbol in the section.  Returns+ S.class = Texts.Inval on error. *)+ PROCEDURE OpenScanner (VAR S: Texts.Scanner; name: ARRAY OF CHAR);++(* Main Oberon task dispatcher. Reads the mouse position and characters +typed, informing the viewer of the display space of events using the +Display.InputMsg. The loop broadcasts a ControlMsg (id = mark) when the +marker is set. Pressing the neutralise key results in a ControlMsg (id = neutralize)++to be broadcast. All frames receiving the neutralize message should remove +selections and the caret. The Loop periodically activates background tasks and++the garbage collector, if no mouse or keyboard events are arriving. *)+ PROCEDURE Loop;+END Oberon.++(* Remarks:++1. Command execution+Execution of commands is the task of modules Module. Oberon.Call provides an++abstraction for this mechanism and also a way to pass parameters in the form+of +a text to the executed command. After command execution, the global variable++Oberon.Par is a pointer to a parameter record specifying a parameter text, a++position in that text, and details what objects are involved in the commands.++The vwr field of the ParRec points to the viewer in which the command was executed.++The frame field of the ParRec points to the direct child of the vwr (the menu+or the +main frame) from which the command was executed. This semantics is compatible++with older Oberon applications and is seldomly used today. The obj field of+the +ParRec points to the object (normally a frame) that executed the command. +The Oberon.Par pointer is initialized before command execution to the parameter++record passed to Oberon.Call.++2. Cursors and Markers+Markers are a way to draw and undraw a shape on the display. Typically, draw++and undraw can be realized by an invert display operation. Cursors keep track+of +the current position and state (visible or not) of a marker. The Mouse cursor+is the +standard mouse arrow, and the Pointer cursor is the star marker placed with+the +Setup key. Repeatedly calling Oberon.DrawCursor with different coordinates move+a +cursor (and marker) across the display. Before drawing in a certain area of+the +display, cursors should be removed with Oberon.RemoveMarks or Oberon.FadeCursor++(failingly to do so may result in the cursor leaving garbage on the display+when +drawing operations are performed in its vicinity). Note that on some Oberon+host +platforms (Windows, Mac, Unix) the mouse cursor is under control of the host++windowing system, and is automatically faded when required. It is recommended++to fade the cursor on these platforms anyway, as your Oberon programs will then++also work on native Oberon systems.++3. The InputMsg+The InputMsg informs the frames of the display space of the current mouse position++and character typed. It is repeatedly broadcast into the display space by the++Oberon.Loop for each input event. An InputMsg id of Oberon.consume indicates+a +key was pressed. The ASCII keycode is contained in the ch field of the message++(check the description of module Input for special keycodes). The fields fnt,+col and +voff give information about the requested font, color (index), and verticall+offset +(in pixels). These values are copied from hidden variables in the Oberon module,++which are set with the procedures SetFont, SetColor, and SetOffset. Note that+the +TextGadgets ignore these fields when typing. Instead the font, color and vertical++offset of the character immediately before the caret is used (thus the fields+have +fallen out of use). A frame should only process the consume message if it has+the +caret set. Afterwards the message should be invalidated by setting the message+res +field to 0 or a positive value. This prevents the character being consumed by+other +frames in the display space and also terminates the message broadcast.+ An InputMsg id of track indicates a mouse event. The display space normally+only + forwards this message to the frame located at position X, Y on the display.+Field X, Y + indicates the absolute mouse position (cursor hotspot) and keys the mouse button++ state (which mouse buttons are pressed). The mouse buttons are numbered 0,+1, 2 + for right, middle, and left respectively. It is typical for a frame receiving+a track + message with keys # {} to temporarily taking control of the mouse by polling+(using + module Input). As soon as all mouse buttons are released, control must be passed++ back to the Oberon loop. A frame should invalidate the track message if it+took + action on a mouse event; otherwise the enclosing frame might think that the+message + could not be handled. In some cases a child frame takes no action on an event+even + though a mouse buttton is pressed and the mouse is located inside the frame.+This is + an indication that the child frame cannot or is unwilling to process the event,+and + the parent (and forwarder of the message in the display space) should take+a default + action. Note that during a tracking operation, no background tasks can be serviced.++4. The ControlMsg+The control message manages display space wide events like removing the (one+and +only) caret, pressing Neutralise (for removing the caret and the selections),+and setting the +star marker with the Setup key. The id field of the control message is set to+defocus, +neutralize, and mark respectively. Note that the mark variant need not be handled+by +own frames; it is already processed by the Viewers. Messages of this type must+never +be invalidated during their travels through the display space.++5. The CaretMsg+The CaretMsg controls the removing (id = reset), retrieving (id = get) and setting++(id = set) of the caret on a frame to frame basis. All text editor-like frames+should +respond to this message. The car field of the message defines the editor frame+involved +for reset and set, and returns the editor frame that has the caret for get.+The text field +specifies which text is meant (or which text is returned for get). In the reset+and set +cases this field is mostly redundant but is checked for correctness ANYWAY.+The pos +field must be valid position in the text. The CaretMsg is always broadcast.++6. The SelectMsg+In a similar way as the CaretMsg, the SelectMsg controls the removing (id =+reset), +retrieving (id = get) and setting (id = set) of the selection. In this case,+the sel field +indicates the destination frame or returned frame, in a similar manner as the+car +field of the CaretMsg. The SelectMsg is extended with fields for specifying/retrieving++the selection time, starting and ending position. The SelectMsg is always broadcast.++7. Background tasks+The handle procedure variable of installed background tasks are periodically+called +by the Oberon loop when the Oberon system is idle (no mouse or keyboard events).++The task handlers have to be programmed in an inverted manner and should return++as quickly as possible to the loop, otherwise the user will notice delays (typically++when elapsed time is greater than 100-200ms). As tasks are activated periodically,++a badly written task can cause a cascade of traps, one for each invocation.+By default, +the loop removes such a task that does not return from the task list (the safe+flag +prevents the loop from such an action). The garbage collector is realized as+a task. +A task can request to be invoked only at a specified time by setting the time+field in +the task descriptor. The time is measured according to Oberon.Time() at tick+frequency +specified by Input.TimeUnit. After each handler invocation, the task is expected+to +advance the time field to the next earliest event, overwise it will never be+invoked in +future. It is highly recommended to use this feature by specifying for tasks+that are +only invoked every few ms. This will save network traffic when using Oberon+in an +X-Window environment.++8. The Oberon Loop+The Oberon loop is called when the Oberon system starts, and never returns until++the Oberon system is left. After a trap occurs, the run-time stack is reset,+and the +Oberon loop is started afresh. The Oberon loop polls the mouse and keyboard+for +events that it broadcasts to the display space using messages. When no events+are +happening, background tasks are activated periodically in a round-robin fashion.+*)
+ examples/AGRS/Objects.Def view
@@ -0,0 +1,460 @@+(*+https://web.archive.org/web/20041226165949/http://www.oberon.ethz.ch:80/ethoberon/defs/Objects.Def.html+*)+DEFINITION Objects; (* portable *)++(* Module Objects forms the basis of the object-oriented part of the Oberon+system. +It provides the system with the type Object and defines what messages objects+understand. +Most entities in Oberon are derived from this base type.+*)+ IMPORT Files;++ CONST+  enum = 0; get = 1; set = 2; (* AttrMsg and LinkMsg id *)+  shallow = 0; deep = 1; (* CopyMsg id *)+  load = 0; store = 1; (* FileMsg id*)++    (* AttrMsg class *)+  Inval = 0; String = 2; Int = 3; Real = 4; LongReal = 5; Char = 6; Bool = 7;++ TYPE+  Name = ARRAY 32 OF CHAR;+  Object = POINTER TO ObjDesc;+  Dummy = POINTER TO DummyDesc;+  Library = POINTER TO LibDesc;+  ObjMsg = RECORD (* Base type of all messages sent to objects. *)+   stamp: LONGINT; (* Message time stamp. *)+   dlink: Object (* Sender of the message. *)+  END;++  Handler = PROCEDURE (obj: Object; VAR M: ObjMsg);+  ObjDesc = RECORD (* Base type of all objects. *)+   stamp: LONGINT; (* Time stamp of last message processed by object. *)+   dlink, (* Next object in the message thread. *)+   slink: Object; (* Next object in a list of objects. *)+   lib: Library; ref: INTEGER; (* Library and reference number of object.+*)+   handle: Handler (* Message handler. *)+  END;++    (* Set, get and enumerate the attributes of an object. *)+  AttrMsg = RECORD ( ObjMsg ) +   id: INTEGER; (* get, set or enum. *)+   Enum: PROCEDURE (name: ARRAY OF CHAR); (* Called by object to enumerate+attribute names. *)+   name: Name; (* Name of the attribute to be set or retrieved. *)+   res: INTEGER; (* Return result: < 0 = no response, >= 0 action completed.+*)+   class: INTEGER; (* Attribute class (Inval, String, Int, Real, LongReal,+Char or Bool). *)+   i: LONGINT;+   x: REAL;+   y: LONGREAL;+   c: CHAR;+   b: BOOLEAN;+   s: ARRAY 64 OF CHAR+  END;++ (* Link objects with each other or retrieve the link structure between objects+*)+  LinkMsg = RECORD ( ObjMsg ) +   id: INTEGER; (* get, set or enum. *)+   Enum: PROCEDURE (name: ARRAY OF CHAR); (* Called by object to enumerate+link names. *)+   name: Name; (* Link name. *)+   res: INTEGER; (* Return result: < 0 = no response, >= 0 action completed.+*)+   obj: Object (* Value of the link to be set, or link result. *)+  END;++ (* Request to an object to make a copy of itself *)+  CopyMsg = RECORD ( ObjMsg ) +   id: INTEGER; (* Copy style: deep or shallow. *)+   obj: Object (* Result of the copy operation. *)+  END;++ (* Request to an object to bind itself to a library. *)+  BindMsg = RECORD ( ObjMsg ) +   lib: Library (* Library where object should be bound. *)+  END;++ (* Request to an object to load/store itself. *)+  FileMsg = RECORD ( ObjMsg ) +   id: INTEGER; (* load or store *)+   len: LONGINT; (* Length of the object data on loading. *)+   R: Files.Rider (* Rider with which to load or store data. *)+  END;++ (* Search request for an object with the specified name. *)+  FindMsg = RECORD ( ObjMsg ) +   name: Name;+   obj: Object (* Result object, if found. *)+  END;++ (* A placeholder object created for objects that cannot be loaded. *)+  DummyDesc = RECORD ( ObjDesc ) +   GName: Name; (* Generator procedure of failed object. *)+  END;++ (* (Hidden) Data structure containing the objects of a library. *)+  Index = POINTER TO IndexDesc;+  IndexDesc = RECORD END;++ (* (Hidden) Map of (ref) numbers and corresponding object names. *)+  Dictionary = POINTER TO DictionaryDesc;+  DictionaryDesc = RECORD END;++  LibDesc = RECORD (* Container for persistent objects. *)+   ind: Index; (* Library contents. *)+   name: Name; (* name of the library. Private library when "", else public+library. *)+   dict: Dictionary; (* Object names. *)+   maxref: INTEGER; (* Highest ref number used in library. *)++      (* Return a free reference number. *)+   GenRef: PROCEDURE (L: Library; VAR ref: INTEGER);++      (* Return the object with the indicated reference number. *)+   GetObj: PROCEDURE (L: Library; ref: INTEGER; VAR obj: Object);++      (* Insert an object under the indicated reference number. *)+   PutObj: PROCEDURE (L: Library; ref: INTEGER; obj: Object);++      (* Free object with indicated reference number. *)+   FreeObj: PROCEDURE (L: Library; ref: INTEGER);++      (* Initialize/load library with L.name. *)+   Load: PROCEDURE (L: Library);++      (* Store library under L.name. *)+   Store: PROCEDURE (L: Library)+  END;++  NewProc = PROCEDURE (): Library; (* Library generator. *)+  EnumProc = PROCEDURE (L: Library); (* Enumerator of public libraries *)++ VAR +  LibBlockId: CHAR; (* Identification character as first character of a Library+file. *)+  NewObj: Object; (* Newly generated objects are returned here. *)+ PROCEDURE Stamp (VAR M: ObjMsg); (* Timestamp a message.  *)++(* Search, load and cache a public library. *)+ PROCEDURE ThisLibrary (name: ARRAY OF CHAR): Library;++(* Free library from public library cache *)+ PROCEDURE FreeLibrary (name: ARRAY OF CHAR);++(* Enumerate public libraries. Don't free libraries during enumeration! *)+ PROCEDURE Enumerate (P: EnumProc);++(* Register a new library file extension and its associated generator procedure.+*)+ PROCEDURE Register (ext: ARRAY OF CHAR; new: NewProc);++(* Load a standard object library from position pos in file f. *)+ PROCEDURE LoadLibrary (L: Library; f: Files.File; pos: LONGINT; VAR len: LONGINT);++(* Store a standard object library at position pos in file f. *)+ PROCEDURE StoreLibrary (L: Library; f: Files.File; pos: LONGINT; VAR len: LONGINT);++(* Initialize a standard object library. *)+ PROCEDURE OpenLibrary (L: Library);++(* Given an object name, return the object reference number from the dictionary.+*)+ PROCEDURE GetRef (VAR D: Dictionary; name: ARRAY OF CHAR; VAR ref: INTEGER);++(* Allocate a key (any integer < 0) to a name. *)+ PROCEDURE GetKey (VAR D: Dictionary; name: ARRAY OF CHAR; VAR key: INTEGER);++(* Get name associated with a key/reference number. *)+ PROCEDURE GetName (VAR D: Dictionary; key: INTEGER; VAR name: ARRAY OF CHAR);++(* Associate a name with a reference number. *)+ PROCEDURE PutName (VAR D: Dictionary; key: INTEGER; name: ARRAY OF CHAR);++END Objects.++(* Remarks:++1. Objects and Messages+Objects and the messages sent to them are both types in the Oberon system. Just+as we can extend an object by defining an object-subtype, we can extend a message+by defining a message sub-type. As root of the object and message type hierarchies+we have the types Objects.Object and Object.ObjMsg respectively. We will refering+to extensions of these types as Objects and Messages respectively. This way+of organizing things allows us to send a message of any type to an object of+any type (even when the receiving object might not make sense of the message).+As an examples of an object we can mention the Frames of module Display (visual+objects). Frames have a set of associated messages called frame messages (i.e.+messages sent to frames). A base type called Display.FrameMsg is an extension+of Object.ObjMsg and the base of the frame messages. The module Objects define+the object messages, i.e. the messages that all objects understand. Objects+are allocated on the heap and messages temporarily on the stack.++2. Message Handlers+Message handlers process the message sent to an object. A message handler is+a procedure with the definition Objects.Handler. A message handler receives+as first parameter the object the message is sent to, and as second parameter+the message itself. The message handler does message type tests to discrimate+between the different message types it receives, and acts accordingly to each+message type (most of the actions are prescribed the messages defined in modules+like Objects and Display). The message handler of a newly created object is+"installed" in an object by assigning it to the field handle of the object.+A typical handler might look as follows:++ PROCEDURE MyHandler(obj: Object; VAR M: ObjMsg);+ BEGIN+  IF M IS Objects.AttrMsg THEN+   WITH M: Objects.AttrMsg DO+    ...+   END+  ELSIF M IS Objects.CopyMsg THEN+   WITH M: Objects.CopyMsg DO+    ...+   END+  ELSE+   (* message not understood by handler. *)+  END+ END MyHandler;++To create a new object, we first have to introduce a new object type, allocate+a new instance on the heap and attach the message handler:++ TYPE+  MyObj = POINTER TO MyObjDesc;+  MyObjDesc = RECORD (Objects.ObjDesc) (* Extension of Objects.ObjDesc. *)+   A, B: LONGINT; (* Object instance variables. *)+  END;+  + PROCEDURE CreateObj;+ VAR obj: MyObj;+ BEGIN+  NEW(obj); (* allocate a new object on the heap *)+  obj.handle := MyHandler; (* attach the message handler. *)+ END CreateObj;+ +Here we created a new object type with two additional instance variables A and+B. To open up access to the instance variables in the message handler, we will+need to modify the message handler slightly:++ PROCEDURE MyHandler(obj: Object; VAR M: ObjMsg);+ BEGIN+  WITH obj: MyObj DO (* Open up access to the instance variables of MyObj. *)+   IF M IS Objects.AttrMsg THEN+    WITH M: Objects.AttrMsg DO+     ...+    END+   ELSIF M IS Objects.CopyMsg THEN+    WITH M: Objects.CopyMsg DO+     ...+    END+   ELSE+    (* message not understood by handler. *)+   END+  END+ END MyHandler;++This change also means that MyHandler can only be safely attached to objects+(or extensions) of type MyObj; attaching the handler to objects of other types+will cause a runtime exception (trap) when trying to open access to the fields+of MyObj. Sending a message to an object involves allocating it on the stack,+filling out the message fields, and calling the object message handler. For+example:++ VAR obj: MyObj;+ + PROCEDURE GetName;+ VAR M: Objects.AttrMsg; (* Allocate message on the stack. *)+ BEGIN+  M.id := Objects.get; M.name := "Name"; M.res := -1; (* Fill out message fields+*)+  obj.handle(obj, M); (* Send message. *)+  Out.String(M.s); Out.Ln; (* Process result. *)+ END GetName;+ +You are allowed to define new message types for your own objects, in a similar+manner as shown in the message definitions above. Note how many of the messages+have id fields; these indicate different sub-operations a message requests.+The id values are declared per message as INTEGER constants at the beginning+of the module.++3. Forwarding and Broadcasts+Objects may forward messages to other objects. This is typically done when an+object cannot handle a message itself or does not even know the message. Sometimes+messages are sent in such a way that each object does some handle of a message,+and then forwards it anyway to all other objects it controls. This we call message+broadcasting. Messages thus pass from one object to another in ways only known+to the objects themselves. The route a message follows we call the message path.++4. Time stamps+During a message broadcast, more than one message path may lead to the same+object, resulting in the object receiving a the message many times (i.e. exactly+once for each message path). To allow an object to determine if it has already+processed a message, each message that is broadcast is given a timestamp. The+receiving object remembers the message timestamp in its field stamp, and can+compare it against a later message received. Due to message broadcasts occuring+during a message broadcast itself (i.e. recursive broadcasts), you should not+assume that message arrive in time stamp sequence. The stamp is a LONGINT value+incremented on each broadcast by the procedure Stamp.++5. The Message Thread+The message thread informs an object of the path a message followed to reach+it, and can be used to implement path dependent behaviour. The dlink field in+the ObjMsg points to the last forwarder of the message. The dlink field of the+latter object contains the previous object in the path, and so onwards until+the beginning of the path (the thread points backwards). Due to recursive message+broadcasts the dlink field in the message and the objects themselves should+be saved on the stack before the values are changed:++ (* Forward a message from one object to another. *)+ PROCEDURE SendMsg(from, to: Objects.Object; VAR M: Objects.ObjMsg);+ VAR p, p0; Objects.Object;+ BEGIN+  p := from.dlink; p0 := M.dlink; (* save *)+  from.dlink := M.dlink; (* hook sender in dlink chain *)+  M.dlink := from; (* set sender of the message *)+  to.handle(to, M);+  from.dlink := p; M.dlink := p0 (* restore *)+ END SendMsg;++A message sender may refuse to add itself to the message thread (for optimization+purposes). This has no effect but to make it invisible to further recipients+in the message path. The message thread is typically used in the display space+(see module Display) to find out how a message travelled from the display root+to an object located somewhere in the display space.++6. The slink field+The slink field links objects together in a list so that they can be passed+around as a group. Never assume that the slink list remains the same before+and after a message broadcast.++7. Libraries+Libraries are indexed collections of objects. An object belonging to a library+is said to be bound to the library (otherwise it is free). When bound, an objects+obtains an index or reference number (>= 0) in its library (and its lib and+ref fields are set accordingly). The Objects module implements the standard+object libraries. These allow you to store the library and its contents in an+atomic action to disk. On disk, reference numbers instead of pointers are used+to refer to objects. Thus pointers and reference numbers are swizzled (exchanged)+when loading or storing libraries. The procedures Gadgets.ReadRef and Gadgets.WriteRef+use the library mechanism to transparently read and write object pointers to+disk. The library dictionary mechanism allows you to attach names to objects+(more concretely to reference numbers). An object belonging to public library+L and having the name O in the dictionary, is refered to as "L.O" (note the+similarity with "M.P"). Sometimes the dictionary is also used to attach keys+(< 0) to strings. Keys are used to save string space when storing libraries.+Libraries are divided into public and private libraries. Public libraries are+named (i.e. L.name # "") and are cached in memory on loading. The garbage collector+will uncache a library automatically if it is not required any more. The Libraries.Panel+allow you to manipulate the contents of public libraries. Private libraries+are primarily used as a means to make objects persistent in documents and are+never cached. The default public library file extension is "Lib". It is possible+to add new types of libraries by registering new library extensions and the+associated library generator.++8. The Object Messages+All objects should implement handlers for the so-called object messages defined+in this module. The object messages are the LinkMsg (for structure building+and exploration), the CopyMsg (for copying an object), the BindMsg (for binding+an object to a library), the AttrMsg (for setting and getting attributes), the+FileMsg (for loading and storing), and the FindMsg (for locating named objects).++9. The LinkMsg+The LinkMsg is used to link objects between each other i.e. setting a pointer+in one object to point to another. The links must be identified by name. Most+displayable gadgets have a "Model" link that points to a model gadget.++10. The CopyMsg+Shallow copy means copying an object but reusing its descendants, and deep copy+means copying all objects reachable from a certain root object. Due to the DAG+nature of the display space, the deep copy message arrives once or more times+at an object, in which case it only should copy itself once to guarantee structure+preserving copies. The following shows that an object should cache the first+copy that it makes of itself in the dlink field, which is then returned on receiving+the message a second time:++  VAR F0: Frame; (* the copy goes here *)+  +  IF M IS Objects.CopyMsg THEN+   WITH M: Objects.CopyMsg DO+    IF M.stamp = F.stamp THEN M.obj := F.dlink (* copy msg arrives again *)+    ELSE (* first time copy message arrives *)+     NEW(F0); F.stamp := M.stamp; F.dlink := F0; CopyFrame(M, F, F0); M.obj+:= F0+    END+   END+  END+  +11. The BindMsg+The BindMsg is a request to an object to bind itself to a library. By convention,+an object can migrate from library to library, except when bound to a public+library. Binding allocates a reference number to an object which is conveniently+used as a pointer alias between objects stored in a file.++ PROCEDURE BindObj(obj: Objects.Object; lib: Objects.Library);+ VAR ref: INTEGER; name: ARRAY 32 OF CHAR;+ BEGIN+  IF lib # NIL THEN +   IF (obj.lib = NIL) OR (obj.lib.name[0] = 0X) & (obj.lib # lib) THEN (* free,+or belongs to a private library *)+    lib.GenRef(lib, ref); (* allocate reference number *)+    IF ref >= 0 THEN (* successful *)+     lib.PutObj(lib, ref, obj);+    END+   END+  END+ END BindObj;++12. The AttrMsg+The attribute message is used to enumerate, set or retrieve an object attribute.+The class field of the AttrMsg indicate what the type of an attribute is. Each+object should have a Name attribute and a Gen attribute (both of type String).+The name attribute refers to the intrinsic name of an object (it should not+be confused with the name the object might have in a dictionary). Copying an+object results in two objects with the same names. The FindMsg locates an object+with a certain intrinsic name. The Gen attribute indicates the name of the object+generator (in the form "M.P"). Calling the generator of an object results in+the freshly created object attached to Objects.NewObj, from where it is picked+up by commands like Gadgets.Insert.++13. The FileMsg+The FileMsg is a request to an object to write or read its state to or from+a Rider. An object should always read and write the same number of bytes, otherwise+traps may result. It is recommended to use version numbers to distinguish objects+of different generations from each other and so allow for smooth upgrading to+new file formats for older objects. The FileMsg is typically used when reading+or writing a library from or to disk.++14. The FindMsg+The FindMsg is a request to an object to locate the object with the indicated+intrinsic name. Should an object not know of an object with such a name, it+should forward the message to all objects it controls (children). By convention,+searching should be done in a bread-first manner between descendants of a container.++15. Keys+Each library has a dictionary of (key, name) pairs. The key is either positive+or zero, in which case it is regarded as a reference number in the library (with+associated object name), or negative, in which case it is simply a short way+of refering to a string (an atom). The latter reduces the space used when the+same string appears many times in a library file.++16. Dummies+Dummies are objects created in place of objects that cannot be loaded into memory+(module missing). Pointers to Dummies are often set to NIL by the application+itself.++17. Extended Libraries+It is possible to add new library types to the system. New types are distinguished+by filename extensions that are registered by Objects.Register. The NewProc+is called by Objects.ThisLibrary to create an empty instance of the new library+type. The name field is filled in, after which the Load procedure of the library+is called to load the library from disk. In accordance, the Store procedure+stores the library under its name to disk. The LoadLibrary and StoreLibrary+procedures implement the default behaviour for the standard object libraries.++*)+
+ examples/AGRS/Parser.Mod view
@@ -0,0 +1,802 @@+MODULE Parser;
+IMPORT AGRS,Names,Library,Texts,SYSTEM;
+
+
+CONST
+   MaxStrLength= 60;
+   SetBits*= MAX(SET)+1;
+
+TYPE
+
+   ParserProc= PROCEDURE(VAR r:Texts.Reader; l:LONGINT): AGRS.Term;
+   ParseWrapper*= POINTER TO RECORD(AGRS.TermDesc)
+      handler*: ParserProc;
+   END;
+
+VAR
+   sentenceName*,spaceCharsName*,customParsersName*,parseName*: AGRS.Name;
+   temp,buildingName*,rulesName,varName,blockName,className: AGRS.Name;
+
+   sentenceParser*,attributeParser*,standardParser,customParser: ParseWrapper;
+   rulesParser,varParser,blockParser,classParser: ParseWrapper;
+   numberParser,stringParser,charParser,charSetParser: ParseWrapper;
+
+   sentence: Texts.Text;         (* Tekst koji se parsira. *)
+   spaceChars: Library.CharSet;  (* Delimiteri. *)
+   collection: AGRS.ClosedClass; (* CustomParsers znacenje. *)
+   idTerm: AGRS.Term;
+
+   attrPosition: INTEGER;    (* Redni broj trenutnog atributa. *)
+
+
+PROCEDURE Rewind*(VAR rd: Texts.Reader; newPos: LONGINT);
+BEGIN
+   Texts.OpenReader(rd,sentence,newPos);
+END Rewind;
+
+
+PROCEDURE BackSpace(VAR rd: Texts.Reader);
+BEGIN
+   Texts.OpenReader(rd,sentence,Texts.Pos(rd)-1);
+END BackSpace;
+
+
+PROCEDURE ParseEmpty*(VAR rd: Texts.Reader; limit: LONGINT): BOOLEAN;
+VAR
+   ch: CHAR;
+BEGIN
+   WHILE ~rd.eot & (Texts.Pos(rd)<limit) DO
+      Texts.Read(rd,ch);
+      IF (rd.elem=NIL) & ~(ORD(ch) MOD SetBits IN 
+           spaceChars.value[ORD(ch) DIV SetBits]) THEN
+         BackSpace(rd);
+         RETURN FALSE
+      END;
+   END;
+   RETURN TRUE
+END ParseEmpty;
+
+
+PROCEDURE ExactParse(parser: ParserProc; VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   result: AGRS.Term;
+BEGIN
+   result:= parser(rd,limit);
+   IF (result.indirection#AGRS.failName) & ParseEmpty(rd,limit) THEN
+      RETURN result
+   ELSE
+      RETURN AGRS.Failure
+   END
+END ExactParse;
+
+
+PROCEDURE ScanCharacter(chSeek: CHAR; 
+      VAR rd: Texts.Reader; limit: LONGINT): BOOLEAN;
+VAR
+   chRead: CHAR;
+BEGIN
+   WHILE Texts.Pos(rd)<limit DO
+      Texts.Read(rd,chRead);
+      IF chSeek=chRead THEN
+         RETURN TRUE
+      END;
+   END;
+   RETURN FALSE
+END ScanCharacter;
+
+
+PROCEDURE ParseTheCharacter(chExpect: CHAR; 
+      VAR rd: Texts.Reader; limit: LONGINT): BOOLEAN;
+VAR
+   chRead: CHAR;
+BEGIN
+   IF Texts.Pos(rd)<limit THEN
+      Texts.Read(rd,chRead);
+      IF chExpect=chRead THEN
+         RETURN TRUE
+      END;
+   END;
+   RETURN FALSE
+END ParseTheCharacter;
+
+
+PROCEDURE ParseTheString*(strExpect: ARRAY OF CHAR; 
+      VAR rd: Texts.Reader; limit: LONGINT): BOOLEAN;
+VAR
+   chRead: CHAR;
+   i: INTEGER;
+BEGIN
+   i:= 0;
+   WHILE (Texts.Pos(rd)<limit) & (i<LEN(strExpect)) 
+                               & (strExpect[i]#0X) DO
+      Texts.Read(rd,chRead);
+      IF strExpect[i]#chRead THEN
+         RETURN FALSE
+      END;
+      INC(i);
+   END;
+   RETURN strExpect[i]=0X
+END ParseTheString;
+
+
+PROCEDURE ParseNumber(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   ch: CHAR;
+   minus: BOOLEAN;
+   x: INTEGER;
+BEGIN
+   Texts.Read(rd,ch);
+   IF ch='-' THEN
+      minus:= TRUE;
+      Texts.Read(rd,ch);
+   ELSE
+      minus:= FALSE;
+      IF ch='+' THEN
+         Texts.Read(rd,ch);
+      END
+   END;
+   IF (ch<'0') OR (ch>'9') THEN
+      RETURN AGRS.Failure
+   END;
+   x:= 0;
+   WHILE (ch>='0') & (ch<='9') & (Texts.Pos(rd)<=limit) DO
+      IF x <= (MAX(INTEGER)-ORD(ch)+ORD('0')) DIV 10 THEN
+         x:= 10*x+ORD(ch)-ORD('0');
+      END;
+      Texts.Read(rd,ch);
+   END;
+   IF minus THEN
+      x:= -x;
+   END;
+   BackSpace(rd);
+   RETURN Library.NewNumber(x)
+END ParseNumber;
+
+
+PROCEDURE ParseChar(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   delimiter,chRead: CHAR;
+BEGIN
+   Texts.Read(rd,delimiter);
+   IF delimiter = "'" THEN
+      Texts.Read(rd,chRead);
+      Texts.Read(rd,delimiter);
+      IF (delimiter="'") & (Texts.Pos(rd)<=limit) THEN
+         RETURN Library.NewChar(chRead)
+      END;
+   END;
+   RETURN AGRS.Failure
+END ParseChar;
+
+
+PROCEDURE ParseCharSet(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   ch,second: CHAR;
+   s: Library.CharSet;
+   complement: BOOLEAN;
+BEGIN
+   Texts.Read(rd,ch);
+   IF ch='~' THEN
+      complement:= TRUE;
+      Texts.Read(rd,ch);
+   ELSE
+      complement:= FALSE;
+   END;
+   IF ch#'{' THEN
+      RETURN AGRS.Failure
+   END;
+   IF ParseEmpty(rd,limit) THEN
+      RETURN AGRS.Failure
+   END;
+   s:= Library.NewCharSet();
+   Texts.Read(rd,ch);
+   IF ch#'}' THEN
+      LOOP
+         IF ch='\' THEN
+            Texts.Read(rd,ch);
+            CASE ch OF 
+               |'0': ch:= 0X;
+               |'s','S': ch:= ' ';
+               |'t','T': ch:= 9X;
+               |'n','N':
+                  ch:= 0DX;
+                  s.Include(0AX);
+            ELSE
+               RETURN AGRS.Failure;
+            END;
+         END;
+         Texts.Read(rd,second);
+         IF second='-' THEN
+            Texts.Read(rd,second);
+            IF second<ch THEN
+               RETURN AGRS.Failure
+            END;
+            WHILE ch<=second DO
+               s.Include(ch);
+               ch:= CHR(ORD(ch)+1);
+            END;
+            Texts.Read(rd,second);
+         ELSE
+            s.Include(ch);
+         END;
+         IF second#',' THEN
+            IF second='}' THEN
+               EXIT
+            ELSE
+               RETURN AGRS.Failure
+            END;
+         END;
+         IF ParseEmpty(rd,limit) THEN
+            RETURN AGRS.Failure
+         END;
+         Texts.Read(rd,ch);
+      END;
+   END;
+   IF Texts.Pos(rd)>limit THEN
+      RETURN AGRS.Failure
+   END;
+   IF complement THEN
+      s.Complement();
+   END;
+   RETURN s
+END ParseCharSet;
+
+
+PROCEDURE ParseIdentifier*(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   wd: AGRS.Name;
+   str: ARRAY MaxStrLength OF CHAR;
+   ch: CHAR;
+   i: INTEGER;
+BEGIN
+   i:= 0;
+   REPEAT
+      Texts.Read(rd,ch);
+      str[i]:= ch;
+      INC(i);
+   UNTIL (ch<'0') OR (CAP(ch)>'Z') OR
+         ((ch>'9') & (CAP(ch)<'A')) OR (Texts.Pos(rd)>limit);
+   IF i=1 THEN
+      RETURN AGRS.Failure;
+   END;
+   BackSpace(rd);
+   str[i-1]:= 0X;
+   wd:= Names.FindPublicName(str);
+   IF wd=NIL THEN
+      Names.AddArgument(wd,str);
+   END;
+   RETURN wd
+END ParseIdentifier;
+   
+
+PROCEDURE ParseString(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   ch,between: CHAR;
+   str: ARRAY MaxStrLength OF CHAR;
+   length: INTEGER;
+BEGIN
+   Texts.Read(rd,between);
+   IF (between="'") OR (between='"') THEN
+      length:= 0;
+      Texts.Read(rd,ch);
+      WHILE (ch#between) & (ch#0DX) & (length<MaxStrLength)
+            & (Texts.Pos(rd)<limit) DO
+         str[length]:= ch;
+         INC(length);
+         Texts.Read(rd,ch);
+      END;
+      IF ch=between THEN
+         str[length]:= 0X;
+         RETURN Library.NewString(Names.NewStringCopy(str))
+      END;
+   END;
+   RETURN AGRS.Failure
+END ParseString;
+
+
+PROCEDURE ParseCustom(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   id,result: AGRS.Term;
+   startPos: LONGINT;
+   
+   
+BEGIN
+   startPos:= Texts.Pos(rd);
+   id:= ParseIdentifier(rd,limit);
+   Rewind(rd,startPos);
+   IF id.indirection=AGRS.failName THEN
+      RETURN AGRS.Failure
+   END;
+   sentenceName.Assign(Library.SubText(sentence,startPos,limit));
+   idTerm.Init(id);
+   result:= customParsersName.Evaluate(idTerm);
+   sentenceName.Restore();
+   Rewind(rd,limit);
+   RETURN result
+END ParseCustom;
+
+
+PROCEDURE ParseSentence(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   result: AGRS.Term;
+   startPos,endPos: LONGINT;
+
+			PROCEDURE ParseSequence(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+			VAR
+         first,rest: AGRS.Term;
+         newTerm: AGRS.SubTerm;
+         scanner: Texts.Reader;
+			BEGIN
+			   startPos:= Texts.Pos(rd);
+         Rewind(scanner,startPos);
+         WHILE ScanCharacter(';',scanner,limit) DO
+            Rewind(rd,startPos);
+            first:= ParseCustom(rd,Texts.Pos(scanner)-1);
+            IF first.indirection#AGRS.failName THEN
+               Rewind(rd,Texts.Pos(scanner));
+               IF ~ParseEmpty(rd,limit) THEN
+                  rest:= ParseSequence(rd,limit);
+                  IF rest.indirection#AGRS.failName THEN
+                     NEW(newTerm);
+                     newTerm.Init(first);
+                     newTerm.InitQuery(rest);
+                     RETURN newTerm
+                  END;
+               END;
+            END;
+         END;
+         Rewind(rd,startPos);
+         Rewind(scanner,startPos);
+         WHILE ScanCharacter(')',scanner,limit) DO
+			      endPos:= Texts.Pos(scanner);
+         END;
+         RETURN ParseSentence(rd,endPos-1);
+			END ParseSequence;
+BEGIN
+   startPos:= Texts.Pos(rd);
+   result:= ExactParse(ParseChar,rd,limit);
+   IF result.indirection#AGRS.failName THEN
+      RETURN result
+   END;
+   Rewind(rd,startPos);
+   result:= ExactParse(ParseString,rd,limit);
+   IF result.indirection#AGRS.failName THEN
+      RETURN result
+   END;
+   Rewind(rd,startPos);
+   result:= ExactParse(ParseNumber,rd,limit);
+   IF result.indirection#AGRS.failName THEN
+      RETURN result
+   END;
+   Rewind(rd,startPos);
+   result:= ExactParse(ParseCharSet,rd,limit);
+   IF result.indirection#AGRS.failName THEN
+      RETURN result
+   END;
+   Rewind(rd,startPos);
+   result:= ParseCustom(rd,limit);
+   IF result.indirection#AGRS.failName THEN
+      RETURN result
+   END;
+   IF ParseTheCharacter('(',rd,limit) & ~ParseEmpty(rd,limit) THEN
+      result:= ParseSequence(rd,limit);
+      IF result.indirection#AGRS.failName THEN
+         IF ~ParseEmpty(rd,limit) THEN
+            IF ParseTheCharacter(')',rd,limit) THEN
+               RETURN result
+            END;
+         END;
+      END;
+   END;
+   RETURN AGRS.Failure
+END ParseSentence;
+
+
+PROCEDURE ParseAttribute(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   startPos: LONGINT;
+   id,meaning,built: AGRS.Term;
+   newTerm: AGRS.Tree;
+   attrPos: INTEGER;
+BEGIN
+   startPos:= Texts.Pos(rd);
+   id:= ParseIdentifier(rd,limit);
+   IF (id.indirection#AGRS.failName) & ~ParseEmpty(rd,limit) 
+         & ParseTheCharacter('=',rd,limit) & ~ParseEmpty(rd,limit) THEN
+      meaning:= ParseSentence(rd,limit);
+      IF meaning.indirection=AGRS.failName THEN
+         RETURN AGRS.Failure
+      END;
+   ELSIF attrPosition>0 THEN
+      Rewind(rd,startPos);
+      IF ParseEmpty(rd,limit) THEN
+         RETURN AGRS.Failure
+      END;
+      attrPos:= attrPosition;         
+      meaning:= ParseSentence(rd,limit);
+      IF meaning.indirection=AGRS.failName THEN
+         RETURN AGRS.Failure
+      END;
+      id:= Names.FindOrdinalName(attrPos);
+   ELSE
+      RETURN AGRS.Failure
+   END;
+   built:= buildingName.indirection;
+   WITH built: AGRS.Tree DO
+      built.AddProperty(id(AGRS.Name),meaning);
+      RETURN built
+   ELSE
+      NEW(newTerm);
+      newTerm.Init(built);
+      newTerm.AddProperty(id(AGRS.Name),meaning);
+      RETURN newTerm
+   END;
+END ParseAttribute;
+
+
+PROCEDURE ParseProperties(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   startPos: LONGINT;
+   attrPos: INTEGER;
+   result: AGRS.Term;
+   attributeReader: Texts.Reader;
+BEGIN
+   startPos:= Texts.Pos(rd);
+   IF ParseTheCharacter(')',rd,limit) THEN
+      RETURN buildingName.indirection
+   END;
+   attrPos:= attrPosition+1;
+   Rewind(rd,startPos);
+   WHILE ScanCharacter(',',rd,limit) DO
+      attrPosition:= attrPos;
+      Rewind(attributeReader,startPos);
+      result:= ParseAttribute(attributeReader,Texts.Pos(rd)-1);
+      IF result.indirection#AGRS.failName THEN
+         IF ParseEmpty(rd,limit) THEN
+            RETURN AGRS.Failure
+         END;
+         attrPosition:= attrPos;
+         buildingName.Assign(result);
+         result:= ParseProperties(rd,limit);
+         buildingName.Restore();
+         IF result.indirection#AGRS.failName THEN
+            RETURN result
+         END;
+      END;
+   END;
+   Rewind(rd,startPos);
+   Rewind(attributeReader,startPos);
+   WHILE ScanCharacter(')',rd,limit) DO
+      startPos:= Texts.Pos(rd);
+   END;
+   attrPosition:= attrPos;
+   RETURN ParseAttribute(attributeReader,startPos-1)
+END ParseProperties;
+
+
+PROCEDURE ParseStandard(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   id,result: AGRS.Term;
+   startPos: LONGINT;
+   result1: AGRS.SubTerm;
+   result2: AGRS.Field;
+   result3: AGRS.Tree;
+BEGIN
+   id:= ParseIdentifier(rd,limit);
+   IF id.indirection=AGRS.failName THEN
+      RETURN AGRS.Failure
+   END;
+   IF ParseEmpty(rd,limit) THEN
+      RETURN id
+   END;
+   startPos:= Texts.Pos(rd);
+   IF ParseTheCharacter('.',rd,limit) THEN
+      result:= ParseStandard(rd,limit);
+      IF result.indirection#AGRS.failName THEN
+         IF (result IS AGRS.Name) OR (result IS AGRS.Field) THEN
+            NEW(result2);
+            result2.Init(id);
+            result2.InitQuery(result);
+            RETURN result2
+         ELSE
+            NEW(result1);
+            result1.Init(id);
+            result1.InitQuery(result);
+            RETURN result1
+         END;
+      END;
+      RETURN AGRS.Failure
+   ELSE
+      Rewind(rd,startPos);
+      IF ParseTheCharacter('(',rd,limit) THEN
+         IF ParseEmpty(rd,limit) THEN
+            RETURN AGRS.Failure
+         END;
+         startPos:= Texts.Pos(rd);
+         IF ParseTheCharacter(')',rd,limit) THEN
+            NEW(result);
+            result.Init(id);
+         ELSE
+            Rewind(rd,startPos);
+            NEW(result3);
+            result3.Init(id);
+            buildingName.Assign(result3);
+            attrPosition:= 0;
+            result:= ParseProperties(rd,limit);
+            buildingName.Restore();
+         END;
+         RETURN result
+      ELSE
+         Rewind(rd,startPos);
+         RETURN id
+      END;
+   END;
+END ParseStandard;
+
+
+PROCEDURE ParseRule(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   startPos: LONGINT;
+   lhs,rhs,rest: AGRS.Term;
+   ruleReader: Texts.Reader;
+BEGIN
+   startPos:= Texts.Pos(rd);
+   WHILE ScanCharacter('=',rd,limit) DO
+      Rewind(ruleReader,startPos);
+      lhs:= ParseStandard(ruleReader,Texts.Pos(rd)-1);
+      IF (lhs.indirection#AGRS.failName)
+            & ~ParseEmpty(ruleReader,limit)
+            & ParseTheCharacter('=', ruleReader,limit)
+            & ~ParseEmpty(ruleReader,limit) THEN
+         startPos:= Texts.Pos(ruleReader);
+         WHILE ScanCharacter(',',rd,limit) DO
+            Rewind(ruleReader,startPos);
+            rhs:= ParseSentence(ruleReader,Texts.Pos(rd)-1);
+            IF (rhs.indirection#AGRS.failName)
+                  & ~ParseEmpty(ruleReader,limit)
+                  & ParseTheCharacter(',', ruleReader,limit)
+                  & ~ParseEmpty(ruleReader,limit) THEN
+               rest:= ParseRule(ruleReader,limit);
+               IF rest.indirection#AGRS.failName THEN
+                  Rewind(rd,Texts.Pos(ruleReader));
+                  RETURN AGRS.MakeAlternative(lhs,rhs) (* ,rest *)
+               END;
+            END;
+         END;
+         Rewind(rd,startPos);
+         Rewind(ruleReader,startPos);
+         WHILE ScanCharacter(')',rd,limit) DO
+            startPos:= Texts.Pos(rd);
+         END;
+         rhs:= ParseSentence(ruleReader,startPos-1);
+         IF rhs.indirection=AGRS.failName THEN
+            RETURN AGRS.Failure
+         END;
+         IF lhs IS AGRS.Name THEN
+            RETURN rhs
+         ELSE
+            RETURN AGRS.MakeAlternative(lhs,rhs) (* ,NIL *)
+         END;
+      END;
+   END;
+   RETURN AGRS.Failure
+END ParseRule;
+
+
+PROCEDURE ParseRules(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+BEGIN
+   IF ParseTheString('RULE',rd,limit) & ~ParseEmpty(rd,limit)
+         & ParseTheCharacter('(',rd,limit) & ~ParseEmpty(rd,limit) THEN
+      RETURN ParseRule(rd,limit)
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END ParseRules;
+
+PROCEDURE ParseVar(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+BEGIN
+   IF ParseTheString('VAR',rd,limit) THEN
+      RETURN AGRS.Variable
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END ParseVar;
+
+PROCEDURE ParseBlock(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   startPos: LONGINT;
+   rest,id: AGRS.Term;
+   vars: AGRS.Tree;
+BEGIN
+   IF ParseTheString('LOCAL',rd,limit) THEN
+      Names.LocalBlock;
+(*      Names.LocalNames; *)
+      NEW(vars);
+      vars.Init(Names.SystemRoot);
+      LOOP
+         IF ParseEmpty(rd,limit) THEN
+            EXIT
+         END;
+         id:= ParseIdentifier(rd,limit);
+         IF (id.indirection=AGRS.failName) OR ParseEmpty(rd,limit) THEN
+            EXIT
+         END;
+         vars.AddProperty(id(AGRS.Name),AGRS.Variable);
+         startPos:= Texts.Pos(rd);
+         IF ~ParseTheCharacter(',',rd,limit) THEN
+            Rewind(rd,startPos);
+            IF ParseTheString('IN',rd,limit) & ~ParseEmpty(rd,limit) THEN
+(*               Names.EndNames; *)
+               rest:= ParseSentence(rd,limit);
+               Names.EndBlock;
+               IF rest.indirection=AGRS.failName THEN
+                  RETURN AGRS.Failure
+               ELSE
+                  RETURN AGRS.MakeLocalBlock(vars,rest)
+               END;
+            ELSE
+               EXIT
+            END;
+         END;
+      END;
+(*      Names.EndNames; *)
+      Names.EndBlock;
+   END;
+   RETURN AGRS.Failure
+END ParseBlock;
+
+PROCEDURE ParseClass(VAR rd: Texts.Reader; limit: LONGINT): AGRS.Term;
+VAR
+   startPos: LONGINT;
+   tree: AGRS.Term;
+   result,tree1: AGRS.Class;
+BEGIN
+   startPos:= Texts.Pos(rd);
+   IF ParseTheString('CLASS',rd,limit) THEN
+      Rewind(rd,startPos);
+      tree:= ParseStandard(rd,limit);
+      IF tree IS AGRS.Tree THEN
+         NEW(result);
+         tree1:= SYSTEM.VAL(AGRS.Class,tree);
+         result^:= tree1^;
+         RETURN result
+      END;
+   END;
+   RETURN AGRS.Failure
+END ParseClass;
+
+
+PROCEDURE pParse;
+VAR
+   txt,parsed: AGRS.Term;
+   sentenceReader: Texts.Reader;
+BEGIN
+   txt:= sentenceName.Value();
+   WITH txt: Library.Text DO
+      sentence:= txt.base;
+      Texts.OpenReader(sentenceReader,sentence,txt.startOffset);
+      IF ~ParseEmpty(sentenceReader,txt.endOffset) THEN
+         parsed:= ParseSentence(sentenceReader,txt.endOffset);
+         IF parsed.indirection#AGRS.failName THEN
+            IF ~AGRS.Continued() THEN
+               AGRS.result:= parsed;
+            END;
+            RETURN
+         END;
+      END;
+      parsed:= Library.NewError(Library.SyntaxError);
+      parsed.Reduce;
+   ELSE
+      parsed:= Library.NewError(Library.NotTextType);
+      parsed.Reduce;
+   END;
+END pParse;
+
+
+PROCEDURE (t: ParseWrapper) Reduce*;
+VAR
+   txt,parsed: AGRS.Term;
+   rd: Texts.Reader;
+BEGIN
+   txt:= sentenceName.Value();
+   WITH txt: Library.Text DO
+      sentence:= txt.base;
+      Texts.OpenReader(rd,sentence,txt.startOffset);
+      parsed:= ExactParse(t.handler,rd,txt.endOffset);
+   ELSE
+      parsed:= Library.NewError(Library.NotTextType);
+   END;
+   IF ~AGRS.Continued() THEN
+      AGRS.result:= parsed;
+   END;
+END Reduce;
+
+BEGIN
+(* Inicijalizacija parametara i pomocnih promjenljivih. *)
+   spaceChars:= Library.NewCharSet();
+   spaceChars.Include(' ');
+   spaceChars.Include(0X);
+   spaceChars.Include(9X);
+   spaceChars.Include(0AX);
+   spaceChars.Include(0DX);
+   Names.DefinePublicName(spaceCharsName,'SpaceCharacters',spaceChars);
+
+   NEW(idTerm);
+
+   NEW(sentenceParser);
+   sentenceParser.Init(Names.SystemRoot);
+   sentenceParser.handler:= ParseSentence;
+   Names.DefinePublicName(temp,'SentenceParser',sentenceParser);
+
+   NEW(standardParser);
+   standardParser.Init(Names.SystemRoot);
+   standardParser.handler:= ParseStandard;
+   Names.DefinePublicName(temp,'StandardParser',standardParser);
+
+   NEW(customParser);
+   customParser.Init(Names.SystemRoot);
+   customParser.handler:= ParseCustom;
+   Names.DefinePublicName(temp,'CustomParser',customParser);
+
+   NEW(attributeParser);
+   attributeParser.Init(Names.SystemRoot);
+   attributeParser.handler:= ParseAttribute;
+   Names.DefinePublicName(temp,'AttributeParser',customParser);
+
+   NEW(numberParser);
+   numberParser.Init(Names.SystemRoot);
+   numberParser.handler:= ParseNumber;
+   Names.DefinePublicName(temp,'NumberParser',numberParser);
+
+   NEW(stringParser);
+   stringParser.Init(Names.SystemRoot);
+   stringParser.handler:= ParseString;
+   Names.DefinePublicName(temp,'StringParser',stringParser);
+
+   NEW(charParser);
+   charParser.Init(Names.SystemRoot);
+   charParser.handler:= ParseChar;
+   Names.DefinePublicName(temp,'CharParser',charParser);
+
+   NEW(charSetParser);
+   charSetParser.Init(Names.SystemRoot);
+   charSetParser.handler:= ParseCharSet;
+   Names.DefinePublicName(temp,'CharSetParser',charSetParser);
+
+   NEW(rulesParser);
+   rulesParser.Init(Names.SystemRoot);
+   rulesParser.handler:= ParseRules;
+   Names.DefinePublicName(temp,'RuleParser',rulesParser);
+   
+   NEW(varParser);
+   varParser.Init(Names.SystemRoot);
+   varParser.handler:= ParseVar;
+   Names.DefinePublicName(temp,'VarParser',varParser);
+   
+   NEW(blockParser);
+   blockParser.Init(Names.SystemRoot);
+   blockParser.handler:= ParseBlock;
+   Names.DefinePublicName(temp,'BlockParser',blockParser);
+   
+   NEW(classParser);
+   classParser.Init(Names.SystemRoot);
+   classParser.handler:= ParseClass;
+   Names.DefinePublicName(temp,'ClassParser',classParser);
+
+   Names.AddSystemName(parseName,'Parse',pParse);
+   Names.AddArgument(sentenceName,'Sentence');
+   Names.AddArgument(rulesName,'RULE');
+   Names.AddArgument(varName, 'VAR');
+   Names.AddArgument(blockName, 'LOCAL');
+   Names.AddArgument(className, 'CLASS');
+   NEW(collection);
+   collection.Init(Names.SystemRoot);
+   collection.AddProperty(rulesName,rulesParser);
+   collection.AddProperty(varName,varParser);
+   collection.AddProperty(blockName,blockParser);
+   collection.AddProperty(className,classParser);
+   collection.AddProperty(AGRS.otherwise,standardParser);
+   Names.DefinePublicName(customParsersName,'CustomParsers',collection);
+   NEW(buildingName);
+   buildingName.Init(Names.SystemRoot);
+END Parser.
+ examples/AGRS/Parser2.Mod view
@@ -0,0 +1,428 @@+MODULE Parser2;
+IMPORT AGRS,Names,Library,Grammars;
+
+CONST
+   MaxStrLength=Grammars.MaxStrLength;
+VAR
+   sentenceName,sExprName,exprName,atomicName: AGRS.Name;
+   treeName,tree1Name,attributesName,attributes1Name,subSentenceName: AGRS.Name;
+   attributeName: AGRS.Name;
+   sequenceName,qualificationName,fieldName: AGRS.Name;
+   disjunctionName: AGRS.Name;
+   charName,stringName,numberName: AGRS.Name;
+   argNoName,numberToIdName,lhsName,rhsName,dummyName: AGRS.Name;
+   customName,customParsersName: AGRS.Name;
+   customIdTerm: AGRS.Field;
+   collection: AGRS.ClosedClass;
+   ruleParser,altBuilder,varParser,blockParser,classParser: AGRS.Name;
+   rulesName,varName,blockName,className,guardName: AGRS.Name;
+   rulesParser,alternativeName,blockLocalsName,guardParser: AGRS.Name;
+
+PROCEDURE NewDisjunction(alt1,alt2: AGRS.Term): AGRS.Term;
+VAR
+   newTerm: AGRS.Disjunction;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(alt1);
+   newTerm.InitAlternative(alt2);
+   RETURN newTerm
+END NewDisjunction;
+
+PROCEDURE NewContinuation(base,cont: AGRS.Term): AGRS.Term;
+VAR
+   newTerm: AGRS.SubTerm;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(base);
+   newTerm.InitQuery(cont);
+   RETURN newTerm
+END NewContinuation;
+
+PROCEDURE NewTreeRoot(root: AGRS.Term): AGRS.Tree;
+VAR
+   newTerm: AGRS.Tree;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(root);
+   RETURN newTerm
+END NewTreeRoot;
+
+PROCEDURE NewClassRoot(root: AGRS.Term): AGRS.Tree;
+VAR
+   newTerm: AGRS.Class;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(root);
+   RETURN newTerm
+END NewClassRoot;
+
+PROCEDURE NewTree(base: AGRS.Tree; prop: AGRS.Name; value: AGRS.Term): AGRS.Tree;
+BEGIN
+   base.AddProperty(prop,value);
+   RETURN base
+END NewTree;
+
+PROCEDURE NewGrammarTree(root,value: AGRS.Term): AGRS.Tree;
+BEGIN
+   RETURN NewTree(NewTreeRoot(root),Grammars.grammarName,value)
+END NewGrammarTree;
+
+PROCEDURE NewOption(grammar: AGRS.Term): AGRS.Tree;
+BEGIN
+   RETURN NewGrammarTree(Grammars.optionName,grammar)
+END NewOption;
+
+PROCEDURE NewCharTerminal(expect: CHAR): AGRS.Tree;
+BEGIN
+   RETURN NewGrammarTree(Grammars.charTerminalParser,
+         Library.NewChar(expect))
+END NewCharTerminal;
+
+PROCEDURE NewStringTerminal(expect: ARRAY OF CHAR): AGRS.Term;
+BEGIN
+   RETURN NewGrammarTree(Grammars.terminalName,
+      NewTree(NewTreeRoot(Grammars.stringParser),
+         Grammars.treeName,Library.NewString(Names.NewStringCopy(expect))))
+END NewStringTerminal;
+
+PROCEDURE NewAttribute(property: AGRS.Name; grammar: AGRS.Term): AGRS.Term;
+VAR
+   temp: AGRS.Term;
+BEGIN
+   NEW(temp);
+   temp.Init(property);
+   RETURN NewTree(NewGrammarTree(Grammars.attrName,grammar),
+      Grammars.propertyName,temp)
+END NewAttribute;
+
+PROCEDURE NumberToId;
+VAR
+   n,newTerm: AGRS.Term;
+BEGIN
+   n:= argNoName.Value();
+   WITH n: Library.Number DO
+      NEW(newTerm);
+      newTerm.Init(Names.FindOrdinalName(n.value));
+      Grammars.propertyName.Assign(newTerm);
+      AGRS.Continue;
+      Grammars.propertyName.Restore;
+   ELSE
+      AGRS.Fail;
+   END;
+END NumberToId;
+
+PROCEDURE ParseChar;
+VAR
+   chRead,chResult: CHAR;
+BEGIN
+   Grammars.Read(chRead);
+   IF chRead="'" THEN
+      Grammars.Read(chResult);
+      Grammars.Read(chRead);
+      IF chRead="'" THEN
+         IF Grammars.treeName.indirection=AGRS.Variable THEN
+            Grammars.treeName.Assign(Library.NewChar(chResult));
+            AGRS.Continue;
+            Grammars.treeName.Restore;
+            RETURN
+         END;
+      END;
+   END;
+   AGRS.Fail;
+END ParseChar;
+
+PROCEDURE ParseString;
+VAR
+   ch,between: CHAR;
+   str: ARRAY MaxStrLength OF CHAR;
+   length: INTEGER;
+BEGIN
+   Grammars.Read(between);
+   IF (between="'") OR (between='"') THEN
+      length:= 0;
+      Grammars.Read(ch);
+      WHILE (ch#between) & (ch#0DX) & (length<MaxStrLength) DO
+         str[length]:= ch;
+         INC(length);
+         Grammars.Read(ch);
+      END;
+      IF ch=between THEN
+         str[length]:= 0X;
+         IF Grammars.treeName.indirection=AGRS.Variable THEN
+            Grammars.treeName.Assign(
+                  Library.NewString(Names.NewStringCopy(str)));
+            AGRS.Continue;
+            Grammars.treeName.Restore;
+            RETURN
+         END;
+      END;
+   END;
+   AGRS.Fail;
+END ParseString;
+
+PROCEDURE ParseNumber;
+VAR
+   ch: CHAR;
+   minus: BOOLEAN;
+   x: INTEGER;
+   c: AGRS.TermStack;
+BEGIN
+   Grammars.Read(ch);
+   IF ch='-' THEN
+      minus:= TRUE;
+      Grammars.Read(ch);
+   ELSE
+      minus:= FALSE;
+      IF ch='+' THEN
+         Grammars.Read(ch);
+      END
+   END;
+   IF (ch<'0') OR (ch>'9') THEN
+      AGRS.Fail;
+      RETURN
+   END;
+   x:= 0;
+   WHILE (ch>='0') & (ch<='9') DO
+      IF x <= (MAX(INTEGER)-ORD(ch)+ORD('0')) DIV 10 THEN
+         x:= 10*x+ORD(ch)-ORD('0');
+      END;
+      Grammars.Read(ch);
+   END;
+   IF minus THEN
+      x:= -x;
+   END;
+   Grammars.BackSpace;
+   IF Grammars.treeName.indirection=AGRS.Variable THEN
+      Grammars.treeName.Assign(Library.NewNumber(x));
+      c:= AGRS.continuation;
+      AGRS.Continue;
+      Grammars.treeName.Restore;
+   ELSE
+      AGRS.Fail;
+   END;
+END ParseNumber;
+
+PROCEDURE ParseCustom;
+VAR
+   id,result: AGRS.Term;
+BEGIN
+   id:= customIdTerm.Actual();
+   IF id.indirection=AGRS.Failure THEN
+      AGRS.Fail;
+   ELSE
+      AGRS.Push(id);
+      customParsersName.Reduce;
+   END;
+END ParseCustom;
+
+PROCEDURE ParseClass;
+VAR
+   result: AGRS.Class;
+   t: AGRS.Term;
+BEGIN
+   NEW(result);
+   result.Init(className);
+   Grammars.treeName.Assign(result);
+   treeName.Reduce;
+   Grammars.treeName.Restore;
+   t:= AGRS.result;
+END ParseClass;
+
+PROCEDURE BuildAlternative;
+BEGIN
+   Grammars.treeName.Assign(
+      AGRS.MakeAlternative(lhsName.indirection,rhsName.indirection));
+   AGRS.Continue;
+   Grammars.treeName.Restore;
+END BuildAlternative;
+
+BEGIN
+   Grammars.DefineParser(charName,'P_CharacterAtom',ParseChar);
+   Grammars.DefineParser(stringName,'P_StringAtom',ParseString);
+   Grammars.DefineParser(numberName,'P_NumberAtom',ParseNumber);
+   Grammars.DefineParser(customName,'P_Custom',ParseCustom);
+   Grammars.DefineParser(classParser,'P_ParseCLASS',ParseClass);
+   Names.AddSystemName(altBuilder,'P_BuildAlternative',BuildAlternative);
+
+   Names.AddArgument(sentenceName,'P_Sentence');
+   Names.AddArgument(sExprName,'P_SExpr');
+   Names.AddArgument(exprName,'P_Expr');
+   Names.AddArgument(treeName,'P_Tree');
+   Names.AddArgument(tree1Name,'P_Tree1');
+   Names.AddArgument(attributesName,'P_Attributes');
+   Names.AddArgument(attributes1Name,'P_Attributes1');
+   Names.AddArgument(subSentenceName,'P_SubSentence');
+   Names.AddArgument(attributeName,'P_Attribute');
+   Names.AddArgument(disjunctionName,'P_Disjunction');
+   Names.AddArgument(sequenceName,'P_Sequence');
+   Names.AddArgument(qualificationName,'P_Qualification');
+   Names.AddArgument(fieldName,'P_Field');
+   Names.AddArgument(argNoName,'P_ArgNo');
+   Names.AddSystemName(numberToIdName,'P_NumberToName',NumberToId);
+   Names.AddArgument(lhsName,'P_LHS');
+   Names.AddArgument(rhsName,'P_RHS');
+   Names.AddArgument(alternativeName,'P_Alternative');
+   Names.AddArgument(varParser,'P_Var');
+   Names.AddArgument(ruleParser,'P_Rule');
+   Names.AddArgument(rulesParser,'P_Rules');
+   Names.AddArgument(guardParser,'P_Guard');
+   Names.AddArgument(rulesName,'RULE');
+   Names.AddArgument(varName,'VAR');
+   Names.AddArgument(blockName,'LOCAL');
+   Names.AddArgument(className,'CLASS');
+   Names.AddArgument(guardName,'GUARD');
+   Names.AddArgument(customParsersName,'P_CustomParsers');
+   Names.AddArgument(dummyName, '#Let');
+   Names.AddArgument(blockParser,'P_ParseBLOCK');
+   Names.AddArgument(blockLocalsName,'P_BlockLocals');
+   sentenceName.Init(NewDisjunction(sExprName,disjunctionName));
+   sExprName.Init(NewDisjunction(exprName,sequenceName));
+   Names.DefinePublicName(atomicName,'P_Atomic',
+      NewDisjunction(
+         charName,NewDisjunction(
+         stringName,
+         numberName)));
+   exprName.Init(NewDisjunction(
+      atomicName,NewDisjunction(
+      customName,NewDisjunction(
+      Grammars.nameParser,NewDisjunction(
+      qualificationName,NewDisjunction(
+      fieldName,
+      subSentenceName))))));
+   tree1Name.Init(AGRS.MakeLocalBlock(
+      NewTree(NewTreeRoot(dummyName),
+         argNoName,Library.NewNumber(0)),
+      attributesName));
+   treeName.Init(NewContinuation(
+      Grammars.idParser,NewContinuation(
+      NewCharTerminal('('),NewContinuation(
+      NewOption(tree1Name),
+      NewCharTerminal(')')))));
+   attributes1Name.Init(NewContinuation(
+      attributeName,
+      NewOption(NewContinuation(
+         NewCharTerminal(','),
+         attributesName))));
+   attributesName.Init(AGRS.MakeLocalBlock(
+      NewTree(NewTreeRoot(dummyName),
+         argNoName,NewTree(
+            NewTree(NewTreeRoot(Library.addName.indirection),
+               Library.argName1,argNoName),
+            Library.argName2,Library.NewNumber(1))),
+      attributes1Name));
+(*   attributesName.Init(NewTree(
+      NewTreeRoot(attributes1Name),
+      argNoName,NewTree(
+         NewTree(
+            NewTreeRoot(Library.addName.indirection),
+            Library.argName1,argNoName),
+         Library.argName2,Library.NewNumber(1))));
+*)
+   subSentenceName.Init(NewContinuation(
+      NewCharTerminal('('),NewContinuation(
+      sentenceName,
+      NewCharTerminal(')'))));
+   attributeName.Init(NewDisjunction(
+      NewGrammarTree(
+         Grammars.genericAttrName,NewContinuation(
+         NewAttribute(Grammars.propertyName,
+            Grammars.nameParser),NewContinuation(
+         NewCharTerminal('='),
+         NewAttribute(Grammars.valueName,exprName)))),
+      NewContinuation(
+         numberToIdName,
+         NewGrammarTree(Grammars.attrName,exprName))));
+   disjunctionName.Init(NewGrammarTree(
+      Grammars.disjunctionName,NewContinuation(
+      NewAttribute(Library.argName1,sExprName),NewContinuation(
+      NewCharTerminal('|'),
+      NewAttribute(Library.argName2,sentenceName)))));
+   sequenceName.Init(NewGrammarTree(
+      Grammars.continuationName,NewContinuation(
+      NewAttribute(Library.argName1,exprName),NewContinuation(
+      NewCharTerminal(';'),
+      NewAttribute(Library.argName2,sExprName)))));
+   qualificationName.Init(NewGrammarTree(
+      Grammars.continuationName,NewContinuation(
+      NewAttribute(Library.argName1,Grammars.nameParser),NewContinuation(
+      NewCharTerminal('.'),
+      NewAttribute(Library.argName2,NewDisjunction(
+         treeName,
+         qualificationName))))));
+   fieldName.Init(NewGrammarTree(
+      Grammars.fieldName,NewContinuation(
+      NewAttribute(Library.argName1,Grammars.nameParser),NewContinuation(
+      NewCharTerminal('.'),
+      NewAttribute(Library.argName2,NewDisjunction(
+         Grammars.nameParser,
+         fieldName))))));
+   blockParser.Init(NewContinuation(
+      NewStringTerminal('LOCAL'),
+      NewGrammarTree(
+         Grammars.blockName,NewContinuation(
+            NewTree(
+               NewTreeRoot(Names.localName),
+               Names.bodyName,blockLocalsName),
+            NewAttribute(Grammars.rootName,sentenceName)))));
+   blockLocalsName.Init(NewContinuation(
+      NewGrammarTree(
+         Grammars.genericAttrName,NewContinuation(
+         NewAttribute(Grammars.propertyName,
+            Grammars.nameParser),
+         NewAttribute(Grammars.valueName,
+            NewTree(
+               NewTreeRoot(dummyName),
+               Grammars.treeName,AGRS.Variable)))),
+      NewDisjunction(
+         NewStringTerminal('IN'),
+         NewContinuation(
+            NewCharTerminal(','),
+            blockLocalsName))));
+   varParser.Init(NewContinuation(
+      NewStringTerminal('VAR'),
+      NewTree(
+         NewClassRoot(dummyName),
+         Grammars.treeName,AGRS.Variable)));
+   ruleParser.Init(NewContinuation(
+      NewStringTerminal('RULE'),NewContinuation(
+      NewCharTerminal('('),
+      rulesParser)));
+   rulesParser.Init(NewGrammarTree(
+      Grammars.disjunctionName,NewContinuation(
+         NewAttribute(Library.argName1,alternativeName),
+         NewAttribute(Library.argName2,NewDisjunction(
+            NewContinuation(
+               NewCharTerminal(')'),
+               NewTree(NewClassRoot(Grammars.constructName),
+                  Grammars.rootName,AGRS.failName)),
+            NewContinuation(
+               NewCharTerminal(','),
+               rulesParser))))));
+   alternativeName.Init(NewContinuation(
+      NewTree(NewTreeRoot(dummyName),     (* shall it stay class? *)
+         Grammars.treeName,NewClassRoot(dummyName)),NewContinuation(
+      NewAttribute(lhsName,treeName),NewContinuation(
+      NewCharTerminal('='),NewContinuation(
+      NewAttribute(rhsName,sExprName),NewContinuation(
+      Grammars.treeName,
+      altBuilder))))));
+   guardParser.Init(NewContinuation(
+      NewStringTerminal('GUARD'),
+      NewTree(
+         NewClassRoot(dummyName),
+         Grammars.treeName,AGRS.GuardTrap)));
+   Grammars.grammarName.Init(sentenceName);
+   NEW(customIdTerm);
+   customIdTerm.Init(Grammars.idParser);
+   customIdTerm.InitQuery(Grammars.treeName);
+   NEW(collection);
+   collection.Init(Names.SystemRoot);
+   collection.AddProperty(rulesName,ruleParser);
+   collection.AddProperty(varName,varParser);
+   collection.AddProperty(blockName,blockParser);
+   collection.AddProperty(className,classParser);
+   collection.AddProperty(guardName,guardParser);
+   collection.AddProperty(AGRS.otherwise,treeName);
+   customParsersName.Init(collection);
+END Parser2.
+
+ examples/AGRS/Perm.Mod view
@@ -0,0 +1,215 @@+MODULE Permanence;
+IMPORT AGRS,Names,Library,Parser,Texts,Directories,Grammars;
+
+CONST
+   PathDelimiter= '\';
+   MaxPathLength= 200;
+
+TYPE
+   Term= AGRS.Term;
+   FilePrimitive= POINTER TO FilePrimitiveDesc;
+   FilePrimitiveDesc= RECORD(AGRS.SubTermDesc)
+   END;
+   FolderPrimitive= POINTER TO RECORD(FilePrimitiveDesc)
+   END;
+VAR
+   folderRoot, directoryName, extensionName: AGRS.Name;
+   environmentName*: AGRS.Name;
+   directory: AGRS.Class;
+   dirTerm, currentFolder: AGRS.Term;
+   i,length: INTEGER;
+
+(*
+PROCEDURE Position(t: AGRS.Var; VAR file: Files.File; VAR startPos,endPos: LONGINT);
+PROCEDURE Replace(t: AGRS.Var; file: File.File; startPos,endPos: LONGINT; VAR replacement: ARRAY OF CHAR);
+PROCEDURE WriteText*(t: AGRS.Var; VAR definition: ARRAY OF CHAR);
+PROCEDURE ReadBuffer*(t: AGRS.Var; VAR definition: ARRAY OF CHAR; startPos: LONGINT);
+PROCEDURE ReadText*(t: AGRS.Var): CharPtr;
+PROCEDURE WriteTerm*(t: AGRS.Var; definition: AGRS.Term);
+PROCEDURE WriteDefinition*(t: AGRS.Var);
+PROCEDURE Definition*(t: AGRS.Var): AGRS.Term;
+
+PROCEDURE WriteHandler;
+VAR
+   path: AGRS.SubTerm;
+BEGIN
+   path:= AGRS.EnvironmentPath(directoryName);
+   WriteDefinition(path);
+   RETURN Library.doneName
+END WriteHandler;
+*)
+
+PROCEDURE CorrectExtension(VAR filename: ARRAY OF CHAR): BOOLEAN;
+VAR
+   extension: AGRS.Term;
+   suffix: Names.CharPtr;
+   pos1,pos2: INTEGER;
+BEGIN
+   extension:= extensionName.Value();
+   WITH extension: Library.String DO
+      suffix:= extension.value;
+      pos1:= 0;
+      pos2:= 0;
+      WHILE filename[pos1]#0X DO
+         INC(pos1);
+      END;
+      WHILE suffix[pos2]#0X DO
+         INC(pos2);
+      END;
+      ASSERT(pos2>3);
+      WHILE (filename[pos1]=suffix[pos2]) & (pos1>0) & (pos2>0) DO
+         DEC(pos1);
+         DEC(pos2);
+      END;
+      IF (pos2=0) & (filename[pos1]=suffix[pos2]) THEN
+         filename[pos1]:= 0X;
+         RETURN TRUE
+      END;
+   END;
+   RETURN FALSE
+END CorrectExtension;      
+
+PROCEDURE GetPath(pathTerm: Term; VAR pathString: ARRAY OF CHAR);
+VAR
+   i,length: INTEGER;
+   dir: Names.CharPtr;
+
+   PROCEDURE WritePath(t: Term);
+   VAR
+      t2: Term;
+   BEGIN
+      t2:= t;
+      WITH t2: FilePrimitive DO
+         WritePath(t2.indirection);
+         WritePath(t2.query);
+      ELSE
+         dir:= Names.NameSpelling(t(AGRS.Name));
+         i:= 0;
+         WHILE dir[i]#0X DO
+            pathString[length]:= dir[i];
+            INC(length);
+            INC(i);
+         END;
+         pathString[length]:= PathDelimiter;
+         INC(length);
+      END;
+   END WritePath;
+BEGIN
+   length:= 0;
+   WritePath(pathTerm);
+   pathString[length-1]:= 0X;
+END GetPath;
+      
+PROCEDURE InitFile(dir: Directories.Directory; filename: ARRAY OF CHAR;
+                  isDir: BOOLEAN; VAR cont: BOOLEAN);
+VAR
+   def: AGRS.Name;
+   newTerm1: FolderPrimitive;
+   newTerm: FilePrimitive;
+BEGIN
+   cont:= TRUE;
+   IF isDir THEN
+      IF filename[0]='.' THEN
+         RETURN
+      END;
+      NEW(newTerm1);
+      newTerm:= newTerm1;
+   ELSE
+      IF ~CorrectExtension(filename) THEN
+         RETURN
+      END;
+      NEW(newTerm);
+   END;
+   def:= Names.FindPublicNameNoCase(filename);
+   IF def=NIL THEN
+      Names.AddArgument(def,filename);
+   END;
+   newTerm.Init(currentFolder);
+   newTerm.InitQuery(def);
+   directory.AddProperty(def,newTerm);
+END InitFile;
+
+PROCEDURE InitFiles(t: AGRS.Term): AGRS.Term;
+VAR
+   path: ARRAY MaxPathLength OF CHAR;
+BEGIN
+   currentFolder:= t;
+   NEW(directory);
+   directory.Init(folderRoot);
+   directory.AddProperty(directoryName,t);
+   GetPath(t,path);
+   Directories.Enumerate(Directories.This(path),InitFile);
+   RETURN directory
+END InitFiles;
+
+PROCEDURE RefreshFolder(dir,value: AGRS.Term);
+BEGIN
+   IF dir IS FolderPrimitive THEN
+      dir:= dir(FolderPrimitive).query;
+   END;      
+   dir.indirection(AGRS.Class).
+       AddProperty(AGRS.lastResult(AGRS.Name),value);
+END RefreshFolder;
+
+PROCEDURE (t: FolderPrimitive) Reduce*;
+VAR
+   newDir: Term;
+BEGIN
+   newDir:= InitFiles(t);
+   RefreshFolder(t.indirection,newDir);
+   t.query(AGRS.Name).Assign(newDir);
+   newDir.Reduce;
+   t.query(AGRS.Name).Restore;
+END Reduce;
+
+PROCEDURE (t: FilePrimitive) Reduce*;
+VAR
+   f: Texts.Text;
+   i,j: INTEGER;
+   strPtr: Names.CharPtr;
+   filename: ARRAY MaxPathLength OF CHAR;
+   result: AGRS.Term;
+BEGIN
+   GetPath(t,filename);
+   j:= 0;
+   WHILE filename[j]#0X DO
+      INC(j);
+   END;
+(*
+   strPtr:= Names.NameSpelling(AGRS.lastResult(AGRS.Name));
+   i:= 0;
+   WHILE strPtr[i]#0X DO
+      filename[j]:= strPtr[i];
+      INC(i);
+      INC(j);
+   END;
+*)
+   result:= extensionName.Value();
+   WITH result: Library.String DO
+      strPtr:= result.value;
+      i:= 0;
+      WHILE strPtr[i]#0X DO
+         filename[j]:= strPtr[i];
+         INC(i);
+         INC(j);
+      END;
+   END;
+   filename[j]:= 0X;
+   NEW(f);
+   Texts.Open(f,filename);
+   Grammars.sentenceName.Assign(Library.SubText(f,0,f.len));
+   result:= Grammars.parseName.Value();
+   Grammars.sentenceName.Restore();
+   RefreshFolder(t.indirection,result);
+   result.Reduce;
+END Reduce;
+
+BEGIN
+   Names.AddArgument(folderRoot, 'FolderClass');
+   Names.AddArgument(directoryName, 'Directory');
+   Names.AddArgument(extensionName, 'FileExtension');
+   Names.AddArgument(environmentName, 'Env');
+   extensionName.Init(Library.NewString(Names.NewStringCopy('.ATG')));
+   environmentName.Init(InitFiles(environmentName));
+END Permanence.
+
+ examples/AGRS/Permanence.Mod view
@@ -0,0 +1,220 @@+MODULE Permanence;
+IMPORT AGRS,Names,Library,Parser,Texts,Directories,Grammars;
+
+CONST
+   PathDelimiter= '\';
+   MaxPathLength= 200;
+
+TYPE
+   Term= AGRS.Term;
+   FilePrimitive= POINTER TO FilePrimitiveDesc;
+   FilePrimitiveDesc= RECORD(AGRS.SubTermDesc)
+   END;
+   FolderPrimitive= POINTER TO RECORD(FilePrimitiveDesc)
+   END;
+VAR
+   folderRoot, directoryName, extensionName: AGRS.Name;
+   environmentName*: AGRS.Name;
+   directory: AGRS.Class;
+   dirTerm, currentFolder: AGRS.Term;
+   i,length: INTEGER;
+
+(*
+PROCEDURE Position(t: AGRS.Var; VAR file: Files.File; VAR startPos,endPos: LONGINT);
+PROCEDURE Replace(t: AGRS.Var; file: File.File; startPos,endPos: LONGINT; VAR replacement: ARRAY OF CHAR);
+PROCEDURE WriteText*(t: AGRS.Var; VAR definition: ARRAY OF CHAR);
+PROCEDURE ReadBuffer*(t: AGRS.Var; VAR definition: ARRAY OF CHAR; startPos: LONGINT);
+PROCEDURE ReadText*(t: AGRS.Var): CharPtr;
+PROCEDURE WriteTerm*(t: AGRS.Var; definition: AGRS.Term);
+PROCEDURE WriteDefinition*(t: AGRS.Var);
+PROCEDURE Definition*(t: AGRS.Var): AGRS.Term;
+
+PROCEDURE WriteHandler;
+VAR
+   path: AGRS.SubTerm;
+BEGIN
+   path:= AGRS.EnvironmentPath(directoryName);
+   WriteDefinition(path);
+   RETURN Library.doneName
+END WriteHandler;
+*)
+
+PROCEDURE CorrectExtension(VAR filename: ARRAY OF CHAR): BOOLEAN;
+VAR
+   extension: AGRS.Term;
+   suffix: Names.CharPtr;
+   pos1,pos2: INTEGER;
+BEGIN
+   extension:= extensionName.Value();
+   WITH extension: Library.String DO
+      suffix:= extension.value;
+      pos1:= 0;
+      pos2:= 0;
+      WHILE filename[pos1]#0X DO
+         INC(pos1);
+      END;
+      WHILE suffix[pos2]#0X DO
+         INC(pos2);
+      END;
+      ASSERT(pos2>3);
+      WHILE (filename[pos1]=suffix[pos2]) & (pos1>0) & (pos2>0) DO
+         DEC(pos1);
+         DEC(pos2);
+      END;
+      IF (pos2=0) & (filename[pos1]=suffix[pos2]) THEN
+         filename[pos1]:= 0X;
+         RETURN TRUE
+      END;
+   END;
+   RETURN FALSE
+END CorrectExtension;      
+
+PROCEDURE GetPath(pathTerm: Term; VAR pathString: ARRAY OF CHAR);
+VAR
+   i,length: INTEGER;
+   dir: Names.CharPtr;
+
+   PROCEDURE WritePath(t: Term);
+   VAR
+      t2: Term;
+   BEGIN
+      t2:= t;
+      WITH t2: FilePrimitive DO
+         WritePath(t2.indirection);
+         WritePath(t2.query);
+      ELSE
+         dir:= Names.NameSpelling(t(AGRS.Name));
+         i:= 0;
+         WHILE dir[i]#0X DO
+            pathString[length]:= dir[i];
+            INC(length);
+            INC(i);
+         END;
+         pathString[length]:= PathDelimiter;
+         INC(length);
+      END;
+   END WritePath;
+BEGIN
+   length:= 0;
+   WritePath(pathTerm);
+   pathString[length-1]:= 0X;
+END GetPath;
+      
+PROCEDURE InitFile(dir: Directories.Directory; filename: ARRAY OF CHAR;
+                  isDir: BOOLEAN; VAR cont: BOOLEAN);
+VAR
+   def: AGRS.Name;
+   newTerm1: FolderPrimitive;
+   newTerm: FilePrimitive;
+BEGIN
+   cont:= TRUE;
+   IF isDir THEN
+      IF filename[0]='.' THEN
+         RETURN
+      END;
+      NEW(newTerm1);
+      newTerm:= newTerm1;
+   ELSE
+      IF ~CorrectExtension(filename) THEN
+         RETURN
+      END;
+      NEW(newTerm);
+   END;
+   def:= Names.FindPublicNameNoCase(filename);
+   IF def=NIL THEN
+      Names.AddArgument(def,filename);
+   END;
+   newTerm.Init(currentFolder);
+   newTerm.InitQuery(def);
+   directory.AddProperty(def,newTerm);
+END InitFile;
+
+PROCEDURE InitFiles(t: AGRS.Term): AGRS.Term;
+VAR
+   path: ARRAY MaxPathLength OF CHAR;
+BEGIN
+   currentFolder:= t;
+   NEW(directory);
+   directory.Init(folderRoot);
+   directory.AddProperty(directoryName,t);
+   GetPath(t,path);
+   Directories.Enumerate(Directories.This(path),InitFile);
+   RETURN directory
+END InitFiles;
+
+PROCEDURE (t: FilePrimitive) RefreshValue(value: AGRS.Term);
+VAR
+   dir: AGRS.Term;
+BEGIN
+   dir:= t.indirection;
+   IF dir IS FolderPrimitive THEN
+      dir:= dir(FolderPrimitive).query;
+   END;
+   dir:= dir(AGRS.Name).indirection;
+   dir(AGRS.Class).AddProperty(t.query(AGRS.Name),value);
+END RefreshValue;
+
+PROCEDURE (t: FolderPrimitive) Reduce*;
+VAR
+   newDir: Term;
+BEGIN
+   newDir:= InitFiles(t);
+   t.RefreshValue(newDir);
+   t.query(AGRS.Name).Assign(newDir);
+   newDir.Reduce;
+   t.query(AGRS.Name).Restore;
+END Reduce;
+
+PROCEDURE (t: FilePrimitive) Reduce*;
+VAR
+   f: Texts.Text;
+   i,j: INTEGER;
+   strPtr: Names.CharPtr;
+   filename: ARRAY MaxPathLength OF CHAR;
+   result: AGRS.Term;
+BEGIN
+   GetPath(t,filename);
+   j:= 0;
+   WHILE filename[j]#0X DO
+      INC(j);
+   END;
+(*
+   strPtr:= Names.NameSpelling(AGRS.lastResult(AGRS.Name));
+   i:= 0;
+   WHILE strPtr[i]#0X DO
+      filename[j]:= strPtr[i];
+      INC(i);
+      INC(j);
+   END;
+*)
+   result:= extensionName.Value();
+   WITH result: Library.String DO
+      strPtr:= result.value;
+      i:= 0;
+      WHILE strPtr[i]#0X DO
+         filename[j]:= strPtr[i];
+         INC(i);
+         INC(j);
+      END;
+   END;
+   filename[j]:= 0X;
+   NEW(f);
+   Texts.Open(f,filename);
+   Grammars.sentenceName.Assign(Library.SubText(f,0,f.len));
+   result:= Grammars.parseName.Value();
+   Grammars.sentenceName.Restore();
+   IF result.indirection#AGRS.failName THEN
+      t.RefreshValue(result);
+   END;
+   result.Reduce;
+END Reduce;
+
+BEGIN
+   Names.AddArgument(folderRoot, 'FolderClass');
+   Names.AddArgument(directoryName, 'Directory');
+   Names.AddArgument(extensionName, 'FileExtension');
+   Names.AddArgument(environmentName, 'Env');
+   extensionName.Init(Library.NewString(Names.NewStringCopy('.ATG')));
+   environmentName.Init(InitFiles(environmentName));
+END Permanence.
+
+ examples/AGRS/Pictures.Def view
@@ -0,0 +1,137 @@+(*+https://web.archive.org/web/20050219180235/http://www.oberon.ethz.ch:80/ethoberon/defs/Pictures.Def.html+*)+DEFINITION Pictures; (* portable, except where noted *)++(*Module Pictures implement an abstract data type (and object type) for manipulating+colored bitmaps of various color depths.+*)+ IMPORT Files, Display, Objects;++ CONST+  redraw = 4; resize = 5; (* UpdateMsg id. *)+  PictFileId = - 4093;  (* First two bytes of a .Pict file (0F0H, 3H). *)++ TYPE+  Picture = POINTER TO PictureDesc;+  UpdateMsg = RECORD ( Display.FrameMsg ) +   id, u, v, w, h: INTEGER;+   pict: Picture;+  END;++  PictureDesc = RECORD ( Objects.ObjDesc ) +   width, height, depth: INTEGER; (* Width, height in pixels, and depth in+bits per pixel (1, 4, or 8). *)+   address: LONGINT; (* non-portable *) (* Pointer to bitmap data. *)+  END;++ VAR +  dots: Display.Pattern;+  colorD: INTEGER; (* Default bitmap color depth. *)++(* Get the color index of the bitmap pixel at X, Y. *)+ PROCEDURE Get (P: Picture; X, Y: INTEGER): INTEGER;++(* Put a pixel of color col at x, y using mode. *)+ PROCEDURE Dot (P: Picture; col: INTEGER; X, Y, mode: INTEGER);++(* Starting at position x, y, determine the longest run of the same colored+pixels (col) on the same scanline. Afterwards x indicates the first pixel of+a different color thatn col. *)+ PROCEDURE GetRun (P: Picture; VAR col: INTEGER; VAR X: INTEGER; Y: INTEGER);++(* Copy a the block sx, sy, w, h from picture sP to position dx, dy in destination+picture dP. Source and destination picture may be the same. *)+ PROCEDURE CopyBlock (sP, dP: Picture; SX, SY, W, H, DX, DY, mode: INTEGER);++(* Copy the pattern pat in color col to position x, y using mode. *)+ PROCEDURE CopyPattern (P: Picture; col: INTEGER; pat: LONGINT; X, Y, mode: INTEGER);++(* Block fill area x, y, w, h in color col using mode. *)+ PROCEDURE ReplConst (P: Picture; col, X, Y, W, H, mode: INTEGER);++(* Pattern fill pattern pat in the area x, y, w, h in color col using mode.+*)+ PROCEDURE ReplPattern (P: Picture; col: INTEGER; pat: LONGINT; X, Y, W, H, mode: INTEGER);++(* Copy area SX, SY, SW, SH of source picture sP to area DX, DY, DW, DH of destination+picture dP. Appropriate scaling is done. *)+ PROCEDURE Copy (sP, dP: Picture; SX, SY, SW, SH, DX, DY, DW, DH, mode: INTEGER);++(* Define the color palette for color index col. *)+ PROCEDURE SetColor (P: Picture; col, red, green, blue: INTEGER);++(* Retrieve the color palette entry for color index col. *)+ PROCEDURE GetColor (P: Picture; col: INTEGER; VAR red, green, blue: INTEGER);++(* Indicate that a change has been made to the area X, Y, W, H of P. This results+in an UpdateMsg with id = redraw to be broadcasted into the display space. *)+ PROCEDURE Update (P: Picture; X, Y, W, H: INTEGER);++(* Copy the area x, y, w, h of picture P to position dx, dy on the display.+*)+ PROCEDURE DisplayBlock (P: Picture; X, Y, W, H, DX, DY, mode: INTEGER);++(* Create a picture of size width x height with depth bits per pixel. The picture+palette is initialized to a default state. If not enough memory is available+to allocate the bitmap data, the width, height, and depth of the picture is+set to zero. *)+ PROCEDURE Create (P: Picture; width, height, depth: INTEGER);++(* Like Dot, for a line of pixels. *)+ PROCEDURE PutLine (P: Picture; VAR data: ARRAY OF INTEGER; x, y, w: INTEGER);++(* Like Get, for a line of pixels. *)+ PROCEDURE GetLine (P: Picture; VAR data: ARRAY OF INTEGER; x, y, w: INTEGER);++(* Stores picture run length encoded to file F (including tag). *)+ PROCEDURE Store (P: Picture; F: Files.File; pos: LONGINT; VAR len: LONGINT);++(* Load a run length encoded picture from position pos from file F. Pos should+be AFTER the two byte picture identification of a picture file. *)+ PROCEDURE Load (P: Picture; F: Files.File; pos: LONGINT; VAR len: LONGINT);++(* Open the picture file with name from disk. Any graphic file format listed+in the PictureConverters section of Oberon.Text can be loaded (e.g. GIF, JPEG,+XBM, BMP). *)+ PROCEDURE Open (P: Picture; name: ARRAY OF CHAR; color: BOOLEAN);++(* Returns the address of the bitmap data of a picture. *)+ PROCEDURE Address (P: Picture): LONGINT; (* non-portable *)++(* Default picture object handler. *)+ PROCEDURE Handle (obj: Objects.Object; VAR msg: Objects.ObjMsg);++(* Generator for a picture object. *)+ PROCEDURE NewPicture;+END Pictures.++(* Remarks++1. The origin (0, 0) is the bottom left corner of a bitmap. A picture has a+bitmap and a color palette. The color palette specifies the reg, green, blue+components (in the range 0 - 255) of the color indexes in the bitmap data. Only+palettized bitmaps are supported in depths of 1, 4, and 8 bits per pixel. On+most Oberon platforms the color palette of a picture is ignored when displaying+the picture. Instead the picture is displayed with the current screen palette.+To see the true colors of a picture, the picture palette has to be copied into+the screen palette.++2. The drawing modes are the same as that of module Display (replace, paint,+invert). After drawing into a picture, a module should indicate using procedure+Update what area of the picture should be displayed fresh.++3. On many Oberon platforms the address of the bitmap data is set to zero. This+indicates that it is impossible to access the bitmap directly.++4. Native Oberon only supports bit depths of 8 bits per pixel.++5. When opening a GIF picture with Pictures.Open, the GIF background color is+burned in to color 14 (light grey).++6. Implementation restriction+Picture objects cannot be named or have attributes (see module Attributes).+Picture objects only understand the messages Objects.FileMsg, Objects.CopyMsg+and Objects.BindMsg.++*)
+ examples/AGRS/SYSTEM.Def view
@@ -0,0 +1,18 @@+DEFINITION SYSTEM;++TYPE BYTE * = CHAR;+TYPE IntPtr = POINTER TO INTEGER;++PROCEDURE ADR(v: INTEGER): LONGINT;+PROCEDURE BIT(a: LONGINT; n: SHORTINT): BOOLEAN;+PROCEDURE CC(n: SHORTINT): BOOLEAN;+PROCEDURE LSH(x: INTEGER; n: SHORTINT): INTEGER;+PROCEDURE ROT(x: INTEGER; n: SHORTINT): INTEGER;+PROCEDURE VAL(T: INTEGER; x: INTEGER) : INTEGER;++PROCEDURE GET(a: LONGINT; VAR v: INTEGER);+PROCEDURE PUT(a: LONGINT; v: INTEGER);+PROCEDURE MOVE(s, d: LONGINT; n: INTEGER);+PROCEDURE NEW(v: IntPtr; n: INTEGER);++END SYSTEM.
+ examples/AGRS/Speller.Mod view
@@ -0,0 +1,405 @@+MODULE Speller;
+IMPORT AGRS,Names,Library,Texts,TextFrames;
+
+
+CONST
+   SetBits= MAX(SET)+1;
+   TabChar= 9X;
+TYPE
+
+   SpellingHandlerType= PROCEDURE(t: AGRS.Term): AGRS.Term;
+   SpellingWrapper= POINTER TO RECORD(AGRS.TermDesc)
+      handler: SpellingHandlerType;
+   END;
+VAR
+   FindSpelling: SpellingHandlerType;
+   spelledTextName,spellingName*,spellingsName*: AGRS.Name;
+   thoughtName*,nameSpellingName,indentionName: AGRS.Name;
+   standardSpellingName: AGRS.Name;
+
+
+   sys: SpellingWrapper;
+   collection: AGRS.ClosedClass;
+
+   spelled: Texts.Text; (* Akumulira spelovani tekst. *)
+   wr: Texts.Writer; 
+   firstAttr: BOOLEAN; (* Da li je prvi spelovani atribut ili ne. *)
+
+(* Sljedece je u planu.
+
+   grammarSpellMeanings: AGRS.Class;
+   grammarSpellingName: AGRS.Name;
+
+PROCEDURE GrammarTermSpellings(query: AGRS.Term): AGRS.Term;
+VAR
+   result: AGRS.Term;
+BEGIN
+   IF query=NIL THEN
+      NEW(result);
+      result.Init(AGRS.lastName);
+   ELSE
+      result:= Grammars.grammarsName.Evaluate(query);
+      Grammars.grammarName.Assign(result);
+      Library.thoughtName.Assign(query);
+      result:= grammarSpellingName.Value();
+      Library.thoughtName.Restore();
+      Grammars.grammarName.Restore();
+   END;
+   RETURN result
+END GrammarTermSpellings;
+
+PROCEDURE GrammarSpelling(): AGRS.Term;
+BEGIN
+   RETURN grammarSpellMeanings.Evaluate(grammarName);
+END GrammarSpelling;
+*)
+
+
+PROCEDURE NewText(): Library.Text;
+VAR
+   oldLength: LONGINT;
+BEGIN
+   oldLength:= spelled.len;
+   Texts.Append(spelled,wr.buf);
+   RETURN Library.SubText(spelled,oldLength,spelled.len)
+END NewText;
+
+PROCEDURE pNameSpelling();
+VAR
+   s: AGRS.Term;
+BEGIN
+   s:= Library.NewString(Names.NameSpelling(thoughtName.indirection));
+   s.Reduce;
+END pNameSpelling;
+
+
+
+PROCEDURE SpellAttribute(name: AGRS.Name; VAR t: AGRS.Term);
+VAR
+   nameSpellPtr: Names.CharPtr;
+   spelled: Library.Text;
+   meaning,indention: AGRS.Term;
+   i: INTEGER;
+BEGIN
+   IF firstAttr THEN
+      firstAttr:= FALSE;
+   ELSE
+      Texts.Write(wr,',');
+      Texts.Write(wr,' ');
+   END;
+   Texts.WriteLn(wr);
+   indention:= indentionName.Value();
+   IF indention IS Library.Number THEN
+      FOR i:= 1 TO indention(Library.Number).value DO
+         Texts.Write(wr,TabChar);
+      END;
+   END;
+   nameSpellPtr:= Names.NameSpelling(name);
+   Texts.WriteString(wr,nameSpellPtr^);
+   Texts.Write(wr,'=');
+   spelled:= spelledTextName.indirection(Library.Text);
+   spelled.AppendBuffer(wr.buf);
+   thoughtName.Assign(t);
+   IF (t IS AGRS.SubTerm) & ~(t.indirection IS AGRS.Name) OR
+         (t IS AGRS.Disjunction) THEN
+      Texts.Write(wr,'(');
+      Texts.WriteLn(wr);
+      FOR i:= 1 TO indention(Library.Number).value+1 DO
+         Texts.Write(wr,TabChar);
+      END;
+      indentionName.Assign(
+            Library.NewNumber(indention(Library.Number).value+1));
+      spelled.AppendBuffer(wr.buf);
+      meaning:= standardSpellingName.Value();
+      indentionName.Restore();
+      Texts.Write(wr,')');
+      meaning(Library.Text).AppendBuffer(wr.buf);
+   ELSE
+      meaning:= FindSpelling(t);
+   END;
+   thoughtName.Restore();
+   IF meaning IS Library.Text THEN
+      spelled.AppendText(meaning(Library.Text));
+   ELSE
+      Texts.WriteString(wr,'!@# Unspellable! ');
+      spelled.AppendBuffer(wr.buf);
+   END;
+END SpellAttribute;
+
+
+PROCEDURE StandardSpelling(query: AGRS.Term): AGRS.Term;
+VAR
+   result: Library.Text;
+   nameSpellPtr: Names.CharPtr;
+   rest,indention: AGRS.Term;
+   i: INTEGER;
+BEGIN
+   IF query IS AGRS.SystemTerm THEN
+      IF query=AGRS.GuardTrap THEN
+         Texts.WriteString(wr,'GUARD');
+      ELSE
+         Texts.WriteString(wr,'#SYSTEM!');
+      END;
+      RETURN NewText()
+   END;
+   indention:= indentionName.Value();
+   IF (query IS AGRS.SubTerm) OR (query IS AGRS.Field) OR 
+            (query IS AGRS.Disjunction) THEN
+      rest:= FindSpelling(query.indirection);
+      IF query IS AGRS.Disjunction THEN
+         Texts.WriteString(wr,' | ');
+         result:= rest(Library.Text);
+         rest:= query(AGRS.Disjunction).alternative;
+      ELSE
+         IF query.indirection IS AGRS.Name THEN
+            Texts.Write(wr,'.');
+         ELSE
+            Texts.Write(wr,';');
+            Texts.WriteLn(wr);
+            FOR i:= 1 TO indention(Library.Number).value DO
+               Texts.Write(wr,TabChar);
+            END;
+         END;
+         result:= rest(Library.Text);
+         rest:= query(AGRS.SubTerm).query;
+      END;
+      result.AppendBuffer(wr.buf);
+      rest:= FindSpelling(rest);
+      result.AppendText(rest(Library.Text));
+      RETURN result
+   ELSIF query IS AGRS.Name THEN
+      nameSpellPtr:= Names.NameSpelling(query);
+      Texts.WriteString(wr,nameSpellPtr^);
+      RETURN NewText()
+   ELSE
+      IF query IS AGRS.Block THEN
+         Texts.WriteString(wr,'LOCAL ');
+      ELSE
+         nameSpellPtr:= Names.NameSpelling(query.indirection);
+         Texts.WriteString(wr,nameSpellPtr^);
+      END;
+      Texts.Write(wr,'(');
+      result:= NewText();
+      IF query IS AGRS.Tree THEN
+         WITH query: AGRS.Tree DO
+            spelledTextName.Assign(result);
+            firstAttr:= TRUE;
+            WITH indention: Library.Number DO
+               indentionName.Assign(
+                     Library.NewNumber(indention.value+1));
+               query.ProcessAttributes(SpellAttribute);
+               indentionName.Restore();
+            ELSE
+               query.ProcessAttributes(SpellAttribute);
+            END;
+            result:= spelledTextName.indirection(Library.Text);
+            spelledTextName.Restore();
+         END;
+      END;
+      Texts.Write(wr,')');
+      result(Library.Text).AppendBuffer(wr.buf);
+      IF query IS AGRS.Block THEN
+         Texts.WriteString(wr,' IN ');
+         result(Library.Text).AppendBuffer(wr.buf);
+         rest:= FindSpelling(query.indirection);
+         result.AppendText(rest(Library.Text));
+      END;
+      RETURN result
+   END;
+END StandardSpelling;
+
+
+PROCEDURE NumberSpelling(query: AGRS.Term): AGRS.Term;
+BEGIN
+   WITH query: Library.Number DO
+      Texts.WriteInt(wr,query.value,0);
+      RETURN NewText()
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END NumberSpelling;
+
+
+PROCEDURE CharSpelling(query: AGRS.Term): AGRS.Term;
+BEGIN
+   WITH query: Library.Character DO
+      Texts.Write(wr,"'");
+      Texts.Write(wr,query.value);
+      Texts.Write(wr,"'");
+      RETURN NewText()
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END CharSpelling;
+
+
+PROCEDURE CharSetSpelling(query: AGRS.Term): AGRS.Term;
+VAR
+   ch: CHAR;
+   first: BOOLEAN;
+BEGIN
+   WITH query: Library.CharSet DO
+      ch:= MIN(CHAR);
+      Texts.Write(wr,'{');
+      first:= TRUE;
+      LOOP
+         IF ((ch=0DX) & (0AH MOD SetBits IN query.value[0AH DIV SetBits])) THEN
+            ch:= CHR(ORD(ch)+1);
+         END;
+         IF ORD(ch) MOD SetBits IN query.value[ORD(ch) DIV SetBits] THEN
+            IF ~first THEN
+               Texts.Write(wr,',');
+            END;
+            first:= FALSE;
+            IF (ch<=' ') THEN
+               Texts.Write(wr,'\');
+               CASE ch OF
+                  |9X: Texts.Write(wr,'T');
+                  |' ': Texts.Write(wr,'S');
+                  |0AX,0DX: Texts.Write(wr,'N');
+                  |0X: Texts.Write(wr,'0');
+               ELSE
+                  Texts.Write(wr,'?');
+               END;
+            ELSE
+               IF (ch=',') OR (ch='}') OR (ch='{') OR (ch='\') THEN
+                  Texts.Write(wr,'\');
+               END;
+               Texts.Write(wr,ch);
+               IF (ORD(ch)+1) MOD SetBits IN 
+                     query.value[(ORD(ch)+1) DIV SetBits] THEN
+                  REPEAT
+                     ch:= CHR(ORD(ch)+1);
+                  UNTIL ~(ORD(ch) MOD SetBits IN 
+                        query.value[ORD(ch) DIV SetBits]);
+                  ch:= CHR(ORD(ch)-1);
+                  Texts.Write(wr,'-');
+                  IF (ch=',') OR (ch='}') OR (ch='{') OR (ch='\') THEN
+                     Texts.Write(wr,'\');
+                  END;
+                  Texts.Write(wr,ch);
+               END;
+            END;
+         END;
+         IF ch<MAX(CHAR) THEN
+            ch:= CHR(ORD(ch)+1);
+         ELSE
+            EXIT
+         END
+      END;
+      Texts.Write(wr,'}');
+      RETURN NewText()
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END CharSetSpelling;
+
+
+PROCEDURE StringSpelling(query: AGRS.Term): AGRS.Term;
+BEGIN
+   WITH query: Library.String DO
+      Texts.Write(wr,'"');
+      Texts.WriteString(wr,query.value^);
+      Texts.Write(wr,'"');
+      RETURN NewText()
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END StringSpelling;
+   
+
+PROCEDURE ErrorSpelling(query: AGRS.Term): AGRS.Term;
+BEGIN
+   WITH query: Library.Error DO
+      CASE query.value OF
+         Library.NotLogicalType: Texts.WriteString(wr,'Not the logical type!');
+         |Library.NotNumberType: Texts.WriteString(wr,'Not the number type!');
+         |Library.NotStringType: Texts.WriteString(wr,'Not the string type!');
+         |Library.NotCharacterType: Texts.WriteString(wr,'Not the character type!');
+         |Library.NotTextType: Texts.WriteString(wr,'Not the text type!');
+         |Library.SyntaxError: Texts.WriteString(wr,'Syntax error!');
+         |Library.NotFound: Texts.WriteString(wr,'Undefined word meaning!');
+      END;
+      RETURN NewText()
+   ELSE
+      RETURN AGRS.Failure
+   END;
+END ErrorSpelling;
+
+PROCEDURE VarSpelling(query: AGRS.Term): AGRS.Term;
+BEGIN
+   HALT(255);
+   Texts.WriteString(wr,'VAR');
+   RETURN NewText()
+END VarSpelling;
+
+
+PROCEDURE TextSpelling(query: AGRS.Term): AGRS.Term;
+BEGIN
+   RETURN query.Value()
+END TextSpelling;
+
+
+PROCEDURE pSpelling(query: AGRS.Term): AGRS.Term;
+VAR
+   result: AGRS.Term;
+BEGIN
+   IF query IS AGRS.Atomic THEN
+      thoughtName.Assign(query);
+      result:= spellingsName.Evaluate(query);
+      thoughtName.Restore;
+      RETURN result
+   ELSE
+      RETURN StandardSpelling(query);
+   END;
+END pSpelling;
+
+
+PROCEDURE (t: SpellingWrapper) Reduce;
+VAR
+   text: AGRS.Term;
+BEGIN
+   text:= t.handler(thoughtName.indirection);
+   text.Reduce;
+END Reduce;
+
+PROCEDURE NewSpeller(h: SpellingHandlerType): AGRS.Term;
+VAR
+   newTerm: SpellingWrapper;
+BEGIN
+   NEW(newTerm);
+   newTerm.Init(Names.SystemRoot);
+   newTerm.handler:= h;
+   RETURN newTerm
+END NewSpeller;
+
+BEGIN
+
+   spelled:= TextFrames.Text("");
+   Texts.OpenWriter(wr);
+   NEW(spelledTextName);
+   spelledTextName.Init(Names.SystemRoot);
+   NEW(collection);
+   collection.Init(Names.SystemRoot);
+   collection.AddProperty(Library.numberName,
+              NewSpeller(NumberSpelling));
+   collection.AddProperty(Library.stringName,NewSpeller(StringSpelling));
+   collection.AddProperty(Library.textName,NewSpeller(TextSpelling));
+   collection.AddProperty(Library.charName,NewSpeller(CharSpelling));
+   collection.AddProperty(Library.charSetName,NewSpeller(CharSetSpelling));
+   collection.AddProperty(Library.errorName,NewSpeller(ErrorSpelling));
+   collection.AddProperty(Names.VariableRoot,NewSpeller(VarSpelling));
+   Names.DefinePublicName(standardSpellingName,'StandardSpelling',
+         NewSpeller(StandardSpelling));
+   collection.AddProperty(AGRS.otherwise,standardSpellingName);
+   Names.DefinePublicName(spellingsName,'Spellings',collection);
+   Names.DefinePublicName(indentionName,'Indention',
+         Library.NewNumber(0));
+   Names.AddSystemName(nameSpellingName,'NameSpelling',pNameSpelling);
+   Names.DefinePublicName(spellingName,'Spelling',
+         NewSpeller(pSpelling));
+   Names.AddArgument(spelledTextName,'SpelledTree');
+   Names.AddArgument(thoughtName,'Thought');
+   FindSpelling:= pSpelling;
+END Speller.
+
+ examples/AGRS/TextFrames.Def view
@@ -0,0 +1,69 @@+(*+https://web.archive.org/web/20041227181940/http://www.oberon.ethz.ch:80/ethoberon/defs/TextFrames.Def.html+*)++DEFINITION TextFrames; (* portable *)++ IMPORT Objects, Display, Texts, Oberon;++ TYPE+  Location = RECORD+   org, pos: LONGINT;+   dx, x, y: INTEGER;+  END;++  Frame = POINTER TO FrameDesc;+  FrameDesc = RECORD ( Display.FrameDesc ) +   text: Texts.Text;+   org: LONGINT;+   col: INTEGER;+   lsp: INTEGER;+   left, right, top, bot: INTEGER;+   markH: INTEGER;+   time: LONGINT;+   mark, car, sel: INTEGER;+   carloc: Location;+   selbeg, selend: Location;+  END;++ VAR +  menuH, barW, left, right, top, bot, lsp: INTEGER;+ PROCEDURE Mark (F: Frame; mark: INTEGER);+ PROCEDURE Restore (F: Frame);+ PROCEDURE Suspend (F: Frame);+ PROCEDURE Extend (F: Frame; newY: INTEGER);+ PROCEDURE Reduce (F: Frame; newY: INTEGER);+ PROCEDURE Show (F: Frame; pos: LONGINT);+ PROCEDURE Pos (F: Frame; X, Y: INTEGER): LONGINT;+ PROCEDURE SetCaret (F: Frame; pos: LONGINT);+ PROCEDURE TrackCaret (F: Frame; X, Y: INTEGER; VAR keysum: SET);+ PROCEDURE RemoveCaret (F: Frame);+ PROCEDURE SetSelection (F: Frame; beg, end: LONGINT);+ PROCEDURE TrackSelection (F: Frame; X, Y: INTEGER; VAR keysum: SET);+ PROCEDURE RemoveSelection (F: Frame);+ PROCEDURE TrackLine (F: Frame; X, Y: INTEGER; VAR org: LONGINT; VAR keysum: SET);+ PROCEDURE TrackWord (F: Frame; X, Y: INTEGER; VAR pos: LONGINT; VAR keysum: SET);+ PROCEDURE GetAttr (F: Frame; VAR s: ARRAY OF CHAR);+ PROCEDURE Call (F: Frame; pos: LONGINT; new: BOOLEAN);+ PROCEDURE Write (F: Frame; ch: CHAR; lib: Objects.Library; col, voff: SHORTINT);+ PROCEDURE Defocus (F: Frame);+ PROCEDURE Neutralize (F: Frame);+ PROCEDURE Modify (F: Frame; id, dY, Y, H: INTEGER);+ PROCEDURE Open (+        F: Frame; H: Objects.Handler; T: Texts.Text; org: LONGINT; +        col, left, right, top, bot, lsp: INTEGER);+ PROCEDURE Copy (F: Frame; VAR F1: Frame);+ PROCEDURE CopyOver (F: Frame; text: Texts.Text; beg, end: LONGINT);+ PROCEDURE GetSelection (F: Frame; VAR M: Oberon.SelectMsg);+ PROCEDURE GetCaret (F: Frame; VAR M: Oberon.CaretMsg);+ PROCEDURE Update (F: Frame; beg, end, len: LONGINT);+ PROCEDURE Edit (F: Frame; X, Y: INTEGER; Keys: SET);+ PROCEDURE Handle (F: Objects.Object; VAR M: Objects.ObjMsg);+ PROCEDURE Text (name: ARRAY OF CHAR): Texts.Text;+ PROCEDURE NewMenu (name, commands: ARRAY OF CHAR): Frame;+ PROCEDURE NewText (text: Texts.Text; pos: LONGINT): Frame;++(* Replace the default system editor with a textframe. *)+ PROCEDURE ReplaceSystemEditor;++END TextFrames.
+ examples/AGRS/Texts.Def view
@@ -0,0 +1,348 @@+(*+https://web.archive.org/web/20041227181940/http://www.oberon.ethz.ch:80/ethoberon/defs/Texts.Def.html+*)+DEFINITION Texts; (* portable *)++(* The Texts module implements the text abstract data type. Texts are sequences+of +characters and objects, with different colors, different fonts, and vertical+offsets.+*)+ IMPORT Files, Objects, Display;++ CONST+    (* Scanner symbol classes.*)+  Inval = 0;           (* Invalid symbol. *)+  Name = 1;        (* Name s (of length len).*)+  String = 2;        (* Quoted string s (length len). *)+  Int = 3;             (* Integer i (decimal or hexadecimal). *)+  Real = 4;          (* Real number x. *)+  LongReal = 5;  (* Long real number y. *)+  Char = 6;          (* Special character c. *)+  Object = 7;      (* Object obj. *)++ TYPE+  Text = POINTER TO TextDesc;+  TextDesc = RECORD ( Objects.ObjDesc ) +   len: LONGINT; (* Text consists of characters 0 to T.len - 1. *)+  END;++  UpdateMsg = RECORD ( Display.FrameMsg )  (* Message broadcast to indicate+that part of a text changed. *)+   text: Text; (* The text that changed. *)+   beg, end, len: LONGINT (* Change location. *)+  END;++  Finder = RECORD (* Finder of (non-character) objects located in text. *)+   eot: BOOLEAN; (* End-of-text reached during search. *)+   pos: LONGINT; (* Offset of Finder in text. *)+  END;++  Reader = RECORD (* Character-wise reader of a text stream. *)+   lib: Objects.Library; (* Library of last character/object read. *)+   col: SHORTINT; (* Color index of last character read. *)+   voff: SHORTINT; (* vertical offset of last character read. *)+   eot: BOOLEAN (* Reader has reached end of the text stream. *)+  END;++  Scanner = RECORD ( Reader )  (* Scanner for symbol streams. *)+   nextCh: CHAR; (* Character immediately following the last symbol scanned.+*)+   line: INTEGER; (* # carriage returns scanned so far. *)+   class: INTEGER; (* Scan result: Int, Real, String etc. *)+   i: LONGINT;+   x: REAL;+   y: LONGREAL;+   c: CHAR;+   len: SHORTINT; (* Length of name or string scanned. *)+   s: ARRAY 64 OF CHAR;+   obj: Objects.Object+  END;++  Buffer = POINTER TO BufDesc; (* Temporary container of text stretches. *)+  BufDesc = RECORD+   len: LONGINT; (* # characters in buffer. *)+  END;++  Writer = RECORD (* Used to write a stream of textual data in a buffer. *)+   buf: Buffer; (* Associated buffer. *)+   lib: Objects.Library; (* Current font/library of characters written. *)+   col: SHORTINT; (* Current color of text being written. *)+   voff: SHORTINT (* Current vertical offset of text being written. *)+  END;++ VAR  (* First character of a text block. *)+  TextBlockId: CHAR;++(* Load text block from ASCII file f to text T. *)+ PROCEDURE LoadAscii (T: Text; f: Files.File);++(* Load text block from file f at position pos to text T (assumes that the text+id has been read already). len returns length. *)+ PROCEDURE Load (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);++(* Store text T on disk file f at position pos. Writes the first id character+too. len is the number of bytes written. *)+ PROCEDURE Store (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);++(* Open text T from file specified by name. A new text is opened when name =+"". *)+ PROCEDURE Open (T: Text; name: ARRAY OF CHAR);++(* Text generator procedure. Resulting text is assigned to Objects.NewObj. *)+ PROCEDURE New;++(* Insert buffer B in text T position pos. B is emptied. *)+ PROCEDURE Insert (T: Text; pos: LONGINT; B: Buffer);++(* Append buffer to the end of text T. B is emptied. *)+ PROCEDURE Append (T: Text; B: Buffer);++(* Delete text stretch [beg, end[. *)+ PROCEDURE Delete (T: Text; beg, end: LONGINT);++(* Replace [beg, end[ of T with contents of buffer B. B is emptied. *)+ PROCEDURE Replace (T: Text; beg, end: LONGINT; B: Buffer);++(* Change character attributes within stretch [beg, end[ of text T. sel selects+the attributes to be changed: 0, 1, 2 IN sel = fnt, col, voff selected. *)+ PROCEDURE ChangeLooks (T: Text; beg, end: LONGINT; sel: SET; lib: Objects.Library; col, voff: SHORTINT);++(* Open a new text buffer B. *)+ PROCEDURE OpenBuf (B: Buffer);++(* Save stretch [beg, end[ of T in buffer B. *)+ PROCEDURE Save (T: Text; beg, end: LONGINT; B: Buffer);++(* Append copy of source buffer SB to destination buffer DB. *)+ PROCEDURE Copy (SB, DB: Buffer);++(* Recall previously deleted text. *)+ PROCEDURE Recall (VAR B: Buffer);++(* Default handler for text objects. This handler understands Objects.AttrMsg(for+Gen attribute), Objects.CopyMsg, Objects.BindMsg, and Objects.FileMsg only.+*)+ PROCEDURE Handle (obj: Objects.Object; VAR M: Objects.ObjMsg);++(* Open Finder at position pos in T. The finder is automatically advanced to+the next object in text. *)+ PROCEDURE OpenFinder (VAR F: Finder; T: Text; pos: LONGINT);++  (* Advance Finder to next object in text and return current object. *)+ PROCEDURE FindObj (VAR F: Finder; VAR obj: Objects.Object);++(* Open text reader R and set it up at position pos in text T. *)+ PROCEDURE OpenReader (VAR R: Reader; T: Text; pos: LONGINT);++(* Read next character into ch. R.eot is set when the last character is read.+The fields lib, voff and col of R give +information about the last character read. *)+ PROCEDURE Read (VAR R: Reader; VAR ch: CHAR);++(* Return reader's position within the text. *)+ PROCEDURE Pos (VAR R: Reader): LONGINT;++(* Open text scanner S and set it up at position pos in text T. *)+ PROCEDURE OpenScanner (VAR S: Scanner; T: Text; pos: LONGINT);++(* Read the next symbol. Whitespace is ignored. CR increments the line counter.+*)+ PROCEDURE Scan (VAR S: Scanner);++(* Open a new writer W. *)+ PROCEDURE OpenWriter (VAR W: Writer);++(* Set writer W to font fnt. *)+ PROCEDURE SetFont (VAR W: Writer; fnt: Objects.Library);++(* Set writer W to color col. *)+ PROCEDURE SetColor (VAR W: Writer; col: SHORTINT);++(* Set writer W to vertical offset voff. Vertical offset controls the writing+of super- and sub-scripts. *)+ PROCEDURE SetOffset (VAR W: Writer; voff: SHORTINT);++(* Write character ch to writer W's buffer. *)+ PROCEDURE Write (VAR W: Writer; ch: CHAR);++(* Write an end-of-line character to W's buffer. *)+ PROCEDURE WriteLn (VAR W: Writer);++(* Write string s to W's buffer. *)+ PROCEDURE WriteString (VAR W: Writer; s: ARRAY OF CHAR);++(* Write integer x to W's buffer. Spaces are padded to the left until the number+field is at least n characters long. *)+ PROCEDURE WriteInt (VAR W: Writer; x, n: LONGINT);++(* Write a hexadecimal representation of x to W's buffer. *)+ PROCEDURE WriteHex (VAR W: Writer; x: LONGINT);++(* Write the hexadecimal representation of x to W's buffer. *)+ PROCEDURE WriteRealHex (VAR W: Writer; x: REAL);++(* Write the hexadecimal representation of x to W's buffer. *)+ PROCEDURE WriteLongRealHex (VAR W: Writer; x: LONGREAL);++(* Write real x to W's buffer using n character positions. *)+ PROCEDURE WriteReal (VAR W: Writer; x: REAL; n: LONGINT);++(* Write real x in a fixed point notation. n is the overall minimal length for+the output field, +f the number of fraction digits following the decimal point, E the fixed exponent+(printed only +when E # 0). *)+ PROCEDURE WriteRealFix (VAR W: Writer; x: REAL; n, f, E: LONGINT);++(* Write LONGREAL x to W's buffer using n character positions. *)+ PROCEDURE WriteLongReal (VAR W: Writer; x: LONGREAL; n: LONGINT);++(* Write LONGREAL x in a fixed point notation. n is the overall minimal length+for the output field, f the number of fraction digits following the decimal+point, D the fixed exponent (printed only when D # 0). *)+ PROCEDURE WriteLongRealFix (VAR W: Writer; x: LONGREAL; n, f, D: LONGINT);++(* Write the time and date to W's buffer. *)+ PROCEDURE WriteDate (VAR W: Writer; t, d: LONGINT);++(* Write a SET value to writer W. *)+ PROCEDURE WriteSet (VAR W: Writer; s: SET);++(* Write obj to writer W. *)+ PROCEDURE WriteObj (VAR W: Writer; obj: Objects.Object);+END Texts.++(* Remarks:++1. Text streams consists of sequence of characters (type Fonts.Char) and and++non-character objects (in different colors, fonts, and vertical offsets). The+only +way to distinguish between a character and an object in the text stream is by++fetching the character/object from its library and then making a type test.++The library of a character/object is given by the lib field of the reader while++advancing through a text stream. The reference number of a character/object++is the ordinal number of the character read (i.e. ORD(ch)). As character objects++are bound to character fonts (Fonts.Font), a quick type test of the Reader lib++field against Fonts.Font also settles the question. Non-character objects of+a +text are typically bound to the obs library field of the text descriptor.++2. The non-character objects of a text stream must have reference numbers +in the range 0 <= ref < 256, and must be bound to a library (not necessarily++obs of the text descriptor). Writing non-character objects involves binding+it +to a library (say T.obs), changing the font of the Writer, and the writing the++reference number of the non-character object into the writer's buffer. +Afterwards the writer font is reset to its old value. More that 256 non-character++objects can be written into the text by allocating a new library when the old++library is full, and attaching it to the obs field of the text descriptor. The+obs field +just acts as a placeholder for libraries and is not used by the texts directly.++3. There are two mechanisms to read from a text and one to write to a text.++The Readers allow characterwise reading from a certain text position onwards.++The Scanners allow reading of formatted tokens like names, strings, numbers+and +characters. Writers are used to write characters into temporary holding areas++called buffers. Buffers contains large sequences of objects (both character+and +non-character) and allow low-level temporary manipulation. The difference +between texts and buffers involve the display update operations. Each text can++possibly be represented on the display by some kind of text editor or viewer.++When a module manipulates a text, a message called the UpdateMsg (type +Texts.UpdateMsg) is broadcast to all viewers or text editors representing the+text. +They then update their representation accordingly. To prevent broadcasts being++sent for potentially each character being written into a text, the text manipulation++is first done in a buffer. Operations on buffers do not result in update messages++being broadcasted. Only when a buffer is applied to a text (inserted or appended),++the texts broadcasts an update message. By convention, once a buffer is applied+to a text, its contents is emptied.++4. The scanner classes indicate what token was scanned. The scanner understands+the following token types:++ Name Longest sequence starting with "A".."Z", "a".."z", ".", "/", and containing++  "A".."Z", "a".."z", "0".."9", "@", ".", "/", ":", "_", 80X..96X+ String Any character sequence surrounded by double quotes, i.e. "string".+  The quotes are not returned in the s field of the scanner descriptor.+ Int Any valid integer number.+ Real Any valid REAL number, including exponent E.+ LongReal Any valid LONGREAL number, including exponent D.+ Char A character (single) not classified as one of the above.+ +5. The end of line character is carriage return (CR or 0DX), tabulators are+9X. +Unprintable characters are show on the display as smallish square boxes.++6. Vertical offsets are typically measured in screen pixels (positive or negative++to the text base line).++7. The Finder allow quick searching for non-character objects in a text. ++8. The meaning of the UpdateMsg fields are defined as in the following table++listed according to the procedures that broadcast the message. Note that a text++stretch identified by (beg, end) does not include the character at position+end +in the text. Below, M is of type Texts.UpdateMsg and B stands for a buffer.++ Delete(beg, end) M.beg = beg+  M.end = end+  M.len = 0+ Replace(beg, end, B) M.beg = beg+  M.end = end+  M.len = B.len+ ChangeLooks(beg, end) M.beg = beg+  M.end = end+  M.len = end - beg+ Insert(pos, buf) M.beg = pos+  M.end = pos+  M.len = B.len+  +The general scheme is that the stretch between M.beg and M.end was "deleted",++and a new stretch of length M.len was inserted at M.beg. The message indicates++a change AFTER it has already been made by the texts module.++9. There is an asymmetry in writing and reading texts to a file. Each text "block"++in a file is identified by a first character. Reading a text block requires+that the +starting position does not include this character, while writing a text block+writes +the id character automatically.++10. Opening of non-text files is allowed with Texts.Open; they are simply converted++to ASCII streams. Storing such an opened text will convert it into an Oberon+text. +Note that the EditTools package allows the manipulation of ASCII texts both+in +MSDOS and UNIX format.+*)
+ examples/AGRS/Viewers.Def view
@@ -0,0 +1,100 @@+(*+https://web.archive.org/web/20041227180027/http://www.oberon.ethz.ch:80/ethoberon/defs/Viewers.Def.html+*)+DEFINITION Viewers; (* portable *)++(*+The module viewers provide the data type for implementing the tiled viewers++of the Oberon system. Each track of the Oberon system consists of a number of+viewers.+*)+ IMPORT Display;++ TYPE+  Viewer = POINTER TO ViewerDesc;+  ViewerDesc = RECORD ( Display.FrameDesc ) +   state: INTEGER;+         (* state > 1: displayed+      state = 1: filler+      state = 0: closed+      state < 0: suspended.*)+  END;++ VAR +  curW: INTEGER; (* Current width of the logical display. *)+  minH: INTEGER; (* Minimum viewer height. *)++ (* Open a new viewer V with top at Y in track X. *)+ PROCEDURE Open (V: Viewer; X, Y: INTEGER);++ (* Expand or shrink a viewer vertically to new top Y. *)+ PROCEDURE Change (V: Viewer; Y: INTEGER);++ (* Remove viewer V from the display. *)+ PROCEDURE Close (V: Viewer);++ (* Recall most recently closed viewer. *)+ PROCEDURE Recall (VAR V: Viewer);++ (* Return viewer located at display coordinates X, Y. *)+ PROCEDURE This (X, Y: INTEGER): Viewer;++ (* Return next upper neighbour of V in a track. *)+ PROCEDURE Next (V: Viewer): Viewer;++ (* In the track at X locate the following viewers: filler fil, bottom-most+viewer, an + alternative viewer alt of height >= H, and the viewer with the maximum height.+*)+ PROCEDURE Locate (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);++ (* Append to the current logical display and init track of width W and height+H, and install filler. *)+ PROCEDURE InitTrack (W, H: INTEGER; Filler: Viewer);++ (* Open new track overlaying span of [X, X +W[. *)+ PROCEDURE OpenTrack (X, W: INTEGER; Filler: Viewer);++ (* Close track at X and restore overlaid tracks. *)+ PROCEDURE CloseTrack (X: INTEGER);+END Viewers.++(* Remarks:++1. Each track consists of a filler and a set of viewers linked together in a+ring +(with the next field) with the filler as sentinel. The filler is the top-most+viewer +in a track and covers the remainding part of the track the viewers do not cover.++The set of tracks form the root objects of the display space.++2. Tracks can overlay each other. Closing a track exposes the track (and viewers)++lying below it. Overlayed tracks and viewers do not receive message broadcasts++in the display space. Before being overlayed, the contents of a track receive+a +Display.ControlMsg with id set to suspend.++3. The logical display increases from X coordinate 0 onwards through multiple++physical displays. Opening a new display involves adding a tracks beyond curW++(typically a system and user track). Oberon uses a single coordinate system+to +address all the different displays. Note that many Oberon systems restrict the++size of the display to the size of the host window.++4. Changing the top coordinate of a viewer with Change results in a +Display.ModifyMsg with id set to reduce or extend (in size) being sent +to the viewer contents (located in V.dsc).++5. The ratio of user and system track width is 5:3.++6. Programmers seldom need to use the Viewers module. Higher level modukes +like Documents provide a simpler display abstraction.++*)
language-oberon.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                language-oberon-version:             0.1+version:             0.1.1 synopsis:            Parser and pretty-printer for the Oberon programming language description:    The library and the executable support both the original Oberon and the Oberon-2 programming language, as described@@ -26,7 +26,7 @@ -- copyright:            category:            Language build-type:          Simple-extra-source-files:  ChangeLog.md+extra-source-files:  ChangeLog.md, examples/AGRS/*.Def, examples/AGRS/*.Mod cabal-version:       >=1.10  library@@ -49,11 +49,11 @@                        optparse-applicative   default-language:    Haskell2010 -test-suite           examples-  type:              exitcode-stdio-1.0-  build-depends:     base >= 4.7 && < 5,-                     either == 5.*, directory < 2, filepath < 1.5,-                     tasty >= 0.7, tasty-hunit,-                     language-oberon-  main-is:           test/Test.hs-  default-language:  Haskell2010+test-suite             examples+  type:                exitcode-stdio-1.0+  build-depends:       base >= 4.7 && < 5,+                       either == 5.*, directory < 2, filepath < 1.5,+                       tasty >= 0.7, tasty-hunit,+                       language-oberon+  main-is:             test/Test.hs+  default-language:    Haskell2010