Oberon/V2/Edit

MODULE Edit; (*JG 26.11.91*)

	IMPORT Files, Display, Viewers, MenuViewers, Oberon, Fonts, Texts, TextFrames, Printer;

	CONST
		CR = 0DX; maxlen = 32;
		StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store";

	VAR
		W: Texts.Writer;
		time: LONGINT;
		M: INTEGER;
		pat: ARRAY maxlen OF CHAR;
		d: ARRAY 256 OF INTEGER;

	PROCEDURE Max (i, j: LONGINT): LONGINT;
	BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
	END Max;

	PROCEDURE Open*;
		VAR par: Oberon.ParList;
			T: Texts.Text; S: Texts.Scanner;
			V: Viewers.Viewer;
			X, Y: INTEGER;
			beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF S.class = Texts.Name THEN
			Oberon.AllocateUserViewer(par.vwr.X, X, Y);
			V := MenuViewers.New(
				TextFrames.NewMenu(S.s, StandardMenu),
				TextFrames.NewText(TextFrames.Text(S.s), 0),
				TextFrames.menuH,
				X, Y)
		END
	END Open;

	PROCEDURE Show*;
		VAR par: Oberon.ParList;
			T, t: Texts.Text;
			R: Texts.Reader; S: Texts.Scanner;
			V: Viewers.Viewer;
			X, Y, n, i, j: INTEGER;
			pos, len, beg, end, time: LONGINT;
			buf: ARRAY 32 OF CHAR;
			name: ARRAY 35 OF CHAR;
			M: INTEGER;
			pat: ARRAY maxlen OF CHAR;
			d: ARRAY 256 OF INTEGER;

		PROCEDURE Forward (n: INTEGER);
			VAR m: INTEGER; j: INTEGER;
		BEGIN m := M - n;
			j := 0;
			WHILE j # m DO buf[j] := buf[n + j]; INC(j) END;
			WHILE j # M DO Texts.Read(R, buf[j]); INC(j) END
		END Forward;

	BEGIN
		par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF S.class = Texts.Name THEN
		i := -1; j := 0;
		WHILE S.s[j] # 0X DO
			IF S.s[j] = "." THEN i := j END;
			name[j] := S.s[j]; j := j+1
		END;
		IF i < 0 THEN name[j] := "."; i := j END;
		name[i+1] := "M"; name[i+2] := "o"; name[i+3] := "d"; name[i+4] := 0X;
		t := TextFrames.Text(name);
		IF j > i THEN (*object name specified*)
			j := i+1; M := 0;
			WHILE (M # maxlen) & (S.s[j] # 0X) DO pat[M] := S.s[j]; j := j+1; M := M+1 END;
			j := 0;
			WHILE j # 256 DO d[j] := M; INC(j) END;
			j := 0;
			WHILE j # M - 1 DO d[ORD(pat[j])] := M - 1 - j; INC(j) END;
			pos := 0; len := t.len;
			Texts.OpenReader(R, t, pos);
			Forward(M); pos := pos + M;
			LOOP j := M;
				REPEAT DEC(j) UNTIL (j < 0) OR (buf[j] # pat[j]);
				IF (j < 0) OR (pos >= len) THEN EXIT END;
				n := d[ORD(buf[M-1])];
				Forward(n); pos := pos + n
			END
		ELSE pos := 0
		END;
		Oberon.AllocateUserViewer(par.vwr.X, X, Y);
		V := MenuViewers.New(
			TextFrames.NewMenu(name, StandardMenu),
			TextFrames.NewText(t, pos-200),
			TextFrames.menuH,
			X, Y)
		END
	END Show;

	PROCEDURE Store*;
		VAR par: Oberon.ParList;
			V: Viewers.Viewer;
			Text: TextFrames.Frame;
			T: Texts.Text; S: Texts.Scanner;
			f: Files.File;
			beg, end, time, len: LONGINT;

		PROCEDURE Backup (VAR name: ARRAY OF CHAR);
			VAR res, i: INTEGER; bak: ARRAY 32 OF CHAR;
		BEGIN i := 0;
			WHILE name[i] # 0X DO bak[i] := name[i]; INC(i) END;
			bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X;
			Files.Rename(name, bak, res)
		END Backup;
		
	BEGIN
		Texts.WriteString(W, "Edit.Store ");
		par := Oberon.Par;
		IF par.frame = par.vwr.dsc THEN
			V := par.vwr; Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0)
		ELSE V := Oberon.MarkedViewer(); Texts.OpenScanner(S, par.text, par.pos)
		END;
		Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF (S.class = Texts.Name) & (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
			Text := V.dsc.next(TextFrames.Frame);
			TextFrames.Mark(Text, -1);
			Texts.WriteString(W, S.s); Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf);
			Backup(S.s);
			f := Files.New(S.s);
			Texts.Store(Text.text, f, 0, len);
			Files.Register(f);
			TextFrames.Mark(Text, 1)
		END
	END Store;

	PROCEDURE CopyFont*;
		VAR
			T: Texts.Text; R: Texts.Reader;
			V: Viewers.Viewer; F: Display.Frame;
			beg, end: LONGINT;
			X, Y: INTEGER;
			ch: CHAR;
	BEGIN
		V := Oberon.MarkedViewer(); F := V.dsc;
		X := Oberon.Pointer.X; Y := Oberon.Pointer.Y;
		LOOP
			IF F = NIL THEN EXIT END;
			IF (X >= F.X) & (X < F.X + F.W) & (Y >= F.Y) & (Y < F.Y + F.H) THEN
				IF F IS TextFrames.Frame THEN
					WITH F: TextFrames.Frame DO
						Texts.OpenReader(R, F.text, TextFrames.Pos(F, X, Y));
						Texts.Read(R, ch);
						Oberon.GetSelection(T, beg, end, time);
						IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {0}, R.fnt, 0, 0) END
					END
				END;
				EXIT
			END;
			F := F.next
		END
	END CopyFont;

	PROCEDURE ChangeFont*;
		VAR par: Oberon.ParList;
			T: Texts.Text; S: Texts.Scanner;
			beg, end: LONGINT;
	BEGIN
		Oberon.GetSelection(T, beg, end, time);
		IF time >= 0 THEN par := Oberon.Par;
			Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
			IF S.class = Texts.Name THEN
				Texts.ChangeLooks(T, beg, end, {0}, Fonts.This(S.s), 0, 0)
			END
		END
	END ChangeFont;

	PROCEDURE ChangeColor*;
		VAR par: Oberon.ParList;
			T: Texts.Text; S: Texts.Scanner;
			col: SHORTINT; ch: CHAR;
			beg, end, time: LONGINT;
	BEGIN par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF S.class = Texts.Int THEN col := SHORT(SHORT(S.i))
		ELSIF (S.class = Texts.Char) & (S.c = "^") & (par.frame(TextFrames.Frame).sel > 0) THEN
			Texts.OpenReader(S, par.text, par.frame(TextFrames.Frame).selbeg.pos);
			Texts.Read(S, ch); col := S.col
		ELSE col := Oberon.CurCol
		END ;
		Oberon.GetSelection(T, beg, end, time);
		IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {1}, NIL, col, 0) END
	END ChangeColor;

	PROCEDURE ChangeOffset*;
		VAR par: Oberon.ParList;
			T: Texts.Text; S: Texts.Scanner;
			voff: SHORTINT; ch: CHAR;
			beg, end, time: LONGINT;
	BEGIN par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF S.class = Texts.Int THEN voff := SHORT(SHORT(S.i))
		ELSIF (S.class = Texts.Char) & (S.c = "^") & (par.frame(TextFrames.Frame).sel > 0) THEN
			Texts.OpenReader(S, par.text, par.frame(TextFrames.Frame).selbeg.pos);
			Texts.Read(S, ch); voff := S.voff
		ELSE voff := Oberon.CurOff
		END ;
		Oberon.GetSelection(T, beg, end, time);
		IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {2}, NIL, voff, 0) END
	END ChangeOffset;

	PROCEDURE Search*;
		VAR V: Viewers.Viewer;
			Text: TextFrames.Frame;
			T: Texts.Text; R: Texts.Reader;
			pos, beg, end, prevTime, len: LONGINT; n, i, j: INTEGER;
			buf: ARRAY 32 OF CHAR;

		PROCEDURE Forward (n: INTEGER);
			VAR m: INTEGER; j: INTEGER;
		BEGIN m := M - n;
			j := 0;
			WHILE j # m DO buf[j] := buf[n + j]; INC(j) END;
			WHILE j # M DO Texts.Read(R, buf[j]); INC(j) END
		END Forward;

	BEGIN
		V := Oberon.Par.vwr;
		IF Oberon.Par.frame # V.dsc THEN V := Oberon.MarkedViewer() END;
		IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
			Text := V.dsc.next(TextFrames.Frame);
			TextFrames.Mark(Text, -1);
			prevTime := time; Oberon.GetSelection(T, beg, end, time);
			IF time > prevTime THEN
				Texts.OpenReader(R, T, beg);
				i := 0; pos := beg;
				REPEAT Texts.Read(R, pat[i]); INC(i); INC(pos)
				UNTIL (i = maxlen) OR (pos = end);
				M := i;
				j := 0;
				WHILE j # 256 DO d[j] := M; INC(j) END;
				j := 0;
				WHILE j # M - 1 DO d[ORD(pat[j])] := M - 1 - j; INC(j) END
			END;
			IF Text.car > 0 THEN pos := Text.carloc.pos ELSE pos := 0 END;
			len := Text.text.len;
			Texts.OpenReader(R, Text.text, pos);
			Forward(M); pos := pos + M;
			LOOP j := M;
				REPEAT DEC(j) UNTIL (j < 0) OR (buf[j] # pat[j]);
				IF (j < 0) OR (pos >= len) THEN EXIT END;
				n := d[ORD(buf[M-1])];
				Forward(n); pos := pos + n
			END;
			IF j < 0 THEN
				TextFrames.RemoveSelection(Text);
				TextFrames.RemoveCaret(Text);
				Oberon.RemoveMarks(Text.X, Text.Y, Text.W, Text.H);
				TextFrames.Show(Text, pos - 200);
				Oberon.PassFocus(V);
				TextFrames.SetCaret(Text, pos)
			END;
			TextFrames.Mark(Text, 1)
		END
	END Search;

	PROCEDURE Locate*;
		VAR V: Viewers.Viewer;
			Text: TextFrames.Frame;
			T: Texts.Text; S: Texts.Scanner;
			beg, end, time: LONGINT;
	BEGIN
		V := Oberon.MarkedViewer();
		IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
			Text := V.dsc.next(TextFrames.Frame);
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN
				Texts.OpenScanner(S, T, beg);
				REPEAT Texts.Scan(S) UNTIL (S.class >= Texts.Int); (*skip names*)
				IF S.class = Texts.Int THEN
					TextFrames.RemoveSelection(Text);
					TextFrames.RemoveCaret(Text);
					Oberon.RemoveMarks(Text.X, Text.Y, Text.W, Text.H);
					TextFrames.Show(Text, Max(0, S.i - 200));
					Oberon.PassFocus(V);
					TextFrames.SetCaret(Text, S.i)
				END
			END
		END
	END Locate;

	PROCEDURE Recall*;
		VAR V: Viewers.Viewer;
			Menu, Main: Display.Frame;
			buf: Texts.Buffer;
			pos: LONGINT;
	BEGIN V := Oberon.FocusViewer;
		IF V IS MenuViewers.Viewer THEN
			Menu := V.dsc; Main := V.dsc.next;
			IF (Main IS TextFrames.Frame) & (Main(TextFrames.Frame).car > 0) THEN
				WITH Main: TextFrames.Frame DO
					Texts.Recall(buf);
					pos := Main.carloc.pos + buf.len;
					Texts.Insert(Main.text, Main.carloc.pos, buf);
					TextFrames.SetCaret(Main, pos)
				END
			ELSIF (Menu IS TextFrames.Frame) & (Menu(TextFrames.Frame).car > 0) THEN
				WITH Menu: TextFrames.Frame DO
					Texts.Recall(buf);
					pos := Menu.carloc.pos + buf.len;
					Texts.Insert(Menu.text, Menu.carloc.pos, buf);
					TextFrames.SetCaret(Menu, pos)
				END
			END
		END
	END Recall;

	PROCEDURE Print*;

		CONST
			textX = 160; textY = 225; botY = 100;

		VAR
			par: Oberon.ParList;
			V: Viewers.Viewer;
			Menu, Text: TextFrames.Frame;
			T, source: Texts.Text;
			R: Texts.Reader; S: Texts.Scanner;
			fnt: Fonts.Font;
			id, ch: CHAR;
			pageno: SHORTINT; listing: BOOLEAN;
			nofcopies, len, lsp, Y, topY: INTEGER;
			beg, end, time: LONGINT;

		PROCEDURE SendHeader;
			VAR pno: ARRAY 4 OF CHAR;
		BEGIN Printer.String(textX, Printer.PageHeight-125, S.s, Fonts.Default.name);
			IF pageno DIV 10 = 0 THEN pno[0] := " " ELSE pno[0] := CHR(pageno DIV 10 + 30H) END ;
			pno[1] := CHR(pageno MOD 10 + 30H); pno[2] := 0X;
			Printer.String(Printer.PageWidth-236, Printer.PageHeight-125, pno, Fonts.Default.name)
		END SendHeader;

		PROCEDURE PrintUnit (source: Texts.Text; pos: LONGINT);
			VAR i: INTEGER; new: BOOLEAN;
				buf: ARRAY 200 OF CHAR;
		BEGIN Texts.WriteString(W, S.s);
			IF source.len # 0 THEN
				Texts.WriteString(W, " printing"); Texts.WriteInt(W, nofcopies, 3);
				Texts.Append(Oberon.Log, W.buf);
				lsp := Fonts.Default.height * 7 DIV 2; pageno := 0;
				SendHeader; Y := topY;
				Texts.OpenReader(R, source, pos);
				IF ~listing THEN
					REPEAT Texts.Read(R, ch);
						new := TRUE; fnt := R.fnt;
						WHILE ~R.eot & (ch # CR) DO
							i := 0;
							REPEAT buf[i] := ch; INC(i); Texts.Read(R, ch)
							UNTIL R.eot OR (ch = CR) OR (R.fnt # fnt);
							buf[i] := 0X;
							IF new THEN Printer.String(textX, Y, buf, fnt.name)
							ELSE Printer.ContString(buf, fnt.name)
							END;
							new := FALSE; fnt := R.fnt
						END;
						Y := Y - lsp;
						IF Y < botY THEN
							Printer.Page(nofcopies); INC(pageno); SendHeader; Y := topY
						END
					UNTIL R.eot
				ELSE lsp := 32;
					REPEAT Texts.Read(R, ch);
						WHILE ~R.eot & (ch # CR) DO
							i := 0;
							REPEAT buf[i] := ch; INC(i); Texts.Read(R, ch)
							UNTIL R.eot OR (ch = CR);
							buf[i] := 0X;
							Printer.String(textX, Y, buf, Fonts.Default.name)
						END;
						Y := Y - lsp;
						IF Y < botY THEN
							Printer.Page(nofcopies); INC(pageno); SendHeader; Y := topY
						END
					UNTIL R.eot
				END;
				IF Y < topY THEN Printer.Page(nofcopies) END
			ELSE Texts.WriteString(W, " not found")
			END;
			Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf)
		END PrintUnit;

		PROCEDURE Option;
			VAR ch: CHAR;
		BEGIN nofcopies := 1;
			IF S.nextCh = "/" THEN
				Texts.Read(S, ch);
				IF (ch >= "0") & (ch <= "9") THEN nofcopies := ORD(ch) - 30H END ;
				WHILE ch > " " DO Texts.Read(S, ch) END;
				S.nextCh := ch
			END
		END Option;

	BEGIN par := Oberon.Par;
		Texts.WriteString(W, "Edit.Print"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF S.class = Texts.Name THEN
			Printer.Open(S.s, Oberon.User, Oberon.Password);
			IF Printer.res = 0 THEN
				topY := Printer.PageHeight - textY; Texts.Scan(S);
				IF (S.class = Texts.Char) & (S.c = "%") THEN
					listing := TRUE; Printer.UseListFont(Fonts.Default.name); Texts.Scan(S)
				ELSE listing := FALSE
				END;
				IF (S.class = Texts.Char) & (S.c = "*") THEN
					Option; V := Oberon.MarkedViewer();
					IF (V.dsc IS TextFrames.Frame) & (V.dsc.next IS TextFrames.Frame) THEN
						Menu := V.dsc(TextFrames.Frame); Text := V.dsc.next(TextFrames.Frame);
						Texts.OpenScanner(S, Menu.text, 0); Texts.Scan(S);
						TextFrames.Mark(Text, -1); PrintUnit(Text.text, 0); TextFrames.Mark(Text, 1)
					END
				ELSE
					WHILE S.class = Texts.Name DO
						Option; NEW(source); Texts.Open(source, S.s); PrintUnit(source, 0);
						Texts.Scan(S)
					END;
					IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
						IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
							IF S.class = Texts.Name THEN
								Option; NEW(source); Texts.Open(source, S.s); PrintUnit(source, 0)
							END
						END
					END
				END;
				Printer.Close
			ELSE
				IF Printer.res = 1 THEN Texts.WriteString(W, " no printer")
					ELSIF Printer.res = 2 THEN Texts.WriteString(W, " no link")
					ELSIF Printer.res = 3 THEN Texts.WriteString(W, " printer not ready")
					ELSIF Printer.res = 4 THEN Texts.WriteString(W, " no permission")
				END;
				Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
			END
		ELSE Texts.WriteString(W, " no printer specified");
			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
		END
	END Print;

	PROCEDURE InitPattern;
		VAR j: INTEGER;
	BEGIN
		pat[0] := " "; M := 1; time := -1; j := 0;
		WHILE j # 256 DO d[j] := M; INC(j) END
	END InitPattern;

BEGIN Texts.OpenWriter(W); InitPattern
END Edit.