Syntax10.Scn.Fnt
StampElems
Alloc
22 Apr 96
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
FoldElems
MODULE VersionElems;	(* HM 14 Sep 95 / 
IMPORT Display, Viewers, Files, Input, Texts, TextFrames, TextPrinter, Oberon, PopupElems, In, Out;
CONST
	maxVersions = 8;
	pixel = LONG(10000);
	ML = 2; MM = 1; MR = 0;
	Beg* = POINTER TO BegDesc;
	BegDesc* = RECORD (PopupElems.ElemDesc)
		cur: ARRAY 32 OF CHAR;	(*current version*)
		vers: ARRAY maxVersions, 32 OF CHAR;	(*version names*)
		buf: ARRAY maxVersions OF Texts.Buffer	(*version texts*)
	END ;
	End* = POINTER TO EndDesc;
	EndDesc* = RECORD (Texts.ElemDesc) END ;
	begIcon, endIcon: Display.Pattern;	(* x = 0, y = 3, w = 6, h = 9 *)
	scratch: Texts.Text;
	w: Texts.Writer;
PROCEDURE (e: Beg) IndexOf (version: ARRAY OF CHAR): INTEGER;	
	VAR i: INTEGER;
BEGIN
	i := 0;
	WHILE (i < maxVersions) & (e.vers[i] # "") DO
		IF e.vers[i] = version THEN RETURN i END;
		INC(i)
	END;
	RETURN -1
END IndexOf;
PROCEDURE (e: Beg) CheckMenu;	
	VAR s: Texts.Scanner; vers: ARRAY maxVersions, 32 OF CHAR; buf: ARRAY maxVersions OF Texts.Buffer; i, j: INTEGER;
BEGIN
	Texts.OpenScanner(s, e.menu, 0); i := 0;
	REPEAT
		Texts.Scan(s);
		IF (i < maxVersions) & (s.class = Texts.Name) THEN
			COPY(s.s, vers[i]);
			j := e.IndexOf(s.s);
			IF j >= 0 THEN buf[i] := e.buf[j] ELSE NEW(buf[i]); Texts.OpenBuf(buf[i]) END;
			INC(i)
		END
	UNTIL s.eot;
	FOR j := 0 TO i-1 DO COPY(vers[j], e.vers[j]); e.buf[j] := buf[j] END;
	IF i < maxVersions THEN e.vers[i] := "" END
END CheckMenu;
PROCEDURE (e: Beg) TwinPos (): LONGINT;	
	VAR r: Texts.Reader; level: INTEGER;
BEGIN
	Texts.OpenReader(r, Texts.ElemBase(e), Texts.ElemPos(e)+1);
	level := 1;
	LOOP
		Texts.ReadElem(r);
		IF r.eot THEN RETURN -1
		ELSIF r.elem IS Beg THEN INC(level)
		ELSIF r.elem IS End THEN DEC(level);
			IF level = 0 THEN RETURN Texts.Pos(r) - 1 END
		END
END TwinPos;
PROCEDURE (e: Beg) SwitchTo (version: ARRAY OF CHAR);	
	VAR t: Texts.Text; beg, end: LONGINT; i, j: INTEGER;
BEGIN
	e.CheckMenu;
	IF version # e.cur THEN
		i := e.IndexOf(version); j := e.IndexOf(e.cur);
		IF i >= 0 THEN
			t := Texts.ElemBase(e); beg := Texts.ElemPos(e) + 1; end := e.TwinPos();
			IF end >= 0 THEN 
				Texts.Delete(t, beg, end);
				Texts.Insert(t, beg, e.buf[i]);
				IF j >= 0 THEN Texts.Recall(e.buf[j]) END;
				COPY(version, e.cur)
			END
		ELSE Out.String("-- no version "); Out.String(version); Out.F(" at pos #$", Texts.ElemPos(e))
		END
END SwitchTo;
PROCEDURE InitIcons;	
	VAR line: ARRAY 10 OF SET;
BEGIN
	line[1] := {4};
	line[2] := {3};
	line[3] := {2};
	line[4] := {1};
	line[5] := {0};
	line[6] := {1};
	line[7] := {2};
	line[8] := {3};
	line[9] := {4};
	begIcon := Display.NewPattern(line, 6, 9);
	line[1] := {1};
	line[2] := {2};
	line[3] := {3};
	line[4] := {4};
	line[5] := {5};
	line[6] := {4};
	line[7] := {3};
	line[8] := {2};
	line[9] := {1};
	endIcon := Display.NewPattern(line, 6, 9);
END InitIcons;
PROCEDURE NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);	
END NoNotify;
PROCEDURE SwitchAll (t: Texts.Text; version: ARRAY OF CHAR);	
	VAR r: Texts.Reader; pos: LONGINT; e: Beg;
BEGIN
	Texts.OpenReader(r, t, 0);
	LOOP
		Texts.ReadElem(r);
		IF r.eot THEN EXIT END;
		IF r.elem IS Beg THEN
			pos := Texts.Pos(r) + 1; e := r.elem(Beg); e.SwitchTo(version); Texts.OpenReader(r, t, pos)
		END
END SwitchAll;
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;
	TextFrames.SetCaret(f, pos)
END ShowPos;
PROCEDURE HandleBeg* (e: Texts.Elem; VAR m: Texts.ElemMsg);	
	VAR e1: Beg; i: INTEGER; str: ARRAY 32 OF CHAR; s: Texts.Scanner;
BEGIN
	WITH e: Beg DO
		WITH m: TextFrames.DisplayMsg DO
			e.W := 6*pixel; e.H := 9*pixel;
			IF ~m.prepare THEN
				Display.CopyPattern(Display.white, begIcon, m.X0, m.Y0+3, Display.paint)
			END
		| m: TextPrinter.PrintMsg DO
			IF m.prepare THEN e.W := 1 ELSE e.W := 7*pixel END
		| m: Texts.CopyMsg DO
			IF m.e = NIL THEN NEW(e1); m.e := e1 ELSE e1 := m.e(Beg) END ;
			COPY(e.cur, e1.cur); i := 0;
			WHILE (i < maxVersions) & (e.vers[i] # "") DO
				COPY(e.vers[i], e1.vers[i]);
				NEW(e1.buf[i]); Texts.OpenBuf(e1.buf[i]); Texts.Copy(e.buf[i], e1.buf[i]);
				INC(i)
			END ;
			PopupElems.Handle(e, m)
		| m: Texts.IdentifyMsg DO
			m.mod := "VersionElems"; m.proc := "AllocBeg"
		| m: Texts.FileMsg DO
			PopupElems.Handle(e, m);
			IF m.id = Texts.load THEN
				Files.ReadString(m.r, e.cur);
				Files.ReadString(m.r, str); i := 0;
				WHILE str # "" DO
					COPY(str, e.vers[i]);
					Texts.Load(m.r, scratch); Texts.Delete(scratch, 0, scratch.len);
					NEW(e.buf[i]); Texts.Recall(e.buf[i]);
					INC(i); Files.ReadString(m.r, str)
				END
			ELSE (*Texts.store*)
				Files.WriteString(m.r, e.cur); i := 0;
				WHILE (i < maxVersions) & (e.vers[i] # "") DO
					Files.WriteString(m.r, e.vers[i]);
					Texts.Append(scratch, e.buf[i]); Texts.Store(m.r, scratch);
					Texts.Delete(scratch, 0, scratch.len); Texts.Recall(e.buf[i]);
					INC(i)
				END ;
				Files.WriteString(m.r, "")
			END
		| m: PopupElems.ExecMsg DO
			Texts.OpenScanner(s, e.menu, m.pos); Texts.Scan(s);
			IF s.class = Texts.Name THEN SwitchAll(Texts.ElemBase(e), s.s) END
		ELSE PopupElems.Handle(e, m)
		END
END HandleBeg;
PROCEDURE HandleEnd* (e: Texts.Elem; VAR m: Texts.ElemMsg);	
	VAR e1: End; keys: SET; x, y: INTEGER;
BEGIN
	WITH e: End DO
		WITH m: TextFrames.DisplayMsg DO
			e.W := 6 * TextFrames.Unit; e.H := 9 * TextFrames.Unit;
			IF ~m.prepare THEN
				Display.CopyPattern(Display.white, endIcon, m.X0, m.Y0+3, Display.paint)
			END
		| m: TextPrinter.PrintMsg DO
			IF m.prepare THEN e.W := 1 ELSE e.W := 7*pixel END
		| m: Texts.CopyMsg DO
			IF m.e = NIL THEN NEW(e1); m.e := e1 ELSE e1 := m.e(End) END ;
			Texts.CopyElem(e, e1)
		| m: Texts.IdentifyMsg DO
			m.mod := "VersionElems"; m.proc := "AllocEnd"
		| m: TextFrames.TrackMsg DO
			IF m.keys = {MM} THEN
				REPEAT
					Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
				UNTIL keys = {}
			END
		ELSE
		END
END HandleEnd;
PROCEDURE AllocBeg*;	
	VAR e: Beg;
BEGIN
	NEW(e); e.handle := HandleBeg; Texts.new := e
END AllocBeg;
PROCEDURE AllocEnd*;	
	VAR e: End;
BEGIN
	NEW(e); e.handle := HandleEnd; Texts.new := e
END AllocEnd;
PROCEDURE Insert*;	
	VAR a: Beg; b: End; t: Texts.Text; beg, end, time: LONGINT; s: Texts.Scanner;
BEGIN
	Oberon.GetSelection(t, beg, end, time);
	IF time >= 0 THEN
		Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
		IF s.class = Texts.Name THEN
			NEW(a);
			a.W := 7*pixel; a.H := 11*pixel; a.handle := HandleBeg; COPY(s.s, a.cur);
			a.menu := TextFrames.Text("");
			Texts.WriteString(w, s.s); Texts.Append(a.menu, w.buf); PopupElems.MeasureMenu(a);
			Texts.WriteElem(w, a); Texts.Insert(t, beg, w.buf);
			NEW(b);
			b.W := 7*pixel; b.H := 11*pixel; b.handle := HandleEnd;
			Texts.WriteElem(w, b); Texts.Insert(t, end+1, w.buf)
		ELSE Out.String("-- version name must be an Oberon name$")
		END
	ELSE Out.String("-- no selection$")
END Insert;
PROCEDURE SetVersion*;	
	VAR version: ARRAY 32 OF CHAR; v: Viewers.Viewer; t: Texts.Text;
BEGIN
	In.Open; In.Name(version);
	IF In.Done THEN
		v := Oberon.MarkedViewer();
		IF (v # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
			t := v.dsc.next(TextFrames.Frame).text;
			SwitchAll(t, version)
		END
	ELSE Out.String("-- version name must be an Oberon name$")
END SetVersion;
PROCEDURE Find*;	
	VAR v: Viewers.Viewer; f: TextFrames.Frame; r: Texts.Reader; pos: LONGINT;
BEGIN
	v := Oberon.FocusViewer;
	IF (v # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
		f := v.dsc.next(TextFrames.Frame);
		IF f.hasCar THEN pos := f.carloc.pos ELSE pos := 0 END;
		Texts.OpenReader(r, f.text, pos);
		REPEAT Texts.ReadElem(r) UNTIL r.eot OR (r.elem IS Beg);
		IF ~r.eot THEN ShowPos(f, Texts.Pos(r)) ELSE TextFrames.RemoveCaret(f) END
END Find;
BEGIN
	InitIcons;
	Texts.OpenWriter(w);
	NEW(scratch); Texts.Open(scratch, ""); scratch.notify := NoNotify
END VersionElems.