Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
12 Dec 95
Syntax10b.Scn.Fnt
Syntax12i.Scn.Fnt
MODULE Log;	(* ww 13 Oct 93, shml 
	IMPORT SYSTEM, Oberon, MenuViewers, TextFrames, Texts, Display, Fonts, Files, Modules;
	CONST
		Menu = "System.Close System.Grow Log.Pin Log.Clear Edit.Search Edit.Locate ";
		LogMenuText = "Log.Menu.Text";
		Enter = 0AX;	(* LF key *)
		task: Oberon.Task;
		pin, lastLen: LONGINT;
		w, whex: Texts.Writer;
		defParc: TextFrames.Parc;
		xeHandle: Display.Handler;
(*from XLog
		hexAlpha : ARRAY 17 OF CHAR;
	PROCEDURE OpenMenu(VAR mf: TextFrames.Frame; name, menuFile, defaultMenu: ARRAY OF CHAR);
		VAR buf: Texts.Buffer; t: Texts.Text;
	BEGIN
		IF Files.Old(menuFile) = NIL THEN mf := TextFrames.NewMenu(name, defaultMenu)
		ELSE
			mf := TextFrames.NewMenu(name, "");
			NEW(t); Texts.Open(t, menuFile);
			NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, 0, t.len, buf); Texts.Append(mf.text, buf)
		END
	END OpenMenu;
	PROCEDURE GetXEHandler;
		VAR save, par: Oberon.ParList; res: INTEGER;
	BEGIN
		save := Oberon.Par;
		NEW(par); NEW(par.frame); par.frame.X := 0; par.frame.Y := 0; par.pos := -210566;	(* magic *)
		Oberon.Call("XE.GetHandler", par, FALSE, res);
		IF res = 0 THEN xeHandle := Oberon.Par.frame.handle
		ELSE xeHandle := TextFrames.Handle
		END;
		Oberon.Par := save
	END GetXEHandler;
(* output primitives *)
	PROCEDURE Int*(x: LONGINT);
	BEGIN Texts.Write(w, " "); Texts.WriteInt(w, x, 0); Texts.Append(Oberon.Log, w.buf)
	END Int;
(* from XLog
	PROCEDURE IntFix*(i, n: LONGINT);
	BEGIN
		Texts.WriteInt(w, i, n);  Texts.Append(Oberon.Log, w.buf)
	END IntFix;
	PROCEDURE Hex*(x: LONGINT);
	BEGIN Texts.WriteHex(w, x); Texts.Append(Oberon.Log, w.buf)
	END Hex;
(* from XLog
	PROCEDURE HexFix* (x : LONGINT; l : INTEGER);
		VAR buffer : ARRAY 64 OF CHAR; i : INTEGER;
	BEGIN
		i := 63;
		WHILE (i >=  0) & (l > 0) DO
			buffer[i] := hexAlpha[x MOD 16];
			x := x DIV 16;
			DEC (l); DEC (i);
		END;
		WHILE i < 63 DO
			INC (i);
			Texts.Write (w, buffer[i]);
		END;
		Texts.Append(Oberon.Log, w.buf)
	END HexFix;
	PROCEDURE RealFix*(x: REAL; n, k: INTEGER);
	BEGIN
		Texts.WriteRealFix(w, x, n, k);  Texts.Append(Oberon.Log, w.buf)
	END RealFix;
	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;
(*from XLog
	PROCEDURE PutCh*(txt: ARRAY OF CHAR; ch: CHAR);
	BEGIN
		Texts.WriteString(w, txt);  Texts.Write(w, " "); Texts.Write(w, ch);  Texts.WriteLn(w);
		Texts.Append(Oberon.Log, w.buf)
	END PutCh;
	PROCEDURE PutStr*(txt1, txt2: ARRAY OF CHAR);
	BEGIN
		Texts.WriteString(w, txt1);  Texts.Write(w, " ");  Texts.WriteString(w, txt2);  Texts.WriteLn(w);  
		Texts.Append(Oberon.Log, w.buf)
	END PutStr;
	PROCEDURE PutInt*(txt: ARRAY OF CHAR; i: LONGINT);
	BEGIN
		Texts.WriteString(w, txt);  Texts.WriteInt(w, i, 1);  Texts.WriteLn(w);  
		Texts.Append(Oberon.Log, w.buf)
	END PutInt;
	PROCEDURE PutHex*(txt: ARRAY OF CHAR; n: LONGINT);
		VAR buffer : ARRAY 64 OF CHAR; i, l : INTEGER;
	BEGIN
		Texts.WriteString(w, txt); 
		i := 63; l := 8;
		WHILE (i >=  0) & (l > 0) DO
			buffer[i] := hexAlpha[n MOD 16];
			n := n DIV 16;
			DEC (l); DEC (i);
		END;
		WHILE i < 63 DO
			INC (i);
			Texts.Write (w, buffer[i]);
		END;
		Texts.WriteLn(w);  
		Texts.Append(Oberon.Log, w.buf)
	END PutHex;
	PROCEDURE PutReal*(txt: ARRAY OF CHAR; x: REAL);
	BEGIN
		CheckViewer; 
		Texts.WriteString(w, txt);  Texts.WriteReal(w, x, 15);  Texts.WriteLn(w);
		Texts.Append(Oberon.Log, w.buf)
	END PutReal;
	PROCEDURE PutBool*(txt: ARRAY OF CHAR; b: BOOLEAN);
	BEGIN
		CheckViewer; 
		Texts.WriteString(w, txt);
		IF b THEN Texts.WriteString(w, " TRUE")  ELSE Texts.WriteString(w, " FALSE")  END;		
		Texts.WriteLn(w);
		Texts.Append(Oberon.Log, w.buf)
	END PutBool;
(* viewers *)
	PROCEDURE Update*(frame: TextFrames.Frame; VAR m: TextFrames.UpdateMsg);
		VAR r: Texts.Reader; prev, last: LONGINT; ch: CHAR;
	BEGIN xeHandle(frame, m); (*<<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);	(*<<*)
		VAR s: Texts.Scanner; par: Oberon.ParList; res: INTEGER;
	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
			ELSIF m IS Oberon.InputMsg THEN
				WITH m: Oberon.InputMsg DO
					IF (m.id = Oberon.consume) & frame.hasCar & (m.ch = Enter) THEN	(* execute command at beg of line *)
						Texts.OpenScanner(s, frame.text, frame.carloc.org); Texts.Scan(s);
						IF s.class = Texts.Name THEN
							NEW(par); par.frame := frame; par.text := frame.text; par.pos := Texts.Pos(s)-1;
							Oberon.Call(s.s, par, FALSE, res);
							IF res > 0 THEN
								Str("Call error: "); Str(Modules.importing);
								IF res = 1 THEN Str(" not found")
								ELSIF res = 2 THEN Str(" not an obj-file")
								ELSIF res = 3 THEN Str(" imports "); Str(Modules.imported); Str(" with bad key")
								ELSIF res = 4 THEN Str(" corrupted obj file")
								ELSIF res = 6 THEN Str(" has too many imports")
								ELSIF res = 7 THEN Str(" not enough space")
								END
							ELSIF res < 0 THEN Str(s.s); Str(" not found")
							END;
							IF res # 0 THEN Ln END
						END
					ELSE xeHandle(frame, m)
					END
				END
			ELSE xeHandle(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);
		OpenMenu(mf, "Log", LogMenuText, Menu);	(*<<*)
		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;
			(*<<scrollMsg.id := Texts.insert; scrollMsg.beg := pin; scrollMsg.end := pos; Viewers.Broadcast(scrollMsg)	(*<<*)*)
		END
	END SetPin;
	PROCEDURE Clear*;
	BEGIN
		Texts.Delete( Oberon.Log, 0,Oberon.Log^.len); pin := 0; lastLen := 0; Elem(defParc);
		Texts.Write(w, CHR(13)); Texts.Append(Oberon.Log, w.buf)
	END Clear;
	PROCEDURE InitParc;
		VAR width: LONGINT; msg: Texts.CopyMsg;
	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"));
	NEW(task); task.handle := SetPin; task.safe:= FALSE; task.time := -1; Oberon.Install(task);
	pin := 0; lastLen := 0; InitParc; GetXEHandler
	(*from XLog
			hexAlpha := "0123456789ABCDEF";
END Log.