ðOberon10.Scn.Fnt Oberon10i.Scn.Fntþ&Oberon12i.Scn.Fnt Oberon10b.Scn.Fntzbm]k¢ìj§Q dK  Y. áWÔMODULE Log; (* ww 9.5.94 *) (*---------------------------------------------------------* * Copyright (c) 1990-1996 ETH Z…rich. All Rights Reserved. * Oberon is a trademark of Institut f…r Computersysteme, ETH Z…rich. *---------------------------------------------------------*) IMPORT Oberon, MenuViewers, TextFrames, Texts, Display, Fonts, SYSTEM; CONST Menu = "System.Close System.Grow Log.Pin Edit.Locate Edit.Search Edit.Store "; VAR task: Oberon.Task; pin, lastLen: LONGINT; w, whex: Texts.Writer; defParc: TextFrames.Parc; menuText: Texts.Text; (* output primitives *) PROCEDURE Int*(x: LONGINT); BEGIN Texts.Write(w, " "); Texts.WriteInt(w, x, 0); Texts.Append(Oberon.Log, w.buf) END Int; PROCEDURE Hex*(x: LONGINT); BEGIN Texts.WriteHex(w, x); Texts.Append(Oberon.Log, w.buf) END Hex; PROCEDURE Real*(x: LONGREAL); BEGIN Texts.WriteLongReal(w, x, 24); Texts.Append(Oberon.Log, w.buf) END Real; PROCEDURE Ch*(ch: CHAR); BEGIN Texts.Write(w, ch); Texts.Append(Oberon.Log, w.buf) END Ch; PROCEDURE Str*(s: ARRAY OF CHAR); BEGIN Texts.WriteString(w, s); Texts.Append(Oberon.Log, w.buf) END Str; PROCEDURE Bool*(b: BOOLEAN); BEGIN IF b THEN Texts.WriteString(w, " TRUE") ELSE Texts.WriteString(w, " FALSE") END; Texts.Append(Oberon.Log, w.buf) END Bool; PROCEDURE Set*(s: SET); VAR i, j: INTEGER; BEGIN Texts.WriteString(w, " {"); i := 0; WHILE s # {} DO IF i IN s THEN j := i; Texts.WriteInt(w, i, 0); REPEAT EXCL(s, i); INC(i) UNTIL (s = {}) OR ~(i IN s); IF i > j + 1 THEN IF i > j + 2 THEN Texts.WriteString(w, "..") ELSE Texts.Write(w, ",") END; Texts.WriteInt(w, i - 1, 0) END; IF s # {} THEN Texts.Write(w, ",") END END; INC(i) END; Texts.Write(w, "}"); Texts.Append(Oberon.Log, w.buf) END Set; PROCEDURE Date*(t, d: LONGINT); BEGIN Texts.WriteDate(w, t, d); Texts.Append(Oberon.Log, w.buf) END Date; PROCEDURE Elem*(e: Texts.Elem); VAR msg: Texts.CopyMsg; BEGIN msg.e := NIL; e.handle(e, msg); Texts.WriteElem(w, msg.e); Texts.Append(Oberon.Log, w.buf) END Elem; PROCEDURE Ln*; BEGIN Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) END Ln; PROCEDURE DumpRange*(VAR a: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT); VAR end: LONGINT; l, h: INTEGER; ch: CHAR; BEGIN end := beg + len; beg := beg; IF end > LEN(a) THEN end := LEN(a) END; WHILE beg < end DO h := ORD(SYSTEM.VAL(CHAR, a[beg])) DIV 16; l := ORD(SYSTEM.VAL(CHAR, a[beg])) MOD 16; IF h > 9 THEN Texts.Write(whex, CHR(h - 10 + ORD("A"))) ELSE Texts.Write(whex, CHR(h + ORD("0"))) END; IF l > 9 THEN Texts.Write(whex, CHR(l - 10 + ORD("A"))) ELSE Texts.Write(whex, CHR(l + ORD("0"))) END; Texts.WriteString(whex, " "); ch := SYSTEM.VAL(CHAR, a[beg]); IF (ch < " ") OR (ch > 7EX) THEN Texts.Write(w, "-") ELSE Texts.Write(w, ch) END; INC(beg); IF beg MOD 8 = 0 THEN Texts.WriteLn(w); Texts.Append(Oberon.Log, whex.buf); Texts.Append(Oberon.Log, w.buf) ELSIF beg MOD 4 = 0 THEN Texts.WriteString(whex, " ") END END; IF beg MOD 8 # 0 THEN Texts.WriteLn(w); IF beg MOD 8 < 4 THEN Texts.WriteString(whex, " ") END; REPEAT Texts.WriteString(whex, " "); INC(beg) UNTIL beg MOD 8 = 0 END; Texts.Append(Oberon.Log, whex.buf); Texts.Append(Oberon.Log, w.buf) END DumpRange; PROCEDURE Dump*(VAR a: ARRAY OF SYSTEM.BYTE); BEGIN DumpRange(a, 0, LEN(a)) END Dump; (* viewers *) PROCEDURE Update*(frame: TextFrames.Frame; VAR m: TextFrames.UpdateMsg); VAR r: Texts.Reader; prev, last: LONGINT; ch: CHAR; BEGIN TextFrames.Handle(frame, m); IF (m.id = TextFrames.insert) & (m.end = frame.text.len) & (frame.H > 0) THEN last := TextFrames.Pos(frame, MAX(INTEGER), frame.Y); IF last < frame.text.len - 1 THEN Oberon.RemoveMarks(frame.X, frame.Y, frame.W, frame.H); TextFrames.RemoveSelection(frame); TextFrames.RemoveCaret(frame); REPEAT prev := frame.org; IF last + 2 < m.beg THEN TextFrames.Show(frame, m.beg) ELSE Texts.OpenReader(r, frame.text, frame.org); REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = 0DX); TextFrames.Show(frame, Texts.Pos(r)) END; last := TextFrames.Pos(frame, MAX(INTEGER), frame.Y) UNTIL (last >= frame.text.len-1) OR (prev = frame.org) END END END Update; PROCEDURE Handler*(frame: Display.Frame; VAR m: Display.FrameMsg); BEGIN WITH frame: TextFrames.Frame DO IF m IS TextFrames.UpdateMsg THEN WITH m: TextFrames.UpdateMsg DO IF m.text = frame.text THEN Update(frame, m) END END ELSE TextFrames.Handle(frame, m) END END END Handler; PROCEDURE Open*; VAR x, y: INTEGER; beg: LONGINT; v: MenuViewers.Viewer; mf, cf: TextFrames.Frame; BEGIN IF Oberon.Log.len > pin THEN beg := pin ELSE beg := 0 END; Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); mf := TextFrames.NewMenu("Log", Menu); mf.text := menuText; cf := TextFrames.NewText(Oberon.Log, beg); cf.handle := Handler; v := MenuViewers.New(mf, cf, TextFrames.menuH, x, y) END Open; PROCEDURE Pin*; VAR frame: TextFrames.Frame; BEGIN frame := Oberon.Par.vwr.dsc.next(TextFrames.Frame); IF (Oberon.Log.len > pin) & (frame.text = Oberon.Log) THEN Oberon.RemoveMarks(frame.X, frame.Y, frame.W, frame.H); TextFrames.RemoveSelection(frame); TextFrames.RemoveCaret(frame); TextFrames.Show(frame, pin) END END Pin; PROCEDURE SetPin; VAR pos: LONGINT; BEGIN pos := Oberon.Log.len; IF pos # lastLen THEN pin := lastLen; lastLen := pos END END SetPin; PROCEDURE Clear*; BEGIN Texts.Delete(Oberon.Log, 0,Oberon.Log^.len); pin := 0; lastLen := 0; Elem(defParc) END Clear; PROCEDURE InitParc; VAR width: LONGINT; msg: Texts.CopyMsg; r: Texts.Reader; BEGIN msg.e := NIL; TextFrames.defParc.handle(TextFrames.defParc, msg); defParc := msg.e(TextFrames.Parc); width := Display.Width - Oberon.SystemTrack(Display.Left) - TextFrames.left - TextFrames.right - 2; defParc.width := width * TextFrames.Unit; Elem(defParc) END InitParc; BEGIN Texts.OpenWriter(w); Texts.OpenWriter(whex); Texts.SetFont(whex, Fonts.This("Courier10.Scn.Fnt")); Texts.WriteString(w, "Log | "); Texts.WriteString(w, Menu); Texts.WriteLn(w); menuText := TextFrames.Text(""); Texts.Append(menuText, w.buf); NEW(task); task.handle := SetPin; task.safe:= FALSE; task.time := -1; Oberon.Install(task); pin := 0; lastLen := 0; InitParc END Log.