(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE Mail IN Oberon; (** portable *) (* ejz, 05.01.03 20:13:24 *)
IMPORT SYSTEM, Kernel, Base64, Files, Strings, Dates, Objects, Display, Fonts, Texts, Oberon, NetSystem, NetTools, MIME,
Streams, TextStreams, Display3, Attributes, Links, Gadgets, ListRiders, ListGadgets, AsciiCoder, TextGadgets, TextDocs, Documents,
Desktops, HyperDocs, MD5 IN A2, Modules, FileDir, Out := OutStub;
CONST
MsgFile = "MailMessages";
IndexFile = "MailMessages.idx"; IndexFileKey=74EF5A0DH;
DefPOPPort = 110;
OberonStart* = "--- start of oberon mail ---";
BufLen = 4096;
Read= 0; Deleted = 1;
SortByDateTime = 1; SortByReplyTo = 2; SortBySubject = 3;
Version = 0;
eq = 1; leq = 2; le = 3; geq = 4; ge = 5; neq = 6; or = 7; and = 8;
from = 20; subject = 21; date = 22; time = 23; text = 24; topic = 25; notopic = 26; readFlag = 27;
Menu = "Desktops.Copy[Copy] TextDocs.Search[Search] TextDocs.Replace[Rep] Mail.Show[Source] Mail.Reply[Reply] Desktops.StoreDoc[Store]";
SysMenu = "Desktops.Copy[Copy] Mail.Reply[Reply] Desktops.StoreDoc[Store]";
(* List of TCP and UDP port numbers *)
DefSMTPPort* = 25; (* Orginal port for non-authenticated connection. *)
ImplicitTlsSMTPPort* = 106; (* RFC 8314 recommends 465 for implicit TLS. If the host
has pre-empted 465, as for Exim in Linux, any available port can be assigned for
connecting the TLS tunnel. *)
simpler = TRUE;
addressWidth = 40;
TYPE
UIDL = ARRAY 64 OF CHAR;
ServerName* = ARRAY HyperDocs.ServerStrLen OF CHAR;
UserName = ARRAY 64 OF CHAR;
AdrString* = ARRAY HyperDocs.PathStrLen OF CHAR;
UIDLList = POINTER TO ARRAY OF UIDL;
UIDLSet = POINTER TO UIDLSetDesc;
UIDLSetDesc = RECORD
F: Files.File;
pop: ServerName;
user: UserName;
nouidls: SIGNED32;
uidls: UIDLList;
next: UIDLSet
END;
MsgHead = RECORD
pos, len (* - From head *), state, stamp: SIGNED32;
flags, topics: SET;
date, time: SIGNED32;
replyTo, subject: SIGNED32
END;
MsgHeadList = POINTER TO ARRAY OF MsgHead;
Topic = POINTER TO TopicDesc;
TopicDesc = RECORD
no, state, stamp: SIGNED32;
topic: ListRiders.String;
next: Topic
END;
SortList = POINTER TO ARRAY OF SIGNED32;
Rider = POINTER TO RiderDesc;
RiderDesc = RECORD (ListRiders.RiderDesc)
noMsgs: SIGNED32;
key, pos, sortPos: SIGNED32;
ascending: BOOLEAN;
sort: SortList
END;
QueryString = ARRAY 128 OF CHAR;
ValueString = ARRAY 64 OF CHAR;
ConnectMsg = RECORD (ListRiders.ConnectMsg)
query: QueryString;
sortBy: SIGNED16; (* SortByDateTime, SortByReplyTo, SortBySubject *)
ascending: BOOLEAN
END;
TopicRider = POINTER TO TopicRiderDesc;
TopicRiderDesc = RECORD (ListRiders.RiderDesc)
topic: Topic
END;
Model = POINTER TO ModelDesc;
ModelDesc = RECORD (Gadgets.ObjDesc)
END;
Frame = POINTER TO FrameDesc;
FrameDesc = RECORD (ListGadgets.FrameDesc)
query, sortBy, ascending: Objects.Object
END;
Cond = POINTER TO CondDesc;
CondDesc = RECORD
val: ValueString;
date, time: SIGNED32;
op, field: SIGNED32;
value, eval: BOOLEAN;
next: Cond
END;
Node = POINTER TO NodeDesc;
NodeDesc = RECORD (CondDesc)
left, right: Cond
END;
Query = RECORD
query: QueryString;
conds, root: Cond;
error: BOOLEAN
END;
SMTPSession* = POINTER TO SMTPSessionDesc;
SMTPSessionDesc* = RECORD (NetTools.SessionDesc)
from*: AdrString
END;
Buffer = POINTER TO ARRAY OF CHAR;
Index = POINTER TO ARRAY OF SIGNED32;
Heap = RECORD
buffer: Buffer; bufLen: SIGNED32;
index: Index; idxLen: SIGNED32
END;
WrapData = RECORD (* Data in the Wrap procedure. *)
nCR: SIGNED32; (* Number of carriage returns in a separator.
nCR = 0 for word separator.
nCR = 1 for line separator.
nCR > 1 for paragraph separator. *)
indent: SIGNED32; (* Length of indentation in first line of paragraph. *)
lineLen: SIGNED32; (* Number of characters accumulated in current line. *)
width: SIGNED32; (* Preferred largest length of line = width of reformatted text. *)
space0, space1, gap: Texts.Writer; (* Writers for collecting characters in separators.
Refer to syntax at definition of Wrap. *)
word: Texts.Writer; (* Writer for collecting visible characters of a word. *)
accum: Texts.Writer (* Writer for collecting the reformatted text. *)
END;
VAR
msgs: MsgHeadList;
noMsgs, delMsgs: SIGNED32;
msgsF: Files.File;
msgNoWidth: SIGNED32; (* Width of field for the message number in the list of messages. *)
strm: Streams.Stream; (* Used to read a message header. *)
msgList: Model;
heap: Heap;
topicList: Model;
topics: Topic;
uidls: UIDLSet;
lastUIDL: SIGNED32;
W: Texts.Writer;
mMethod, tmMethod: ListRiders.Method;
vMethod: ListGadgets.Method;
textFnt, headFnt, fieldFnt: Fonts.Font;
mailer: ValueString;
trace: BOOLEAN;
(* String Heap *)
PROCEDURE Open(VAR heap: Heap);
BEGIN
NEW(heap.buffer, 512); heap.bufLen := 0;
NEW(heap.index, 64); heap.idxLen := 0
END Open;
PROCEDURE Append(VAR heap: Heap; idx: SIGNED32; VAR str: ARRAY OF CHAR);
VAR buffer: Buffer; index: Index; len, i, j: SIGNED32;
BEGIN
len := heap.idxLen; INC(heap.idxLen);
IF heap.idxLen >= LEN(heap.index^) THEN
NEW(index, 2*heap.idxLen);
IF len > 0 THEN
SYSTEM.MOVE(ADDRESSOF(heap.index[0]), ADDRESSOF(index[0]), len*SIZEOF(SIGNED32))
END;
heap.index := index
END;
WHILE len > idx DO
heap.index[len] := heap.index[len-1]; DEC(len)
END;
heap.index[idx] := heap.bufLen;
IF (heap.bufLen+LEN(str)) >= LEN(heap.buffer^) THEN
NEW(buffer, 2*(heap.bufLen+LEN(str)));
SYSTEM.MOVE(ADDRESSOF(heap.buffer[0]), ADDRESSOF(buffer[0]), heap.bufLen*SIZEOF(CHAR));
heap.buffer := buffer
END;
i := 0; j := heap.bufLen;
WHILE str[i] # 0X DO
heap.buffer[j] := str[i];
INC(i); INC(j)
END;
heap.buffer[j] := 0X; heap.bufLen := j+1
END Append;
PROCEDURE Compare(VAR heap: Heap; ofs: SIGNED32; VAR str: ARRAY OF CHAR): SIGNED32;
VAR i: SIGNED32; cb, cs: CHAR;
BEGIN
cb := heap.buffer[ofs];
i := 0; cs := str[0];
WHILE (cb # 0X) & (cs # 0X) & (cb = cs) DO
INC(ofs); cb := heap.buffer[ofs];
INC(i); cs := str[i]
END;
RETURN ORD(cb)-ORD(cs)
END Compare;
PROCEDURE Insert(VAR heap: Heap; str: ARRAY OF CHAR; VAR ofs: SIGNED32);
VAR l, r, m, c, idx: SIGNED32;
BEGIN
l := 0; r := heap.idxLen-1; c := 1; idx := 0;
WHILE (l <= r) & (c # 0) DO
m := (l+r) DIV 2; idx := m;
c := Compare(heap, heap.index[m], str);
IF c < 0 THEN
l := m+1
ELSIF c > 0 THEN
r := m-1
END
END;
IF c # 0 THEN
IF c < 0 THEN INC(idx) END;
Append(heap, idx, str)
END;
ofs := heap.index[idx]
END Insert;
PROCEDURE Copy(VAR heap: Heap; ofs: SIGNED32; VAR str: ARRAY OF CHAR);
VAR i, l: SIZE;
BEGIN
i := 0; l := LEN(str)-1;
WHILE (heap.buffer[ofs] # 0X) & (i < l) DO
str[i] := heap.buffer[ofs]; INC(i); INC(ofs)
END;
str[i] := 0X
END Copy;
PROCEDURE Store(VAR R: Files.Rider; VAR heap: Heap);
VAR i: SIGNED32;
BEGIN
Files.WriteLInt(R, heap.bufLen);
Files.WriteBytes(R, heap.buffer^, heap.bufLen);
Files.WriteLInt(R, heap.idxLen);
i := 0;
WHILE i < heap.idxLen DO
Files.WriteLInt(R, heap.index[i]); INC(i)
END
END Store;
PROCEDURE Load(VAR R: Files.Rider; VAR heap: Heap);
VAR i: SIGNED32;
BEGIN
Files.ReadLInt(R, heap.bufLen);
NEW(heap.buffer, heap.bufLen);
Files.ReadBytes(R, heap.buffer^, heap.bufLen);
Files.ReadLInt(R, heap.idxLen);
NEW(heap.index, heap.idxLen);
i := 0;
WHILE i < heap.idxLen DO
Files.ReadLInt(R, heap.index[i]); INC(i)
END
END Load;
PROCEDURE NrToArg(nr: SIGNED32; VAR arg: ARRAY OF CHAR);
BEGIN
IF nr > 9 THEN
Strings.IntToStr(nr, arg)
ELSE
arg[0] := CHR(nr+ORD("0")); arg[1] := 0X
END
END NrToArg;
PROCEDURE SendCmd*(S: NetTools.Session; cmd, arg: ARRAY OF CHAR);
BEGIN
IF trace THEN
Texts.WriteString(W, "SND: "); Texts.WriteString(W, cmd);
IF arg # "" THEN
Texts.Write(W, " ");
IF cmd # "PASS" THEN Texts.WriteString(W, arg) ELSE Texts.WriteString(W, "****") END
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END;
NetTools.SendString(S.C, cmd);
IF arg # "" THEN
NetSystem.Write(S.C, " ")
END;
NetSystem.WriteString(S.C, arg)
END SendCmd;
PROCEDURE ReadState(S: NetTools.Session): BOOLEAN;
BEGIN
NetSystem.ReadString(S.C, S.reply);
IF trace THEN
Texts.WriteString(W, "RCV: "); Texts.WriteString(W, S.reply);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END;
IF S.reply[0] = "+" THEN
S.status := NetTools.Done; S.res := NetTools.Done
ELSE
S.status := NetTools.Failed; S.res := NetTools.Failed
END;
RETURN S.status = NetTools.Done
END ReadState;
PROCEDURE ClosePOP(S: NetTools.Session);
BEGIN
IF S.C # NIL THEN
SendCmd(S, "QUIT", "");
S.res := NetTools.Done;
NetTools.Disconnect(S.C); S.C := NIL; S.S := NIL
ELSE
S.res := NetTools.Failed
END
END ClosePOP;
PROCEDURE APOP(S: NetTools.Session; user, passwd: ARRAY OF CHAR);
VAR
cont: MD5.Context;
digest: MD5.Digest;
stamp, login: ARRAY 128 OF CHAR;
i, j: SIGNED32;
BEGIN
i := 0;
WHILE (S.reply[i] # 0X) & (S.reply[i] # "<") DO
INC(i)
END;
j := 0;
WHILE (S.reply[i] # 0X) & (S.reply[i] # ">") DO
stamp[j] := S.reply[i]; INC(i); INC(j)
END;
stamp[j] := ">"; stamp[j+1] := 0X;
cont := MD5.New();
MD5.WriteBytes(cont, stamp, Strings.Length(stamp));
MD5.WriteBytes(cont, passwd, Strings.Length(passwd));
MD5.Close(cont, digest);
MD5.ToString(digest, stamp);
COPY(user, login); Strings.AppendCh(login, " "); Strings.Append(login, stamp);
SendCmd(S, "APOP", login)
END APOP;
PROCEDURE OpenPOP(VAR S: NetTools.Session; host, user, passwd: ARRAY OF CHAR; port: SIGNED16; apop: BOOLEAN);
VAR hostIP: NetSystem.IPAdr; login: BOOLEAN;
BEGIN
IF trace THEN
Texts.WriteString(W, "--- POP"); Texts.WriteLn(W);
Texts.WriteString(W, "host = "); Texts.WriteString(W, host); Texts.WriteLn(W);
Texts.WriteString(W, "user = "); Texts.WriteString(W, user); Texts.WriteLn(W);
Texts.WriteString(W, "To dispay the password, edit and recompile Oberon.Mail.Mod."); Texts.WriteLn(W);
(* Texts.WriteString(W, "passwd = "); Texts.WriteString(W, passwd); Texts.WriteLn(W); *)
Texts.Append(Oberon.Log, W.buf)
END;
IF (port <= 0) OR (port >= 10000) THEN
port := DefPOPPort
END;
NEW(S);
IF (host[0] # "<") & (host[0] # 0X) & (user[0] # 0X) & (passwd[0] # 0X) THEN
NetSystem.GetIP(host, hostIP);
IF NetTools.Connect(S.C, port, host, FALSE) THEN
S.S := NetTools.OpenStream(S.C);
IF ReadState(S) THEN
login := TRUE;
IF apop THEN
APOP(S, user, passwd)
ELSE
SendCmd(S, "USER", user);
IF ReadState(S) THEN
SendCmd(S, "PASS", passwd)
ELSE
login := FALSE
END
END;
IF login THEN
IF ReadState(S) THEN
S.reply := "connected"; S.res := NetTools.Done;
RETURN
ELSE
NetSystem.DelPassword("pop", host, user)
END
END
ELSIF S.reply[0] = 0X THEN
S.reply := "timed out"
END;
ClosePOP(S)
ELSE
S.reply := "no connection"
END
ELSE
IF (host[0] = "<") OR (host[0] = 0X) THEN
S.reply := "no pop-host specified"
ELSIF user[0] = 0X THEN
S.reply := "no pop user set"
ELSE
S.reply := "no pop password set"
END
END;
S.res := NetTools.Failed; S.C := NIL; S.S := NIL
END OpenPOP;
PROCEDURE ReadText(S: NetTools.Session; VAR R: Files.Rider);
VAR
buffer: ARRAY BufLen OF CHAR;
len, rlen, i, offs: SIGNED32;
state: SIGNED16;
ch, old: CHAR;
BEGIN
old := 0X; offs := 1;
len := NetSystem.Available(S.C);
state := NetSystem.State(S.C);
WHILE (len > 0) OR (state = NetSystem.inout) DO
IF len > (BufLen-2) THEN
rlen := BufLen-2
ELSE
rlen := len
END;
NetSystem.ReadBytes(S.C, 0, rlen, buffer);
i := 0;
WHILE i < rlen DO
ch := buffer[i];
IF ch = Strings.CR THEN
Files.Write(R, ch);
IF (offs = 2) & (old = ".") THEN
Files.Write(R, Strings.LF);
RETURN
END;
offs := 0
ELSE
IF (offs > 0) OR (ch # ".") THEN
Files.Write(R, ch)
END;
INC(offs)
END;
old := ch; INC(i)
END;
DEC(len, rlen);
IF len <= 0 THEN
len := NetSystem.Available(S.C);
state := NetSystem.State(S.C)
END
END
END ReadText;
PROCEDURE DeleteMail(S: NetTools.Session; no: SIGNED32);
VAR arg: ARRAY 12 OF CHAR;
BEGIN
NrToArg(no, arg); SendCmd(S, "DELE", arg);
IF ~ReadState(S) THEN
END
END DeleteMail;
PROCEDURE ReceiveMail(S: NetTools.Session; no: SIGNED32; VAR R: Files.Rider);
VAR arg: ARRAY 12 OF CHAR;
BEGIN
NrToArg(no, arg); SendCmd(S, "RETR", arg);
IF ReadState(S) THEN
ReadText(S, R)
END
END ReceiveMail;
PROCEDURE MessageSize(S: NetTools.Session; no: SIGNED32): SIGNED32;
VAR
arg: ARRAY 12 OF CHAR;
size: SIGNED32;
i: SIGNED16;
BEGIN
NrToArg(no, arg); SendCmd(S, "LIST", arg);
IF ReadState(S) THEN
i := 4; Strings.StrToIntPos(S.reply, size, i);
Strings.StrToIntPos(S.reply, size, i)
ELSE
size := 0
END;
RETURN size
END MessageSize;
PROCEDURE GetUIDLs(S: NetTools.Session; VAR T: Texts.Text);
VAR
F: Files.File;
R: Files.Rider;
BEGIN
SendCmd(S, "UIDL", "");
IF ReadState(S) THEN
F := Files.New(""); Files.Set(R, F, 0);
ReadText(S, R);
NEW(T); Texts.LoadAscii(T, F)
ELSE
T := NIL
END
END GetUIDLs;
PROCEDURE UIDLFile(VAR pop, user: ARRAY OF CHAR; new: BOOLEAN): Files.File;
VAR
F: Files.File;
name: FileDir.FileName;
num: ARRAY 20 OF CHAR;
ip: NetSystem.IPAdr;
BEGIN
NetSystem.GetIP(pop, ip); (* assume server has a single IP address *)
NetSystem.ToNum(ip, num);
name := "UIDL.";
Strings.Append(name, num);
Strings.AppendCh(name, ".");
Strings.Append(name, user);
F := Files.Old(name);
IF F # NIL THEN
Files.GetName(F, name)
END;
IF new OR (F = NIL) THEN
F := Files.New(name); Files.Register(F)
END;
RETURN F
END UIDLFile;
PROCEDURE GetUIDLSet(VAR pop, user: ARRAY OF CHAR): UIDLSet;
VAR
set: UIDLSet;
uidll: UIDLList;
R: Files.Rider;
i, j, l: SIGNED32;
BEGIN
set := uidls;
WHILE (set # NIL) & ~((set.pop = pop) & (set.user = user)) DO
set := set.next
END;
IF set = NIL THEN
NEW(set); set.next := uidls; uidls := set;
COPY(pop, set.pop); COPY(user, set.user);
NEW(set.uidls, 128); l := 128;
set.F := UIDLFile(pop, user, FALSE);
IF Files.Length(set.F) <= 0 THEN
set.nouidls := 0
ELSE
Files.Set(R, set.F, 0); i := 0;
Files.ReadString(R, set.uidls[i]);
WHILE ~R.eof DO
INC(i);
IF i >= l THEN
NEW(uidll, l+128);
FOR j := 0 TO l-1 DO
uidll[j] := set.uidls[j]
END;
INC(l, 128); set.uidls := uidll
END;
Files.ReadString(R, set.uidls[i])
END;
set.nouidls := i
END
ELSIF set.F = NIL THEN
set.F := UIDLFile(pop, user, TRUE)
END;
lastUIDL := 0;
RETURN set
END GetUIDLSet;
PROCEDURE NewUIDLSet(VAR pop, user: ARRAY OF CHAR): UIDLSet;
VAR set: UIDLSet;
BEGIN
NEW(set); set.next := NIL;
COPY(pop, set.pop); COPY(user, set.user);
NEW(set.uidls, 128); set.nouidls := 0;
set.F := UIDLFile(pop, user, TRUE);
RETURN set
END NewUIDLSet;
PROCEDURE AddUIDL(set: UIDLSet; VAR uidl: UIDL);
VAR
R: Files.Rider;
uidll: UIDLList;
i, l: SIZE;
BEGIN
Files.Set(R, set.F, Files.Length(set.F));
Files.WriteString(R, uidl);
l := LEN(set.uidls^);
IF l <= set.nouidls THEN
NEW(uidll, 2*l);
FOR i := 0 TO l-1 DO
uidll[i] := set.uidls[i]
END;
set.uidls := uidll
END;
set.uidls[set.nouidls] := uidl;
INC(set.nouidls)
END AddUIDL;
PROCEDURE ExistsUIDL(set: UIDLSet; VAR uidl: UIDL): SIGNED32;
VAR
nouidls, i: SIGNED32;
uidls: UIDLList;
BEGIN
nouidls := set.nouidls; uidls := set.uidls;
i := lastUIDL;
WHILE (i < nouidls) & (uidls[i] # uidl) DO
INC(i)
END;
IF i >= nouidls THEN
i := 0;
WHILE (i < lastUIDL) & (uidls[i] # uidl) DO
INC(i)
END;
IF i < lastUIDL THEN
RETURN i
ELSE
RETURN -1
END
ELSE
lastUIDL := i+1;
RETURN i
END
END ExistsUIDL;
PROCEDURE FlushUIDL(set: UIDLSet);
BEGIN
IF set.F # NIL THEN
Files.Close(set.F); set.F := NIL
END
END FlushUIDL;
PROCEDURE ParseContent*(h: MIME.Header; VAR cont: MIME.Content);
VAR val: ValueString; pos: SIGNED32;
BEGIN
cont := NIL;
pos := MIME.FindField(h, "X-Content-Type");
IF pos > 0 THEN
MIME.ExtractContentType(h, pos, cont);
IF cont.typ.typ = "application" THEN
COPY(cont.typ.subTyp, val);
IF Strings.CAPPrefix("oberon", val) THEN
cont.encoding := MIME.EncAsciiCoder
ELSIF Strings.CAPPrefix("compressed/oberon", val) THEN
cont.encoding := MIME.EncAsciiCoderC
ELSE
cont := NIL
END
ELSE
cont := NIL
END
END;
IF cont = NIL THEN
pos := MIME.FindField(h, "Content-Type");
IF pos < 0 THEN
pos := MIME.FindField(h, "X-Content-Type")
END;
IF pos > 0 THEN
MIME.ExtractContentType(h, pos, cont);
IF cont.typ.typ = "text" THEN
pos := MIME.FindField(h, "Content-Transfer-Encoding");
MIME.TextEncoding(h, pos, cont)
END
ELSE
NEW(cont); cont.typ := MIME.GetContentType("text/plain");
IF MIME.FindField(h, "X-Sun-Charset") > 0 THEN
cont.encoding := MIME.Enc8Bit
ELSE
cont.encoding := MIME.EncBin
END
END
END;
cont.len := MAX(SIGNED32)
END ParseContent;
PROCEDURE AddMsgHead(pos: SIGNED32);
VAR
S: Streams.Stream;
h: MIME.Header;
cont: MIME.Content;
nmsgs: MsgHeadList;
len, i, v: SIGNED32;
str: ARRAY BufLen OF CHAR;
BEGIN
S := Streams.OpenFileReader(msgsF, pos);
MIME.ReadHeader(S, NIL, h, len);
ParseContent(h, cont);
len := LEN(msgs^)(SIGNED32);
IF noMsgs >= len THEN
NEW(nmsgs, 2*len);
FOR i := 0 TO noMsgs-1 DO
nmsgs[i] := msgs[i]
END;
msgs := nmsgs
END;
msgs[noMsgs].pos := pos;
msgs[noMsgs].state:= 0;
msgs[noMsgs].stamp := 0;
msgs[noMsgs].len := -1;
pos := MIME.FindField(h, "Reply-To");
IF pos < 0 THEN
pos := MIME.FindField(h, "From")
END;
(* ASSERT(pos > 0); *)
MIME.ExtractEMail(h, pos, str);
Insert(heap, str, msgs[noMsgs].replyTo);
pos := MIME.FindField(h, "Date");
MIME.ExtractGMTDate(h, pos, msgs[noMsgs].time, msgs[noMsgs].date);
pos := MIME.FindField(h, "Subject");
MIME.ExtractValue(h, pos, str);
Insert(heap, str, msgs[noMsgs].subject);
pos := MIME.FindField(h, "X-Oberon-Status");
msgs[noMsgs].flags := {}; msgs[noMsgs].topics := {};
IF pos > 0 THEN
MIME.ExtractValue(h, pos, str);
IF CAP(str[0]) = "R" THEN
INCL(msgs[noMsgs].flags, Read)
END;
IF CAP(str[1]) = "D" THEN
INCL(msgs[noMsgs].flags, Deleted);
INC(delMsgs); DEC(noMsgs)
ELSE
v := 0;
FOR i := 7 TO 0 BY-1 DO
IF str[2+i] <= "9" THEN
v := 16*v+ORD(str[2+i])-ORD("0")
ELSE
v := 16*v+ORD(str[2+i])-ORD("A")+10
END
END;
FOR i := MIN(SET) TO MAX(SET) DO
IF (v MOD 2) > 0 THEN
INCL(msgs[noMsgs].topics, i)
END;
v := v DIV 2
END
END
END;
INC(noMsgs)
END AddMsgHead;
PROCEDURE FindObj(name: ARRAY OF CHAR): Objects.Object;
VAR obj, context: Objects.Object;
BEGIN
context := Gadgets.context;
obj := Gadgets.FindObj(context, name);
WHILE (obj = NIL) & (context # NIL) DO
context := context.dlink;
obj := Gadgets.FindObj(context, name)
END;
RETURN obj
END FindObj;
PROCEDURE GetSetting*(name: ARRAY OF CHAR; VAR value: ARRAY OF CHAR; local: BOOLEAN);
VAR obj: Objects.Object;
BEGIN
obj := FindObj(name);
IF obj # NIL THEN
Attributes.GetString(obj, "Value", value)
ELSE
COPY("", value)
END;
IF (value = "") & ~local THEN
IF ~NetTools.QueryString(name, value) THEN
COPY("", value)
END
END
END GetSetting;
PROCEDURE ShowStatus(msg: ARRAY OF CHAR);
VAR obj: Objects.Object;
BEGIN
obj := FindObj("StatusBar");
IF obj # NIL THEN
Attributes.SetString(obj, "Value", msg);
Gadgets.Update(obj)
ELSE
Texts.WriteString(W, msg); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END
END ShowStatus;
PROCEDURE WriteString(VAR R: Files.Rider; str: ARRAY OF CHAR);
VAR i: SIGNED32;
BEGIN
i := 0;
WHILE str[i] # 0X DO
Files.Write(R, str[i]); INC(i)
END
END WriteString;
PROCEDURE WriteLn(VAR R: Files.Rider);
BEGIN
Files.WriteBytes(R, Strings.CRLF, 2)
END WriteLn;
PROCEDURE SetVPos(F: Objects.Object);
VAR obj: Objects.Object;
BEGIN
Links.GetLink(F, "VPos", obj);
Attributes.SetInt(obj, "Value", 0);
Gadgets.Update(obj);
END SetVPos;
(* Synchronize local data with the server. The list of UIDs and the MsgFile are updated.
The command accepts no parameters. Invoked interactively and by Get in the Mail.Panel. *)
PROCEDURE Synchronize*;
VAR
S: NetTools.Session;
set, newSet: UIDLSet;
uidl: UIDL;
pop: ServerName;
user: UserName; passwd: ValueString;
Ri: Files.Rider;
uT: Texts.Text;
Sc: Texts.Scanner;
R: Texts.Reader;
pos, i, k, new, maxSize: SIGNED32;
onServer: BOOLEAN;
obj: Objects.Object;
ch: CHAR;
apop, add: BOOLEAN;
BEGIN
(* trace := NetTools.QueryBool("TraceMail"); *)
GetSetting("POPMode", pop, FALSE); Strings.Upper(pop, pop);
apop := pop = "APOP";
GetSetting("MaxMsgSize", user, FALSE);
Strings.StrToInt(user, maxSize);
GetSetting("LeaveOnServer", user, TRUE); (* first check local in Mail.Panel *)
IF user = "No" THEN (* not set, check config file for final setting *)
IF ~NetTools.QueryString("LeaveOnServer", user) THEN user[0] := 0X END
END;
IF user # "" THEN
Strings.StrToBool(user, onServer)
ELSE
onServer := TRUE
END;
GetSetting("User", user, FALSE); GetSetting("POP", pop, FALSE);
NetSystem.GetPassword("pop", pop, user, passwd);
ShowStatus("downloading...");
OpenPOP(S, pop, user, passwd, DefPOPPort, apop);
IF S.res = NetTools.Done THEN
set := GetUIDLSet(pop, user); newSet := NewUIDLSet(pop, user);
GetUIDLs(S, uT);
IF (S.res = NetTools.Done) & (uT # NIL) & (uT.len > 0) THEN
k := 0;
WHILE k < set.nouidls DO
set.uidls[k][63] := 0X; INC(k)
END;
Texts.OpenScanner(Sc, uT, 0); Texts.Scan(Sc);
new := 0; i := 1;
WHILE (Sc.class = Texts.Int) & (Sc.i = i) & (S.res = NetTools.Done) DO
Texts.OpenReader(R, uT, Texts.Pos(Sc));
k := 0; Texts.Read(R, ch);
WHILE ~R.eot & (ch > " ") DO
uidl[k] := ch; INC(k);
Texts.Read(R, ch)
END;
uidl[k] := 0X; k := ExistsUIDL(set, uidl); add := TRUE;
IF k < 0 THEN
k := MessageSize(S, i);
IF k <= maxSize THEN
INC(new);
Files.Set(Ri, msgsF, Files.Length(msgsF));
WriteString(Ri, "From "); WriteLn(Ri); (* msg tag *)
pos := Files.Pos(Ri);
WriteString(Ri, "X-Oberon-Status: 0010000000"); WriteLn(Ri);
WriteString(Ri, "X-UIDL: "); WriteString(Ri, uidl); WriteLn(Ri);
AddUIDL(set, uidl); set.uidls[set.nouidls-1][63] := 01X;
ReceiveMail(S, i, Ri); add := S.res = NetTools.Done;
AddMsgHead(pos); msgs[noMsgs-1].len := Files.Length(msgsF)-msgs[noMsgs-1].pos;
IF add & ~onServer THEN
Files.Close(msgsF); DeleteMail(S, i)
END
ELSE
Texts.WriteString(W, "message "); Texts.WriteInt(W, i, 0);
Texts.WriteString(W, " too large ("); Texts.WriteInt(W, k, 0);
Texts.WriteString(W, " bytes)"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf); add := FALSE
END
ELSIF set.uidls[k][63] # 0X THEN
Texts.WriteString(W, "message "); Texts.WriteInt(W, i, 0);
Texts.WriteString(W, " ignored (UIDL not unique)"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf); add := FALSE
ELSE
set.uidls[k][63] := 01X
END;
IF add THEN
AddUIDL(newSet, uidl)
END;
Texts.OpenScanner(Sc, uT, Texts.Pos(R));
INC(i); Texts.Scan(Sc);
WHILE (Sc.class = Texts.Char) & (Sc.c <= " ") DO
Texts.Scan(Sc)
END
END
END;
ClosePOP(S);
FlushUIDL(newSet); set^ := newSet^;
IF new > 0 THEN
Files.Close(msgsF);
Gadgets.Update(msgList);
obj := FindObj("MailList");
SetVPos(obj)
END
END;
IF S.res # NetTools.Done THEN
ShowStatus(S.reply)
ELSIF new = 0 THEN
ShowStatus("no new mail")
ELSE
Strings.IntToStr(new, passwd); Strings.Append(passwd, " new messages");
ShowStatus(passwd)
END
END Synchronize;
PROCEDURE POPCollect*;
VAR
S: NetTools.Session;
set, newSet: UIDLSet;
uidl: UIDL;
pop: ServerName;
user: UserName; passwd: ValueString;
uT: Texts.Text;
Sc: Texts.Scanner;
R: Texts.Reader;
i, k: SIGNED32;
apop: BOOLEAN;
ch: CHAR;
BEGIN
GetSetting("POPMode", pop, FALSE); Strings.Upper(pop, pop);
apop := pop = "APOP";
GetSetting("User", user, FALSE); GetSetting("POP", pop, FALSE);
NetSystem.GetPassword("pop", pop, user, passwd);
OpenPOP(S, pop, user, passwd, DefPOPPort, apop);
IF S.res = NetTools.Done THEN
set := GetUIDLSet(pop, user);
GetUIDLs(S, uT);
IF S.res = NetTools.Done THEN
Texts.OpenScanner(Sc, uT, 0); Texts.Scan(Sc);
i := 1;
WHILE (Sc.class = Texts.Int) & (Sc.i = i) & (S.res = NetTools.Done) DO
Texts.OpenReader(R, uT, Texts.Pos(Sc));
k := 0; Texts.Read(R, ch);
WHILE ~R.eot & (ch > " ") DO
uidl[k] := ch; INC(k);
Texts.Read(R, ch)
END;
uidl[k] := 0X;
IF ExistsUIDL(set, uidl) >= 0 THEN
Strings.IntToStr(i, passwd); ShowStatus(passwd);
DeleteMail(S, i)
END;
Texts.OpenScanner(Sc, uT, Texts.Pos(R));
INC(i); Texts.Scan(Sc);
WHILE (Sc.class = Texts.Char) & (Sc.c <= " ") DO
Texts.Scan(Sc)
END
END
END;
ClosePOP(S)
END;
IF S.res # NetTools.Done THEN
ShowStatus(S.reply)
ELSE
newSet := NewUIDLSet(pop, user);
FlushUIDL(newSet); set^ := newSet^;
ShowStatus("")
END
END POPCollect;
PROCEDURE ReadString(VAR R: Texts.Reader; VAR s: ARRAY OF CHAR);
VAR
l, i: SIZE;
ch: CHAR;
BEGIN
l := LEN(s)-1; i := 0;
Texts.Read(R, ch);
WHILE ~R.eot & (ch # Strings.CR) & (i < l) DO
s[i] := ch; INC(i);
Texts.Read(R, ch)
END;
WHILE ~R.eot & (ch # Strings.CR) DO
Texts.Read(R, ch)
END;
s[i] := 0X
END ReadString;
PROCEDURE ScanHeader(no: SIGNED32; VAR h: MIME.Header);
VAR
S: Streams.Stream;
len: SIGNED32;
BEGIN
S := Streams.OpenFileReader(msgsF, msgs[no].pos); S.mode := Streams.binary;
MIME.ReadHeader(S, NIL, h, len)
END ScanHeader;
PROCEDURE WriteStatus(h: MIME.Header; no: SIGNED32);
VAR
R: Files.Rider;
pos, i, v: SIGNED32;
ch: CHAR;
BEGIN
pos := MIME.FindField(h, "X-Oberon-Status");
IF pos > 0 THEN
pos := msgs[no].pos+pos;
Files.Set(R, msgsF, pos);
IF Read IN msgs[no].flags THEN
Files.Write(R, "R")
ELSE
Files.Write(R, "0")
END;
IF Deleted IN msgs[no].flags THEN
Files.Write(R, "D")
ELSE
Files.Write(R, "0")
END;
v := 0;
FOR i := MAX(SET) TO MIN(SET) BY -1 DO
v := 2*v;
IF i IN msgs[no].topics THEN
INC(v)
END
END;
FOR i := 0 TO 7 DO
ch := CHR(ORD("0")+(v MOD 16));
IF ch > "9" THEN
ch := CHR(ORD("A")+(v MOD 16)-10)
END;
Files.Write(R, ch);
v := v DIV 16
END
END
END WriteStatus;
PROCEDURE WriteField(VAR h: MIME.Header; field: ARRAY OF CHAR; empty, long: BOOLEAN);
VAR
caption: ARRAY 64 OF CHAR; value: ARRAY 128 OF CHAR;
pos: SIGNED32; first: BOOLEAN;
BEGIN
COPY(field, caption);
pos := MIME.FindField(h, field);
first := empty;
WHILE (pos > 0) OR first DO
first := FALSE; Texts.SetFont(W, headFnt);
MIME.ExtractValue(h, pos, value);
IF empty OR (value # "") THEN
Texts.WriteString(W, caption); Texts.Write(W, ":");
IF pos > 0 THEN
Texts.SetFont(W, fieldFnt); Texts.Write(W, Strings.Tab);
IF long THEN
WHILE h.fields[pos] # 0X DO
Texts.Write(W, Strings.ISOToOberon[ORD(h.fields[pos])]); INC(pos)
END
ELSE
Texts.WriteString(W, value)
END
END;
Texts.WriteLn(W)
END;
IF (pos > 0) & (field # "") THEN
MIME.FindFieldPos(h, field, pos)
ELSE
pos := -1
END
END
END WriteField;
PROCEDURE DecodeMessage*(VAR T: Texts.Text; h: MIME.Header; cont: MIME.Content; no: SIGNED32);
VAR
F, Fc: Files.File;
R: Texts.Reader;
str: ValueString;
style: TextGadgets.Style;
topic: Topic;
pos, len: SIGNED32;
first, ok, oberon: BOOLEAN;
BEGIN
oberon := (cont.typ.typ = "application") & (cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain});
pos := 0; len := 0;
Texts.OpenReader(R, T, pos);
ok := TRUE; ReadString(R, str);
WHILE ~R.eot & ((~oberon & (len > 0)) OR (str # OberonStart)) DO
len := Texts.Pos(R);
IF (str # "") & ok THEN
pos := Texts.Pos(R)
ELSE
ok := FALSE
END;
ReadString(R, str)
END;
IF str = OberonStart THEN
F := Files.New(""); len := Texts.Pos(R);
AsciiCoder.Decode(T, len, F, ok);
IF ok THEN
IF cont.encoding = MIME.EncAsciiCoderC THEN
Fc := Files.New(""); AsciiCoder.Expand(F, Fc)
ELSE
Fc := F
END;
Texts.Save(T, 0, pos+1, W.buf);
NEW(T); Texts.Load(T, Fc, 1, len);
Texts.Insert(T, 0, W.buf)
END
END;
IF no >= 0 THEN
style := TextGadgets.newStyle();
Attributes.SetInt(style, "Message", no);
style.mode := {TextGadgets.left};
style.noTabs := 1;
style.tab[0] := 6*(headFnt.maxX-headFnt.minX);
Texts.WriteObj(W, style);
WriteField(h, "Reply-To", FALSE, FALSE);
WriteField(h, "From", TRUE, FALSE);
WriteField(h, "Subject", TRUE, FALSE);
IF msgs[no].topics # {} THEN
Texts.SetFont(W, headFnt);
Texts.WriteString(W, "Topics:"); Texts.Write(W, Strings.Tab);
Texts.SetFont(W, fieldFnt);
first := TRUE;
FOR pos := MIN(SET) TO MAX(SET) DO
IF pos IN msgs[no].topics THEN
topic := topics;
WHILE (topic # NIL) & (topic.no # pos) DO
topic:= topic.next
END;
IF ~first THEN
Texts.WriteString(W, ", ")
ELSE
first := FALSE
END;
IF topic # NIL THEN
Texts.WriteString(W, topic.topic.s)
ELSE
Texts.WriteString(W, "Topic"); Texts.WriteInt(W, pos, 1)
END
END
END;
Texts.WriteLn(W);
END;
WriteField(h, "Date", TRUE, FALSE);
WriteField(h, "To", TRUE, TRUE);
WriteField(h, "Cc", FALSE, TRUE);
WriteField(h, "Bcc", FALSE, TRUE);
style := TextGadgets.newStyle();
style.mode := {TextGadgets.left};
style.noTabs := 0;
Texts.WriteObj(W, style);
Texts.Insert(T, 0, W.buf)
END;
Texts.SetFont(W, Fonts.Default)
END DecodeMessage;
PROCEDURE decodeMessage(no: SIGNED32; VAR T: Texts.Text; plain: BOOLEAN);
VAR
S: Streams.Stream;
mT: Texts.Text;
h: MIME.Header;
cont: MIME.Content;
len: SIGNED32;
BEGIN
S := Streams.OpenFileReader(msgsF, msgs[no].pos); S.mode := Streams.binary;
IF plain THEN
NEW(cont); cont.typ := MIME.GetContentType("text/plain");
S := Streams.OpenFileReader(msgsF, msgs[no].pos)
ELSE
MIME.ReadHeader(S, NIL, h, len); ParseContent(h, cont);
S := Streams.OpenFileReader(msgsF, msgs[no].pos+len)
END;
S.mode := Streams.binary;
ASSERT(len < msgs[no].len);
cont.len := msgs[no].len - len;
IF plain THEN
Texts.SetFont(W, Fonts.Default)
ELSE
Texts.SetFont(W, textFnt)
END;
IF cont.typ.typ # "multipart" THEN
MIME.ReadText(S, W, cont, TRUE)
ELSE
MIME.ReadMultipartText(S, mT, cont, TRUE); Texts.Save(mT, 0, mT.len, W.buf)
END;
NEW(T); Texts.Open(T, "");
Texts.Append(T, W.buf);
IF ~plain THEN
DecodeMessage(T, h, cont, no)
END;
IF ~(Read IN msgs[no].flags) THEN
INCL(msgs[no].flags, Read);
WriteStatus(h, no); Files.Close(msgsF);
Gadgets.Update(msgList)
END
END decodeMessage;
PROCEDURE DocHandler(D: Objects.Object; VAR M: Objects.ObjMsg);
BEGIN
WITH D: Documents.Document DO
IF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.class := Objects.String; M.s := "Mail.NewMsgDoc"; M.res := 0
ELSE
TextDocs.DocHandler(D, M)
END
END
ELSIF M IS Objects.LinkMsg THEN
WITH M: Objects.LinkMsg DO
IF M.id = Objects.get THEN
IF M.name = "DeskMenu" THEN
M.obj := Gadgets.CopyPublicObject("NetDocs.MailDeskMenu", TRUE);
IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END;
M.res := 0
ELSIF M.name = "SystemMenu" THEN
M.obj := Gadgets.CopyPublicObject("NetDocs.MailSystemMenu", TRUE);
IF M.obj = NIL THEN M.obj := Desktops.NewMenu(SysMenu) END;
M.res := 0
ELSIF M.name = "UserMenu" THEN
M.obj := Gadgets.CopyPublicObject("NetDocs.MailUserMenu", TRUE);
IF M.obj = NIL THEN M.obj := Desktops.NewMenu(Menu) END;
M.res := 0
ELSE
TextDocs.DocHandler(D, M)
END
ELSE
TextDocs.DocHandler(D, M)
END
END
ELSE
TextDocs.DocHandler(D, M)
END
END
END DocHandler;
PROCEDURE ShowText(title: ARRAY OF CHAR; T: Texts.Text; reply: BOOLEAN);
VAR
D: Documents.Document;
F: TextGadgets.Frame;
BEGIN
NEW(D); TextDocs.InitDoc(D);
NEW(F); TextGadgets.Init(F, T, FALSE);
Documents.Init(D, F); COPY(title, D.name);
IF reply THEN D.handle := DocHandler END;
Desktops.ShowDoc(D)
END ShowText;
PROCEDURE WriteNchar(CONST s: ARRAY OF CHAR; n: SIGNED32);
VAR i: SIGNED32;
BEGIN
i := 0;
WHILE (i < n) & (s[i] # 0X) DO
Texts.Write(W, s[i]);
INC(i)
END;
WHILE i < n DO
Texts.Write(W, " ");
INC(i)
END
END WriteNchar;
PROCEDURE WriteMsgLine(CONST no: SIGNED32);
VAR
len, pos: SIGNED32;
offsetInLine: SIGNED32;
h: MIME.Header;
cont: MIME.Content;
str: ARRAY BufLen OF CHAR;
BEGIN
Texts.WriteString(W, "Mail.Show "); offsetInLine := 10;
Texts.WriteInt(W, no, msgNoWidth); INC(offsetInLine, msgNoWidth);
Texts.Write(W, " "); INC(offsetInLine);
strm := Streams.OpenFileReader(msgsF, msgs[no].pos); strm.mode := Streams.binary;
MIME.ReadHeader(strm, NIL, h, len);
ParseContent(h, cont);
pos := MIME.FindField(h, "From");
MIME.ExtractValue(h, pos, str);
WriteNchar(str, addressWidth); INC(offsetInLine, msgNoWidth);
Texts.Write(W, " "); INC(offsetInLine);
pos := MIME.FindField(h, "To");
MIME.ExtractValue(h, pos, str);
WriteNchar(str, addressWidth); INC(offsetInLine, msgNoWidth);
Texts.Write(W, " "); INC(offsetInLine);
pos := MIME.FindField(h, "Subject");
MIME.ExtractValue(h, pos, str);
WriteNchar(str, 169 - offsetInLine); Texts.WriteLn(W)
END WriteMsgLine;
(* Show the message activated in the Mail.Panel.
Show the message identified by number. Mail.Show 13 ~
With no message identified, list all messages beginning with oldest. Mail.Show ~
With a negative message number, list beginning with newest. Mail.Show -1 ~ *)
PROCEDURE Show*;
VAR
S: Attributes.Scanner;
T: Texts.Text;
D: Documents.Document;
obj: Objects.Object;
F: Texts.Finder;
no: SIGNED32;
plain: BOOLEAN;
line: ListGadgets.Line;
font: Objects.Library;
BEGIN
IF Desktops.IsInMenu(Gadgets.context) THEN
D := Desktops.CurDoc(Gadgets.context);
Links.GetLink(D.dsc, "Model", obj);
IF (obj # NIL) & (obj IS Texts.Text) THEN
Texts.OpenFinder(F, obj(Texts.Text), 0);
Texts.FindObj(F, obj);
IF (obj # NIL) & (obj IS TextGadgets.Style) THEN
Attributes.SetString(Gadgets.executorObj, "Caption", "Text");
Attributes.GetInt(obj, "Message", no); plain := TRUE
ELSE
Attributes.SetString(Gadgets.executorObj, "Caption", "Source");
Attributes.GetInt(Gadgets.executorObj, "Message", no); plain := FALSE
END;
IF (no >= 0) & (no < noMsgs) THEN
decodeMessage(no, T, plain);
Attributes.SetInt(Gadgets.executorObj, "Message", no);
Links.SetLink(D.dsc, "Model", T)
END;
Gadgets.Update(Gadgets.executorObj)
END
ELSE
Attributes.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
Attributes.Scan(S);
IF (S.class = Attributes.Int) & (S.i >= 0) & (S.i < noMsgs) THEN (* Valid message number. *)
obj := FindObj("MailList");
IF obj # NIL THEN
WITH obj: ListGadgets.Frame DO
line := obj.lines;
REPEAT
line.sel := msgs[S.i].pos = line.key;
line := line.next
UNTIL line = obj.lines;
obj.sel := TRUE; obj.time := Oberon.Time();
Gadgets.Update(obj)
END
END;
decodeMessage(S.i, T, FALSE);
ShowText("Mail.Text", T, TRUE)
ELSIF 0 < noMsgs THEN (* Invalid message number but messages to list. *)
msgNoWidth := 0;
no := noMsgs;
WHILE 0 < no DO
no := no DIV 10;
INC(msgNoWidth)
END;
Out.String("msgNoWidth = "); Out.Int(msgNoWidth, 0); Out.Ln();
IF 60 < noMsgs THEN
Texts.WriteInt(W, noMsgs, 0);
Texts.WriteString(W, " messages. Stand by while list is created."); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
END;
font := W.lib;
Texts.SetFont(W, Fonts.This("Courier8.Scn.Fnt"));
Texts.WriteString(W, "To see a message, middle mouse on Mail.Show <messageNumber>. A message can not be deleted here."); Texts.WriteLn(W);
Texts.WriteString(W, "To open the Mail.Panel, middle mouse on Desktops.OpenDoc Mail.Panel. Read and delete messages there."); Texts.WriteLn(W);
Texts.WriteLn(W);
WriteNchar("", 10 + msgNoWidth); Texts.Write(W, " ");
WriteNchar("From", addressWidth); Texts.Write(W, " ");
WriteNchar("To", addressWidth); Texts.Write(W, " ");
Texts.WriteString(W, "Subject"); Texts.WriteLn(W);
Out.String("Headings completed."); Out.Ln();
IF S.class = Attributes.Int THEN (* (S.i < 0) OR (noMsgs < S.i); List with oldest at top. *)
no := 0;
WHILE no < noMsgs DO
WriteMsgLine(no);
INC(no)
END
ELSE (* Newest at top. *)
no := noMsgs;
WHILE 0 < no DO
DEC(no);
WriteMsgLine(no)
END
END;
NEW(T); Texts.Open(T, ""); Texts.Append(T, W.buf);
ShowText("Messages", T, TRUE);
Texts.SetFont(W, font)
END
(*
ELSIF Desktops.IsInMenu(Gadgets.context) THEN
D := Desktops.CurDoc(Gadgets.context);
Links.GetLink(D.dsc, "Model", obj);
IF (obj # NIL) & (obj IS Texts.Text) THEN
*)
END
END Show;
PROCEDURE Shrink;
VAR
F: Files.File;
R: Files.Rider;
msg, bak: FileDir.FileName;
beg, end, offs, i: SIGNED32;
res: SIGNED16;
ch, old: CHAR;
PROCEDURE Copy;
VAR
R, r: Files.Rider;
ch: CHAR;
BEGIN
IF (msgs[i].pos > beg) & (msgs[i].pos < end) THEN
Files.Set(R, msgsF, beg);
Files.Set(r, F, Files.Length(F));
msgs[i].pos := Files.Pos(r)+offs;
WHILE beg < end DO
Files.Read(R, ch); Files.Write(r, ch);
INC(beg)
END;
INC(i)
END
END Copy;
BEGIN
ShowStatus("shrinking message file");
Files.GetName(msgsF, msg);
COPY(msg, bak); Strings.Append(bak, ".Bak");
Files.Rename(msg, bak, res); ASSERT(res = 0);
F := Files.New(msg); i := 0;
msgsF := Files.Old(bak); Files.Set(R, msgsF, 0);
old := Strings.LF; beg := MAX(SIGNED32);
Files.Read(R, ch);
WHILE ~R.eof DO
end := Files.Pos(R)-1;
IF (ch = "F") & (old = Strings.LF) THEN
Files.Read(R, ch);
IF ch = "r" THEN
Files.Read(R, ch);
IF ch = "o" THEN
Files.Read(R, ch);
IF ch = "m" THEN
Files.Read(R, ch);
IF ch = " " THEN
WHILE ~R.eof & (ch >= " ") DO
Files.Read(R, ch)
END;
WHILE ~R.eof & (ch < " ") DO
Files.Read(R, ch)
END;
IF end > beg THEN
Copy()
END;
offs := Files.Pos(R)-1-end; beg := end
END
END
END
END
END;
old := ch; Files.Read(R, ch)
END;
end := Files.Length(msgsF);
Copy();
ASSERT(i = noMsgs); delMsgs := 0;
Files.Register(F); msgsF := F;
ShowStatus("")
END Shrink;
PROCEDURE collect;
VAR i, j, no: SIGNED32;
BEGIN
i := 0; j := 0; no := noMsgs;
WHILE i < no DO
IF msgs[i].pos >= 0 THEN
msgs[j] := msgs[i]; INC(j)
ELSE
INC(delMsgs); DEC(noMsgs)
END;
INC(i)
END;
IF delMsgs > 100 THEN
Shrink()
END
END collect;
PROCEDURE Collect*;
BEGIN
delMsgs := 200; collect();
Gadgets.Update(msgList)
END Collect;
PROCEDURE DeleteMessage(no: SIGNED32);
VAR h: MIME.Header;
BEGIN
INCL(msgs[no].flags, Deleted);
ScanHeader(no, h);
WriteStatus(h, no);
msgs[no].pos := -1
END DeleteMessage;
PROCEDURE Re*(VAR W: Texts.Writer; VAR t: ARRAY OF CHAR);
VAR
i, j, re, oldre: SIGNED32;
p: SIGNED16;
end: BOOLEAN;
PROCEDURE Blanks;
BEGIN
WHILE (t[i] # 0X) & (t[i] <= " ") DO
INC(i)
END
END Blanks;
BEGIN
re := 1; i := 0;
REPEAT
end := TRUE; Blanks(); j := i;
IF CAP(t[i]) = "R" THEN
IF CAP(t[i+1]) = "E" THEN
INC(i, 2); Blanks();
IF t[i] = ":" THEN
INC(i); INC(re); end := FALSE
ELSIF t[i] = "(" THEN
INC(i); p := SHORT(i); oldre := re;
Strings.StrToIntPos(t, re, p);
IF re > 0 THEN
i := p; Blanks();
IF t[i] = ")" THEN
INC(i); Blanks();
IF t[i] = ":" THEN
INC(i)
END;
INC(re); end := FALSE
END
ELSE
re := oldre
END
END
END
END
UNTIL end;
IF t[j] = 0X THEN
RETURN
ELSIF re > 1 THEN
Texts.WriteString(W, "Re ("); Texts.WriteInt(W, re, 0); Texts.WriteString(W, "): ")
ELSE
Texts.WriteString(W, "Re: ")
END;
WHILE t[j] # 0X DO
Texts.Write(W, t[j]); INC(j)
END
END Re;
PROCEDURE ReplyText(T: Texts.Text);
VAR
S: Streams.Stream;
R: Texts.Reader;
h: MIME.Header;
t: ARRAY BufLen OF CHAR;
pos, len: SIGNED32;
ch: CHAR;
BEGIN
pos := 0; Texts.OpenReader(R, T, pos);
Texts.Read(R, ch);
WHILE ~R.eot & (ch <= " ") & ~(R.lib IS Fonts.Font) DO
Texts.Read(R, ch); INC(pos)
END;
Texts.WriteString(W, "To: ");
S := TextStreams.OpenReader(T, pos);
MIME.ReadHeader(S, NIL, h, len);
pos := MIME.FindField(h, "Reply-To");
IF pos < 0 THEN
pos := MIME.FindField(h, "From")
END;
MIME.ExtractEMail(h, pos, t);
Texts.WriteString(W, t); Texts.WriteLn(W);
pos := MIME.FindField(h, "Subject");
MIME.ExtractValue(h, pos, t);
Texts.WriteString(W, "Subject: "); Re(W, t);
Texts.WriteLn(W)
END ReplyText;
PROCEDURE CiteText*(VAR W: Texts.Writer; T: Texts.Text; beg, end: SIGNED32);
VAR
R: Texts.Reader;
lib: Objects.Library;
col, voff: SIGNED8;
ch: CHAR;
BEGIN
lib := W.lib; col := W.col; voff := W.voff;
Texts.OpenReader(R, T, beg); Texts.Read(R, ch);
Texts.WriteString(W, "> ");
WHILE ~R.eot & (Texts.Pos(R) <= end) DO
Texts.SetFont(W, R.lib); Texts.SetColor(W, R.col); Texts.SetOffset(W, R.voff);
Texts.Write(W, ch);
IF (R.lib IS Fonts.Font) & (ch = Strings.CR) & (Texts.Pos(R) < end) THEN
Texts.SetFont(W, lib); Texts.SetColor(W, col); Texts.SetOffset(W, voff);
Texts.WriteString(W, "> ")
END;
Texts.Read(R, ch)
END;
Texts.SetFont(W, lib); Texts.SetColor(W, col); Texts.SetOffset(W, voff)
END CiteText;
PROCEDURE Reply*;
VAR
S: Attributes.Scanner;
T, text: Texts.Text;
D: Documents.Document;
obj: Objects.Object;
beg, end, time: SIGNED32;
fnt: Objects.Library;
str: AdrString;
BEGIN
fnt := W.lib; Texts.SetFont(W, textFnt);
NEW(T); Texts.Open(T, "");
Attributes.OpenScanner(S, Oberon.Par.text,Oberon.Par.pos);
Attributes.Scan(S);
IF S.class = Attributes.Int THEN
IF (S.i >= 0) & (S.i < noMsgs) THEN
Copy(heap, msgs[S.i].replyTo, str);
Texts.WriteString(W, "To: "); Texts.WriteString(W, str); Texts.WriteLn(W);
Copy(heap, msgs[S.i].subject, str);
Texts.WriteString(W, "Subject: "); Re(W, str); Texts.WriteLn(W)
END
ELSIF Desktops.IsInMenu(Gadgets.context) THEN
D := Desktops.CurDoc(Gadgets.context);
Links.GetLink(D.dsc, "Model", obj);
IF (obj # NIL) & (obj IS Texts.Text) THEN
ReplyText(obj(Texts.Text));
text := NIL; time := -1;
Oberon.GetSelection(text, beg, end, time);
IF text = obj THEN
Texts.WriteLn(W);
CiteText(W, text, beg, end)
END
END
ELSE
Texts.WriteString(W, "To: "); Texts.WriteLn(W);
Texts.WriteString(W, "Subject: "); Texts.WriteLn(W)
END;
Texts.WriteLn(W); Texts.Append(T, W.buf);
ShowText("Mail.Out.Text", T, FALSE);
Texts.SetFont(W, fnt)
END Reply;
PROCEDURE DoTopic(set: BOOLEAN);
VAR
S: Attributes.Scanner;
mailL: Objects.Object;
topic: Topic;
C: ListRiders.ConnectMsg;
R: ListRiders.Rider;
mLine: ListGadgets.Line;
h: MIME.Header;
no: SIGNED32;
BEGIN
Attributes.OpenScanner(S, Oberon.Par.text,Oberon.Par.pos);
Attributes.Scan(S);
IF S.class IN {Attributes.Name, Attributes.String} THEN
mailL := FindObj(S.s);
Attributes.Scan(S);
IF S.class IN {Attributes.Name, Attributes.String} THEN
topic := topics;
WHILE (topic # NIL) & (topic.topic.s # S.s) DO
topic := topic.next
END;
IF topic # NIL THEN
WITH mailL: ListGadgets.Frame DO
C.R := NIL; Objects.Stamp(C); mailL.obj.handle(mailL.obj, C); R := C.R;
mLine := mailL.lines;
REPEAT
IF mLine.sel THEN
R.do.Seek(R, mLine.key);
no := R.d(ListRiders.Int).i;
IF set THEN
INCL(msgs[no].topics, topic.no)
ELSE
EXCL(msgs[no].topics, topic.no)
END;
ScanHeader(no, h);
WriteStatus(h, no)
END;
mLine := mLine.next
UNTIL mLine = mailL.lines;
Files.Close(msgsF); Gadgets.Update(msgList)
END
END
END
END
END DoTopic;
PROCEDURE SetTopic*;
BEGIN
DoTopic(TRUE)
END SetTopic;
PROCEDURE ClearTopic*;
BEGIN
DoTopic(FALSE)
END ClearTopic;
(* Move mail(s) from current topic to another topic. It's only allowed if your current query is a topic. (es, 22.10.2000 *)
PROCEDURE MoveTopic*;
VAR
S: Attributes.Scanner;
mailL: Objects.Object;
topic: Topic;
C: ListRiders.ConnectMsg;
R: ListRiders.Rider;
mLine: ListGadgets.Line;
h: MIME.Header;
currentNo, no: SIGNED32;
queryObj: Objects.Object;
queryStr: ARRAY 128 OF CHAR;
PROCEDURE GetTopicNo(queryStr: ARRAY OF CHAR): SIGNED32;
VAR topic: Topic; name: ARRAY 128 OF CHAR; i, j: SIGNED32; ch: CHAR;
BEGIN
(* drop 'topic="' and '"' from query string *)
IF queryStr[6] = 22X THEN ch := 22X; j := 7 ELSE ch := " "; j := 6 END;
i := 0;
WHILE (queryStr[j] # ch) & (queryStr[j] # 0X) DO
name[i] := queryStr[j]; INC(i); INC(j)
END;
name[i] := 0X;
topic := topics;
WHILE (topic # NIL) & (topic.topic.s # name) DO
topic := topic.next
END;
IF topic # NIL THEN
RETURN topic.no
ELSE
COPY("Topic not found: ", queryStr); Strings.Append(queryStr, name); ShowStatus(queryStr);
RETURN -1
END
END GetTopicNo;
BEGIN
queryObj := FindObj("Query");
IF queryObj # NIL THEN
Attributes.GetString(queryObj, "Value", queryStr);
IF ~Strings.Prefix("topic=", queryStr) THEN
ShowStatus("must show single topic first"); RETURN
ELSE
currentNo := GetTopicNo(queryStr)
END
ELSE
ShowStatus("no query value found"); RETURN;
END;
Attributes.OpenScanner(S, Oberon.Par.text,Oberon.Par.pos);
Attributes.Scan(S);
IF S.class IN {Attributes.Name, Attributes.String} THEN
mailL := FindObj(S.s);
Attributes.Scan(S);
IF S.class IN {Attributes.Name, Attributes.String} THEN
topic := topics;
WHILE (topic # NIL) & (topic.topic.s # S.s) DO
topic := topic.next
END;
IF topic # NIL THEN
WITH mailL: ListGadgets.Frame DO
C.R := NIL; Objects.Stamp(C); mailL.obj.handle(mailL.obj, C); R := C.R;
mLine := mailL.lines;
REPEAT
IF mLine.sel THEN
R.do.Seek(R, mLine.key);
no := R.d(ListRiders.Int).i;
IF currentNo > -1 THEN EXCL(msgs[no].topics, currentNo) END;
INCL(msgs[no].topics, topic.no);
ScanHeader(no, h);
WriteStatus(h, no)
END;
mLine := mLine.next
UNTIL mLine = mailL.lines;
Files.Close(msgsF); Gadgets.Update(msgList)
END
END
END
END
END MoveTopic;
PROCEDURE QueryTopic*;
VAR
S: Attributes.Scanner;
obj: Objects.Object;
topic: Topic;
query: QueryString;
BEGIN
Attributes.OpenScanner(S, Oberon.Par.text,Oberon.Par.pos);
Attributes.Scan(S);
IF S.class IN {Attributes.Name, Attributes.String} THEN
obj := FindObj(S.s);
Attributes.Scan(S);
IF S.class IN {Attributes.Name, Attributes.String} THEN
topic := topics;
WHILE (topic # NIL) & (topic.topic.s # S.s) DO
topic := topic.next
END;
IF (obj # NIL) & (topic # NIL) THEN
query := 'topic="';
Strings.Append(query, topic.topic.s);
Strings.AppendCh(query, '"');
Attributes.SetString(obj, "Value", query);
Gadgets.Update(obj)
END
END
END
END QueryTopic;
PROCEDURE SaveIndexFile;
VAR f: Files.File; r: Files.Rider; i, t, d, len: SIGNED32; new: BOOLEAN;
BEGIN
ASSERT(msgsF # NIL);
f := Files.Old(IndexFile); new := FALSE;
IF f = NIL THEN f := Files.New(IndexFile); new := TRUE END;
IF f # NIL THEN
Files.GetDate(msgsF, t, d); len := Files.Length(msgsF);
Files.Set(r, f, 0);
Files.WriteLInt(r, IndexFileKey);
Files.WriteNum(r, t); Files.WriteNum(r, d); Files.WriteNum(r, len);
Files.WriteNum(r, noMsgs); Files.WriteNum(r, delMsgs);
Files.WriteNum(r, LEN(msgs^)(SIGNED32)); (* size of msgs array *)
Files.WriteNum(r, noMsgs);
FOR i := 0 TO noMsgs - 1 DO
Files.WriteNum(r, i);
Files.WriteNum(r, msgs[i].pos);
Files.WriteNum(r, msgs[i].len);
Files.WriteNum(r, msgs[i].state);
Files.WriteNum(r, msgs[i].stamp);
Files.WriteSet(r, msgs[i].flags);
Files.WriteSet(r, msgs[i].topics);
Files.WriteNum(r, msgs[i].date);
Files.WriteNum(r, msgs[i].time);
Files.WriteLInt(r, msgs[i].replyTo);
Files.WriteLInt(r, msgs[i].subject);
Files.WriteLInt(r, SIGNED32(0FFFFFFFFH))
END;
Store(r, heap);
IF new THEN Files.Register(f) ELSE Files.Close(f) END
END
END SaveIndexFile;
PROCEDURE TryLoadIndexFile(): BOOLEAN;
VAR
f: Files.File; r: Files.Rider;
t0, d0, len0, key, i, t, d, len: SIGNED32;
PROCEDURE err(n: SIGNED16);
BEGIN
Texts.WriteString(W, "Reparsing Mail: ");
CASE n OF
1: Texts.WriteString(W, "(1) MailMessages.idx not found.");
| 2: Texts.WriteString(W, "(2) MailMessages not open.");
| 3: Texts.WriteString(W, "(3) MailMessages.idx lacks proper key.");
Texts.WriteHex(W, key); Texts.WriteString(W, " # "); Texts.WriteHex(W, IndexFileKey);
| 4: Texts.WriteString(W, "(4) MailMessages has changed since index was saved.");
| 5: Texts.WriteString(W, "(5) MailMessages.idx internally corrupted.");
| 6: Texts.WriteString(W, "(6) MailMessages.idx sequence number corrupted.");
| 7: Texts.WriteString(W, "(7) MailMessages.idx internally corrupted.")
| 8: Texts.WriteString(W, "(8) readcount is too large.");
ELSE
Texts.WriteString(W, "Unknown problem.");
END;
Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
END err;
BEGIN
f := Files.Old(IndexFile);
IF f = NIL THEN err(1); RETURN FALSE END;
IF msgsF = NIL THEN msgsF := Files.Old(MsgFile) END;
IF msgsF = NIL THEN err(2); RETURN FALSE END;
Files.Set(r, f, 0);
Files.ReadLInt(r, key);
IF key # IndexFileKey THEN err(3); RETURN FALSE END;
Files.GetDate(msgsF, t, d); len := Files.Length(msgsF);
Files.ReadNum(r, t0); Files.ReadNum(r, d0); Files.ReadNum(r, len0);
IF (t0 # t) OR (d0 # d) OR (len0 # len) THEN err(4); RETURN FALSE END;
Files.ReadNum(r, noMsgs); Files.ReadNum(r, delMsgs);
Files.ReadNum(r, len); (* size of msgs array *)
IF (msgs = NIL) OR (LEN(msgs^) < len) THEN NEW(msgs, len) END;
Files.ReadNum(r, len); (* number of elements to be read *)
IF (len > LEN(msgs^)) THEN err(8); RETURN FALSE END;
FOR i := 0 TO len - 1 DO
Files.ReadNum(r, t); IF (t # i) THEN err(6); RETURN FALSE END;
Files.ReadNum(r, msgs[i].pos);
Files.ReadNum(r, msgs[i].len);
Files.ReadNum(r, msgs[i].state);
Files.ReadNum(r, msgs[i].stamp);
Files.ReadSet(r, msgs[i].flags);
Files.ReadSet(r, msgs[i].topics);
Files.ReadNum(r, msgs[i].date);
Files.ReadNum(r, msgs[i].time);
Files.ReadLInt(r, msgs[i].replyTo);
Files.ReadLInt(r, msgs[i].subject);
Files.ReadLInt(r, d); IF (d # 0FFFFFFFFH) THEN err(7); RETURN FALSE END
END;
Load(r, heap);
RETURN TRUE
END TryLoadIndexFile;
PROCEDURE LoadMsgs;
VAR
R: Files.Rider;
buf: ARRAY BufLen+4 OF CHAR;
pat: ARRAY 8 OF CHAR;
div: ARRAY 8 OF SIGNED32;
pos: SIGNED32;
PROCEDURE Search(VAR pos: SIGNED32);
VAR
i: SIGNED32;
ch: CHAR;
BEGIN
ch := buf[pos]; i := 0;
WHILE (i # 6) & (ch # 0X) DO
IF ch = pat[i] THEN
INC(i);
IF i < 6 THEN
INC(pos); ch := buf[pos]
END
ELSIF i = 0 THEN
INC(pos); ch := buf[pos]
ELSE
i := i - div[i]
END
END;
IF i # 6 THEN
pos := -1
END
END Search;
PROCEDURE AddMsgs;
VAR i, j: SIGNED32;
BEGIN
i := 0; Search(i);
WHILE i >= 0 DO
j := i;
WHILE buf[i] >= " " DO
INC(i)
END;
WHILE (buf[i] # 0X) & (buf[i] < " ") DO
INC(i)
END;
IF buf[i] # 0X THEN
IF (noMsgs > 0) & (msgs[noMsgs-1].len <= 0) THEN
msgs[noMsgs-1].len := pos+j-4-msgs[noMsgs-1].pos
END;
AddMsgHead(pos+i)
ELSE
pos := pos+j-8;
Files.Set(R, msgsF, pos);
RETURN
END;
Search(i)
END;
IF ~R.eof THEN
i := BufLen-5;
WHILE (i < BufLen) & (buf[i] # Strings.LF) DO
INC(i)
END;
IF i < BufLen THEN
pos := pos+i;
Files.Set(R, msgsF, pos);
RETURN
END
END;
INC(pos, BufLen);
Files.Set(R, msgsF, pos)
END AddMsgs;
PROCEDURE CalcDispVec;
VAR i, j, d: SIGNED32;
BEGIN
i := 1; d := 1;
WHILE i <= 6 DO
j := 0;
WHILE ((j + d) < 6) & (pat[j] = pat[j+d]) DO
INC(j)
END;
WHILE i <= j + d DO
div[i] := d; INC(i)
END;
INC(d)
END
END CalcDispVec;
BEGIN
uidls := NIL; Open(heap);
IF ~TryLoadIndexFile() THEN
Texts.WriteString(W, "Generating mail index..."); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
pat := " From "; pat[0] := Strings.LF;
NEW(msgs, 128); noMsgs := 0; delMsgs := 0;
msgsF := Files.Old(MsgFile);
IF msgsF = NIL THEN
msgsF := Files.New(MsgFile); Files.Register(msgsF)
END;
CalcDispVec();
Files.Set(R, msgsF, 0); buf[BufLen] := 0X;
IF Files.Length(msgsF) > 7 THEN
AddMsgHead(7)
END;
pos := 0; Files.ReadBytes(R, buf, BufLen);
WHILE ~R.eof DO
AddMsgs();
Files.ReadBytes(R, buf, BufLen)
END;
buf[BufLen-R.res] := 0X;
AddMsgs();
IF (noMsgs > 0) & (msgs[noMsgs-1].len <= 0) THEN
msgs[noMsgs-1].len := Files.Length(msgsF)-1-msgs[noMsgs-1].pos
END;
SaveIndexFile()
END
END LoadMsgs;
PROCEDURE LoadTopics;
VAR
key, value: ValueString;
topic: Topic;
i: SIGNED32;
BEGIN
topics := NIL; i := 0;
LOOP
key := "Topic"; Strings.IntToStr(i, value);
Strings.Append(key, value);
IF NetTools.QueryString(key, value) THEN
NEW(topic); topic.next := topics; topics := topic; topic.no := i; INC(i);
NEW(topic.topic); COPY(value, topic.topic.s)
ELSE
EXIT
END
END;
IF topicList # NIL THEN
Gadgets.Update(topicList)
END
END LoadTopics;
PROCEDURE Key(R: ListRiders.Rider): SIGNED32;
BEGIN
RETURN R(Rider).key
END Key;
PROCEDURE Seek(R: ListRiders.Rider; key: SIGNED32);
BEGIN
WITH R: Rider DO
R.key := key; R.pos := 0; R.sortPos := 0;
WHILE (R.pos < noMsgs) & (msgs[R.pos].pos # key) DO
INC(R.pos)
END;
IF R.pos >= noMsgs THEN
R.key := -1; R.pos := -1; R.sortPos := -1; R.eol := TRUE;
RETURN
END;
IF R.sort # NIL THEN
WHILE msgs[R.sort[R.sortPos]].pos # key DO
INC(R.sortPos)
END
END;
R.d(ListRiders.Int).i := R.pos
END
END Seek;
PROCEDURE Pos(R: ListRiders.Rider): SIGNED32;
VAR pos: SIGNED32;
BEGIN
WITH R: Rider DO
IF R.sort # NIL THEN
pos := R.sortPos
ELSE
pos := R.pos
END;
IF ~R.ascending THEN
pos := R.noMsgs-pos-1
END;
RETURN pos
END
END Pos;
PROCEDURE Set(R: ListRiders.Rider; pos: SIGNED32);
BEGIN
WITH R: Rider DO
IF (pos >= 0) & (pos < R.noMsgs) THEN
IF ~R.ascending THEN
pos := R.noMsgs-pos-1
END;
IF R.sort # NIL THEN
R.pos := R.sort[pos]; R.sortPos := pos
ELSE
R.pos := pos; R.sortPos := 0
END;
R.key := msgs[R.pos].pos
ELSE
R.key := -1; R.pos := -1; R.sortPos := -1; R.eol := TRUE
END;
R.d(ListRiders.Int).i := R.pos
END
END Set;
PROCEDURE GetState(R: ListRiders.Rider): SIGNED32;
BEGIN
RETURN msgs[R(Rider).pos].state
END GetState;
PROCEDURE SetState(R: ListRiders.Rider; state: SIGNED32);
BEGIN
msgs[R(Rider).pos].state := state
END SetState;
PROCEDURE GetStamp(R: ListRiders.Rider): SIGNED32;
BEGIN
RETURN msgs[R(Rider).pos].stamp
END GetStamp;
PROCEDURE SetStamp(R: ListRiders.Rider; stamp: SIGNED32);
BEGIN
msgs[R(Rider).pos].stamp := stamp
END SetStamp;
PROCEDURE Write(R: ListRiders.Rider; d: ListRiders.Data);
END Write;
PROCEDURE WriteLink(R, linkR: ListRiders.Rider);
END WriteLink;
PROCEDURE DeleteLink(R, linkR: ListRiders.Rider);
VAR no: SIGNED32;
BEGIN
R := linkR;
WITH R: Rider DO
no := R.pos;
IF ~(Deleted IN msgs[no].flags) THEN
DeleteMessage(no);
Files.Close(msgsF); collect();
(*R.do.Set(R, no)*)
END
END
END DeleteLink;
PROCEDURE Desc(R, old: ListRiders.Rider): ListRiders.Rider;
END Desc;
PROCEDURE Less(VAR i, j: MsgHead; sortBy: SIGNED16): BOOLEAN;
BEGIN
CASE sortBy OF
SortByDateTime: IF i.date < j.date THEN
RETURN TRUE
ELSIF i.date = j.date THEN
IF i.time < j.time THEN
RETURN TRUE
ELSIF i.time > j.time THEN
RETURN FALSE
END
ELSIF i.date > j.date THEN
RETURN FALSE
END
|SortByReplyTo: IF i.replyTo < j.replyTo THEN
RETURN TRUE
ELSIF i.replyTo > j.replyTo THEN
RETURN FALSE
END
|SortBySubject: IF i.subject < j.subject THEN
RETURN TRUE
ELSIF i.subject > j.subject THEN
RETURN FALSE
END
END;
RETURN i.pos < j.pos
END Less;
PROCEDURE QuickSort(sort: SortList; noMsgs: SIGNED32; sortBy: SIGNED16);
PROCEDURE Sort(lo, hi: SIGNED32);
VAR
i, j: SIGNED32;
m, t: SIGNED32;
BEGIN
IF lo < hi THEN
i := lo; j := hi;
m := sort[(lo + hi) DIV 2];
REPEAT
WHILE Less(msgs[sort[i]], msgs[m], sortBy) DO INC(i) END;
WHILE Less(msgs[m], msgs[sort[j]], sortBy) DO DEC(j) END;
IF i <= j THEN
t := sort[i]; sort[i] := sort[j]; sort[j] := t;
INC(i); DEC(j)
END
UNTIL i > j;
Sort(lo, j); Sort(i, hi)
END
END Sort;
BEGIN
Sort(0, noMsgs - 1)
END QuickSort;
PROCEDURE ToISO(VAR value: ARRAY OF CHAR);
VAR i: SIGNED32;
BEGIN
i := 0;
WHILE value[i] # 0X DO
value[i] := Strings.OberonToISO[ORD(value[i])];
INC(i)
END
END ToISO;
PROCEDURE CompileQuery(VAR Q: Query);
CONST
eof = 0; colon = 9; name = 10; string = 11; number = 12; dot = 13; today = 14; now = 15;
read = 16; unread = 17;
VAR
str, keyw: ValueString;
pos, num, d, m, y, h, s, sym: SIGNED32;
ch: CHAR;
PROCEDURE GetName;
VAR j: SIGNED32;
BEGIN
j := 0;
WHILE (ch # 0X) & (Strings.IsAlpha(ch) OR (ch = ".") OR (ch = "@") OR Strings.IsDigit(ch)) DO
str[j] := ch; INC(j); ch := Q.query[pos]; INC(pos)
END;
str[j] := 0X
END GetName;
PROCEDURE GetString;
VAR j: SIGNED32;
BEGIN
j := 0;
WHILE (ch # 0X) & (ch # 022X) DO
str[j] := ch; INC(j); ch := Q.query[pos]; INC(pos)
END;
IF ch = 022X THEN
ch := Q.query[pos]; INC(pos)
END;
str[j] := 0X
END GetString;
PROCEDURE GetNumber;
BEGIN
num := 0;
WHILE (ch # 0X) & Strings.IsDigit(ch) DO
num := 10*num+ORD(ch)-ORD("0"); ch := Q.query[pos]; INC(pos)
END
END GetNumber;
PROCEDURE Next;
BEGIN
WHILE (ch # 0X) & (ch <= " ") DO
ch := Q.query[pos]; INC(pos)
END;
CASE ch OF
"=": sym := eq; ch := Q.query[pos]; INC(pos)
|":": sym := colon; ch := Q.query[pos]; INC(pos)
|"<": ch := Q.query[pos]; INC(pos);
IF ch = "=" THEN
ch := Q.query[pos]; INC(pos); sym := leq
ELSE
sym := le
END
|">": ch := Q.query[pos]; INC(pos);
IF ch = "=" THEN
ch := Q.query[pos]; INC(pos); sym := geq
ELSE
sym := ge
END
|"&": sym := and; ch := Q.query[pos]; INC(pos)
|".": sym := dot; ch := Q.query[pos]; INC(pos)
|"#": sym := neq; ch := Q.query[pos]; INC(pos)
|"A" .. "Z", "a" .. "z": GetName(); Strings.Upper(str, keyw);
IF (keyw = "FROM") OR (keyw = "REPLYTO") THEN
sym := from
ELSIF keyw = "SUBJECT" THEN
sym := subject
ELSIF keyw = "DATE" THEN
sym := date
ELSIF keyw = "NOW" THEN
sym := now
ELSIF keyw = "TEXT" THEN
sym := text
ELSIF keyw = "TIME" THEN
sym := time
ELSIF keyw = "TOPIC" THEN
sym := topic
ELSIF keyw = "TODAY" THEN
sym := today
ELSIF keyw = "OR" THEN
sym := or
ELSIF keyw = "READ" THEN
sym := read
ELSIF keyw = "UNREAD" THEN
sym := unread
ELSE
sym := name
END
|"0" .. "9": sym := number; GetNumber()
|022X: sym := string; ch := Q.query[pos]; INC(pos); GetString()
ELSE
sym := eof
END
END Next;
PROCEDURE Check(sy: SIGNED32);
BEGIN
IF sy = sym THEN
Next()
ELSE
Q.error := TRUE
END
END Check;
PROCEDURE Factor(): Cond;
VAR
cond: Cond;
topicp: Topic;
BEGIN
NEW(cond); cond.field := sym;
IF sym IN {from, subject, topic, text} THEN
Next();
IF sym IN {eq, neq} THEN
cond.op := sym
ELSE
Q.error := TRUE
END;
Next();
IF sym IN {name, string} THEN
COPY(str, cond.val); Next();
IF cond.field = topic THEN
topicp := topics;
WHILE (topicp # NIL) & ~Strings.CAPCompare(cond.val, topicp.topic.s) DO
topicp := topicp.next
END;
IF topicp # NIL THEN
cond.time := topicp.no
ELSIF cond.val = "" THEN
cond.field := notopic
ELSE
Q.error := TRUE
END
ELSIF cond.field = text THEN
ToISO(cond.val)
END
ELSE
Q.error := TRUE
END
ELSIF sym = date THEN
Next();
IF sym IN {eq, leq, le, geq, ge, neq} THEN
cond.op := sym
ELSE
Q.error := TRUE
END;
Next();
IF sym = today THEN
MIME.GetClock(cond.time, cond.date); Next()
ELSE
Check(number);
d := num;
Check(dot);
Check(number);
m := num;
Check(dot);
Check(number);
y := num;
IF y >= 1900 THEN DEC(y, 1900) END; (* assume user typed 4-digit year *)
cond.date := (y*16+m)*32+d;
cond.time := Dates.ToTime(SHORT(Dates.TimeDiff DIV 60), SHORT(Dates.TimeDiff MOD 60), 0);
Dates.AddTime(cond.time, cond.date, -Dates.TimeDiff * 60)
END
ELSIF sym = time THEN
Next();
IF sym IN {eq, leq, le, geq, ge, neq} THEN
cond.op := sym
ELSE
Q.error := TRUE
END;
Next();
IF sym = now THEN
MIME.GetClock(cond.time, cond.date); Next()
ELSE
Check(number);
h := num;
Check(colon);
Check(number);
m := num;
IF sym = colon THEN
Check(colon);
Check(number);
s := num
ELSE
s := 0
END;
cond.time := h*1000H + m*40H + s;
cond.time := Dates.AddMinute(cond.time, -SHORT(Dates.TimeDiff))
END
ELSIF sym IN {read, unread} THEN
cond.field := readFlag; cond.op := eq;
COPY(keyw, cond.val); Next()
ELSIF sym IN {name, string} THEN
cond.field := text; cond.op := eq;
COPY(str, cond.val); ToISO(cond.val);
Next()
ELSE
Q.error := TRUE
END;
IF ~Q.error THEN
cond.next := Q.conds; Q.conds := cond
END;
RETURN cond
END Factor;
PROCEDURE Term(): Cond;
VAR
factor: Cond;
term: Node;
BEGIN
factor := Factor();
WHILE (sym = and) & ~Q.error DO
NEW(term); term.field := MAX(SIGNED16); term.op := and;
term.next := Q.conds; Q.conds := term; term.left := factor;
Next(); term.right := Factor(); factor := term
END;
RETURN factor
END Term;
PROCEDURE Expr(): Cond;
VAR
term: Cond;
expr: Node;
BEGIN
term := Term();
WHILE (sym = or) & ~Q.error DO
NEW(expr); expr.field := MAX(SIGNED16); expr.op := or;
expr.next := Q.conds; Q.conds := expr; expr.left := term;
Next(); expr.right := Expr(); term := expr
END;
RETURN term
END Expr;
BEGIN
Q.conds := NIL; Q.root := NIL; Q.error := FALSE;
ch := Q.query[0]; pos := 1;
Next(); Q.root := Expr();
IF (sym # eof) OR Q.error THEN
Q.conds := NIL; Q.root := NIL;
Q.error := TRUE
END
END CompileQuery;
PROCEDURE TextSearch(cond: Cond; no: SIGNED32): BOOLEAN;
CONST
MaxPatLen = 128;
VAR
i, sPatLen: SIZE;
pos, end: SIGNED32;
R: Files.Rider;
sPat: ARRAY MaxPatLen OF CHAR;
sDv: ARRAY MaxPatLen + 1 OF SIGNED32;
ch: CHAR;
PROCEDURE CalcDispVec;
VAR i, j: SIZE; d: SIGNED32;
BEGIN
i := 1; d := 1;
WHILE i <= sPatLen DO
j := 0;
WHILE ((j + d) < sPatLen) & (sPat[j] = sPat[j+d]) DO
INC(j)
END;
WHILE i <= j + d DO
sDv[i] := d; INC(i)
END;
INC(d)
END
END CalcDispVec;
BEGIN
COPY(cond.val, sPat);
sPatLen := Strings.Length(sPat);
CalcDispVec();
IF sPatLen > 0 THEN
pos := msgs[no].pos; Files.Set(R, msgsF, pos);
Files.Read(R, ch); INC(pos);
end := msgs[no].pos+msgs[no].len;
i := 0;
WHILE (i # sPatLen) & (pos <= end) DO
IF ch = sPat[i] THEN
INC(i);
IF i < sPatLen THEN
Files.Read(R, ch); INC(pos)
END
ELSIF i = 0 THEN
Files.Read(R, ch); INC(pos)
ELSE
i := i - sDv[i]
END
END
ELSE
i := -1
END;
RETURN i = sPatLen
END TextSearch;
PROCEDURE MatchQuery(VAR Q: Query; no: SIGNED32; VAR msg: MsgHead): BOOLEAN;
VAR
cond: Cond;
pos, i: SIZE;
str: ValueString;
txt: BOOLEAN;
BEGIN
cond := Q.conds; txt := FALSE;
WHILE cond # NIL DO (* evaluate simple conditions *)
cond.eval := TRUE;
CASE cond.field OF
from: pos := 0; Copy(heap, msg.replyTo, str);
Strings.Search(cond.val, str, pos);
cond.value := ((cond.op = eq) & (pos >= 0)) OR ((cond.op = neq) & (pos < 0))
|subject: pos := 0; Copy(heap, msg.subject, str);
Strings.Search(cond.val, str, pos);
cond.value := ((cond.op = eq) & (pos >= 0)) OR ((cond.op = neq) & (pos < 0))
|topic: cond.value := ((cond.op = eq) & (cond.time IN msg.topics)) OR ((cond.op = neq) & ~(cond.time IN msg.topics))
|notopic: cond.value := msg.topics = {}
|date: CASE cond.op OF
eq: cond.value := msg.date = cond.date
|leq: cond.value := msg.date <= cond.date
|le: cond.value := msg.date < cond.date
|geq: cond.value := msg.date >= cond.date
|ge: cond.value := msg.date > cond.date
|neq: cond.value := msg.date # cond.date
END
|time: CASE cond.op OF
eq: cond.value := msg.time = cond.time
|leq: cond.value := msg.time <= cond.time
|le: cond.value := msg.time < cond.time
|geq: cond.value := msg.time >= cond.time
|ge: cond.value := msg.time > cond.time
|neq: cond.value := msg.time # cond.time
END
|readFlag: cond.value := (Read IN msg.flags) = (cond.val[0] = "R")
|text: txt := TRUE; cond.value := FALSE; cond.eval := FALSE
ELSE (* or, and *)
cond.value := FALSE; cond.eval := FALSE
END;
cond := cond.next
END;
LOOP
REPEAT
i := 0; cond := Q.conds; (* evaluate logical ops *)
WHILE cond # NIL DO
IF cond IS Node THEN
WITH cond: Node DO
IF ~cond.eval THEN
IF cond.left.eval & cond.right.eval THEN
IF cond.op = or THEN (* OR *)
cond.value := cond.left.value OR cond.right.value
ELSIF cond.op = and THEN (* AND *)
cond.value := cond.left.value & cond.right.value
ELSE
HALT(99)
END;
cond.eval := TRUE; INC(i)
ELSIF (cond.op = or) & ((cond.left.eval & cond.left.value) OR (cond.right.eval & cond.right.value)) THEN
cond.value := TRUE; cond.eval := TRUE; cond.left.eval := TRUE; cond.right.eval := TRUE; INC(i)
ELSIF (cond.op = and) & ((cond.left.eval & ~cond.left.value) OR (cond.right.eval & ~cond.right.value)) THEN
cond.value := FALSE; cond.eval := TRUE; cond.left.eval := TRUE; cond.right.eval := TRUE; INC(i)
END
END
END
END;
cond := cond.next
END
UNTIL Q.root.eval OR (i <= 0);
IF Q.root.eval THEN
RETURN Q.root.value
ELSIF txt THEN
cond := Q.conds;
WHILE cond # NIL DO
IF (cond.field = text) & ~cond.eval THEN
cond.value := TextSearch(cond, no);
cond.eval := TRUE
END;
cond := cond.next
END
ELSE
HALT(99)
END
END
END MatchQuery;
PROCEDURE ConnectRider(VAR M: ListRiders.ConnectMsg; base: Model);
VAR
R: Rider;
int: ListRiders.Int;
i: SIGNED32;
Q: Query;
BEGIN
NEW(R); R.do := mMethod; R.sort := NIL;
R.noMsgs := noMsgs; Q.error := FALSE;
IF M IS ConnectMsg THEN
WITH M: ConnectMsg DO
R.ascending := M.ascending;
IF ((M.sortBy > 0) OR (M.query # "")) & (noMsgs > 0) THEN
NEW(R.sort, noMsgs);
FOR i := 0 TO noMsgs-1 DO
R.sort[i] := i
END;
IF M.query # "" THEN
COPY(M.query, Q.query);
CompileQuery(Q);
IF ~Q.error THEN
R.noMsgs := 0;
FOR i := 0 TO noMsgs-1 DO
IF MatchQuery(Q, i, msgs[i]) THEN
R.sort[R.noMsgs] := i; INC(R.noMsgs)
END
END
ELSE
ShowStatus("error in query")
END
END;
IF M.sortBy > 0 THEN
QuickSort(R.sort, R.noMsgs, M.sortBy)
END
END
END
ELSE
R.ascending := FALSE
END;
R.base := base; R.dsc := FALSE; R.eol := FALSE;
NEW(int); R.d := int;
R.do.Set(R, 0); M.R := R
END ConnectRider;
PROCEDURE ModelHandler(obj: Objects.Object; VAR M: Objects.ObjMsg);
BEGIN
WITH obj: Model DO
IF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.class := Objects.String; M.s := "Mail.NewModel"; M.res := 0
ELSE
Gadgets.objecthandle(obj, M)
END
END
ELSIF M IS Objects.CopyMsg THEN
M(Objects.CopyMsg).obj := obj
ELSIF M IS ListRiders.ConnectMsg THEN
ConnectRider(M(ListRiders.ConnectMsg), obj)
ELSE
Gadgets.objecthandle(obj, M)
END
END
END ModelHandler;
PROCEDURE NewModel*;
BEGIN
Objects.NewObj := msgList
END NewModel;
PROCEDURE GetRider(F: ListGadgets.Frame; new: BOOLEAN): ListRiders.Rider;
VAR
M: ConnectMsg;
i: SIGNED32;
BEGIN
IF ((F.R = NIL) OR new) & (F.obj # NIL) THEN
IF F IS Frame THEN
WITH F: Frame DO
Attributes.GetString(F.sortBy, "Value", M.query);
Strings.Upper(M.query, M.query);
IF (M.query = "DATE") OR (M.query = "TIME") THEN
M.sortBy := SortByDateTime
ELSIF M.query = "REPLYTO" THEN
M.sortBy := SortByReplyTo
ELSIF M.query = "SUBJECT" THEN
M.sortBy := SortBySubject
ELSE
Attributes.GetInt(F.sortBy, "Value", i);
M.sortBy := SHORT(i)
END;
Attributes.GetBool(F.ascending, "Value", M.ascending);
Attributes.GetString(F.query, "Value", M.query)
END
ELSE
M.sortBy := 0; M.ascending := FALSE; M.query := ""
END;
M.R := NIL; Objects.Stamp(M);
F.obj.handle(F.obj, M); F.R := M.R
END;
RETURN F.R
END GetRider;
PROCEDURE FormatLine(F: ListGadgets.Frame; R: ListRiders.Rider; L: ListGadgets.Line);
BEGIN
L.w := F.W; L.h := F.fnt.height; L.dsr := -F.fnt.minY; L.dx := 0
END FormatLine;
PROCEDURE DisplayLine(F: ListGadgets.Frame; Q: Display3.Mask; x, y, w, h: SIGNED16; R: ListRiders.Rider; L: ListGadgets.Line);
VAR
Q2: Display3.Mask;
str: ValueString;
textC: SIGNED16;
BEGIN
Display3.ReplConst(Q, F.backC, x, y, w-50, h, Display.replace);
WITH R: Rider DO
IF Read IN msgs[R.pos].flags THEN
textC := F.textC
ELSE
textC := Display3.red
END;
Copy(heap, msgs[R.pos].subject, str);
Display3.String(Q, textC, x + (w DIV 3) + 8, y + L.dsr, F.fnt, str, Display.paint);
Display3.Copy(Q, Q2); Display3.AdjustMask(Q2, x, y, w DIV 3, h);
Copy(heap, msgs[R.pos].replyTo, str);
Display3.String(Q2, textC, x, y + L.dsr, F.fnt, str, Display.paint);
Strings.DateToStr(msgs[R.pos].date, str);
Display3.ReplConst(Q, F.backC, x+w-50, y, 50, h, Display.replace);
Display3.String(Q, textC, x+w-42, y + L.dsr, F.fnt, str, Display.paint)
END
END DisplayLine;
PROCEDURE CopyFrame(VAR M: Objects.CopyMsg; from, to: Frame);
BEGIN
ListGadgets.CopyFrame(M, from, to);
to.query := Gadgets.CopyPtr(M, from.query);
to.sortBy := Gadgets.CopyPtr(M, from.sortBy);
to.ascending := Gadgets.CopyPtr(M, from.ascending)
END CopyFrame;
PROCEDURE Update(F: Frame);
VAR M: Gadgets.UpdateMsg;
BEGIN
M.F := F; M.obj := F.obj;
Display.Broadcast(M);
SetVPos(F)
END Update;
PROCEDURE FrameHandler(F: Objects.Object; VAR M: Objects.ObjMsg);
VAR
F1: Frame;
obj: Objects.Object;
ver: SIGNED16;
BEGIN
WITH F: Frame DO
IF M IS Display.FrameMsg THEN
WITH M: Display.FrameMsg DO
IF (M.F = NIL) OR (M.F = F) THEN
IF M IS Gadgets.UpdateMsg THEN
WITH M: Gadgets.UpdateMsg DO
IF M.obj # NIL THEN
IF M.obj = F.query THEN
Update(F)
ELSIF M.obj = F.sortBy THEN
Update(F)
ELSIF M.obj = F.ascending THEN
Update(F)
ELSE
ListGadgets.FrameHandler(F, M)
END
ELSE
ListGadgets.FrameHandler(F, M)
END
END
ELSE
ListGadgets.FrameHandler(F, M)
END
ELSE
ListGadgets.FrameHandler(F, M)
END
END
ELSIF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.class := Objects.String; M.s := "Mail.NewFrame"; M.res := 0
ELSE
ListGadgets.FrameHandler(F, M)
END
END
ELSIF M IS Objects.LinkMsg THEN
WITH M: Objects.LinkMsg DO
IF M.id = Objects.get THEN
IF M.name = "SortBy" THEN
M.obj := F.sortBy; M.res := 0
ELSIF M.name = "Ascending" THEN
M.obj := F.ascending; M.res := 0
ELSIF M.name = "Query" THEN
M.obj := F.query; M.res := 0
ELSE
ListGadgets.FrameHandler(F, M)
END
ELSIF M.id = Objects.set THEN
IF M.name = "SortBy" THEN
F.sortBy := M.obj; M.res := 0
ELSIF M.name = "Ascending" THEN
F.ascending := M.obj; M.res := 0
ELSIF M.name = "Query" THEN
F.query := M.obj; M.res := 0
ELSE
ListGadgets.FrameHandler(F, M)
END
ELSIF M.id = Objects.enum THEN
ListGadgets.FrameHandler(F, M);
M.Enum("SortBy"); M.Enum("Ascending"); M.Enum("Query")
ELSE
ListGadgets.FrameHandler(F, M)
END
END
ELSIF M IS Objects.CopyMsg THEN
WITH M: Objects.CopyMsg DO
IF M.stamp = F.stamp THEN
M.obj := F.dlink
ELSE
NEW(F1); F.stamp := M.stamp; F.dlink := F1;
CopyFrame(M, F, F1); M.obj := F1
END
END
ELSIF M IS Objects.FileMsg THEN
WITH M: Objects.FileMsg DO
IF M.id = Objects.load THEN
Files.ReadInt(M.R, ver); ASSERT(ver = Version);
Gadgets.ReadRef(M.R, F.lib, F.sortBy);
Gadgets.ReadRef(M.R, F.lib, F.ascending);
Gadgets.ReadRef(M.R, F.lib, F.query)
ELSIF M.id = Objects.store THEN
Files.WriteInt(M.R, Version);
Gadgets.WriteRef(M.R, F.lib, F.sortBy);
Gadgets.WriteRef(M.R, F.lib, F.ascending);
Gadgets.WriteRef(M.R, F.lib, F.query)
END;
ListGadgets.FrameHandler(F, M);
IF M.id = Objects.load THEN
Links.GetLink(F, "VRange", obj);
Attributes.SetInt(obj, "Value", noMsgs)
END
END
ELSE
ListGadgets.FrameHandler(F, M)
END
END
END FrameHandler;
PROCEDURE InitFrame(F: Frame);
BEGIN
ListGadgets.InitFrame(F);
F.handle := FrameHandler; F.do := vMethod; F.tab := 8;
F.ascending := NIL; F.sortBy := NIL; F.query := NIL;
Attributes.SetString(F, "Cmd", "Mail.Show #Point")
END InitFrame;
PROCEDURE NewFrame*;
VAR F: Frame;
BEGIN
NEW(F); InitFrame(F);
Objects.NewObj := F
END NewFrame;
PROCEDURE TopicKey(R: ListRiders.Rider): SIGNED32;
BEGIN
WITH R: TopicRider DO
IF R.topic # NIL THEN
RETURN R.topic.no
ELSE
RETURN 0
END
END
END TopicKey;
PROCEDURE TopicSeek(R: ListRiders.Rider; key: SIGNED32);
BEGIN
WITH R: TopicRider DO
R.topic := topics;
WHILE (R.topic # NIL) & (R.topic.no # key) DO
R.topic := R.topic.next
END;
IF R.topic # NIL THEN
R.d := R.topic.topic
END;
R.eol := R.topic = NIL
END
END TopicSeek;
PROCEDURE TopicPos(R: ListRiders.Rider): SIGNED32;
BEGIN
RETURN R.do.Key(R)
END TopicPos;
PROCEDURE TopicSet(R: ListRiders.Rider; pos: SIGNED32);
BEGIN
R.do.Seek(R, pos)
END TopicSet;
PROCEDURE TopicGetState(R: ListRiders.Rider): SIGNED32;
BEGIN
RETURN R(TopicRider).topic.state
END TopicGetState;
PROCEDURE TopicSetState(R: ListRiders.Rider; state: SIGNED32);
BEGIN
R(TopicRider).topic.state := state
END TopicSetState;
PROCEDURE TopicGetStamp(R: ListRiders.Rider): SIGNED32;
BEGIN
RETURN R(TopicRider).topic.stamp
END TopicGetStamp;
PROCEDURE TopicSetStamp(R: ListRiders.Rider; stamp: SIGNED32);
BEGIN
R(TopicRider).topic.stamp := stamp
END TopicSetStamp;
PROCEDURE TopicDeleteLink(R, linkR: ListRiders.Rider);
END TopicDeleteLink;
PROCEDURE ConnectTopicRider(VAR M: ListRiders.ConnectMsg; base: Model);
VAR
R: TopicRider;
BEGIN
NEW(R); R.do := tmMethod;
R.base := base; R.dsc := FALSE; R.eol := FALSE;
R.do.Set(R, 0); M.R := R
END ConnectTopicRider;
PROCEDURE TopicModelHandler(obj: Objects.Object; VAR M: Objects.ObjMsg);
BEGIN
WITH obj: Model DO
IF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.class := Objects.String; M.s := "Mail.NewTopicModel"; M.res := 0
ELSE
Gadgets.objecthandle(obj, M)
END
END
ELSIF M IS Objects.CopyMsg THEN
M(Objects.CopyMsg).obj := obj
ELSIF M IS ListRiders.ConnectMsg THEN
ConnectTopicRider(M(ListRiders.ConnectMsg), obj)
ELSE
Gadgets.objecthandle(obj, M)
END
END
END TopicModelHandler;
PROCEDURE NewTopicModel*;
BEGIN
Objects.NewObj := topicList
END NewTopicModel;
PROCEDURE Recipient(VAR i: SIGNED32; VAR s, rcpt: ARRAY OF CHAR);
VAR
j, k, end, dom: SIGNED32;
candidate: AdrString;
special: BOOLEAN;
ch, old, close: CHAR;
BEGIN
IF simpler THEN
WHILE (s[i] # 0X) & (s[i] <= " ") DO
INC(i)
END;
IF s[i] = "," THEN
INC(i);
WHILE (s[i] # 0X) & (s[i] <= " ") DO
INC(i)
END
END;
j := 0;
WHILE (s[i] > " ") & (s[i] # ",") DO
rcpt[j] := s[i];
INC(j); INC(i)
END;
rcpt[j] := 0X
ELSE
j := i; ch := s[j]; old := 01X; close := 02X;
WHILE (ch # 0X) & ~( ((ch = ",") & (close = 02X)) OR (old = close) ) DO
IF ch = "(" THEN
close := ")"
ELSIF ch = "<" THEN
close := ">"
ELSIF ch = "{" THEN
close := "}"
ELSIF ch = "[" THEN
close := "]"
ELSIF ch = 22X THEN
close := 22X
END;
INC(j); old := ch; ch := s[j]
END;
IF old # close THEN
end := j
ELSE
end := j-1
END;
WHILE (j >= i) & (s[j] <= " ") DO
DEC(j)
END;
WHILE (j >= i) & (s[j] > " ") DO
DEC(j)
END;
INC(j);
k := 0; dom := -1; special := FALSE; ch := s[j];
IF ch = "(" THEN
close := ")"; INC(j)
ELSIF ch = "<" THEN
close := ">"; INC(j)
ELSIF ch = "{" THEN
close := "}"; INC(j)
ELSIF ch = "[" THEN
close := "]"; INC(j)
ELSE
close := 02X
END;
ch := s[j];
WHILE (ch > " ") & (j < end) & (ch # close) DO
IF ch = "@" THEN
dom := j
ELSIF (dom < 0) & ((ch = "(") OR (ch = ")") OR (ch = "<") OR (ch = ">") OR (ch = ",") OR (ch = ";") OR (ch = ":") OR
(ch = "\") OR (ch = 22X) OR (*(ch = ".") OR*) (ch = "[") OR (ch = "]") OR (ch = "/")) THEN
special := TRUE
END;
candidate[k] := ch; INC(k); INC(j); ch := s[j]
END;
candidate[k] := 0X;
IF special THEN
IF candidate[0] # 22X THEN
rcpt[0] := 22X; k := 1
ELSE
k := 0
END; j := 0;
WHILE (candidate[j] # 0X) & (candidate[j] # "@") DO
rcpt[k] := candidate[j]; INC(k); INC(j)
END;
rcpt[k] := 22X; INC(k);
WHILE candidate[j] # 0X DO
rcpt[k] := candidate[j]; INC(k); INC(j)
END;
IF candidate[j-1] = 22X THEN
DEC(k)
END;
rcpt[k] := 0X
ELSE
COPY(candidate, rcpt)
END;
WHILE (s[end] # 0X) & (s[end] # ",") DO
INC(end)
END;
IF s[end] = "," THEN
i := end+1
ELSE
i := end
END
END
END Recipient;
PROCEDURE QueryContType*(T: Texts.Text; beg: SIGNED32; cont: MIME.Content);
VAR R: Texts.Reader; ch: CHAR;
BEGIN
cont.typ := MIME.GetContentType("text/plain"); cont.encoding := MIME.EncBin;
Texts.OpenReader(R, T, beg); Texts.Read(R, ch);
WHILE ~R.eot & ((ch <= " ") OR ~(R.lib IS Fonts.Font)) DO
Texts.Read(R, ch)
END;
WHILE ~R.eot DO
IF ~(R.lib IS Fonts.Font) THEN
cont.typ := MIME.GetContentType(MIME.OberonMime);
cont.encoding := MIME.EncAsciiCoderC; RETURN
ELSIF ch > CHR(127) THEN
cont.encoding := MIME.Enc8Bit
END;
Texts.Read(R, ch)
END
END QueryContType;
PROCEDURE ReadResponse(S: SMTPSession);
VAR
reply: ARRAY BufLen OF CHAR;
l: SIGNED32;
BEGIN
NetSystem.ReadString(S.C, S.reply);
IF trace THEN
Texts.WriteString(W, "RCV: "); Texts.WriteString(W, S.reply);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END;
Strings.StrToInt(S.reply, l); S.status := SHORT(l);
COPY(S.reply, reply);
(* WHILE reply[3] = "-" DO *)
WHILE S.reply[3] = "-" DO
(* NetSystem.ReadString(S.C, reply); *)
NetSystem.ReadString(S.C, S.reply);
IF trace THEN
Texts.WriteString(W, "RCV: "); Texts.WriteString(W, S.reply);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END
END ReadResponse;
PROCEDURE CloseSMTP*(S: SMTPSession);
BEGIN
IF S.C # NIL THEN
SendCmd(S, "QUIT", "");
(*NetSystem.ReadString(S.C, S.reply);*)
S.res := NetTools.Done;
NetTools.Disconnect(S.C); S.C := NIL; S.S := NIL
ELSE
S.res := NetTools.Failed
END
END CloseSMTP;
(* SMTP with authentication should connect inside a TLS tunnel connected to port 465. *)
PROCEDURE OpenSMTP*(VAR S: SMTPSession; host, user, passwd, from: ARRAY OF CHAR; port: SIGNED16);
VAR
T: Texts.Text; tR: Texts.Reader;
F: Files.File; fR: Files.Rider;
i: SIGNED32; (* Index in authString. *)
authString: ARRAY 48 OF CHAR;
BEGIN
IF trace THEN
Texts.WriteString(W, "--- SMTP"); Texts.WriteLn(W);
Texts.WriteString(W, "host = "); Texts.WriteString(W, host); Texts.WriteLn(W);
Texts.WriteString(W, "user = "); Texts.WriteString(W, user); Texts.WriteLn(W);
(* Texts.WriteString(W, "To display the password edit Oberon.Mail.Mod and recompile."); Texts.WriteLn(W); *)
Texts.WriteString(W, "passwd = "); Texts.WriteString(W, passwd); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
IF (port <= 0) OR (port >= 10000) THEN
(* port := DefSMTPPort *)
port := ImplicitTlsSMTPPort
END;
NEW(S);
S.res := NetTools.Failed; S.C := NIL; S.S := NIL;
IF (host[0] = "<") OR (host[0] = 0X) THEN
S.reply := "no smtp-host specified"
ELSE (* smtp-host name available *)
IF ~NetTools.Connect(S.C, port, host, TRUE) THEN
S.reply := "no connection"
ELSE (* Connection established. *)
S.S := NetTools.OpenStream(S.C);
ReadResponse(S);
IF S.reply[0] # "2" THEN (* Server declined to open stream. *)
CloseSMTP(S)
ELSE (* Server cooperating *)
IF (user[0] = 0X) OR (passwd[0] = 0X) THEN (* authentication not possible *)
SendCmd(S, "EHLO", NetSystem.hostName);
ReadResponse(S);
IF S.reply[0] = "2" THEN (* Server cooperating *)
COPY(from, S.from);
S.res := NetTools.Done
END
ELSE (* user and passwd available; try to authenticate *)
SendCmd(S, "EHLO", NetSystem.hostName);
ReadResponse(S);
IF S.reply[0] = "2" THEN (* server cooperating *)
IF trace THEN
Texts.WriteString(W, "user = "); Texts.WriteString(W, user); Texts.WriteLn(W);
Texts.WriteString(W, "passwd = "); Texts.WriteString(W, passwd); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
(* Put user & passwd, base64 encoded, in authString. *)
F := Files.New("passwdFile"); Files.Set(fR, F, 0);
Files.Write(fR, 0X);
Files.WriteString(fR, user);
i := 0;
WHILE (passwd[i] # 0X) & (i < LEN(passwd)) DO
Files.Write(fR, passwd[i]); INC(i)
END;
NEW(T); Texts.Open(T, "");
Base64.EncodeFile(F, T);
Files.Close(F);
i := 0; Texts.OpenReader(tR, T, 0);
WHILE (i < LEN(authString)) & (~tR.eot) DO
Texts.Read(tR, authString[i]); INC(i)
END;
Out.String("authString = "); Out.String(authString); Out.Ln();
SendCmd(S, "AUTH PLAIN", authString);
ReadResponse(S);
IF S.reply[0] = "2" THEN (* authentication accepted *)
COPY(from, S.from);
S.res := NetTools.Done
END
END
END
END
END
END
END OpenSMTP;
PROCEDURE SendReplyLine*(S: NetTools.Session; cont: MIME.Content);
BEGIN
S.reply := "Done ";
CASE cont.encoding OF
MIME.EncBin: Strings.Append(S.reply, "ASCII")
|MIME.Enc8Bit: Strings.Append(S.reply, "ASCII (ISO 8bit)")
|MIME.Enc7Bit: Strings.Append(S.reply, "ASCII (ISO 7bit)")
|MIME.EncQuoted: Strings.Append(S.reply, "ASCII (ISO quoted)")
|MIME.EncAsciiCoder, MIME.EncAsciiCoderC: Strings.Append(S.reply, "Oberon + Text")
|MIME.EncAsciiCoderCPlain: Strings.Append(S.reply, "Oberon")
ELSE
Strings.Append(S.reply, "???")
END
END SendReplyLine;
PROCEDURE MakeAscii*(body: Texts.Text; beg, end: SIGNED32; compress: BOOLEAN; VAR ascii: Texts.Text);
VAR
F, Fc: Files.File;
buf: Texts.Buffer;
len: SIGNED32;
BEGIN
NEW(buf); Texts.OpenBuf(buf);
Texts.Save(body, beg, end, buf);
NEW(ascii); Texts.Open(ascii, "");
Texts.Append(ascii, buf);
F := Files.New("");
Texts.Store(ascii, F, 0, len);
IF compress THEN
Fc := Files.New("");
AsciiCoder.Compress(F, Fc);
F := Fc
END;
NEW(ascii); Texts.Open(ascii, "");
AsciiCoder.Code(F, ascii)
END MakeAscii;
(* PROCEDURE WritePair(VAR a: ARRAY OF CHAR; VAR i: SIGNED16; ch: CHAR; x: SIGNED32);
BEGIN
a[i] := ch; INC(i);
a[i] := CHR(x DIV 10 + 30H)); INC(i);
a[i] := CHR(x MOD 10 + 30H); INC(i)
END WritePair;
Write a character and an integer to buffer of W.
PROCEDURE WritePair(VAR W: Texts.Writer; ch: CHAR; x: SIGNED32);
BEGIN
Texts.Write(W, ch);
Texts.Write(W, CHR(x DIV 10 + 30H));
Texts.Write(W, CHR(x MOD 10 + 30H))
END WritePair;
PROCEDURE CopyMonth(mo: ARRAY OF CHAR; VAR date: ARRAY OF CHAR; VAR i: SIGNED16);
BEGIN
date[i] := mo[0]; INC(i); date[i] := mo[1]; INC(i); date[i] := mo[2]; INC(i)
END CopyMonth;
PROCEDURE CopyStr(VAR str: Strings.String; VAR date: ARRAY OF CHAR; VAR i: SIGNED16);
BEGIN
j := 0;
WHILE (i < LEN(date)) & (j < LEN(str)) & (str[j] # 0X) DO
date[i] := str[j]; INC(i); INC(j);
END;
END CopyCh; *)
PROCEDURE RFC5322Date(VAR s: ARRAY OF CHAR);
VAR
x, t, d: SIGNED32;
m: ARRAY 40 OF CHAR;
BEGIN
m := "JanFebMarAprMayJunJulAugSepOctNovDec";
s := "DD MMM 20YY hh:mm:ss -0700";
Oberon.GetClock(t, d); (* Ref. Oberon.Oberon.Mod *)
x := d MOD 32; s[0] := CHR(x DIV 10+ORD("0")); s[1] := CHR(x MOD 10+ORD("0"));
x := (d DIV 32 MOD 16-1)*3; s[3] := m[x]; s[4] := m[x+1]; s[5] := m[x+2];
x := d DIV 512 MOD 100; s[9] := CHR(x DIV 10+ORD("0")); s[10] := CHR(x MOD 10+ORD("0"));
x := t DIV 4096 MOD 32; s[12] := CHR(x DIV 10+ORD("0")); s[13] := CHR(x MOD 10+ORD("0"));
x := t DIV 64 MOD 64; s[15] := CHR(x DIV 10+ORD("0")); s[16] := CHR(x MOD 10+ORD("0"));
x := t MOD 64; s[18] := CHR(x DIV 10+ORD("0")); s[19] := CHR(x MOD 10+ORD("0"));
END RFC5322Date;
PROCEDURE SendText*(S: SMTPSession; head, body: Texts.Text; beg, end: SIGNED32; cont: MIME.Content);
VAR
enc: SIGNED32;
ascii: Texts.Text;
dateTime: ARRAY 30 OF CHAR;
BEGIN
enc := cont.encoding; cont.len := MAX(SIGNED32);
SendCmd(S,"From: ", S.from);
RFC5322Date(dateTime);
SendCmd(S,"Date: ", dateTime);
SendCmd(S, "X-Mailer:", mailer);
IF enc IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain} THEN
SendCmd(S, "X-Content-Type:", MIME.OberonMime);
cont.encoding := MIME.Enc8Bit
END;
IF cont.encoding # MIME.EncBin THEN
MIME.WriteISOMime(S.S, cont)
END;
cont.encoding := MIME.Enc8Bit;
MIME.WriteText(head, 0, head.len, S.S, cont, TRUE, FALSE);
NetSystem.WriteString(S.C, "");
IF enc IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain} THEN
IF enc IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC} THEN
MIME.WriteText(body, beg, end, S.S, cont, TRUE, FALSE)
END;
NetSystem.WriteString(S.C, "");
NetSystem.WriteString(S.C, OberonStart);
MakeAscii(body, beg, end, enc # MIME.EncAsciiCoder, ascii);
MIME.WriteText(ascii, 0, ascii.len, S.S, cont, TRUE, TRUE)
ELSE
cont.encoding := enc;
MIME.WriteText(body, beg, end, S.S, cont, TRUE, TRUE)
END;
cont.encoding := enc;
NetSystem.WriteString(S.C, ".")
END SendText;
PROCEDURE SendMail*(S: SMTPSession; T: Texts.Text; cont: MIME.Content; autoCc: BOOLEAN);
VAR
R: Texts.Reader;
t: ARRAY BufLen OF CHAR;
pos: SIGNED32;
head: Texts.Text;
ch, old: CHAR;
PROCEDURE Recipients(VAR pos: SIGNED32): BOOLEAN;
VAR
R: Texts.Reader;
t: ARRAY BufLen OF CHAR;
i: SIGNED32;
rcpt: AdrString;
first: BOOLEAN;
BEGIN
Texts.OpenReader(R, T, pos); ReadString(R, t); first := TRUE;
WHILE (Strings.CAPPrefix("TO:", t) OR Strings.CAPPrefix("CC:", t) OR Strings.CAPPrefix("BCC:", t)) OR
(~first & (t[0] = " ") OR (t[0] = 09X)) DO
Texts.WriteString(W, t); Texts.WriteLn(W);
IF (t[0] = " ") OR (t[0] = 09X) THEN
i := 1
ELSIF Strings.CAPPrefix("BCC:", t) THEN
i := 4
ELSE
i := 3
END;
Recipient(i, t, rcpt);
WHILE rcpt # "" DO
Texts.Append(head, W.buf);
Texts.WriteString(W, "To: "); Texts.WriteString(W, rcpt);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
SendCmd(S, "RCPT TO:", rcpt); ReadResponse(S);
IF S.reply[0] # "2" THEN
S.res := NetTools.Failed; RETURN FALSE
END;
Recipient(i, t, rcpt); first := FALSE
END;
pos := Texts.Pos(R); ReadString(R, t)
END;
IF autoCc THEN
Texts.WriteString(W, "Cc: "); Texts.WriteString(W, S.from);
Texts.WriteLn(W); Texts.Append(head, W.buf);
SendCmd(S, "RCPT TO:", S.from); ReadResponse(S);
IF S.reply[0] # "2" THEN
S.res := NetTools.Failed; RETURN FALSE
END
END;
Texts.Append(head, W.buf);
RETURN TRUE
END Recipients;
BEGIN
Texts.OpenReader(R, T, 0); Texts.Read(R, ch); pos := 1;
WHILE ~R.eot & ((ch <= " ") OR ~(R.lib IS Fonts.Font)) DO
Texts.Read(R, ch); INC(pos)
END;
DEC(pos); Texts.OpenReader(R, T, pos);
REPEAT
pos := Texts.Pos(R); ReadString(R, t)
UNTIL R.eot OR Strings.CAPPrefix("TO:", t) OR Strings.CAPPrefix("CC:", t) OR Strings.CAPPrefix("BCC:", t);
IF ~R.eot THEN
SendCmd(S, "MAIL FROM:", S.from); ReadResponse(S);
IF S.reply[0] = "2" THEN
S.res := NetTools.Done;
NEW(head); Texts.Open(head, "");
IF Recipients(pos) THEN
Texts.OpenReader(R, T, pos);
old := 0X; Texts.Read(R, ch);
WHILE ~R.eot & ~( ((old = Strings.CR) OR (old = Strings.LF)) & ((ch = Strings.CR) OR (ch = Strings.LF)) ) DO
old := ch; Texts.Read(R, ch)
END;
Texts.Save(T, pos, Texts.Pos(R)-1, W.buf);
Texts.Append(head, W.buf);
SendCmd(S, "DATA", ""); ReadResponse(S);
IF S.reply[0] = "3" THEN
SendText(S, head, T, Texts.Pos(R), T.len, cont); ReadResponse(S);
IF S.reply[0] = "2" THEN
SendReplyLine(S, cont); RETURN
END
END
END
END
ELSE
S.reply := "no recipient"
END;
S.res := NetTools.Failed
END SendMail;
(** (es), Mail.Send ( @ | ^ | {mailfile} ~ ) *)
PROCEDURE Send*;
VAR
email: AdrString;
server: ServerName;
user: UserName; passwd: ValueString;
val: ValueString;
S: SMTPSession;
cont: MIME.Content;
Sc: Texts.Scanner;
T, sig: Texts.Text;
F: Texts.Finder;
obj: Objects.Object;
beg, end, time, i: SIGNED32;
autoCc: BOOLEAN;
PROCEDURE SendIt;
BEGIN
IF T # NIL THEN
IF cont.encoding = MIME.EncAuto THEN
QueryContType(T, beg, cont)
END;
GetSetting("MailSignature", val, FALSE);
IF val # "" THEN
NEW(sig); Texts.Open(sig, val);
IF sig.len > 0 THEN
Texts.Save(T, 0, T.len, W.buf);
NEW(T); Texts.Open(T, "");
Texts.WriteLn(W); Texts.Append(T, W.buf);
Texts.Save(sig, 0, sig.len, W.buf);
Texts.Append(T, W.buf)
END
END;
NetSystem.GetPassword("smtp", server, user, passwd);
IF trace THEN
Texts.WriteString(W, "passwd = "); Texts.WriteString(W, passwd); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
OpenSMTP(S, server, user, passwd, email, ImplicitTlsSMTPPort);
IF trace THEN
Texts.WriteString(W, "OpenSMTP returned."); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
IF S.res = NetTools.Done THEN
ShowStatus("mailing ");
SendMail(S, T, cont, autoCc);
CloseSMTP(S)
END;
ShowStatus(S.reply)
ELSE
ShowStatus("no text")
END
END SendIt;
BEGIN
(* trace := NetTools.QueryBool("TraceMail"); *)
GetSetting("EMail", email, FALSE);
GetSetting("SMTP", server, FALSE);
GetSetting("AutoCc", val, TRUE);
Strings.StrToBool(val, autoCc);
IF email = "" THEN
ShowStatus("no return address set"); RETURN
ELSE
i := 0; Recipient(i, email, val);
IF val # email THEN
ShowStatus("invalid return address"); RETURN
END
END;
GetSetting("ContType", val, TRUE);
NEW(cont); cont.typ := MIME.GetContentType("text/plain");
IF val[0] = "0" THEN
cont.encoding := MIME.EncBin
ELSIF val[0] = "1" THEN
cont.encoding := MIME.Enc8Bit
ELSIF val[0] = "2" THEN
cont.typ := MIME.GetContentType(MIME.OberonMime); cont.encoding := MIME.EncAsciiCoderC
ELSE
cont.encoding := MIME.EncAuto
END;
beg := 0; T := NIL;
Texts.OpenScanner(Sc, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(Sc);
IF (Sc.class = Texts.Char) & (Sc.c = "*") THEN (* send marked text *)
T := Oberon.MarkedText(); SendIt()
ELSIF (Sc.class = Texts.Char) & (Sc.c = "^") THEN (* send selected text *)
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(Sc, T, beg); Texts.Scan(Sc);
IF Sc.class IN {Texts.Name, Texts.String} THEN NEW(T); Texts.Open(T, Sc.s); SendIt() END
END
ELSIF (Sc.class = Texts.Char) & (Sc.c = "@") THEN (* Send button (mailto url) *)
IF Gadgets.executorObj # NIL THEN
Gadgets.GetObjName(Gadgets.executorObj, val);
IF val = "mailto" THEN
Links.GetLink(Gadgets.context, "Model", obj);
IF (obj # NIL) & (obj IS Texts.Text) THEN
T := obj(Texts.Text);
Texts.OpenFinder(F, T, beg);
beg := F.pos; Texts.FindObj(F, obj);
WHILE ~F.eot & (obj # Gadgets.executorObj) DO
beg := F.pos; Texts.FindObj(F, obj)
END;
INC(beg);
SendIt()
END
END
END
ELSIF Sc.class IN {Texts.Name, Texts.String} THEN (* {filename} ~ *)
WHILE Sc.class IN {Texts.Name, Texts.String} DO
NEW(T); Texts.Open(T, Sc.s); SendIt();
Texts.Scan(Sc)
END
END
END Send;
(** Mail.Cite (selection & caret)
Copy the selection to the caret with an left indent "> ". *)
PROCEDURE Cite*;
VAR
text: Texts.Text;
beg, end, time: SIGNED32;
C: Oberon.CaretMsg;
BEGIN
text := NIL; time := -1;
Oberon.GetSelection(text, beg, end, time);
IF (text # NIL) & (time > 0) THEN
C.id := Oberon.get; C.car := NIL; C.text := NIL; C.pos := -1; C.F := NIL;
Objects.Stamp(C); Display.Broadcast(C);
IF C.text # NIL THEN
CiteText(W, text, beg, end);
Texts.Insert(C.text, C.pos, W.buf)
END
END
END Cite;
(** Mail.Mono (marked text)
Change the font of the marked viewer into Courier10. *)
PROCEDURE Mono*;
VAR T: Texts.Text;
BEGIN
T := Oberon.MarkedText();
IF T # NIL THEN
Texts.ChangeLooks(T, 0, T.len, {0, 1}, textFnt, Display.FG, 0)
END
END Mono;
(** Mail.CutLines [width] (marked text)
Break all lines in the marked viewer after a maximum of width characters.
The default width is 80. *)
PROCEDURE CutLines*;
VAR
S: Attributes.Scanner;
T: Texts.Text;
R: Texts.Reader;
pos, crpos, n, l: SIGNED32;
ch: CHAR;
BEGIN
T := Oberon.MarkedText();
IF T = NIL THEN
RETURN
END;
Attributes.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Attributes.Scan(S);
IF S.class = Attributes.Int THEN
IF S.i < 40 THEN
n := 40
ELSIF S.i > 132 THEN
n := 132
ELSE
n := S.i
END
ELSE
n := 80
END;
Texts.OpenReader(R, T, 0); Texts.Read(R, ch);
pos := 0; crpos := 0; l := 1;
WHILE ~R.eot DO
IF R.lib IS Fonts.Font THEN
IF ch = Strings.CR THEN
l := 0; pos := Texts.Pos(R); crpos := pos
ELSIF (l >= n) & (pos # crpos) THEN
Texts.WriteLn(W); Texts.Insert(T, pos, W.buf);
Texts.OpenReader(R, T, Texts.Pos(R)+1);
l := Texts.Pos(R)-pos
ELSIF ch <= " " THEN
pos := Texts.Pos(R)
END
ELSE
pos := Texts.Pos(R)
END;
Texts.Read(R, ch); INC(l)
END
END CutLines;
(** Ref. List of Unicode characters#Control codes
and syntax of MText in the heading of Wrap. *)
PROCEDURE Visible(ch: CHAR): BOOLEAN;
VAR visible: BOOLEAN;
BEGIN
IF ((" " < ch) & (ch < 7FX)) OR (0A0X < ch) THEN
visible := TRUE
ELSE
visible := FALSE
END;
RETURN visible
END Visible;
(** Copy and reset buffer. *)
PROCEDURE WCopy(VAR w, x: Texts.Writer);
BEGIN
Texts.Copy(w.buf, x.buf);
Texts.OpenBuf(w.buf) (* Reset buffer. *)
END WCopy;
(** Append unchanged separator to accumulator. *)
PROCEDURE WCopySeparator(VAR wdata: WrapData);
BEGIN
WCopy(wdata.space0, wdata.accum);
IF 0 < wdata.nCR THEN
Texts.WriteLn(wdata.accum);
DEC(wdata.nCR);
WCopy(wdata.space1, wdata.accum);
IF 0 < wdata.nCR THEN
Texts.WriteLn(wdata.accum);
wdata.nCR := 0;
WCopy(wdata.gap, wdata.accum)
END
END
END WCopySeparator;
(** Append separator and word to accumulator with CR included or not
to adjust length of line. *)
PROCEDURE WCopySepWord(VAR wdata: WrapData);
VAR candidateLen: SIGNED32; (* Number of characters in candidate extended line. *)
spaceLength: SIGNED32; (* Total of invisible characters in sep0 + sep1. *)
BEGIN
IF wdata.nCR = 0 THEN (* Word separator; insert CR if necessary. *)
ASSERT(wdata.space1.buf.len = 0); ASSERT(wdata.gap.buf.len = 0);
candidateLen := wdata.lineLen + wdata.space0.buf.len + wdata.word.buf.len;
WCopy(wdata.space0, wdata.accum);
IF candidateLen <= wdata.width THEN
wdata.lineLen := candidateLen
ELSE (* wdata.width < candidateLen; insert CR. *)
Texts.WriteLn(wdata.accum);
wdata.lineLen := wdata.word.buf.len
END
ELSIF wdata.nCR = 1 THEN (* Line separator; remove CR when possible. *)
ASSERT(wdata.gap.buf.len = 0);
spaceLength := wdata.space0.buf.len + wdata.space1.buf.len;
IF spaceLength = 0 THEN
candidateLen := wdata.lineLen + 1 + wdata.word.buf.len;
ELSE
candidateLen := wdata.lineLen + spaceLength + wdata.word.buf.len
END;
IF candidateLen <= wdata.width THEN (* Extend line by omitting CR. *)
IF spaceLength = 0 THEN (* Create a separator. *)
Texts.Write(wdata.accum, " ")
ELSE
WCopy(wdata.space0, wdata.accum);
WCopy(wdata.space1, wdata.accum)
END;
wdata.lineLen := candidateLen
ELSE (* wdata.width < candidateLen; retain original structure. *)
WCopy(wdata.space0, wdata.accum);
Texts.WriteLn(wdata.accum);
wdata.lineLen := wdata.space1.buf.len + wdata.word.buf.len;
WCopy(wdata.space1, wdata.accum)
END;
DEC(wdata.nCR)
ELSE (* 1 < wdata.nCR THEN Paragraph separator. Retain original structure. *)
WCopySeparator(wdata);
(* ASSERT(wdata.nCR = 0); *)
wdata.lineLen := wdata.indent + wdata.word.buf.len
END;
WCopy(wdata.word, wdata.accum);
ASSERT(wdata.nCR = 0)
END WCopySepWord;
(** Wrap lines of Text to fit in width.
Mail.Wrap width ("*" | "@" | "^")
Mail.Wrap 60 * (Text marked with * to 60 characters wide. )
Mail.Wrap 70 @ (Text beginning at selection wrapped to 70 characters wide.)
Mail.Wrap 1 * (Wrap marked Text as one word per line. Useful to compare
similar texts differing in format.)
Mail.Wrap 10000 * (Unwrap paragraphs. )
DEFICIENCIES
Oberon Text attributes and non-character objects are omitted.
Result is plain ASCII text.
Syntax of Text input for this procedure.
WText = [word] {separator word} [separator].
word = visibleChar {visibleChar}.
separator = wordSeparator | lineSeparator | paragraphSeparator.
wordSeparator = spaceCh { spaceCh }.
lineSeparator = { spaceCh } CR { spaceCh }.
paragraphSeparator = lineSeparator { CR { spaceCh } }.
spaceCh = 00X | 01X | .. | 0CX | 0EX .. 20X | 7FX .. 9FX.
visibleChar = "!" | """ .. "~" | A1X .. FFX.
CR = 0DX. *)
PROCEDURE Wrap*;
VAR
S: Texts.Scanner;
T: Texts.Text;
rdr: Texts.Reader;
wdata: WrapData;
ch: CHAR;
previousVisible, visible: BOOLEAN;
pos0, pos, end, time: SIGNED32;
BEGIN
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
Texts.Scan(S);
IF S.class # Texts.Int THEN
Texts.WriteString(W, "Mail.Wrap: 1st parameter should be an integer"); Texts.WriteLn(W);
Texts.WriteString(W, "representing width of column of text."); Texts.WriteLn(W)
ELSE
wdata.width := S.i;
Texts.Scan(S);
NEW(T);
T := NIL;
IF S.c = "*" THEN
T := Oberon.MarkedText();
pos0 := 0; pos := pos0; end := T.len;
ELSIF S.c = "^" THEN
Oberon.GetSelection(T, pos0, end, time);
IF time <= 0 THEN
T := NIL
ELSE
pos := pos0
END
ELSIF S.c = "@" THEN
Oberon.GetSelection(T, pos0, end, time);
IF time <= 0 THEN
T := NIL
ELSE
pos := pos0; end := T.len
END
ELSE
Texts.WriteString(W, "Mail.Wrap: 2nd parameter should be * or @ or ^. Aborting.");
Texts.WriteLn(W)
END;
IF T = NIL THEN
Texts.WriteString(W, "Mail.Wrap: T = NIL. No Text to wrap."); Texts.WriteLn(W)
ELSE (* T # NIL *)
IF pos0 < end THEN (* T has content. *)
Texts.OpenReader(rdr, T, pos);
wdata.nCR := 0;
wdata.lineLen := 0;
Texts.OpenWriter(wdata.space0);
Texts.OpenWriter(wdata.space1);
Texts.OpenWriter(wdata.gap);
Texts.OpenWriter(wdata.word);
Texts.OpenWriter(wdata.accum);
ch := " ";
visible := FALSE;
WHILE pos < end DO
Texts.Read(rdr, ch);
INC(pos);
IF ~(rdr.lib IS Fonts.Font) THEN
Out.String("Non-character object at pos = "); Out.Int(pos, 0); Out.Ln();
ELSE
previousVisible := visible;
IF Visible(ch) THEN
visible := TRUE;
Texts.Write(wdata.word, ch);
ELSE
ASSERT(~Visible(ch));
visible := FALSE;
IF previousVisible THEN (* Beginning a fresh separator; copy out and reset buffers. *)
WCopySepWord(wdata)
END;
(* Incorporate ch into wdata. *)
CASE wdata.nCR OF
0: IF ch = Strings.CR THEN INC(wdata.nCR) ELSE Texts.Write(wdata.space0, ch) END |
1: IF ch = Strings.CR THEN (* Paragraph separator found. *)
INC(wdata.nCR)
ELSE
Texts.Write(wdata.space1, ch)
END
ELSE (* 1 < wdata.nCR; reading paragraph separator. *)
IF ch = Strings.CR THEN
INC(wdata.nCR); wdata.indent := 0
ELSE
INC(wdata.indent)
END;
Texts.Write(wdata.gap, ch)
END (* CASE *)
END (* IF Visible(ch) *)
END (* IF ~(rdr.lib IS Fonts.Font) *)
END; (* WHILE; finished reading from T *)
IF 0 < wdata.word.buf.len THEN
WCopySepWord(wdata)
ELSE (* text ends with a separator. Copy unchanged. *)
WCopySeparator(wdata)
END;
Texts.Replace(T, pos0, end, wdata.accum.buf)
END (* IF pos < end *)
END (* IF T = NIL *)
END; (* IF S.class # Texts.Int *)
Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END Wrap;
(** Parsing of a mailto url. *)
PROCEDURE SplitMailTo*(VAR url, mailadr: ARRAY OF CHAR): SIGNED32;
VAR
key: SIGNED32;
i, j, l: SIZE;
buffer: ARRAY BufLen OF CHAR;
iskey: BOOLEAN;
PROCEDURE Blanks;
BEGIN
WHILE (url[i] # 0X) & (url[i] <= " ") DO
INC(i)
END
END Blanks;
BEGIN
HyperDocs.UnESC(url);
i := 0; Blanks();
(* skip mailto *)
WHILE (url[i] # 0X) & (url[i] # ":") DO
INC(i)
END;
(* skip : *)
WHILE (url[i] # 0X) & ((url[i] = ":") OR (url[i] = "/")) DO
INC(i)
END;
Blanks();
(* get mailadr *)
iskey := TRUE;
l := LEN(mailadr); j := 0;
WHILE url[i] # 0X DO
IF (url[i] > " ") & ~Strings.IsDigit(url[i]) THEN
iskey := FALSE
END;
IF j < l THEN
mailadr[j] := url[i]; INC(j)
END;
INC(i)
END;
mailadr[j] := 0X; DEC(j);
WHILE (j >= 0) & (mailadr[j] <= " ") DO
mailadr[j] := 0X; DEC(j)
END;
IF (url[i] = 0X) & iskey THEN
IF mailadr # "" THEN
Strings.StrToInt(mailadr, key);
HyperDocs.RetrieveLink(key, buffer);
key := SplitMailTo(buffer, mailadr)
ELSE
key := HyperDocs.UndefKey
END
ELSE
COPY("mailto:", url);
Strings.Append(url, mailadr);
key := HyperDocs.RegisterLink(url)
END;
RETURN key
END SplitMailTo;
PROCEDURE MailToSchemeHandler(L: Objects.Object; VAR M: Objects.ObjMsg);
VAR mailadr: ARRAY NetTools.PathStrLen OF CHAR;
BEGIN
WITH L: HyperDocs.LinkScheme DO
IF M IS HyperDocs.RegisterLinkMsg THEN
WITH M: HyperDocs.RegisterLinkMsg DO
M.key := SplitMailTo(M.link, mailadr);
IF M.key # HyperDocs.UndefKey THEN
M.res := 0
END
END
ELSIF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.class := Objects.String;
M.s := "Mail.NewMailToLinkScheme";
M.res := 0
ELSE
HyperDocs.LinkSchemeHandler(L, M)
END
END
ELSE
HyperDocs.LinkSchemeHandler(L, M)
END
END
END MailToSchemeHandler;
PROCEDURE NewMailToLinkScheme*;
VAR L: HyperDocs.LinkScheme;
BEGIN
NEW(L); L.usePath := FALSE;
L.handle := MailToSchemeHandler; Objects.NewObj := L
END NewMailToLinkScheme;
(** Parsing of a mailserver url. *)
PROCEDURE SplitMailServer*(VAR url, mailadr, subject, body: ARRAY OF CHAR): SIGNED32;
VAR
key: SIGNED32;
i, j, l: SIZE;
buffer: ARRAY BufLen OF CHAR;
iskey: BOOLEAN;
PROCEDURE Blanks;
BEGIN
WHILE (url[i] # 0X) & (url[i] <= " ") DO
INC(i)
END
END Blanks;
BEGIN
HyperDocs.UnESC(url);
i := 0; Blanks();
(* skip mailserver *)
WHILE (url[i] # 0X) & (url[i] # ":") DO
INC(i)
END;
(* skip : *)
WHILE (url[i] # 0X) & ((url[i] = ":") OR (url[i] = "/")) DO
INC(i)
END;
Blanks();
(* get mailadr *)
iskey := TRUE;
l := LEN(mailadr); j := 0;
WHILE (url[i] # 0X) & (url[i] # "/") DO
IF (url[i] > " ") & ~Strings.IsDigit(url[i]) THEN
iskey := FALSE
END;
IF j < l THEN
mailadr[j] := url[i]; INC(j)
END;
INC(i)
END;
mailadr[j] := 0X; DEC(j);
WHILE (j >= 0) & (mailadr[j] <= " ") DO
mailadr[j] := 0X; DEC(j)
END;
IF (url[i] = 0X) & iskey THEN
IF mailadr # "" THEN
Strings.StrToInt(mailadr, key);
HyperDocs.RetrieveLink(key, buffer);
key := SplitMailServer(buffer, mailadr, subject, body)
ELSE
key := HyperDocs.UndefKey
END;
RETURN key
END;
IF url[i] = "/" THEN
INC(i)
END;
l := LEN(subject); j := 0;
WHILE (url[i] # 0X) & (url[i] # "/") DO
IF j < l THEN
subject[j] := url[i]; INC(j)
END;
INC(i)
END;
subject[j] := 0X; DEC(j);
WHILE (j >= 0) & (subject[j] <= " ") DO
subject[j] := 0X; DEC(j)
END;
IF url[i] = "/" THEN
INC(i)
END;
l := LEN(body); j := 0;
WHILE url[i] # 0X DO
IF j < l THEN
body[j] := url[i]; INC(j)
END;
INC(i)
END;
body[j] := 0X;
COPY("mailserver:", url);
Strings.Append(url, mailadr);
Strings.AppendCh(url, "/");
Strings.Append(url, subject);
Strings.AppendCh(url, "/");
Strings.Append(url, body);
key := HyperDocs.RegisterLink(url);
RETURN key
END SplitMailServer;
PROCEDURE MailServerSchemeHandler(L: Objects.Object; VAR M: Objects.ObjMsg);
VAR mailadr, subject, body: ARRAY NetTools.PathStrLen OF CHAR;
BEGIN
WITH L: HyperDocs.LinkScheme DO
IF M IS HyperDocs.RegisterLinkMsg THEN
WITH M: HyperDocs.RegisterLinkMsg DO
M.key := SplitMailServer(M.link, mailadr, subject, body);
IF M.key # HyperDocs.UndefKey THEN
M.res := 0
END
END
ELSIF M IS Objects.AttrMsg THEN
WITH M: Objects.AttrMsg DO
IF (M.id = Objects.get) & (M.name = "Gen") THEN
M.class := Objects.String;
M.s := "Mail.NewMailServerLinkScheme";
M.res := 0
ELSE
HyperDocs.LinkSchemeHandler(L, M)
END
END
ELSE
HyperDocs.LinkSchemeHandler(L, M)
END
END
END MailServerSchemeHandler;
PROCEDURE NewMailServerLinkScheme*;
VAR L: HyperDocs.LinkScheme;
BEGIN
NEW(L); L.usePath := FALSE;
L.handle := MailServerSchemeHandler; Objects.NewObj := L
END NewMailServerLinkScheme;
PROCEDURE LoadDoc(D: Documents.Document);
VAR
T, text: Texts.Text;
objb: Objects.Object;
mailadr, subject, body: ARRAY NetTools.PathStrLen OF CHAR;
buffer: ARRAY BufLen OF CHAR;
key, beg, end, time, i: SIGNED32;
node: HyperDocs.Node;
BEGIN
IF Strings.CAPPrefix("mailto", D.name) THEN
key := SplitMailTo(D.name, mailadr); subject := ""; body := ""
ELSIF Strings.CAPPrefix("mailserver", D.name) THEN
key := SplitMailServer(D.name, mailadr, subject, body)
ELSE
key := HyperDocs.UndefKey
END;
IF key = HyperDocs.UndefKey THEN
D.dsc := NIL; RETURN
END;
NEW(T); Texts.Open(T, "");
objb := Gadgets.CreateObject("BasicGadgets.NewButton");
Attributes.SetString(objb, "Caption", "Send"); Attributes.SetString(objb, "Cmd", "Mail.Send @ ~");
Gadgets.NameObj(objb, "mailto");
Texts.WriteObj(W, objb); Texts.WriteLn(W); Texts.WriteLn(W);
Texts.WriteString(W, "To: "); Texts.WriteString(W, mailadr); Texts.WriteLn(W);
Texts.WriteString(W, "Subject: "); Texts.WriteString(W, subject); Texts.WriteLn(W);
IF (HyperDocs.context # NIL) & (HyperDocs.context.old # NIL) THEN
node := HyperDocs.context.old
ELSE
node := HyperDocs.NodeByDoc(Desktops.CurDoc(Gadgets.context))
END;
IF node # NIL THEN
Texts.WriteString(W, "X-URL: "); HyperDocs.RetrieveLink(node.key, buffer); Texts.WriteString(W, buffer); Texts.WriteLn(W)
END;
IF body # "" THEN
Texts.WriteLn(W); i := 0;
WHILE body[i] # 0X DO
IF body[i] = "/" THEN
Texts.WriteLn(W)
ELSE
Texts.Write(W, body[i])
END;
INC(i)
END;
Texts.WriteLn(W)
ELSE
text := NIL; time := -1;
Oberon.GetSelection(text, beg, end, time);
IF (text # NIL) & (time > 0) THEN
Texts.WriteLn(W); Texts.Append(T, W.buf); CiteText(W, text, beg, end)
END
END;
Texts.Append(T, W.buf);
COPY(mailadr, D.name); Links.SetLink(D.dsc, "Model", T);
IF HyperDocs.context # NIL THEN
HyperDocs.context.replace := FALSE; HyperDocs.context.history := FALSE
END
END LoadDoc;
(** Mail.NewDoc
Document new-procedure for "mailto:" & "mailserver:" documents.
E.g. Use Desktops.OpenDoc "mailto:zeller@inf.ethz.ch" to send me a mail. *)
PROCEDURE NewDoc*;
VAR D: Objects.Object;
BEGIN
D := Gadgets.CreateObject("TextDocs.NewDoc");
D(Documents.Document).Load := LoadDoc
END NewDoc;
BEGIN
Modules.InstallTermHandler(SaveIndexFile);
trace := NetTools.QueryBool("TraceMail");
mailer := "Oberon Mail (ejz) on "; Strings.Append(mailer, Kernel.version);
headFnt := Fonts.This("Default12b.Scn.Fnt");
fieldFnt := Fonts.This("Default12.Scn.Fnt");
textFnt := Fonts.This("Courier10.Scn.Fnt");
Texts.OpenWriter(W); LoadMsgs(); LoadTopics();
NEW(mMethod);
mMethod.Key := Key; mMethod.Seek := Seek;
mMethod.Pos := Pos; mMethod.Set := Set;
mMethod.State := GetState; mMethod.SetState := SetState;
mMethod.GetStamp := GetStamp; mMethod.SetStamp := SetStamp;
mMethod.Write := Write; mMethod.WriteLink := WriteLink;
mMethod.DeleteLink := DeleteLink; mMethod.Desc := Desc;
NEW(msgList); msgList.handle := ModelHandler;
NEW(vMethod); vMethod^ := ListGadgets.methods^;
vMethod.GetRider := GetRider;
vMethod.Display := DisplayLine; vMethod.Format := FormatLine;
NEW(tmMethod); tmMethod^ := mMethod^;
tmMethod.Key := TopicKey; tmMethod.Seek := TopicSeek;
tmMethod.Pos := TopicPos; tmMethod.Set := TopicSet;
tmMethod.State := TopicGetState; tmMethod.SetState := TopicSetState;
tmMethod.GetStamp := TopicGetStamp; tmMethod.SetStamp := TopicSetStamp;
tmMethod.DeleteLink := TopicDeleteLink;
NEW(topicList); topicList.handle := TopicModelHandler
END Mail.
!System.CopyFiles MailMessages => ejz.MailMessages ~
!System.CopyFiles ejz.MailMessages => MailMessages ~
!System.DeleteFiles MailMessages MailMessages.Bak lillian.inf.ethz.ch.zeller.UIDLs ~
System.Set NetSystem Topic0 := Miscellaneous ~
System.Set NetSystem Topic1 := "Bug Report" ~
System.Set NetSystem Topic2 := "To Do" ~
ListGadgets.InsertVScrollList Mail.NewFrame Mail.NewModel ~
Gadgets.Insert ListGadgets.NewFrame Mail.NewTopicModel ~
Mail.Mod
Mail.Panel
Mail.Show ~ Mail.Show 12 ~
Mail.Collect
- snooper?
- signature?
- simplify GetUIDLs -> Texts.LoadAscii
- ReSync: delete messages on server
- import/export
- use faster text search (t-search)
(- query, optimize with stamp)
LayLa.OpenAsDoc ( CONFIG { Mail.Panel }
{ Patch:
1. Mark the pin of the Settings iconizer and open a Columbus inspector.
2. Click on pin of Settings iconizer to open settings panel.
3. Click on Coords button in Columbus, set X=4 Y=-195 and Apply.
}
(DEF CW 32) (DEF BW 42) (DEF BH 23) (DEF IW 42) (DEF IW2 87)
(DEF LW 80) (DEF LH 100) (DEF SW 376) (DEF SH 192)
(DEF mailmodel (NEW Mail.NewModel))
(DEF topicmodel (NEW Mail.NewTopicModel))
(DEF query (NEW String (ATTR Name="Query" Value="topic=ToDo")))
(DEF vpos (NEW Integer))
(DEF vrange (NEW Integer))
(DEF sortby (NEW Integer (ATTR Value=1)))
(DEF ascend (NEW Boolean (ATTR Value=FALSE)))
(DEF cont (NEW Integer (ATTR Name="ContType" Value=3)))
{ Iconizer front panels }
( DEF set0 (HLIST Panel (w=IW h=BH vjustify=CENTER hjustify=CENTER) (ATTR Locked=TRUE)
(NEW Caption (ATTR Value="Set")))
)
( DEF move0 (HLIST Panel (w=IW h=BH vjustify=CENTER hjustify=CENTER) (ATTR Locked=TRUE)
(NEW Caption (ATTR Value="Move")))
)
( DEF clear0 (HLIST Panel (w=IW h=BH vjustify=CENTER hjustify=CENTER) (ATTR Locked=TRUE)
(NEW Caption (ATTR Value="Clear")))
)
( DEF query0 (HLIST Panel (w=IW h=BH vjustify=CENTER hjustify=CENTER) (ATTR Locked=TRUE)
(NEW Caption (ATTR Value="Topic")))
)
( DEF conf0 (HLIST Panel (w=IW2 h=BH vjustify=CENTER hjustify=CENTER) (ATTR Locked=TRUE)
(NEW Caption (ATTR Value="Settings")))
)
{ Iconizer insides }
( DEF set1
(NEW ListGadget (w=LW h=LH) (LINKS Model=topicmodel) (ATTR Cmd="Mail.SetTopic MailList '#Point '" Locked=TRUE))
)
( DEF move1
(NEW ListGadget (w=LW h=LH) (LINKS Model=topicmodel) (ATTR Cmd="Mail.MoveTopic MailList '#Point '" Locked=TRUE))
)
( DEF clear1
(NEW ListGadget (w=LW h=LH) (LINKS Model=topicmodel) (ATTR Cmd="Mail.ClearTopic MailList '#Point '" Locked=TRUE))
)
( DEF query1
(NEW ListGadget (w=LW h=LH) (LINKS Model=topicmodel) (ATTR Cmd="Mail.QueryTopic Query '#Point '" Locked=TRUE))
)
( DEF conf1 { Settings panel }
( HLIST Panel (border=5 w=SW h=SH dist=14 vjustify=CENTER) (ATTR Locked=TRUE)
( VLIST VIRTUAL (w=[2] dist=8)
( HLIST VIRTUAL (w=[] hjustify=CENTER)
(NEW Caption (ATTR Value="Local Settings (override Oberon.Text)"))
)
( TABLE VIRTUAL (w=[] cols=2)
(NEW Caption (ATTR Value="EMail Address"))
(NEW TextField (w=[10]) (ATTR Name="EMail"))
(NEW Caption (ATTR Value="SMTP Server"))
(NEW TextField (w=[10]) (ATTR Name="SMTP"))
(NEW Caption (ATTR Value="POP Server"))
( HLIST VIRTUAL (w=[10])
(NEW TextField (w=[7]) (ATTR Name="POP"))
(NEW TextField (w=[3]) (ATTR Name="POPMode") (ATTR Value="POP3"))
)
(NEW Caption (ATTR Value="POP User"))
(NEW TextField (w=[10]) (ATTR Name="User"))
(NEW Caption (ATTR Value="Max message size"))
(NEW TextField (w=[10]) (ATTR Name="MaxMsgSize" Value="100000"))
)
( HLIST VIRTUAL (w=[])
(NEW Caption (ATTR Value="Leave messages on server"))
(NEW CheckBox (ATTR Name="LeaveOnServer"))
(NEW VIRTUAL (w=[]))
(NEW Caption (ATTR Value="Auto Cc"))
(NEW CheckBox (ATTR Name="AutoCc" Value=TRUE))
)
)
( TABLE VIRTUAL (w=[] orientation=VERT rows=6)
(HLIST VIRTUAL (w=45 h=BH hjustify=CENTER vjustify=CENTER) (NEW Caption (ATTR Value="Sorting")))
(NEW Button (w=[] h=BH) (ATTR Caption="Date" SetVal=1) (LINKS Model=sortby))
(NEW Button (w=[] h=BH) (ATTR Caption="From" SetVal=2) (LINKS Model=sortby))
(NEW Button (w=[] h=BH) (ATTR Caption="Subject" SetVal=3) (LINKS Model=sortby))
(NEW Button (w=[] h=BH) (ATTR Caption="None" SetVal=0) (LINKS Model=sortby))
( SPAN 1 2
( HLIST VIRTUAL (w=[])
(NEW Caption (ATTR Value="Ascending"))
(NEW CheckBox (LINKS Model=ascend))
(NEW VIRTUAL (w=[]))
)
)
(HLIST VIRTUAL (w=[] h=BH hjustify=CENTER vjustify=CENTER) (NEW Caption (ATTR Value="Content")))
(NEW Button (w=[] h=BH) (ATTR Caption="Auto" SetVal=3) (LINKS Model=cont))
(NEW Button (w=[] h=BH) (ATTR Caption="Oberon" SetVal=2) (LINKS Model=cont))
(NEW Button (w=[] h=BH) (ATTR Caption="ISO-8859-1" SetVal=1) (LINKS Model=cont))
(NEW Button (w=[] h=BH) (ATTR Caption="ASCII" SetVal=0) (LINKS Model=cont))
)
)
)
{ Main panel }
( VLIST Panel (border=5 w=384 h=200 dist=3 vjustify=CENTER) (ATTR Locked=TRUE)
( HLIST VIRTUAL (w=[] h=[] dist=0) { Mail list & scrollbar }
( NEW Mail.NewFrame (w=[] h=[]) (ATTR Name="MailList")
(LINKS Model=mailmodel SortBy=sortby Ascending=ascend Query=query VPos=vpos VRange=vrange)
)
(NEW Scrollbar (h=[]) (ATTR Max=0 HeavyDrag=TRUE) (LINKS Min=vrange Model=vpos))
)
( HLIST VIRTUAL (w=[] vdist=5 hdist=3 vjustify=CENTER) { Top row }
(HLIST VIRTUAL (w=CW hjustify=CENTER) (NEW Caption (ATTR Value="Show")))
(NEW Button (w=BW h=BH) (ATTR Caption="ToDo" Cmd="Gadgets.Set Query.Value 'topic=ToDo'"))
(NEW Button (w=BW h=BH) (ATTR Caption="All" Cmd="Gadgets.Set Query.Value ''"))
(NEW TextField (w=[]) (LINKS Model=query))
(NEW Iconizer (w=IW h=[]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=query0 Open=query1))
)
( HLIST VIRTUAL (w=[] vdist=5 hdist=3 vjustify=CENTER) { Middle row }
(HLIST VIRTUAL (w=CW hjustify=CENTER) (NEW Caption (ATTR Value="Text")))
(NEW Button (w=BW h=BH) (ATTR Caption="Reply" Cmd="Mail.Reply ^"))
(NEW Button (w=BW h=BH) (ATTR Caption="Cite ^" Cmd="Mail.Cite"))
(NEW Button (w=66 h=BH) (ATTR Caption="AsciiCode ^" Cmd="AsciiCoder.CodeFiles % ^"))
(NEW VIRTUAL (w=[]))
(HLIST VIRTUAL (w=BW hjustify=CENTER) (NEW Caption (ATTR Value="Topic")))
(NEW Iconizer (w=IW h=[]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=set0 Open=set1))
(NEW Iconizer (w=IW h=[]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=clear0 Open=clear1))
(NEW Iconizer (w=IW h=[]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=move0 Open=move1))
)
( HLIST VIRTUAL (w=[] vdist=5 hdist=3 vjustify=CENTER) { Bottom row }
(HLIST VIRTUAL (w=CW hjustify=CENTER) (NEW Caption (ATTR Value="Server")))
(NEW Button (w=BW h=BH) (ATTR Caption="Get" Cmd="Mail.Synchronize"))
(NEW Button (w=BW h=BH) (ATTR Caption="Send *" Cmd="Mail.Send *"))
(NEW TextField (w=[]) (ATTR Name="StatusBar" Value=""))
(NEW Iconizer (w=IW2 h=[]) (ATTR FixedViews=FALSE Locked=TRUE) (LINKS Closed=conf0 Open=conf1))
)
)
)
UIDL handling
POPCollect -> remove all UIDLs -> new UIDL file
Synchronize -> store only UIDLs current (from UIDL command) UIDL
System.Directory UIDL.*
System.Free News Mail NetTools HyperDocs MIME ~
