ð›Syntax10.Scn.FntSyntax10i.Scn.FntõåSyntax10b.Scn.Fnté€iò7MODULE LineSorter; (* Copyright: ww 2 Nov 94 *) IMPORT Oberon, MenuViewers, Viewers, TextFrames, Texts, Fonts, Files; CONST Menu = "System.Close System.Copy System.Grow Edit.Search Edit.Replace Edit.Parcs Edit.Store "; Version = "LineSorter 2.1 (ww 2 Nov 94)"; NofLevel = 32; TYPE FieldList = POINTER TO FieldListDesc; FieldListDesc = RECORD next: FieldList; n: LONGINT; numeric: BOOLEAN END; FormList = POINTER TO FormListDesc; FormListDesc = RECORD next: FormList END; TextForm = POINTER TO RECORD(FormListDesc) text: Texts.Text; beg, end: LONGINT END; CharForm = POINTER TO RECORD(FormListDesc) fnt: Fonts.Font; col, voff, pos: SHORTINT END; FieldForm = POINTER TO RECORD(FormListDesc) fnt: Fonts.Font; col, voff, n: SHORTINT END; BranchForm = POINTER TO RECORD(FormListDesc) skip: FormList; cond: ARRAY NofLevel OF RECORD n: SHORTINT; neg: BOOLEAN END END; EntryList = POINTER TO ARRAY OF LONGINT; Index = POINTER TO ARRAY OF INTEGER; Scanner = RECORD(Texts.Scanner) base: Texts.Text END; VAR w: Texts.Writer; characters: Texts.Text; error: BOOLEAN; errorText: ARRAY 7, 32 OF CHAR; PROCEDURE OpenInput(VAR s: Scanner; cmd: ARRAY OF CHAR); BEGIN error := FALSE; Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s); s.base := Oberon.Par.text; Texts.WriteString(w, cmd); Texts.WriteString(w, ": ") END OpenInput; PROCEDURE ParameterError(VAR s: Scanner; no: LONGINT); BEGIN error := TRUE; Texts.WriteString(w, errorText[no]); Texts.WriteString(w, " pos "); Texts.WriteInt(w, Texts.Pos(s), 0); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) END ParameterError; PROCEDURE Report(nofLines: LONGINT); BEGIN Texts.WriteInt(w, nofLines, 0); Texts.WriteString(w, " lines read."); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) END Report; PROCEDURE GetSource(VAR s: Scanner; VAR text: Texts.Text; VAR beg, end: LONGINT); VAR time: LONGINT; v: Viewers.Viewer; BEGIN IF (s.class = Texts.Name) OR (s.class = Texts.String) THEN text := TextFrames.Text(s.s); beg := 0; end := text.len; Texts.Scan(s) ELSIF s.class = Texts.Char THEN IF s.c = "*" THEN v := Oberon.MarkedViewer(); IF (v # NIL) & (v IS MenuViewers.Viewer) & (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN text := v.dsc.next(TextFrames.Frame).text; beg := 0; end := text.len; Texts.Scan(s) END ELSIF s.c = "@" THEN Oberon.GetSelection(text, beg, end, time); IF time < 0 THEN text := NIL; beg := 0; end := 0; ParameterError(s, 0) END; Texts.Scan(s) ELSE ParameterError(s, 1) END ELSE ParameterError(s, 1) END END GetSource; PROCEDURE GetFieldList(VAR s: Scanner; VAR list: FieldList); VAR last, f: FieldList; BEGIN list := NIL; last := NIL; WHILE ~error & (((s.class = Texts.Char) & (s.c = "#")) OR (s.class = Texts.Int)) DO NEW(f); IF last # NIL THEN last.next := f ELSE list := f END; last := f; f.numeric := s.class # Texts.Int; IF s.class # Texts.Int THEN Texts.Scan(s) END; IF s.class = Texts.Int THEN f.n := s.i; Texts.Scan(s) ELSE ParameterError(s, 2) END END END GetFieldList; PROCEDURE GetNumber(VAR s: Scanner; VAR n: SHORTINT); BEGIN n := 0; Texts.Read(s, s.nextCh); WHILE ~s.eot & (s.nextCh >= "0") & (s.nextCh <= "9") DO n := 10 * n + SHORT(ORD(s.nextCh) - ORD("0")); Texts.Read(s, s.nextCh) END; IF n = 0 THEN ParameterError(s, 2) END END GetNumber; PROCEDURE GetFormat(VAR s: Scanner; VAR list: FormList); VAR text: Texts.Text; beg, end, time, level, i: LONGINT; del: CHAR; last, f: FormList; tf: TextForm; cf: CharForm; ff: FieldForm; bf: BranchForm; stack: ARRAY NofLevel OF BranchForm; BEGIN IF (s.class = Texts.Char) & (s.c = "^") THEN Oberon.GetSelection(text, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(s, text, beg); s.base := text; Texts.Scan(s) END END; WHILE (s.class = Texts.Char) & (s.c = Texts.ElemChar) DO Texts.Scan(s) END; list := NIL; IF ~error & (s.class = Texts.Char) & (s.c = "[") THEN last := NIL; level := 0; WHILE ~s.eot & (s.nextCh <= " ") DO Texts.Read(s, s.nextCh) END; WHILE ~s.eot & ~error & ((s.nextCh # "]") OR (level # 0)) DO IF s.nextCh = "]" THEN DEC(level); stack[level].skip := last; Texts.Read(s, s.nextCh) ELSE IF (s.nextCh = 22X) OR (s.nextCh = "'") THEN NEW(tf); f := tf; del := s.nextCh; tf.text := s.base; tf.beg := Texts.Pos(s); Texts.Read(s, s.nextCh); WHILE ~s.eot & (s.nextCh # del) DO Texts.Read(s, s.nextCh) END; tf.end := Texts.Pos(s) - 1; Texts.Read(s, s.nextCh) ELSIF s.nextCh = "F" THEN NEW(ff); f := ff; ff.fnt := s.fnt; ff.col := s.col; ff.voff := s.voff; GetNumber(s, ff.n) ELSIF (s.nextCh = "T") OR (s.nextCh = "C") OR (s.nextCh = "B") THEN NEW(cf); f := cf; cf.fnt := s.fnt; cf.col := s.col; cf.voff := s.voff; IF s.nextCh = "T" THEN cf.pos := 0 ELSIF s.nextCh = "C" THEN cf.pos := 1 ELSE cf.pos := 2 END; Texts.Read(s, s.nextCh) ELSIF (s.nextCh = "!") OR (s.nextCh = "~") THEN IF level < NofLevel THEN NEW(bf); f := bf; stack[level] := bf; INC(level); i := 0; REPEAT bf.cond[i].neg := s.nextCh = "~"; GetNumber(s, bf.cond[i].n); INC(i); WHILE ~s.eot & (s.nextCh <= " ") DO Texts.Read(s, s.nextCh) END UNTIL s.eot OR error OR ((s.nextCh # "!") & (s.nextCh # "~")) OR (i = NofLevel); IF i # NofLevel THEN bf.cond[i].n := 0; IF ~error THEN IF s.nextCh # "[" THEN ParameterError(s, 3) END; Texts.Read(s, s.nextCh) END ELSE ParameterError(s, 4) END ELSE ParameterError(s, 4) END ELSE ParameterError(s, 5) END; IF last # NIL THEN last.next := f ELSE list := f END; last := f END; WHILE ~s.eot & (s.nextCh <= " ") DO Texts.Read(s, s.nextCh) END END; IF s.eot & ~error THEN ParameterError(s, 6) END END END GetFormat; PROCEDURE NewTable(t: Texts.Text; beg, end: LONGINT): EntryList; VAR i, pos: LONGINT; ch: CHAR; tab: EntryList; r: Texts.Reader; BEGIN Texts.OpenReader(r, t, beg); Texts.Read(r, ch); pos := beg; i := 0; WHILE pos < end DO WHILE ~r.eot & (ch # 0DX) DO Texts.Read(r, ch); INC(pos) END; Texts.Read(r, ch); INC(pos); INC(i) END; NEW(tab, i); Texts.OpenReader(r, t, beg); Texts.Read(r, ch); pos := beg; i := 0; WHILE pos < end DO tab[i] := pos; INC(i); WHILE ~r.eot & (ch # 0DX) DO Texts.Read(r, ch); INC(pos) END; Texts.Read(r, ch); INC(pos) END; RETURN tab END NewTable; PROCEDURE Read(VAR r: Texts.Reader; VAR ch: CHAR); BEGIN REPEAT Texts.Read(r, ch) UNTIL r.elem = NIL; CASE ch OF "a" .. "z": ch := CAP(ch) | "ƒ", "€", "†", "‹", "”": ch := "A" | "„", "", "‰", "Ž": ch := "O" | "…", "‚", "Š", "": ch := "U" | "", "‘", "Œ", "‡": ch := "E" | "ˆ", "", "’": ch := "I" | "“": ch := "C" | "•": ch := "N" | "«": ch := "S" ELSE (* skip *) END END Read; PROCEDURE ReadNumber(VAR r: Texts.Reader; VAR ch: CHAR; VAR x: LONGINT); BEGIN x := 0; WHILE ~r.eot & (ch # 09X) & (ch # 0DX) & ((ch < "0") OR (ch > "9")) DO Read(r, ch) END; WHILE ~r.eot & (ch >= "0") & (ch <= "9") DO x := x * 10 + ORD(ch) - ORD("0"); Read(r, ch) END END ReadNumber; PROCEDURE Less(t: Texts.Text; x, y: LONGINT; fields: FieldList): BOOLEAN; VAR ch1, ch2: CHAR; x1, x2, i: LONGINT; r1, r2: Texts.Reader; BEGIN Texts.OpenReader(r1, t, x); Read(r1, ch1); Texts.OpenReader(r2, t, y); Read(r2, ch2); IF fields # NIL THEN i := fields.n - 1; WHILE (i > 0) & (ch1 # 0DX) & ~r1.eot DO IF ch1 = 09X THEN DEC(i) END; Read(r1, ch1) END; i := fields.n - 1; WHILE (i > 0) & (ch2 # 0DX) & ~r2.eot DO IF ch2 = 09X THEN DEC(i) END; Read(r2, ch2) END END; IF fields = NIL THEN WHILE (ch1 = ch2) & (ch1 # 0DX) & (ch2 # 0DX) & ~r1.eot & ~r2.eot DO Read(r1, ch1); Read(r2, ch2) END; IF ch1 = 0DX THEN ch1 := 0X END; IF ch2 = 0DX THEN ch2 := 0X END; RETURN ch1 < ch2 ELSIF fields.numeric THEN ReadNumber(r1, ch1, x1); ReadNumber(r2, ch2, x2); IF (x1 = x2) & (fields.next # NIL) THEN RETURN Less(t, x, y, fields.next) ELSE RETURN x1 < x2 END ELSE WHILE (ch1 = ch2) & (ch1 # 0DX) & (ch1 # 09X) & (ch2 # 0DX) & (ch2 # 09X) & ~r1.eot & ~r2.eot DO Read(r1, ch1); Read(r2, ch2) END; IF (ch1 = 0DX) OR (ch1 = 09X) THEN ch1 := 0X END; IF (ch2 = 0DX) OR (ch2 = 09X) THEN ch2 := 0X END; IF (ch1 = ch2) & (fields.next # NIL) THEN RETURN Less(t, x, y, fields.next) ELSE RETURN ch1 < ch2 END END END Less; PROCEDURE NewIndex(t: Texts.Text; entries: EntryList; fields: FieldList): Index; VAR len: LONGINT; i: INTEGER; index, help: Index; PROCEDURE Sort(VAR line: ARRAY OF LONGINT; VAR index, help: ARRAY OF INTEGER; beg, end: LONGINT); VAR i, j, k, m: LONGINT; BEGIN IF end - beg > 1 THEN m := (beg + end) DIV 2; Sort(line, index, help, beg, m); Sort(line, index, help, m, end); i := beg; j := m; k := beg; WHILE (i < m) & (j < end) DO IF Less(t, line[index[j]], line[index[i]], fields) THEN help[k] := index[j]; INC(j) ELSE help[k] := index[i]; INC(i) END; INC(k) END; WHILE i < m DO help[k] := index[i]; INC(i); INC(k) END; k := beg; WHILE k < j DO index[k] := help[k]; INC(k) END END END Sort; BEGIN len := LEN(entries^); NEW(index, len); NEW(help, len); i := 0; WHILE i < len DO index[i] := i; INC(i) END; Sort(entries^, index^, help^, 0, len); RETURN index END NewIndex; PROCEDURE WriteEntry(to, source: Texts.Text; pos: LONGINT; form: FormList); CONST MaxFields = 128; VAR i, j, n, beg, end: LONGINT; ch: CHAR; f: FormList; r: Texts.Reader; buf: ARRAY MaxFields OF RECORD beg, end: LONGINT END; BEGIN Texts.OpenReader(r, source, pos); Texts.Read(r, ch); IF ~r.eot THEN i := 0; WHILE ~r.eot & (ch # 0DX) DO buf[i].beg := Texts.Pos(r) - 1; WHILE ~r.eot & (ch # 09X) & (ch # 0DX) DO Texts.Read(r, ch) END; buf[i].end := Texts.Pos(r) - 1; INC(i); IF ~r.eot & (ch = 09X) THEN Texts.Read(r, ch) END END; IF form = NIL THEN Texts.Save(source, pos, Texts.Pos(r), w.buf); Texts.Append(to, w.buf) ELSE REPEAT f := form; WITH f: TextForm DO Texts.Save(f.text, f.beg, f.end, w.buf); Texts.Append(to, w.buf) | f: CharForm DO Texts.Save(characters, f.pos, f.pos + 1, w.buf); pos := to.len; Texts.Append(to, w.buf); Texts.ChangeLooks(to, pos, to.len, {0, 1, 2}, f.fnt, f.col, f.voff) | f: FieldForm DO n := f.n - 1; IF n < i THEN beg := buf[n].beg; end := buf[n].end; IF beg < end THEN Texts.Save(source, beg, end, w.buf); pos := to.len; Texts.Append(to, w.buf); Texts.ChangeLooks(to, pos, to.len, {0, 1, 2}, f.fnt, f.col, f.voff) END END | f: BranchForm DO j := 0; n := f.cond[0].n - 1; WHILE (n # -1) & ((n < i) & (buf[n].beg # buf[n].end) = f.cond[j].neg) DO INC(j); n := f.cond[j].n - 1 END; IF n = -1 THEN form := f.skip END END; form := form.next UNTIL form = NIL END END END WriteEntry; PROCEDURE NoNotification(t: Texts.Text; op: INTEGER; beg, end: LONGINT); END NoNotification; PROCEDURE Show(t: Texts.Text; e: EntryList; ind: Index; len: LONGINT; form: FormList; cmd: ARRAY OF CHAR); VAR i, j, x, y: INTEGER; v: MenuViewers.Viewer; out: Texts.Text; mf, cf: TextFrames.Frame; BEGIN out := TextFrames.Text(""); out.notify := NoNotification; cf := TextFrames.NewText(out, 0); mf := TextFrames.NewMenu(cmd, Menu); IF Files.Old("Edit.Menu.Text") # NIL THEN Texts.Open(mf.text, "Edit.Menu.Text"); Texts.WriteString(w, cmd); Texts.WriteString(w, " | "); Texts.Insert(mf.text, 0, w.buf) END; Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); v := MenuViewers.New(mf, cf, TextFrames.menuH, x, y); i := 0; WHILE i < len DO IF ind # NIL THEN j := ind[i] ELSE j := i END; WriteEntry(out, t, e[j], form); INC(i) END; out.notify := TextFrames.NotifyDisplay; TextFrames.NotifyDisplay(out, Texts.insert, 0, out.len) END Show; PROCEDURE Sort*; VAR src: Texts.Text; beg, end: LONGINT; fields: FieldList; format: FormList; entries: EntryList; index: Index; s: Scanner; BEGIN OpenInput(s, "LineSorter.Sort"); GetSource(s, src, beg, end); GetFieldList(s, fields); GetFormat(s, format); IF ~error THEN entries := NewTable(src, beg, end); Report(LEN(entries^)); index := NewIndex(src, entries, fields); Show(src, entries, index, LEN(index^), format, "LineSorter.Sort"); Oberon.Collect(0) END END Sort; PROCEDURE List*; VAR src: Texts.Text; beg, end: LONGINT; format: FormList; entries: EntryList; s: Scanner; BEGIN OpenInput(s, "LineSorter.List"); GetSource(s, src, beg, end); GetFormat(s, format); IF ~error THEN entries := NewTable(src, beg, end); Report(LEN(entries^)); Show(src, entries, NIL, LEN(entries^), format, "LineSorter.List"); Oberon.Collect(0) END END List; PROCEDURE ListDuplicates*; VAR src: Texts.Text; i, j, k, beg, end, len: LONGINT; fields: FieldList; format: FormList; entries: EntryList; index: Index; s: Scanner; BEGIN OpenInput(s, "LineSorter.ListDuplicates"); GetSource(s, src, beg, end); GetFieldList(s, fields); GetFormat(s, format); IF ~error THEN entries := NewTable(src, beg, end); len := LEN(entries^); Report(len); index := NewIndex(src, entries, fields); i := 1; k := 0; WHILE i < len DO IF Less(src, entries[index[i - 1]], entries[index[i]], fields) THEN INC(i) ELSE index[k] := index[i - 1]; INC(k); j := i; REPEAT index[k] := index[i]; INC(k); INC(i) UNTIL (i >= len) OR Less(src, entries[index[j]], entries[index[i]], fields); INC(i) END END; Show(src, entries, index, k, format, "LineSorter.ListDuplicates"); Oberon.Collect(0) END END ListDuplicates; BEGIN Texts.OpenWriter(w); Texts.WriteString(w, Version); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf); Texts.Write(w, 09X); Texts.WriteLn(w); Texts.Write(w, " "); characters := TextFrames.Text(""); Texts.Append(characters, w.buf); errorText[0] := "selection missing"; errorText[1] := "bad source"; errorText[2] := "field number expected"; errorText[3] := "format description expected"; errorText[4] := "too many levels of conditions"; errorText[5] := "invalid format object"; errorText[6] := "']' expected" END LineSorter.