ð:Syntax10.Scn.Fntyƒÿÿÿp°­VersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows PowerMacPowerMac Windows#Syntax10.Scn.FntiOPTp°­VersionElemsAllocEndØ Syntax10b.Scn.FntjSyntax10i.Scn.FntÅŸMODULE TreeElems; (* mah 15.5.97 *) IMPORT Display, Texts, TextFrames, Viewers, PopupElems, FoldElems, Compiler, OPT := POPT, Oberon; CONST middle = 1; pixel = LONG(10000); TYPE Node = POINTER TO NodeDesc; NodeDesc = RECORD name: ARRAY 32 OF CHAR; color: SHORTINT; pos, menuPos: LONGINT; down, next: Node END; Action = PROCEDURE (VAR root: Node; obj: OPT.Object); Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD (PopupElems.ElemDesc) objs: Node; END; VAR icon: Display.Pattern; (* x = 0, y = 3, w = 13, h = 8 *) w: Texts.Writer; PROCEDURE Traverse (VAR root: Node; scope: OPT.Object; action: Action); BEGIN IF scope # NIL THEN Traverse (root, scope.right, action); action (root, scope); Traverse (root, scope.left, action) END END Traverse; PROCEDURE CollectProcs (VAR root: Node; obj: OPT.Object); VAR n: Node; BEGIN IF (obj.mode>=6) & (obj.mode<=10) OR (obj.mode=13) THEN NEW (n); COPY (obj.name, n.name); n.pos := obj.scope.adr; n.color := Display.white; n.next := root; root := n; Traverse (root.down, obj.scope.right, CollectProcs) END END CollectProcs; PROCEDURE CollectTypes (VAR root: Node; obj: OPT.Object); VAR n: Node; BEGIN IF obj.mode=5 THEN NEW (n); COPY (obj.name, n.name); n.pos := obj.typ.txtpos; n.color := 3; n.next := root; root := n; Traverse (root.down, obj.typ.link, CollectProcs) END END CollectTypes; PROCEDURE Show (n: Node; indent: INTEGER); VAR i: INTEGER; BEGIN WHILE n # NIL DO n.menuPos := w.buf.len; FOR i := 1 TO indent DO Texts.WriteString (w, " ") END; Texts.SetColor (w, n.color); Texts.WriteString (w, n.name); Texts.WriteLn (w); Show (n.down, indent+1); n := n.next END END Show; PROCEDURE ScanAST (e: Elem; scope: OPT.Object); BEGIN Traverse (e.objs, scope.right, CollectProcs); Traverse (e.objs, scope.right, CollectTypes); Show (e.objs, 0) END ScanAST; PROCEDURE BuildMenu (e: Elem; f0: Display.Frame); VAR f: TextFrames.Frame; t: Texts.Text; err: BOOLEAN; r: Texts.Reader; ch: CHAR; oldNotify: Texts.Notifier; BEGIN IF (f0.next = NIL) OR ~ (f0.next IS TextFrames.Frame) THEN Texts.WriteString(w, "tree element not in menu bar of a text frame"); Texts.WriteLn(w); Texts.WriteLn(w) ELSE f := f0.next(TextFrames.Frame); t := f.text; e.objs := NIL; Texts.Delete (e.menu, 0, e.menu.len); oldNotify := t.notify; t.notify := NIL; FoldElems.ExpandAll(t, 0, TRUE); Texts.OpenReader (r, t, 0); Compiler.Module (r, "f", 0, TextFrames.Text(""), err); FoldElems.CollapseAll(t, {FoldElems.tempLeft}); t.notify := oldNotify; ScanAST (e, Compiler.mainMod); Compiler.mainMod := NIL END; Texts.Append(e.menu, w.buf); PopupElems.MeasureMenu(e) END BuildMenu; PROCEDURE Find (n: Node; menuPos: LONGINT) : Node; VAR node: Node; BEGIN node := NIL; WHILE (n # NIL) & (node = NIL) DO IF n.menuPos = menuPos THEN node := n ELSE node := Find (n.down, menuPos) END; n := n.next END; RETURN node END Find; PROCEDURE ShowPos (f: TextFrames.Frame; pos: LONGINT); VAR beg, end, delta: LONGINT; BEGIN delta := 200; LOOP beg := f.org; end := TextFrames.Pos(f, f.X + f.W, f.Y); IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END; TextFrames.Show(f, pos - delta); delta := delta DIV 2 END END ShowPos; PROCEDURE Exec (e: Elem; pos: LONGINT; f0: Display.Frame); VAR n: Node; f: TextFrames.Frame; r: Texts.Reader; fold, twin: FoldElems.Elem; newPos: LONGINT; t: Texts.Text; oldNotifier: Texts.Notifier; BEGIN n := Find (e.objs, pos); IF n = NIL THEN RETURN END; newPos := n.pos; (* fetch target Position *) f := f0(TextFrames.Frame); t := f.text; oldNotifier := t.notify; t.notify := NIL; FoldElems.ExpandAll(t, 0, TRUE); Texts.OpenReader (r, t, newPos); Texts.ReadPrevElem (r); WHILE r.elem # NIL DO IF r.elem IS FoldElems.Elem THEN fold := r.elem(FoldElems.Elem); IF fold.mode = FoldElems.tempLeft THEN twin := FoldElems.Twin(fold); IF Texts.ElemPos(twin) < newPos THEN pos := Texts.ElemPos(twin); FoldElems.Switch (twin); DEC(newPos, pos - Texts.ElemPos(twin)) ELSE fold.mode := FoldElems.expLeft END END END; Texts.ReadPrevElem (r) END; FoldElems.CollapseAll(t, {FoldElems.tempLeft}); t.notify := oldNotifier; t.notify(t, Texts.replace, 0, t.len); ShowPos (f, newPos); Oberon.PassFocus(Viewers.This(f.X, f.Y)); TextFrames.SetCaret(f, newPos) END Exec; PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg); VAR e1: Elem; BEGIN WITH e: Elem DO WITH m: Texts.IdentifyMsg DO m.mod := "TreeElems"; m.proc := "Alloc" | m: Texts.CopyMsg DO IF m.e = NIL THEN NEW (e1); m.e := e1 END; PopupElems.Handle(e, m) | m: TextFrames.DisplayMsg DO IF m.prepare THEN e.W := 18 * pixel; e.H := LONG(TextFrames.menuH-1) * pixel; ELSE e.name := ""; PopupElems.Handle(e, m); Display.CopyPattern(Display.white, icon, m.X0+2, m.Y0+2, Display.paint) END | m: TextFrames.TrackMsg DO IF middle IN m.keys THEN BuildMenu(e, m.frame) END; PopupElems.Handle(e, m) | m: PopupElems.ExecMsg DO Exec(e, m.pos, m.frame.next) ELSE PopupElems.Handle(e, m) END END END Handle; PROCEDURE Alloc*; VAR e: Elem; BEGIN NEW(e); e.handle := Handle; Texts.new := e END Alloc; PROCEDURE Insert*; VAR e: Elem; insert: TextFrames.InsertElemMsg; BEGIN NEW(e); e.handle := Handle; e.menu := TextFrames.Text(""); e.small := TRUE; insert.e := e; Viewers.Broadcast(insert) END Insert; PROCEDURE InitIcon; VAR line: ARRAY 9 OF SET; BEGIN line[8] := {0..2, 5..12}; line[7] := {0, 1, 3, 4, 8, 12}; line[6] := {0, 1, 3, 6, 7, 9..11}; line[5] := {0, 1, 3, 6..9}; line[4] := {0, 1, 3, 7, 9}; line[3] := {0..5, 7, 9}; line[2] := {0..2, 5..8}; line[1] := {}; icon := Display.NewPattern(line, 13, 8) END InitIcon; BEGIN Texts.OpenWriter(w); InitIcon END TreeElems.