Oberon/A2/Oberon.Mail.Mod

(* 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&#58;&#47;/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&#91;Copy] TextDocs.Search&#91;Search] TextDocs.Replace&#91;Rep] Mail.Show&#91;Source] Mail.Reply&#91;Reply] Desktops.StoreDoc&#91;Store]"; SysMenu = "Desktops.Copy&#91;Copy] Mail.Reply&#91;Reply] Desktops.StoreDoc&#91;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&#91;0]), ADDRESSOF(index&#91;0]), len*SIZEOF(SIGNED32)) END; heap.index := index END; WHILE len > idx DO 			heap.index&#91;len] := heap.index&#91;len-1]; DEC(len) END; heap.index&#91;idx] := heap.bufLen; IF (heap.bufLen+LEN(str)) >= LEN(heap.buffer^) THEN NEW(buffer, 2*(heap.bufLen+LEN(str))); SYSTEM.MOVE(ADDRESSOF(heap.buffer&#91;0]), ADDRESSOF(buffer&#91;0]), heap.bufLen*SIZEOF(CHAR)); heap.buffer := buffer END; i := 0; j := heap.bufLen; WHILE str&#91;i] # 0X DO 			heap.buffer&#91;j] := str&#91;i]; INC(i); INC(j) END; heap.buffer&#91;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&#91;ofs]; i := 0; cs := str&#91;0]; WHILE (cb # 0X) & (cs # 0X) & (cb = cs) DO 			INC(ofs); cb := heap.buffer&#91;ofs]; INC(i); cs := str&#91;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 &#60;= r) & (c # 0) DO 			m := (l+r) DIV 2; idx := m; 			c := Compare(heap, heap.index&#91;m], str); IF c &#60; 0 THEN l := m+1 ELSIF c > 0 THEN r := m-1 END END; IF c # 0 THEN IF c &#60; 0 THEN INC(idx) END; Append(heap, idx, str) END; ofs := heap.index&#91;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&#91;ofs] # 0X) & (i &#60; l) DO 			str&#91;i] := heap.buffer&#91;ofs]; INC(i); INC(ofs) END; str&#91;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 &#60; heap.idxLen DO 			Files.WriteLInt(R, heap.index&#91;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 &#60; heap.idxLen DO 			Files.ReadLInt(R, heap.index&#91;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&#91;0] := CHR(nr+ORD("0")); arg&#91;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&#91;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&#91;i] # 0X) & (S.reply&#91;i] # "&#60;") DO 			INC(i) END; j := 0; WHILE (S.reply&#91;i] # 0X) & (S.reply&#91;i] # ">") DO 			stamp&#91;j] := S.reply&#91;i]; INC(i); INC(j) END; stamp&#91;j] := ">"; stamp&#91;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 &#60;= 0) OR (port >= 10000) THEN port := DefPOPPort END; NEW(S); IF (host&#91;0] # "&#60;") & (host&#91;0] # 0X) & (user&#91;0] # 0X) & (passwd&#91;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&#91;0] = 0X THEN S.reply := "timed out" END; ClosePOP(S) ELSE S.reply := "no connection" END ELSE IF (host&#91;0] = "&#60;") OR (host&#91;0] = 0X) THEN S.reply := "no pop-host specified" ELSIF user&#91;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 &#60; rlen DO 				ch := buffer&#91;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 &#60;= 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) &#60;= 0 THEN set.nouidls := 0 ELSE Files.Set(R, set.F, 0); i := 0; Files.ReadString(R, set.uidls&#91;i]); WHILE ~R.eof DO 					INC(i); IF i >= l THEN NEW(uidll, l+128); FOR j := 0 TO l-1 DO 							uidll&#91;j] := set.uidls&#91;j] END; INC(l, 128); set.uidls := uidll END; Files.ReadString(R, set.uidls&#91;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 &#60;= set.nouidls THEN NEW(uidll, 2*l); FOR i := 0 TO l-1 DO 				uidll&#91;i] := set.uidls&#91;i] END; set.uidls := uidll END; set.uidls&#91;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 &#60; nouidls) & (uidls&#91;i] # uidl) DO 			INC(i) END; IF i >= nouidls THEN i := 0; WHILE (i &#60; lastUIDL) & (uidls&#91;i] # uidl) DO 				INC(i) END; IF i &#60; 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 &#60; 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&#91;i] := msgs&#91;i] END; msgs := nmsgs END; msgs&#91;noMsgs].pos := pos; msgs&#91;noMsgs].state:= 0; msgs&#91;noMsgs].stamp := 0; msgs&#91;noMsgs].len := -1; pos := MIME.FindField(h, "Reply-To"); IF pos &#60; 0 THEN pos := MIME.FindField(h, "From") END; (* ASSERT(pos > 0); *) MIME.ExtractEMail(h, pos, str); Insert(heap, str, msgs&#91;noMsgs].replyTo); pos := MIME.FindField(h, "Date"); MIME.ExtractGMTDate(h, pos, msgs&#91;noMsgs].time, msgs&#91;noMsgs].date); pos := MIME.FindField(h, "Subject"); MIME.ExtractValue(h, pos, str); Insert(heap, str, msgs&#91;noMsgs].subject); pos := MIME.FindField(h, "X-Oberon-Status"); msgs&#91;noMsgs].flags := {}; msgs&#91;noMsgs].topics := {}; IF pos > 0 THEN MIME.ExtractValue(h, pos, str); IF CAP(str&#91;0]) = "R" THEN INCL(msgs&#91;noMsgs].flags, Read) END; IF CAP(str&#91;1]) = "D" THEN INCL(msgs&#91;noMsgs].flags, Deleted); INC(delMsgs); DEC(noMsgs) ELSE v := 0; FOR i := 7 TO 0 BY-1 DO 					IF str&#91;2+i] &#60;= "9" THEN v := 16*v+ORD(str&#91;2+i])-ORD("0") ELSE v := 16*v+ORD(str&#91;2+i])-ORD("A")+10 END END; FOR i := MIN(SET) TO MAX(SET) DO 					IF (v MOD 2) > 0 THEN INCL(msgs&#91;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&#91;i] # 0X DO 			Files.Write(R, str&#91;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&#91;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 &#60; set.nouidls DO 					set.uidls&#91;k]&#91;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&#91;k] := ch; INC(k); Texts.Read(R, ch) END; uidl&#91;k] := 0X; k := ExistsUIDL(set, uidl); add := TRUE; IF k &#60; 0 THEN k := MessageSize(S, i); IF k &#60;= 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&#91;set.nouidls-1]&#91;63] := 01X; ReceiveMail(S, i, Ri); add := S.res = NetTools.Done; AddMsgHead(pos); msgs&#91;noMsgs-1].len := Files.Length(msgsF)-msgs&#91;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&#91;k]&#91;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&#91;k]&#91;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 &#60;= " ") 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&#91;k] := ch; INC(k); Texts.Read(R, ch) END; uidl&#91;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 &#60;= " ") 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 &#60; l) DO 			s&#91;i] := ch; INC(i); Texts.Read(R, ch) END; WHILE ~R.eot & (ch # Strings.CR) DO 			Texts.Read(R, ch) END; s&#91;i] := 0X END ReadString; PROCEDURE ScanHeader(no: SIGNED32; VAR h: MIME.Header); VAR S: Streams.Stream; len: SIGNED32; BEGIN S := Streams.OpenFileReader(msgsF, msgs&#91;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&#91;no].pos+pos; Files.Set(R, msgsF, pos); IF Read IN msgs&#91;no].flags THEN Files.Write(R, "R") ELSE Files.Write(R, "0") END; IF Deleted IN msgs&#91;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&#91;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&#91;pos] # 0X DO 							Texts.Write(W, Strings.ISOToOberon&#91;ORD(h.fields&#91;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&#91;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&#91;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&#91;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&#91;no].pos); S.mode := Streams.binary; IF plain THEN NEW(cont); cont.typ := MIME.GetContentType("text/plain"); S := Streams.OpenFileReader(msgsF, msgs&#91;no].pos) ELSE MIME.ReadHeader(S, NIL, h, len); ParseContent(h, cont); S := Streams.OpenFileReader(msgsF, msgs&#91;no].pos+len) END; S.mode := Streams.binary; ASSERT(len &#60; msgs&#91;no].len); cont.len := msgs&#91;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&#91;no].flags) THEN INCL(msgs&#91;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 &#60; n) & (s&#91;i] # 0X) DO 			Texts.Write(W, s&#91;i]); INC(i) END; WHILE i &#60; 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&#91;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 &#60; 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 &#60; noMsgs) THEN (* Valid message number. *) obj := FindObj("MailList"); IF obj # NIL THEN WITH obj: ListGadgets.Frame DO 						line := obj.lines; REPEAT line.sel := msgs&#91;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 &#60; noMsgs THEN (* Invalid message number but messages to list. *) msgNoWidth := 0; no := noMsgs; WHILE 0 &#60; no DO 			 		no := no DIV 10; INC(msgNoWidth) END; Out.String("msgNoWidth = "); Out.Int(msgNoWidth, 0); Out.Ln; IF 60 &#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 &#60;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 &#60; 0) OR (noMsgs &#60; S.i); List with oldest at top. *) no := 0; WHILE no &#60; noMsgs DO 						WriteMsgLine(no); INC(no) END ELSE (* Newest at top. *) no := noMsgs; WHILE 0 &#60; 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&#91;i].pos > beg) & (msgs&#91;i].pos &#60; end) THEN Files.Set(R, msgsF, beg); Files.Set(r, F, Files.Length(F)); msgs&#91;i].pos := Files.Pos(r)+offs; WHILE beg &#60; 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 &#60; " ") 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 &#60; no DO 			IF msgs&#91;i].pos >= 0 THEN msgs&#91;j] := msgs&#91;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&#91;no].flags, Deleted); ScanHeader(no, h); WriteStatus(h, no); msgs&#91;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&#91;i] # 0X) & (t&#91;i] &#60;= " ") DO 				INC(i) END END Blanks; BEGIN re := 1; i := 0; REPEAT end := TRUE; Blanks; j := i; 			IF CAP(t&#91;i]) = "R" THEN IF CAP(t&#91;i+1]) = "E" THEN INC(i, 2); Blanks; IF t&#91;i] = ":" THEN INC(i); INC(re); end := FALSE ELSIF t&#91;i] = "(" THEN 						INC(i); p := SHORT(i); oldre := re; 						Strings.StrToIntPos(t, re, p); 						IF re > 0 THEN 							i := p; Blanks; 							IF t&#91;i] = ")" THEN INC(i); Blanks; IF t&#91;i] = ":" THEN INC(i) END; INC(re); end := FALSE END ELSE re := oldre END END END END UNTIL end; IF t&#91;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&#91;j] # 0X DO 			Texts.Write(W, t&#91;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 &#60;= " ") & ~(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 &#60; 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) &#60;= 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) &#60; 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 &#60; noMsgs) THEN Copy(heap, msgs&#91;S.i].replyTo, str); Texts.WriteString(W, "To: "); Texts.WriteString(W, str); Texts.WriteLn(W); Copy(heap, msgs&#91;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&#91;no].topics, topic.no) ELSE EXCL(msgs&#91;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&#91;6] = 22X THEN ch := 22X; j := 7 ELSE ch := " "; j := 6 END; 			i := 0; 			WHILE (queryStr&#91;j] # ch) & (queryStr&#91;j] # 0X) DO 				name&#91;i] := queryStr&#91;j]; INC(i); INC(j) 			END; 			name&#91;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&#91;no].topics, currentNo) END; INCL(msgs&#91;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&#91;i].pos); Files.WriteNum(r, msgs&#91;i].len); Files.WriteNum(r, msgs&#91;i].state); Files.WriteNum(r, msgs&#91;i].stamp); Files.WriteSet(r, msgs&#91;i].flags); Files.WriteSet(r, msgs&#91;i].topics); Files.WriteNum(r, msgs&#91;i].date); Files.WriteNum(r, msgs&#91;i].time); Files.WriteLInt(r, msgs&#91;i].replyTo); Files.WriteLInt(r, msgs&#91;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^) &#60; 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&#91;i].pos); Files.ReadNum(r, msgs&#91;i].len); Files.ReadNum(r, msgs&#91;i].state); Files.ReadNum(r, msgs&#91;i].stamp); Files.ReadSet(r, msgs&#91;i].flags); Files.ReadSet(r, msgs&#91;i].topics); Files.ReadNum(r, msgs&#91;i].date); Files.ReadNum(r, msgs&#91;i].time); Files.ReadLInt(r, msgs&#91;i].replyTo); Files.ReadLInt(r, msgs&#91;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&#91;pos]; i := 0; WHILE (i # 6) & (ch # 0X) DO 				IF ch = pat&#91;i] THEN INC(i); IF i &#60; 6 THEN INC(pos); ch := buf&#91;pos] END ELSIF i = 0 THEN INC(pos); ch := buf&#91;pos] ELSE i := i - div&#91;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&#91;i] >= " " DO 					INC(i) END; WHILE (buf&#91;i] # 0X) & (buf&#91;i] &#60; " ") DO 					INC(i) END; IF buf&#91;i] # 0X THEN IF (noMsgs > 0) & (msgs&#91;noMsgs-1].len &#60;= 0) THEN msgs&#91;noMsgs-1].len := pos+j-4-msgs&#91;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 &#60; BufLen) & (buf&#91;i] # Strings.LF) DO 					INC(i) END; IF i &#60; 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 &#60;= 6 DO 				j := 0; WHILE ((j + d) &#60; 6) & (pat&#91;j] = pat&#91;j+d]) DO 					INC(j) END; WHILE i &#60;= j + d DO 					div&#91;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&#91;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&#91;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&#91;BufLen-R.res] := 0X; AddMsgs; IF (noMsgs > 0) & (msgs&#91;noMsgs-1].len &#60;= 0) THEN msgs&#91;noMsgs-1].len := Files.Length(msgsF)-1-msgs&#91;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 &#60; noMsgs) & (msgs&#91;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&#91;R.sort&#91;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 &#60; R.noMsgs) THEN IF ~R.ascending THEN pos := R.noMsgs-pos-1 END; IF R.sort # NIL THEN R.pos := R.sort&#91;pos]; R.sortPos := pos ELSE R.pos := pos; R.sortPos := 0 END; R.key := msgs&#91;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&#91;R(Rider).pos].state END GetState; PROCEDURE SetState(R: ListRiders.Rider; state: SIGNED32); BEGIN msgs&#91;R(Rider).pos].state := state END SetState; PROCEDURE GetStamp(R: ListRiders.Rider): SIGNED32; BEGIN RETURN msgs&#91;R(Rider).pos].stamp END GetStamp; PROCEDURE SetStamp(R: ListRiders.Rider; stamp: SIGNED32); BEGIN msgs&#91;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&#91;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 &#60; j.date THEN RETURN TRUE ELSIF i.date = j.date THEN IF i.time &#60; 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 &#60; j.replyTo THEN RETURN TRUE ELSIF i.replyTo > j.replyTo THEN RETURN FALSE END |SortBySubject: IF i.subject &#60; j.subject THEN RETURN TRUE ELSIF i.subject > j.subject THEN RETURN FALSE END END; RETURN i.pos &#60; 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 &#60; hi THEN i := lo; j := hi; m := sort&#91;(lo + hi) DIV 2]; REPEAT WHILE Less(msgs&#91;sort&#91;i]], msgs&#91;m], sortBy) DO INC(i) END; WHILE Less(msgs&#91;m], msgs&#91;sort&#91;j]], sortBy) DO DEC(j) END; IF i &#60;= j THEN t := sort&#91;i]; sort&#91;i] := sort&#91;j]; sort&#91;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&#91;i] # 0X DO 			value&#91;i] := Strings.OberonToISO&#91;ORD(value&#91;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&#91;j] := ch; INC(j); ch := Q.query&#91;pos]; INC(pos) END; str&#91;j] := 0X END GetName; PROCEDURE GetString; VAR j: SIGNED32; BEGIN j := 0; WHILE (ch # 0X) & (ch # 022X) DO 				str&#91;j] := ch; INC(j); ch := Q.query&#91;pos]; INC(pos) END; IF ch = 022X THEN ch := Q.query&#91;pos]; INC(pos) END; str&#91;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&#91;pos]; INC(pos) END END GetNumber; PROCEDURE Next; BEGIN WHILE (ch # 0X) & (ch &#60;= " ") DO 				ch := Q.query&#91;pos]; INC(pos) END; CASE ch OF 				"=": sym := eq; ch := Q.query&#91;pos]; INC(pos) |":": sym := colon; ch := Q.query&#91;pos]; INC(pos) |"&#60;": ch := Q.query&#91;pos]; INC(pos); IF ch = "=" THEN ch := Q.query&#91;pos]; INC(pos); sym := leq ELSE sym := le 						END |">": ch := Q.query&#91;pos]; INC(pos); IF ch = "=" THEN ch := Q.query&#91;pos]; INC(pos); sym := geq ELSE sym := ge 						END |"&": sym := and; ch := Q.query&#91;pos]; INC(pos) |".": sym := dot; ch := Q.query&#91;pos]; INC(pos) |"#": sym := neq; ch := Q.query&#91;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&#91;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&#91;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 &#60;= sPatLen DO 				j := 0; WHILE ((j + d) &#60; sPatLen) & (sPat&#91;j] = sPat&#91;j+d]) DO 					INC(j) END; WHILE i &#60;= j + d DO 					sDv&#91;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&#91;no].pos; Files.Set(R, msgsF, pos); Files.Read(R, ch); INC(pos); end := msgs&#91;no].pos+msgs&#91;no].len; i := 0; WHILE (i # sPatLen) & (pos &#60;= end) DO 				IF ch = sPat&#91;i] THEN INC(i); IF i &#60; sPatLen THEN Files.Read(R, ch); INC(pos) END ELSIF i = 0 THEN Files.Read(R, ch); INC(pos) ELSE i := i - sDv&#91;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 &#60; 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 &#60; 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 &#60;= cond.date |le: cond.value := msg.date &#60; 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 &#60;= cond.time |le: cond.value := msg.time &#60; 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&#91;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 &#60;= 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&#91;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&#91;i]) THEN R.sort&#91;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&#91;R.pos].flags THEN textC := F.textC ELSE textC := Display3.red END; Copy(heap, msgs&#91;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&#91;R.pos].replyTo, str); Display3.String(Q2, textC, x, y + L.dsr, F.fnt, str, Display.paint); Strings.DateToStr(msgs&#91;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&#91;i] # 0X) & (s&#91;i] &#60;= " ") DO 				INC(i) END; IF s&#91;i] = "," THEN INC(i); WHILE (s&#91;i] # 0X) & (s&#91;i] &#60;= " ") DO 					INC(i) END END; j := 0; WHILE (s&#91;i] > " ") & (s&#91;i] # ",") DO 				rcpt&#91;j] := s&#91;i]; INC(j); INC(i) END; rcpt&#91;j] := 0X ELSE j := i; ch := s&#91;j]; old := 01X; close := 02X; WHILE (ch # 0X) & ~( ((ch = ",") & (close = 02X)) OR (old = close) ) DO 				IF ch = "(" THEN 					close := ")" ELSIF ch = "&#60;" THEN close := ">" ELSIF ch = "{" THEN close := "}" ELSIF ch = "&#91;" THEN close := "]" ELSIF ch = 22X THEN close := 22X END; INC(j); old := ch; ch := s&#91;j] END; IF old # close THEN end := j 			ELSE end := j-1 END; WHILE (j >= i) & (s&#91;j] &#60;= " ") DO 				DEC(j) END; WHILE (j >= i) & (s&#91;j] > " ") DO 				DEC(j) END; INC(j); k := 0; dom := -1; special := FALSE; ch := s&#91;j]; IF ch = "(" THEN 				close := ")"; INC(j) ELSIF ch = "&#60;" THEN close := ">"; INC(j) ELSIF ch = "{" THEN close := "}"; INC(j) ELSIF ch = "&#91;" THEN close := "]"; INC(j) ELSE close := 02X END; ch := s&#91;j]; WHILE (ch > " ") & (j &#60; end) & (ch # close) DO 				IF ch = "@" THEN dom := j 				ELSIF (dom &#60; 0) & ((ch = "(") OR (ch = ")") OR (ch = "&#60;") OR (ch = ">") OR (ch = ",") OR (ch = ";") OR (ch = ":") OR 					(ch = "\") OR (ch = 22X) OR (*(ch = ".") OR*) (ch = "&#91;") OR (ch = "]") OR (ch = "/")) THEN special := TRUE END; candidate&#91;k] := ch; INC(k); INC(j); ch := s&#91;j] END; candidate&#91;k] := 0X; IF special THEN IF candidate&#91;0] # 22X THEN rcpt&#91;0] := 22X; k := 1 ELSE k := 0 END; j := 0; WHILE (candidate&#91;j] # 0X) & (candidate&#91;j] # "@") DO 					rcpt&#91;k] := candidate&#91;j]; INC(k); INC(j) END; rcpt&#91;k] := 22X; INC(k); WHILE candidate&#91;j] # 0X DO 					rcpt&#91;k] := candidate&#91;j]; INC(k); INC(j) END; IF candidate&#91;j-1] = 22X THEN DEC(k) END; rcpt&#91;k] := 0X ELSE COPY(candidate, rcpt) END; WHILE (s&#91;end] # 0X) & (s&#91;end] # ",") DO 				INC(end) END; IF s&#91;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 &#60;= " ") 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&#91;3] = "-" DO *) WHILE S.reply&#91;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 &#60;= 0) OR (port >= 10000) THEN (* port := DefSMTPPort *) port := ImplicitTlsSMTPPort END; NEW(S); S.res := NetTools.Failed; S.C := NIL; S.S := NIL; IF (host&#91;0] = "&#60;") OR (host&#91;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&#91;0] # "2" THEN (* Server declined to open stream. *) CloseSMTP(S) ELSE (* Server cooperating *) IF (user&#91;0] = 0X) OR (passwd&#91;0] = 0X) THEN (* authentication not possible *) SendCmd(S, "EHLO", NetSystem.hostName); ReadResponse(S); IF S.reply&#91;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&#91;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&#91;i] # 0X) & (i &#60; LEN(passwd)) DO 								Files.Write(fR, passwd&#91;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 &#60; LEN(authString)) & (~tR.eot) DO 								Texts.Read(tR, authString&#91;i]); INC(i) END; Out.String("authString = "); Out.String(authString); Out.Ln; SendCmd(S, "AUTH PLAIN", authString); ReadResponse(S); IF S.reply&#91;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&#91;i] := ch; INC(i);  		a&#91;i] := CHR(x DIV 10 + 30H)); INC(i); a&#91;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&#91;i] := mo&#91;0]; INC(i); date&#91;i] := mo&#91;1]; INC(i); date&#91;i] := mo&#91;2]; INC(i) END CopyMonth; PROCEDURE CopyStr(VAR str: Strings.String; VAR date: ARRAY OF CHAR; VAR i: SIGNED16); BEGIN j := 0; WHILE (i &#60; LEN(date)) & (j &#60; LEN(str)) & (str&#91;j] # 0X) DO 			date&#91;i] := str&#91;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&#91;0] := CHR(x DIV 10+ORD("0"));   s&#91;1] := CHR(x MOD 10+ORD("0")); 		x := (d DIV 32 MOD 16-1)*3; s&#91;3] := m&#91;x]; s&#91;4] := m&#91;x+1]; s&#91;5] := m&#91;x+2]; 		x := d DIV 512 MOD 100;       s&#91;9] := CHR(x DIV 10+ORD("0")); s&#91;10] := CHR(x MOD 10+ORD("0")); 		x := t DIV 4096 MOD 32;      s&#91;12] := CHR(x DIV 10+ORD("0")); s&#91;13] := CHR(x MOD 10+ORD("0")); 		x := t DIV 64 MOD 64;           s&#91;15] := CHR(x DIV 10+ORD("0")); s&#91;16] := CHR(x MOD 10+ORD("0")); 		x := t MOD 64;                        s&#91;18] := CHR(x DIV 10+ORD("0")); s&#91;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&#91;0] = " ") OR (t&#91;0] = 09X)) DO 				Texts.WriteString(W, t); Texts.WriteLn(W); IF (t&#91;0] = " ") OR (t&#91;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&#91;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&#91;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 &#60;= " ") 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&#91;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&#91;0] = "3" THEN SendText(S, head, T, Texts.Pos(R), T.len, cont); ReadResponse(S); IF S.reply&#91;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&#91;0] = "0" THEN cont.encoding := MIME.EncBin ELSIF val&#91;0] = "1" THEN cont.encoding := MIME.Enc8Bit ELSIF val&#91;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 &#91;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 &#60; 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 &#60;= " " 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 ((" " &#60; ch) & (ch &#60; 7FX)) OR (0A0X &#60; 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 &#60; wdata.nCR THEN Texts.WriteLn(wdata.accum); DEC(wdata.nCR); WCopy(wdata.space1, wdata.accum); IF 0 &#60; 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 &#60;= wdata.width THEN wdata.lineLen := candidateLen ELSE (* wdata.width &#60; 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 &#60;= 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 &#60; 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 &#60; 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 = &#91;word] {separator word} &#91;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 &#60;= 0 THEN T := NIL ELSE pos := pos0 END ELSIF S.c = "@" THEN Oberon.GetSelection(T, pos0, end, time); IF time &#60;= 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 &#60; 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 &#60; 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 &#60; 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 &#60; 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 &#60; 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&#91;i] # 0X) & (url&#91;i] &#60;= " ") DO 				INC(i) END END Blanks; BEGIN HyperDocs.UnESC(url); i := 0; Blanks; (* skip mailto *) WHILE (url&#91;i] # 0X) & (url&#91;i] # ":") DO 			INC(i) END; (* skip : *) WHILE (url&#91;i] # 0X) & ((url&#91;i] = ":") OR (url&#91;i] = "/")) DO 			INC(i) END; Blanks; (* get mailadr *) iskey := TRUE; l := LEN(mailadr); j := 0; WHILE url&#91;i] # 0X DO 			IF (url&#91;i] > " ") & ~Strings.IsDigit(url&#91;i]) THEN iskey := FALSE END; IF j &#60; l THEN mailadr&#91;j] := url&#91;i]; INC(j) END; INC(i) END; mailadr&#91;j] := 0X; DEC(j); WHILE (j >= 0) & (mailadr&#91;j] &#60;= " ") DO 			mailadr&#91;j] := 0X; DEC(j) END; IF (url&#91;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&#91;i] # 0X) & (url&#91;i] &#60;= " ") DO 				INC(i) END END Blanks; BEGIN HyperDocs.UnESC(url); i := 0; Blanks; (* skip mailserver *) WHILE (url&#91;i] # 0X) & (url&#91;i] # ":") DO 			INC(i) END; (* skip : *) WHILE (url&#91;i] # 0X) & ((url&#91;i] = ":") OR (url&#91;i] = "/")) DO 			INC(i) END; Blanks; (* get mailadr *) iskey := TRUE; l := LEN(mailadr); j := 0; WHILE (url&#91;i] # 0X) & (url&#91;i] # "/") DO 			IF (url&#91;i] > " ") & ~Strings.IsDigit(url&#91;i]) THEN iskey := FALSE END; IF j &#60; l THEN mailadr&#91;j] := url&#91;i]; INC(j) END; INC(i) END; mailadr&#91;j] := 0X; DEC(j); WHILE (j >= 0) & (mailadr&#91;j] &#60;= " ") DO 			mailadr&#91;j] := 0X; DEC(j) END; IF (url&#91;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&#91;i] = "/" THEN INC(i) END; l := LEN(subject); j := 0; WHILE (url&#91;i] # 0X) & (url&#91;i] # "/") DO 			IF j &#60; l THEN subject&#91;j] := url&#91;i]; INC(j) END; INC(i) END; subject&#91;j] := 0X; DEC(j); WHILE (j >= 0) & (subject&#91;j] &#60;= " ") DO 			subject&#91;j] := 0X; DEC(j) END; IF url&#91;i] = "/" THEN INC(i) END; l := LEN(body); j := 0; WHILE url&#91;i] # 0X DO 			IF j &#60; l THEN body&#91;j] := url&#91;i]; INC(j) END; INC(i) END; body&#91;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&#91;i] # 0X DO 				IF body&#91;i] = "/" THEN Texts.WriteLn(W) ELSE Texts.Write(W, body&#91;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=&#91;2] dist=8) ( HLIST VIRTUAL (w=&#91;] hjustify=CENTER) 					(NEW Caption (ATTR Value="Local Settings (override Oberon.Text)")) 				) ( TABLE VIRTUAL (w=&#91;] cols=2) 					(NEW Caption (ATTR Value="EMail Address")) 					(NEW TextField (w=&#91;10]) (ATTR Name="EMail")) 					(NEW Caption (ATTR Value="SMTP Server")) 					(NEW TextField (w=&#91;10]) (ATTR Name="SMTP")) 					(NEW Caption (ATTR Value="POP Server")) 					( HLIST VIRTUAL (w=&#91;10]) (NEW TextField (w=&#91;7]) (ATTR Name="POP")) (NEW TextField (w=&#91;3]) (ATTR Name="POPMode") (ATTR Value="POP3")) ) 					(NEW Caption (ATTR Value="POP User")) 					(NEW TextField (w=&#91;10]) (ATTR Name="User")) 					(NEW Caption (ATTR Value="Max message size")) 					(NEW TextField (w=&#91;10]) (ATTR Name="MaxMsgSize" Value="100000")) 				) ( HLIST VIRTUAL (w=&#91;]) 					(NEW Caption (ATTR Value="Leave messages on server")) 					(NEW CheckBox (ATTR Name="LeaveOnServer")) 					(NEW VIRTUAL (w=&#91;])) 					(NEW Caption (ATTR Value="Auto Cc")) 					(NEW CheckBox (ATTR Name="AutoCc" Value=TRUE)) 				) ) 			( TABLE VIRTUAL (w=&#91;] orientation=VERT rows=6) (HLIST VIRTUAL (w=45 h=BH hjustify=CENTER vjustify=CENTER) (NEW Caption (ATTR Value="Sorting"))) (NEW Button (w=&#91;] h=BH) (ATTR Caption="Date" SetVal=1) (LINKS Model=sortby)) (NEW Button (w=&#91;] h=BH) (ATTR Caption="From" SetVal=2) (LINKS Model=sortby)) (NEW Button (w=&#91;] h=BH) (ATTR Caption="Subject" SetVal=3) (LINKS Model=sortby)) (NEW Button (w=&#91;] h=BH) (ATTR Caption="None" SetVal=0) (LINKS Model=sortby)) ( SPAN 1 2 					( HLIST VIRTUAL (w=&#91;]) (NEW Caption (ATTR Value="Ascending")) (NEW CheckBox (LINKS Model=ascend)) (NEW VIRTUAL (w=&#91;])) ) 				) 				(HLIST VIRTUAL (w=&#91;] h=BH hjustify=CENTER vjustify=CENTER) (NEW Caption (ATTR Value="Content"))) (NEW Button (w=&#91;] h=BH) (ATTR Caption="Auto" SetVal=3) (LINKS Model=cont)) (NEW Button (w=&#91;] h=BH) (ATTR Caption="Oberon" SetVal=2) (LINKS Model=cont)) (NEW Button (w=&#91;] h=BH) (ATTR Caption="ISO-8859-1" SetVal=1) (LINKS Model=cont)) (NEW Button (w=&#91;] 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=&#91;] h=&#91;] dist=0)	 { Mail list & scrollbar } 			( NEW Mail.NewFrame (w=&#91;] h=&#91;]) (ATTR Name="MailList") (LINKS Model=mailmodel SortBy=sortby Ascending=ascend Query=query VPos=vpos VRange=vrange) ) 			(NEW Scrollbar (h=&#91;]) (ATTR Max=0 HeavyDrag=TRUE) (LINKS Min=vrange Model=vpos)) 		) ( HLIST VIRTUAL (w=&#91;] 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 '&#39;")) 			(NEW TextField (w=&#91;]) (LINKS Model=query)) 			(NEW Iconizer (w=IW h=&#91;]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=query0 Open=query1)) 		) ( HLIST VIRTUAL (w=&#91;] 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=&#91;])) 			(HLIST VIRTUAL (w=BW hjustify=CENTER) (NEW Caption (ATTR Value="Topic"))) 			(NEW Iconizer (w=IW h=&#91;]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=set0 Open=set1)) 			(NEW Iconizer (w=IW h=&#91;]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=clear0 Open=clear1)) 			(NEW Iconizer (w=IW h=&#91;]) (ATTR Popup=TRUE Pin=FALSE Locked=TRUE) (LINKS Closed=move0 Open=move1)) 		) ( HLIST VIRTUAL (w=&#91;] 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=&#91;]) (ATTR Name="StatusBar" Value="")) 			(NEW Iconizer (w=IW2 h=&#91;]) (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 ~