MODULE ObxMMerge;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
(* note that as in the other sample programs, no error handling is performed *)
IMPORT Files, Dialog, Views, TextModels, TextViews, TextControllers;
CONST tab = 09X;
TYPE
Field = POINTER TO RECORD
prev: Field; (* field list is sorted in reverse order *)
name: ARRAY 24 OF CHAR; (* name of placeholder *)
tmplFrom, tmplTo: INTEGER; (* character range used by placeholder in template *)
index: INTEGER; (* column index of this field *)
dataFrom, dataTo: INTEGER (* character range used by actual data in database *)
END;
PROCEDURE TmplFields (t: TextModels.Model): Field;
(* returns a list of placeholder fields, in reverse order *)
(* each field defines a text range and name of a placeholder *)
(* the placeholder has the form "...<NameOfPlaceholder>..." *)
VAR l, f: Field; r: TextModels.Reader; ch: CHAR; i: INTEGER;
BEGIN
l := NIL; r := t.NewReader(NIL); r.ReadChar(ch);
WHILE ~r.eot DO
IF ch = "<" THEN
NEW(f); f.tmplFrom := r.Pos() - 1;
r.ReadChar(ch); i := 0;
WHILE ch # ">" DO
f.name[i] := ch; INC(i);
r.ReadChar(ch)
END;
f.name[i] := 0X; f.tmplTo := r.Pos();
f.dataFrom := -1; f.dataTo := -1;
f.prev := l; l := f
END;
r.ReadChar(ch)
END;
RETURN l
END TmplFields;
PROCEDURE ThisDatabase (): TextModels.Model;
VAR loc: Files.Locator; name: Files.Name; v: Views.View;
t: TextModels.Model;
BEGIN
t := NIL; loc := NIL; name := "";
Dialog.GetIntSpec("", loc, name);
IF loc # NIL THEN
v := Views.OldView(loc, name);
IF (v # NIL) & (v IS TextViews.View) THEN
t := v(TextViews.View).ThisModel()
END
END;
RETURN t
END ThisDatabase;
PROCEDURE MergeFields (f: Field; t: TextModels.Model);
(* determine every template field's index in the data text's row of fields *)
VAR r: TextModels.Reader; index, i: INTEGER; ch: CHAR;
BEGIN
r := t.NewReader(NIL);
WHILE f # NIL DO (* iterate over all fields in the template *)
f.index := -1;
r.SetPos(0); index := 0; ch := tab;
WHILE (ch = tab) & (f.index = -1) DO (* compare names of the fields *)
REPEAT r.ReadChar(ch) UNTIL ch >= " ";
i := 0; WHILE ch = f.name[i] DO r.ReadChar(ch); INC(i) END;
IF (ch < " ") & (f.name[i] = 0X) THEN (* names match *)
f.index := index
ELSE (* no match; proceed to next data field *)
WHILE ch >= " " DO r.ReadChar(ch) END
END;
INC(index)
END;
f := f.prev
END
END MergeFields;
PROCEDURE ReadTuple (f: Field; r: TextModels.Reader);
(* read tuple in data, and assign ranges to corresponding fields *)
VAR index: INTEGER; from, to: INTEGER; ch: CHAR; g: Field;
BEGIN
index := 0; ch := tab;
WHILE ch = tab DO
REPEAT r.ReadChar(ch) UNTIL (ch = 0X) OR (ch >= " ") OR (ch = tab) OR (ch = 0DX);
from := r.Pos() - 1;
WHILE ch >= " " DO r.ReadChar(ch) END;
to := r.Pos(); IF ~r.eot THEN DEC(to) END;
g := f;
WHILE g # NIL DO
IF g.index = index THEN g.dataFrom := from; g.dataTo := to END;
g := g.prev
END;
INC(index)
END
END ReadTuple;
PROCEDURE AppendInstance (f: Field; data, tmpl, out: TextModels.Model);
VAR start, from: INTEGER; r: TextModels.Reader; attr: TextModels.Attributes;
BEGIN
start := out.Length();
r := out.NewReader(NIL);
out.InsertCopy(start, tmpl, 0, tmpl.Length()); (* append new copy of template *)
WHILE f # NIL DO (* substitute placeholders, from end to beginning of template *)
from := start + f.tmplFrom;
r.SetPos(from); r.ReadRun(attr); (* save attributes *)
out.Delete(from, from + f.tmplTo - f.tmplFrom); (* delete placeholder *)
out.InsertCopy(from, data, f.dataFrom, f.dataTo); (* insert actual data *)
out.SetAttr(from, from + f.dataTo - f.dataFrom, attr); (* set attributes *)
f := f.prev
END
END AppendInstance;
PROCEDURE Merge*;
VAR c: TextControllers.Controller; tmpl, data, out: TextModels.Model;
tmplFields: Field; r: TextModels.Reader; v: TextViews.View;
BEGIN
c := TextControllers.Focus();
IF c # NIL THEN
tmpl := c.text; (* text template used for mail merge *)
tmplFields := TmplFields(tmpl); (* determine fields in template *)
data := ThisDatabase(); (* get text database for mail merge *)
IF data # NIL THEN
MergeFields(tmplFields, data); (* determine every template field's column in database *)
out := TextModels.dir.New(); (* create output text *)
r := data.NewReader(NIL); r.SetPos(0);
ReadTuple(tmplFields, r); (* skip meta data *)
REPEAT
ReadTuple(tmplFields, r); (* read next data row *)
AppendInstance(tmplFields, data, tmpl, out) (* append new instance of template *)
UNTIL r.eot;
v := TextViews.dir.New(out);
Views.OpenView(v) (* open text view in window *)
END
END
END Merge;
END ObxMMerge.