Oberon/A2/Oberon.News.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://www.oberon.ethz.ch/ *)

MODULE News IN Oberon; (** portable *)	(* ejz,  *)
	IMPORT BTrees, Strings, HyperDocs, Files, Objects, Texts, Display, Fonts, Display3, Oberon, NetSystem, NetTools, Gadgets,
		Attributes, TextGadgets, TextDocs, Documents, Desktops, Links, Modules, MIME, Streams, TextStreams,
		Mail, Dates, FileDir;

(** This module implements a newsreader (RFC 977, 1036) for oberon. The News-module supports news and nntp urls.
		The nntp host is specified in the NetSystem section of the Registry (e.g. NNTP=news.inf.ethz.ch).
		The following lines should be added to the LinkSchemes section of the Registry:
			nntp = News.NewNNTPLinkScheme
			news = News.NewNewsLinkScheme
		And the following lines to the Documents section:
			nntp News.NewDoc
			news News.NewDoc.
		For sending or posting new articles your e-mail address should be defined in the NetSystem section of the Registry.
		e.g.: EMail = "me@home" *)

	CONST
		DefPort = 119;
		InitText = "News.Read.Text";
		Done* = NetTools.Done;
		ErrGroup* = 1;
		ErrXOver* = 2;
		ErrArticle* = 3;
		ErrStat* = 4;
		ErrList* = 5;
		ErrPost* = 6;
		Failed* = NetTools.Failed;
		MaxMessages = 16*1024;

	TYPE
		ArtNrs = POINTER TO ArtNrsDesc;
		ArtNrsDesc = RECORD
			beg, end: SIGNED32;
			next: ArtNrs
		END;
		Group = POINTER TO GroupDesc;
		GroupDesc = RECORD
			name: ARRAY 128 OF CHAR;
			subscribed: BOOLEAN;
			readArtNrs: ArtNrs;
			next: Group
		END;
(** The connection to an nntp. *)
		Session* = POINTER TO SessionDesc;
		SessionDesc* = RECORD (Mail.SMTPSessionDesc)
		END;

	VAR
		W, Wr: Texts.Writer;
		groups, curGrp: Group;
		curGrpNewOnly: BOOLEAN;
		newgDate, newgTime: SIGNED32;
		EMail: ARRAY NetTools.ServerStrLen OF CHAR;
		refs: Files.File;
		indexM, indexA: BTrees.Tree;
		availBeg, beg, end, level, thread: SIGNED32;
		marked: POINTER TO ARRAY OF BOOLEAN;
		line: ARRAY 2*NetTools.MaxLine OF CHAR;
		newsFont: Fonts.Font;
		trace: BOOLEAN;

	PROCEDURE ScanInt(VAR S: Texts.Scanner; VAR i: SIGNED16);
	BEGIN
		IF S.class = Texts.Int THEN
			i := SHORT(S.i);
			Texts.Scan(S)
		ELSE
			i := 0
		END
	END ScanInt;

	PROCEDURE ScanDate(VAR S: Texts.Scanner; VAR date: SIGNED32);
		VAR day, month, year: SIGNED16;
	BEGIN
		ScanInt(S, day); ScanInt(S, month); ScanInt(S, year);
		IF year < 100 THEN
			IF (month = 0) OR (day = 0) THEN
				year := 1980; month := 1; day := 1
			ELSE
				year := year + 1900
			END
		END;
		date := Dates.ToDate(year, month, day)
	END ScanDate;

	PROCEDURE ScanTime(VAR S: Texts.Scanner; VAR time: SIGNED32);
		VAR hour, min, sec: SIGNED16;
	BEGIN
		ScanInt(S, hour); ScanInt(S, min); ScanInt(S, sec);
		time := Dates.ToTime(hour, min, sec)
	END ScanTime;

	PROCEDURE TwoDigit(i: SIGNED16; VAR str: ARRAY OF CHAR);
	BEGIN
		str[0] := CHR((i DIV 10)+ORD("0"));
		str[1] := CHR((i MOD 10)+ORD("0"));
		str[2] := 0X
	END TwoDigit;

	PROCEDURE ConcatDate(VAR line: ARRAY OF CHAR; VAR date: SIGNED32);
		VAR
			str: ARRAY 8 OF CHAR;
			day, month, year: SIGNED16;
	BEGIN
		Dates.ToYMD(date, year, month, day);
		IF year < 2000 THEN
			TwoDigit(year MOD 100, str)
		ELSE
			Strings.IntToStr(year, str)
		END;
		Strings.Append(line, str);
		TwoDigit(month, str);
		Strings.Append(line, str);
		TwoDigit(day, str);
		Strings.Append(line, str)
	END ConcatDate;

	PROCEDURE ConcatTime(VAR line: ARRAY OF CHAR; VAR time: SIGNED32);
		VAR
			str: ARRAY 8 OF CHAR;
			hour, min, sec: SIGNED16;
	BEGIN
		Dates.ToHMS(time, hour, min, sec);
		TwoDigit(hour, str);
		Strings.Append(line, str);
		TwoDigit(min, str);
		Strings.Append(line, str);
		TwoDigit(sec, str);
		Strings.Append(line, str)
	END ConcatTime;

	PROCEDURE LoadInitText;
		VAR
			text: Texts.Text;
			S: Texts.Scanner;
			group, lastg: Group;
			art, last: ArtNrs;
			i: SIGNED32;
			val: ARRAY 64 OF CHAR;
	BEGIN
		IF NetTools.QueryString("NewsFont", val) & (Fonts.This(val) # NIL) THEN
			newsFont := Fonts.This(val)
		ELSE
			newsFont := Fonts.Default
		END;
		groups := NIL; lastg := NIL;
		NEW(text); Texts.Open(text, InitText);
		Texts.OpenScanner(S, text, 0); Texts.Scan(S);
		ScanDate(S, newgDate); ScanTime(S, newgTime);
		WHILE ~S.eot DO
			NEW(group);
			IF (S.class = Texts.Char) & (S.c = "!") THEN
				group.subscribed := FALSE;
				Texts.Scan(S)
			ELSE
				group.subscribed := TRUE
			END;
			IF S.class IN {Texts.Name, Texts.String} THEN
				COPY(S.s, group.name);
				i := 0;
				WHILE group.name[i] # 0X DO
					INC(i)
				END;
				IF group.name[i-1] = ":" THEN
					group.name[i-1] := 0X
				END;
				group.next := NIL;
				IF lastg # NIL THEN
					lastg.next := group
				ELSE
					groups := group
				END;
				lastg := group;
				group.readArtNrs := NIL; last := NIL;
				Texts.Scan(S);
				IF ((S.class = Texts.Char) & (S.c = ":")) OR ((S.class IN {Texts.Name, Texts.String}) & (S.s = ":")) THEN
					Texts.Scan(S)
				END;
				WHILE ~S.eot & (S.class = Texts.Int) DO
					NEW(art); art.next := NIL;
					IF last = NIL THEN
						group.readArtNrs := art
					ELSE
						last.next := art
					END;
					last := art;
					art.beg := S.i; Texts.Scan(S);
					IF ((S.class = Texts.Char) & (S.c = "-")) OR ((S.class IN {Texts.Name, Texts.String}) & (S.s = "-")) THEN
						Texts.Scan(S);
						IF S.class = Texts.Int THEN
							art.end := S.i;
							Texts.Scan(S)
						ELSE
							art.end := art.beg
						END
					ELSIF (S.class = Texts.Int) & (S.i < 0) THEN
						art.end := -S.i;
						Texts.Scan(S)
					ELSE
						art.end := art.beg
					END;
					IF (S.class = Texts.Char) & (S.c = ",") THEN
						Texts.Scan(S)
					END
				END
			ELSE
				Texts.Scan(S)
			END
		END
	END LoadInitText;

	PROCEDURE WriteDate(VAR W: Texts.Writer; VAR date: SIGNED32);
		VAR day, month, year: SIGNED16;
	BEGIN
		Dates.ToYMD(date, year, month, day);
		Texts.WriteInt(W, day, 0);
		Texts.Write(W, " ");
		Texts.WriteInt(W, month, 0);
		Texts.Write(W, " ");
		Texts.WriteInt(W, year, 0)
	END WriteDate;

	PROCEDURE WriteTime(VAR W: Texts.Writer; VAR time: SIGNED32);
		VAR hour, min, sec: SIGNED16;
	BEGIN
		Dates.ToHMS(time, hour, min, sec);
		Texts.WriteInt(W, hour, 0);
		Texts.Write(W, " ");
		Texts.WriteInt(W, min, 0);
		Texts.Write(W, " ");
		Texts.WriteInt(W, sec, 0)
	END WriteTime;

	PROCEDURE storeInitText;
		VAR
			text: Texts.Text;
			group: Group;
			art: ArtNrs;
			F: Files.File;
			len: SIGNED32;
			name: FileDir.FileName;
	BEGIN
		NEW(text); Texts.Open(text, "");
		WriteDate(W, newgDate);
		Texts.Write(W, " ");
		WriteTime(W, newgTime);
		Texts.WriteLn(W);
		group := groups;
		WHILE group # NIL DO
			IF ~group.subscribed THEN
				Texts.Write(W, "!")
			END;
			len := 0;
			WHILE (group.name[len] # 0X) & (Strings.IsAlpha(group.name[len]) OR (group.name[len] = ".")) DO
				INC(len)
			END;
			IF group.name[len] # 0X THEN
				Texts.Write(W, 22X);
				Texts.WriteString(W, group.name);
				Texts.Write(W, 22X)
			ELSE
				Texts.WriteString(W, group.name)
			END;
			Texts.WriteString(W, ": ");
			art := group.readArtNrs;
			WHILE art # NIL DO
				Texts.WriteInt(W, art.beg, 0);
				IF art.end > art.beg THEN
					Texts.WriteString(W, " - "); Texts.WriteInt(W, art.end, 0)
				END;
				art := art.next;
				IF art # NIL THEN Texts.WriteString(W, ", ") END
			END;
			Texts.WriteLn(W);
			group := group.next
		END;
		Texts.Append(text, W.buf);
		F := Files.Old(InitText);
		IF F # NIL THEN
			Files.GetName(F, name)
		ELSE
			COPY(InitText, name)
		END;
		F := Files.New(name);
		Texts.Store(text, F, 0, len);
		Files.Register(F)
	END storeInitText;

(** News.StoreInitText
		Store information on read articles and subscribed groups. *)
	PROCEDURE StoreInitText*;
	BEGIN
		Texts.WriteString(W, "Store ");
		Texts.WriteString(W, InitText);
		Texts.WriteLn(W);
		Texts.Append(Oberon.Log, W.buf);
		storeInitText()
	END StoreInitText;

	PROCEDURE NewArtNr(nr: SIGNED32): ArtNrs;
		VAR art: ArtNrs;
	BEGIN
		NEW(art); art.next := NIL;
		art.beg := nr; art.end := nr;
		RETURN art
	END NewArtNr;

	PROCEDURE AddArtNr(group: Group; nr: SIGNED32);
		VAR prev, cur, art: ArtNrs;
	BEGIN
		prev := NIL; cur := group.readArtNrs;
		WHILE (cur # NIL) & (cur.beg <= nr) DO
			prev := cur; cur := cur.next
		END;
		IF cur # NIL THEN
			IF cur.beg = (nr+1) THEN
				cur.beg := nr
			ELSIF prev # NIL THEN
				IF prev.end = (nr-1) THEN
					prev.end := nr
				ELSIF prev.end < nr THEN
					art := NewArtNr(nr);
					prev.next := art; art.next := cur
				END
			ELSE
				art := NewArtNr(nr); prev := art;
				group.readArtNrs := art; art.next := cur
			END;
			IF (prev # NIL) & ((prev.end+1) = cur.beg) THEN
				prev.end := cur.end;
				prev.next := cur.next
			END
		ELSIF prev # NIL THEN
			IF prev.end = (nr-1) THEN
				prev.end := nr
			ELSIF prev.end < nr THEN
				art := NewArtNr(nr);
				prev.next := art
			END
		ELSE
			art := NewArtNr(nr);
			group.readArtNrs := art
		END
	END AddArtNr;

	PROCEDURE GetGroup(name: ARRAY OF CHAR; new: BOOLEAN): Group;
		VAR group: Group;
	BEGIN
		group := groups;
		WHILE (group # NIL) & (group.name # name) DO
			group := group.next
		END;
		IF (group = NIL) & new THEN
			NEW(group);
			COPY(name, group.name);
			group.subscribed := FALSE;
			group.readArtNrs := NIL;
			group.next := groups;
			groups := group
		END;
		RETURN group
	END GetGroup;

	PROCEDURE ReadArt(group: Group; nr: SIGNED32): BOOLEAN;
		VAR article: ArtNrs;
	BEGIN
		article := group.readArtNrs;
		WHILE (article # NIL) & (article.beg <= nr) DO
			IF (nr >= article.beg) & (nr <= article.end) THEN
				RETURN TRUE
			END;
			article := article.next
		END;
		RETURN FALSE
	END ReadArt;

	PROCEDURE ReadResponse(S: Session);
		VAR i: 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, i);
		S.status := SHORT(i)
	END ReadResponse;

(** Open a new session to nntp-host host on ort port. *)
	PROCEDURE Open*(VAR S: Session; host: ARRAY OF CHAR; port: SIGNED16);
	BEGIN
		NEW(S);
		IF NetTools.Connect(S.C, port, host, FALSE) THEN
			ReadResponse(S);
			IF S.status # 200 THEN
				NetTools.Disconnect(S.C); S.C := NIL; S.S := NIL
			ELSE
				S.S := NetTools.OpenStream(S.C);
				S.res := Done; RETURN
			END
		ELSE
			S.reply := "no connection"
		END;
		S.res := Failed
	END Open;

	PROCEDURE Open1*(VAR S: Session; host, user, passwd: ARRAY OF CHAR; port: SIGNED16);
	BEGIN
		IF trace THEN
			Texts.WriteString(W, "--- NNTP"); 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, "passwd = "); Texts.WriteString(W, passwd); Texts.WriteLn(W); *)
			Texts.Append(Oberon.Log, W.buf)
		END;
		NEW(S);
		S.res := NetTools.Failed; S.C := NIL; S.S := NIL;
		IF host[0] = 0X THEN
			S.reply := "no news-host specified"
		ELSE (* nntp-host name available *)
			IF ~NetTools.Connect(S.C, port, host, FALSE) THEN
				S.reply := "no connection";
				S.res := Failed
			ELSE (* Connection established. *)
				S.S := NetTools.OpenStream(S.C);
				ReadResponse(S);
				IF S.status # 200 THEN (* Server declined to open stream. *)
					NetTools.Disconnect(S.C); S.C := NIL; S.S := NIL; S.res := Failed
				ELSE (* Stream opened. *)
					IF (user[0] = 0X) OR (passwd[0] = 0X) THEN
						IF trace THEN
							Texts.WriteString(W, "(user[0] = 0X) OR (passwd[0] = 0X)).  Authentication not possible ");
							Texts.WriteString(W, "but server may proceed without authentication."); Texts.WriteLn(W);
							Texts.Append(Oberon.Log, W.buf)
						END
					ELSE(* Try to authenticate. *)
						Mail.SendCmd(S, "CAPABILITIES", "");
						REPEAT ReadResponse(S) UNTIL S.reply[0] = ".";
						Mail.SendCmd(S, "AUTHINFO USER", user);
						ReadResponse(S);
						IF S.reply[0] = "3" THEN (* user received; passwd now required. *)
							Mail.SendCmd(S, "AUTHINFO PASS", passwd);
							ReadResponse(S);
							IF S.reply[0] = "2" THEN
								IF trace THEN
									Texts.WriteString(W, "Authentication accepted."); Texts.WriteLn(W);
									Texts.Append(Oberon.Log, W.buf);
								END
							ELSIF (S.reply[0] = "4") & (S.reply[2] = "2") THEN
								IF trace THEN
									Texts.WriteString(W, "Authentication failed/rejected."); Texts.WriteLn(W);
									Texts.Append(Oberon.Log, W.buf)
								END
							END
						END
					END;
					S.res := Done
				END
			END
		END
	END Open1;

(** Close the connection for session S. *)
	PROCEDURE Close*(S: Session);
	BEGIN
		IF S.C # NIL THEN
			NetTools.Disconnect(S.C); S.C := NIL; S.S := NIL
		END
	END Close;

	PROCEDURE Connect(VAR S: Session): BOOLEAN;
		VAR
			NNTPHost, user, passwd: ARRAY 64 OF CHAR;
			NNTPPort: SIGNED16;
	BEGIN
		NetTools.GetHostPort("NNTP", NNTPHost, NNTPPort, DefPort);
		IF NNTPHost # "" THEN
			NetSystem.GetPassword("nntp", NNTPHost, user, passwd);
			Open1(S, NNTPHost, user, passwd, NNTPPort)
		ELSE
			NEW(S); S.C := NIL;
			S.reply := "NNTP-Host not set";
			S.res := Failed
		END;
		RETURN S.res = Done
	END Connect;

	PROCEDURE RegisterNewsAdr(host, group: ARRAY OF CHAR): SIGNED32;
		VAR key: SIGNED32;
	BEGIN
		COPY("news:", line);
		Strings.Append(line, group);
		IF host # "" THEN
			Strings.AppendCh(line, "@");
			Strings.Append(line, host)
		END;
		key := HyperDocs.RegisterLink(line);
		RETURN key
	END RegisterNewsAdr;

	PROCEDURE WriteGroup(VAR group: ARRAY OF CHAR);
		VAR
			i, key: SIGNED32;
			link: Objects.Object;
	BEGIN
		Texts.SetColor(W, SHORT(HyperDocs.linkC));
		i := 0;
		WHILE (group[i] # 0X) & (group[i] > " ") DO
			Texts.Write(W, group[i]);
			INC(i)
		END;
		group[i] := 0X;
		key := RegisterNewsAdr("", group);
		link := HyperDocs.LinkControl(key);
		Texts.WriteObj(W, link);
		Texts.SetColor(W, SHORT(Display3.textC));
		Texts.WriteLn(W)
	END WriteGroup;

	PROCEDURE SubGroups(T: Texts.Text);
		VAR group: Group;
	BEGIN
		group := groups;
		WHILE group # NIL DO
			IF group.subscribed THEN
				WriteGroup(group.name)
			END;
			group := group.next
		END;
		Texts.Append(T, W.buf)
	END SubGroups;

(** Write al list of all available groups to T. *)
	PROCEDURE AllGroups*(S: Session; VAR T: Texts.Text);
	BEGIN
		NetSystem.WriteString(S.C, "LIST");
		ReadResponse(S);
		IF S.status = 215 THEN
			NEW(T); Texts.Open(T, "");
			NetSystem.ReadString(S.C, line);
			WHILE (line[0] # ".") OR (line[1] # 0X) DO
				Texts.WriteString(W, "news:"); Texts.WriteString(W, line); Texts.WriteLn(W);
				NetSystem.ReadString(S.C, line)
			END;
			Texts.Append(T, W.buf);
			S.res := Done
		ELSE
			T := NIL;
			S.res := ErrList
		END
	END AllGroups;

(** List all new groups since the last access. *)
	PROCEDURE NewGroups*(S: Session; date, time: SIGNED32; VAR T: Texts.Text);
	BEGIN
		line := "NEWGROUPS ";
		ConcatDate(line, date);
		Strings.AppendCh(line, " ");
		ConcatTime(line, time);
		NetSystem.WriteString(S.C, line);
		ReadResponse(S);
		IF S.status = 231 THEN
			NEW(T); Texts.Open(T, "");
			NetSystem.ReadString(S.C, line);
			WHILE (line[0] # ".") OR (line[1] # 0X) DO
				Texts.WriteString(W, "news:"); Texts.WriteString(W, line); Texts.WriteLn(W);
				NetSystem.ReadString(S.C, line)
			END;
			Texts.Append(T, W.buf);
			S.res := Done
		ELSE
			T := NIL;
			S.res := ErrList
		END
	END NewGroups;

	PROCEDURE NewGrp(S: Session; VAR T: Texts.Text);
		VAR time, date: SIGNED32;
	BEGIN
		Oberon.GetClock(time, date);
		NewGroups(S, newgDate, newgTime, T);
		IF S.res = Done THEN
			newgDate := date; newgTime := time
		END
	END NewGrp;

	PROCEDURE HorzRule(): Objects.Object;
		VAR obj: Objects.Object;
	BEGIN
		obj := Gadgets.CreateObject("BasicFigures.NewRect3D");
		Attributes.SetBool(obj, "Filled", TRUE);
		Attributes.SetInt(obj, "Color", Display3.textbackC);
		Gadgets.ModifySize(obj(Display.Frame), Display.Width, 4);
		RETURN obj
	END HorzRule;

	PROCEDURE WriteGrpHead(group: ARRAY OF CHAR);
	BEGIN
		Texts.Write(Wr, 22X);
		Texts.WriteString(Wr, "news:");
		Texts.WriteString(Wr, group);
		Texts.Write(Wr, 22X);
		Texts.WriteLn(Wr);
		Texts.WriteObj(Wr, HorzRule());
		Texts.WriteLn(Wr)
	END WriteGrpHead;

	PROCEDURE RegisterNNTPAdr(group: ARRAY OF CHAR; artnr: SIGNED32): SIGNED32;
		VAR
			line: ARRAY NetTools.MaxLine OF CHAR;
			str: ARRAY 12 OF CHAR;
			key: SIGNED32;
	BEGIN
		COPY("nntp:", line);
		Strings.Append(line, group);
		Strings.AppendCh(line, "/");
		Strings.IntToStr(artnr, str);
		Strings.Append(line, str);
		key := HyperDocs.RegisterLink(line);
		RETURN key
	END RegisterNNTPAdr;

	PROCEDURE WriteArticle(nr: SIGNED32; VAR line: ARRAY OF CHAR);
		VAR
			link: Objects.Object;
			i, key: SIGNED32;
	BEGIN
		IF nr >= availBeg THEN
			IF ~ReadArt(curGrp, nr) THEN
				Texts.SetColor(Wr, SHORT(Display3.red))
			ELSE
				Texts.SetColor(Wr, SHORT(HyperDocs.linkC))
			END
		ELSE
			Texts.SetColor(Wr, SHORT(Display3.textC))
		END;
		i := 0;
		WHILE line[i] # 0X DO
			Texts.Write(Wr, line[i]);
			IF (line[i] = Strings.Tab) & (Wr.col # Display3.textC) THEN
				key := RegisterNNTPAdr(curGrp.name, nr);
				link := HyperDocs.LinkControl(key);
				Texts.WriteObj(Wr, link);
				Texts.SetColor(Wr, SHORT(Display3.textC))
			END;
			INC(i)
		END;
		Texts.WriteLn(Wr);
		Texts.SetColor(Wr, SHORT(Display3.textC))
	END WriteArticle;

	PROCEDURE ListArts(T: Texts.Text);
		VAR
			R: Files.Rider;
			key, org: SIGNED32;
	BEGIN
		Files.Set(R, refs, 0);
		Files.ReadLInt(R, org);
		WHILE ~R.eof DO
			Files.ReadLInt(R, key);
			Files.Set(R, refs, org);
			Files.ReadString(R, line);
			WriteArticle(key, line);
			Texts.Insert(T, 0, Wr.buf);
			Files.ReadLInt(R, org)
		END
	END ListArts;

	PROCEDURE enumThread(key, org: SIGNED32; VAR cont: BOOLEAN);
		VAR
			R: Files.Rider;
			sorg, app, i, oldThread: SIGNED32;
			inthread: BOOLEAN;
	BEGIN
		inthread := FALSE;
		Files.Set(R, refs, org);
		Files.ReadLInt(R, sorg);
		Files.ReadLInt(R, app);
		Files.ReadLInt(R, app);
		WHILE (app >= 0) & ~inthread DO	(* for all references *)
			inthread := thread = app;
			Files.ReadLInt(R, app)
		END;
		IF inthread & ~marked[key-beg] THEN
			marked[key-beg] := TRUE;
			Files.Set(R, refs, sorg);
			Files.ReadString(R, line);
			FOR i := 1 TO level DO
				Texts.Write(Wr, Strings.Tab)
			END;
			WriteArticle(key, line);
			oldThread := thread; thread := org; INC(level);
			BTrees.EnumLInt(indexA, key+1, end, enumThread);
			thread := oldThread; DEC(level)
		END
	END enumThread;

	PROCEDURE Thread(T: Texts.Text);
		VAR
			R: Files.Rider;
			a, org, sorg, porg: SIGNED32;
			re: SIGNED16;
	BEGIN
		NEW(marked, MaxMessages);
		FOR a := 0 TO MaxMessages-1 DO
			marked[a] := FALSE
		END;
		IF (end - beg) >= MaxMessages  THEN beg := end - MaxMessages  + 1 END;
		NetTools.curLen := end-beg;
		FOR a := beg TO end DO	(* from oldest to newest *)
			BTrees.SearchLInt(indexA, a, org, re);
			IF re = BTrees.Done THEN
				Files.Set(R, refs, org);
				Files.ReadLInt(R, sorg);
				Files.ReadLInt(R, porg);
				Files.ReadLInt(R, porg);
				IF porg < 0 THEN	(* article has no references *)
					Files.Set(R, refs, sorg);
					Files.ReadString(R, line);
					WriteArticle(a, line);
					marked[a-beg] := TRUE;
					thread := org; level := 1;
					BTrees.EnumLInt(indexA, a+1, end, enumThread)	(* enum all newer articles *)
				ELSIF ~marked[a-beg] THEN (* article not yet marked *)
					Files.Set(R, refs, sorg);
					Files.ReadString(R, line);
					WriteArticle(a, line);
					marked[a-beg] := TRUE
				END;
				Texts.Insert(T, 0, Wr.buf)
			END
		END;
		marked := NIL
	END Thread;

(** List all available articles in group in a certain range. 0-0 = all *)
	PROCEDURE ArticleRange(S: Session; group: ARRAY OF CHAR; VAR T: Texts.Text; thread: BOOLEAN; from, to: SIGNED32);
		VAR
			nr: SIGNED32;
			org, org2, org3, fixup: SIGNED32;
			str: ARRAY 16 OF CHAR;
			msgid: ARRAY 128 OF CHAR;
			dummy: ARRAY 256 OF CHAR;
			R: Files.Rider;
			i, j, iRef, bres: SIGNED16;
	BEGIN
		line := "GROUP ";
		Strings.Append(line, group);
		NetSystem.WriteString(S.C, line);
		ReadResponse(S);
		IF S.status = 211 THEN
			NEW(T); Texts.Open(T, "");
			i := 0;
			Strings.StrToIntPos(S.reply, beg, i);
			Strings.StrToIntPos(S.reply, beg, i);
			Strings.StrToIntPos(S.reply, beg, i);
			Strings.StrToIntPos(S.reply, end, i);
			Texts.WriteString(W, group);  Texts.WriteString(W, " available: ");
			Texts.WriteInt(W, beg, 1);  Texts.Write(W, "-");  Texts.WriteInt(W, end, 1);
			IF (from #  0) & (to = 0) THEN
				(* get 'from' newest articles *)
				beg := end - from + 1
			ELSIF (from #  0) & (to # 0) THEN
				(* from-to articles *)
				beg := from;  end := to
			END;
			(* be careful that your number range is smaller than MaxMessages  *)
			IF (end - beg) >= MaxMessages  THEN beg := end - MaxMessages  + 1 END;
			Texts.WriteString(W, ", get ");  Texts.WriteInt(W, beg, 1);
			Texts.Write(W, "-");  Texts.WriteInt(W, end, 1);
			IF curGrpNewOnly THEN Texts.WriteString(W, " unread") END;
			Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf);
			indexM := BTrees.NewStr(Files.New(""), 0, SHORT(2*(end-beg))); BTrees.Flush(indexM);
			indexA := BTrees.NewLInt(BTrees.Base(indexM), Files.Length(BTrees.Base(indexM)), SHORT(2*(end-beg)));
			NetTools.curLen := end-beg; availBeg := beg;
			refs := Files.New(""); Files.Set(R, refs, 0);
			line := "XOVER ";
			Strings.IntToStr(beg, str);
			Strings.Append(line, str);
			Strings.AppendCh(line, "-");
			Strings.IntToStr(end, str);
			Strings.Append(line, str);
			NetSystem.WriteString(S.C, line);
			ReadResponse(S);
			IF S.status = 224 THEN
				curGrp := GetGroup(group, TRUE);
				NetSystem.ReadString(S.C, line);
				WHILE (line[0] # ".") OR (line[1] # 0X) DO	(* parse "message" line *)
					Strings.StrToInt(line, nr);
					IF ~curGrpNewOnly OR ~ReadArt(curGrp, nr) THEN
						i := 0; j := 0;
						WHILE (line[i] # 0X) & (j < 4) DO
							IF line[i] = Strings.Tab THEN
								INC(j)
							END;
							INC(i)
						END;
						line[i-1] := 0X;
						j := 0;
						WHILE (line[i] > " ") & (line[i] # ">") DO
							msgid[j] := line[i];
							INC(j); INC(i)
						END;
						IF line[i] = ">" THEN
							msgid[j] := line[i];
							INC(j); INC(i)
						END;
						msgid[j] := 0X;
						Strings.Upper(msgid, msgid);
						WHILE (line[i] # 0X) & (line[i] # "<") DO
							INC(i)
						END;
						org := Files.Pos(R);
						BTrees.InsertStr(indexM, msgid, org, bres);	(* add msgid to msgs index *)
						BTrees.InsertLInt(indexA, nr, org, bres);
						Files.WriteLInt(R, -1);	(* offset of title line *)
						Files.WriteLInt(R, nr);	(* the article nr. for article msgid *)
						iRef := i; fixup := 0;
						WHILE line[i] = "<" DO
							j := 0;
							WHILE (line[i] > " ") & (line[i] # ">") DO
								msgid[j] := line[i];
								INC(j); INC(i)
							END;
							IF line[i] = ">" THEN
								msgid[j] := line[i];
								INC(j); INC(i)
							END;
							msgid[j] := 0X;
							Strings.Upper(msgid, msgid);
							BTrees.SearchStr(indexM, msgid, org2, bres);	(* lookup the msgid referenced *)
							IF bres = BTrees.Done THEN
								Files.WriteLInt(R, org2)	(* add it to the references list *)
							ELSE	(* referenced article no longer available *)
								Files.WriteLInt(R, -2); INC(fixup)
							END;
							WHILE (line[i] # 0X) & (line[i] # "<") DO
								INC(i)
							END
						END;
						Files.WriteLInt(R, -1);	(* end of reference list *)
						org2 := Files.Pos(R);
						Files.Set(R, refs, org);	(* fixup for title line *)
						Files.WriteLInt(R, org2);
						Files.Set(R, refs, org2);	(* write the title line *)
						Files.WriteString(R, line);
						IF thread & (fixup > 0) THEN
							Files.Set(R, refs, org);
							Files.ReadLInt(R, org);
							Files.ReadLInt(R, org);
							i := iRef;
							WHILE line[i] = "<" DO
								j := 0;
								WHILE (line[i] > " ") & (line[i] # ">") DO
									msgid[j] := line[i];
									INC(j); INC(i)
								END;
								IF line[i] = ">" THEN
									msgid[j] := line[i];
									INC(j); INC(i)
								END;
								msgid[j] := 0X;
								Strings.Upper(msgid, msgid);
								Files.ReadLInt(R, org);
								IF org = -2 THEN
									org2 := Files.Length(refs); DEC(beg);
									BTrees.InsertStr(indexM, msgid, org2, bres);
									BTrees.InsertLInt(indexA, beg, org2, bres);
									org := Files.Pos(R)-4;
									Files.Set(R, refs, org2);
									Files.WriteLInt(R, -1);	(* offset of title line *)
									Files.WriteLInt(R, beg);	(* the article nr. for article msgid *)
									Files.WriteLInt(R, -1);	(* end of reference list *)
									org3 := Files.Pos(R);
									Strings.IntToStr(beg, dummy); Strings.AppendCh(dummy, Strings.Tab);
									Strings.Append(dummy, "Was: "); Strings.Append(dummy, msgid);
									Files.WriteString(R, dummy);	(* write the title line *)
									Files.Set(R, refs, org2);
									Files.WriteLInt(R, org3);	(* fixup for title line *)
									Files.Set(R, refs, org);
									Files.WriteLInt(R, org2);
									DEC(fixup)
								END;
								WHILE (line[i] # 0X) & (line[i] # "<") DO
									INC(i)
								END
							END;
							org := Files.Length(refs); Files.Set(R, refs, org)
						END
					END;
					NetSystem.ReadString(S.C, line)
				END;
				S.res := Done
			ELSE
				S.res := ErrXOver
			END
		ELSE
			S.res := ErrGroup
		END;
		IF S.res = Done THEN
			IF thread THEN
				Thread(T)
			ELSE
				ListArts(T)
			END;
			Texts.Append(T, Wr.buf);
			WriteGrpHead(group);
			Texts.Insert(T, 0, Wr.buf)
		END;
		curGrp := NIL; refs := NIL;
		indexM := NIL; indexA := NIL
	END ArticleRange;

(** List all available articles in group. *)
	PROCEDURE Articles*(S: Session; group: ARRAY OF CHAR; VAR T: Texts.Text; thread: BOOLEAN);
	BEGIN
		ArticleRange(S, group, T, thread, 0, 0)
	END Articles;

	PROCEDURE ReadString(VAR R: Texts.Reader; VAR s: ARRAY OF CHAR);
		VAR
			l, i: SIZE;
			ch: CHAR;
	BEGIN
		l := LEN(s)-1; i := 0;
		Texts.Read(R, ch);
		WHILE ~R.eot & (ch # Strings.CR) & (i < l) DO
			IF R.lib IS Fonts.Font THEN
				s[i] := ch; INC(i)
			END;
			Texts.Read(R, ch)
		END;
		s[i] := 0X
	END ReadString;

	PROCEDURE ReadArticle(S: Session; VAR T: Texts.Text);
		VAR
			h: MIME.Header;
			cont: MIME.Content;
			out: Streams.Stream;
			val: ARRAY 256 OF CHAR;
			pos: SIGNED32;
			mT: Texts.Text;
			i: SIGNED16;
	BEGIN
		out := TextStreams.OpenWriter(T);
		MIME.ReadHeader(S.S, out, h, pos); out.Flush(out);
		Mail.ParseContent(h, cont);
		pos := MIME.FindField(h, "Xref");
		IF pos > 0 THEN
			MIME.ExtractValue(h, pos, line);
			i := 0; pos := 0;
			WHILE line[pos] # 0X DO
				IF line[pos] <= " " THEN
					i := 0; INC(pos)
				ELSIF line[pos] = ":" THEN
					val[i] := 0X; INC(pos); i := SHORT(pos);
					Strings.StrToIntPos(line, pos, i);
					AddArtNr(GetGroup(val, TRUE), pos);
					pos := i
				ELSE
					val[i] := line[pos];
					INC(i); INC(pos)
				END
			END
		END;
		Texts.Append(T, W.buf); (*Texts.WriteLn(W);*)
		cont.len := MAX(SIGNED32);
		IF cont.typ.typ # "multipart" THEN
			MIME.ReadText(S.S, W, cont, TRUE)
		ELSE
			Texts.Append(T, W.buf);
			MIME.ReadMultipartText(S.S, mT, cont, TRUE); Texts.Save(mT, 0, mT.len, W.buf)
		END;
		Texts.Append(T, W.buf);
		IF (cont.typ.typ = "application") & (cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain}) THEN
			Mail.DecodeMessage(T, h, cont, -1);
		ELSIF NetTools.QueryString("NewsFont", val) & (Fonts.This(val) # NIL) THEN
			newsFont := Fonts.This(val);
			Texts.ChangeLooks(T, 0, T.len, {0}, newsFont, 0, 0)
		END
	END ReadArticle;

(** Retrieve article with number artnr in group. *)
	PROCEDURE ArticleByNr*(S: Session; group: ARRAY OF CHAR; artnr: SIGNED32; VAR T: Texts.Text);
		VAR str: ARRAY 12 OF CHAR;
	BEGIN
		line := "GROUP ";
		Strings.Append(line, group);
		NetSystem.WriteString(S.C, line);
		ReadResponse(S);
		IF S.status = 211 THEN
			NEW(T); Texts.Open(T, "");
			line := "STAT ";
			Strings.IntToStr(artnr, str);
			Strings.Append(line, str);
			NetSystem.WriteString(S.C, line);
			ReadResponse(S);
			IF S.status = 223 THEN
				line := "ARTICLE";
				NetSystem.WriteString(S.C, line);
				ReadResponse(S);
				IF S.status = 220 THEN
					AddArtNr(GetGroup(group, TRUE), artnr);
					ReadArticle(S, T);
					S.res := Done
				ELSE
					S.res := ErrArticle
				END
			ELSE
				S.res := ErrStat
			END
		ELSE
			S.res := ErrGroup
		END
	END ArticleByNr;

(** Retrieve the article with the message-id msgid. *)
	PROCEDURE ArticleByMsgId*(S: Session; msgid: ARRAY OF CHAR; VAR T: Texts.Text);
	BEGIN
		line := "ARTICLE <";
		Strings.Append(line, msgid);
		Strings.AppendCh(line, ">");
		NetSystem.WriteString(S.C, line);
		ReadResponse(S);
		IF S.status = 220 THEN
			NEW(T); Texts.Open(T, "");
			ReadArticle(S, T);
			S.res := Done
		ELSE
			S.res := ErrArticle
		END
	END ArticleByMsgId;

	PROCEDURE ReadGroupName(VAR name: ARRAY OF CHAR);
		VAR
			R: Texts.Reader;
			beg, end, time: SIGNED32;
			text: Texts.Text;
			ch: CHAR;
	BEGIN
		COPY("", name);
		Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos);
		Texts.Read(R, ch);
		WHILE ~R.eot & (ch <= " ") DO
			Texts.Read(R, ch)
		END;
		IF ~R.eot & (ch = "^") THEN
			time := -1; text := NIL;
			Oberon.GetSelection(text, beg, end, time);
			IF (text # NIL) & (time >= 0) THEN
				Texts.OpenReader(R, text, beg);
				Texts.Read(R, ch);
				WHILE ~R.eot & (ch <= " ") DO
					Texts.Read(R, ch)
				END
			ELSE
				RETURN
			END
		END;
		IF ch = 22X THEN
			Texts.Read(R, ch)
		END;
		beg := 0;
		WHILE ~R.eot & (ch > " ") & (ch # 22X) DO
			name[beg] := ch;
			INC(beg);
			IF ch = ":" THEN
				beg := 0
			END;
			Texts.Read(R, ch)
		END;
		name[beg] := 0X
	END ReadGroupName;

(** News.SubGroup ^
		Subscribe a group (selection). *)
	PROCEDURE SubGroup*;
		VAR
			name: ARRAY 128 OF CHAR;
			group: Group;
	BEGIN
		ReadGroupName(name);
		IF name # "" THEN
			group := GetGroup(name, TRUE);
			group.subscribed := TRUE;
			Texts.WriteString(W, name);
			Texts.WriteString(W, " subcribed");
			Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf)
		END
	END SubGroup;

(** News.UnsubGroup ^
		Unsubscribe a group (selection). *)
	PROCEDURE UnsubGroup*;
		VAR
			name: ARRAY 128 OF CHAR;
			group: Group;
	BEGIN
		ReadGroupName(name);
		IF name # "" THEN
			Texts.WriteString(W, name);
			group := GetGroup(name, FALSE);
			IF group # NIL THEN
				group.subscribed := FALSE;
				Texts.WriteString(W, " unsubcribed")
			ELSE
				Texts.WriteString(W, " not found")
			END;
			Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf)
		END
	END UnsubGroup;

	PROCEDURE catchUp(S: Session; group: Group);
		VAR
			end: SIGNED32;
			art: ArtNrs;
			i: SIGNED16;
	BEGIN
		line := "GROUP ";
		Strings.Append(line, group.name);
		NetSystem.WriteString(S.C, line);
		ReadResponse(S);
		IF S.status = 211 THEN
			i := 0;
			Strings.StrToIntPos(S.reply, end, i);
			Strings.StrToIntPos(S.reply, end, i);
			Strings.StrToIntPos(S.reply, end, i);
			Strings.StrToIntPos(S.reply, end, i)
		ELSE
			Texts.WriteString(W, S.reply);Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf);
			art := group.readArtNrs;
			WHILE art # NIL DO
				IF art.end > end THEN end := art.end END;
				art := art.next
			END
		END;
		NEW(art); art.beg := 0; art.end := end; art.next := NIL;
		group.readArtNrs := art
	END catchUp;

(** News.CatchUp ^
		Mark all articles in a group (selection) as read. *)
	PROCEDURE CatchUp*;
		VAR
			name: ARRAY 128 OF CHAR;
			group: Group;
			S: Session;
	BEGIN
		ReadGroupName(name);
		IF name # "" THEN
			group := GetGroup(name, TRUE);
			IF Connect(S) THEN
				catchUp(S, group)
			END;
			IF (S # NIL) & (S.res # Done) THEN
				Texts.WriteString(W, S.reply);
				Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
			END;
			Close(S)
		END
	END CatchUp;

(** News.CatchUpAll
		Mark all articles in all subscribed groups. *)
	PROCEDURE CatchUpAll*;
		VAR
			group: Group;
			S: Session;
	BEGIN
		IF Connect(S) THEN
			group := groups;
			WHILE group # NIL DO
				IF group.subscribed THEN
					catchUp(S, group)
				END;
				group := group.next
			END
		END;
		IF (S # NIL) & (S.res # Done) THEN
			Texts.WriteString(W, S.reply);
			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
		END;
		Close(S)
	END CatchUpAll;

	PROCEDURE SplitNewsAdr(VAR url, host, groupart: ARRAY OF CHAR): SIGNED32;
		VAR
			key: SIGNED32;
			i, j, l: SIZE;
			iskey: BOOLEAN;
		PROCEDURE Blanks;
		BEGIN
			WHILE (url[i] # 0X) & (url[i] <= " ") DO
				INC(i)
			END
		END Blanks;
	BEGIN
		HyperDocs.UnESC(url);
		i := 0;
		Blanks();
		(* skip news *)
		WHILE (url[i] # 0X) & (url[i] # ":") DO
			INC(i)
		END;
		(* skip : *)
		WHILE (url[i] # 0X) & (url[i] = ":") DO
			INC(i)
		END;
		Blanks();
		(* get groupart *)
		iskey := TRUE;
		l := LEN(groupart);
		j := 0;
		WHILE (url[i] # 0X) & (url[i] # "@") DO
			IF (url[i] > " ") & ~Strings.IsDigit(url[i]) THEN
				iskey := FALSE
			END;
			IF j < l THEN
				groupart[j] := url[i];
				INC(j)
			END;
			INC(i)
		END;
		groupart[j] := 0X;
		DEC(j);
		WHILE (j >= 0) & (groupart[j] <= " ") DO
			groupart[j] := 0X;
			DEC(j)
		END;
		IF (url[i] = 0X) & iskey THEN
			IF groupart # "" THEN
				Strings.StrToInt(groupart, key);
				HyperDocs.RetrieveLink(key, line);
				key := SplitNewsAdr(line, host, groupart);
				RETURN key
			ELSE
				RETURN HyperDocs.UndefKey
			END
		ELSIF url[i] = "@" THEN
			INC(i);
			l := LEN(host);
			j := 0;
			WHILE url[i] # 0X DO
				IF j < l THEN
					host[j] := url[i];
					INC(j)
				END;
				INC(i)
			END;
			host[j] := 0X;
			DEC(j);
			WHILE (j >= 0) & (host[j] <= " ") DO
				host[j] := 0X;
				DEC(j)
			END
		ELSE
			COPY("", host)
		END;
		key := RegisterNewsAdr(host, groupart);
		RETURN key
	END SplitNewsAdr;

	PROCEDURE SplitNNTPAdr(VAR url, group: ARRAY OF CHAR; VAR artnr: SIGNED32): SIGNED32;
		VAR
			i, j, l: SIZE;
			key: SIGNED32;
			iskey: BOOLEAN;
			str: ARRAY 12 OF CHAR;
		PROCEDURE Blanks;
		BEGIN
			WHILE (url[i] # 0X) & (url[i] <= " ") DO
				INC(i)
			END
		END Blanks;
	BEGIN
		HyperDocs.UnESC(url);
		i := 0;
		Blanks();
		(* skip nntp *)
		WHILE (url[i] # 0X) & (url[i] # ":") DO
			INC(i)
		END;
		(* skip : *)
		WHILE (url[i] # 0X) & (url[i] = ":") DO
			INC(i)
		END;
		Blanks();
		(* get group *)
		iskey := TRUE;
		l := LEN(group);
		j := 0;
		WHILE (url[i] # 0X) & (url[i] # "/") DO
			IF (url[i] > " ") & ~Strings.IsDigit(url[i]) THEN
				iskey := FALSE
			END;
			IF j < l THEN
				group[j] := url[i];
				INC(j)
			END;
			INC(i)
		END;
		group[j] := 0X;
		DEC(j);
		WHILE (j >= 0) & (group[j] <= " ") DO
			group[j] := 0X;
			DEC(j)
		END;
		IF (url[i] = 0X) & iskey THEN
			IF group # "" THEN
				Strings.StrToInt(group, key);
				HyperDocs.RetrieveLink(key, line);
				key := SplitNNTPAdr(line, group, artnr);
				RETURN key
			ELSE
				RETURN -1
			END
		ELSIF url[i] = "/" THEN
			INC(i);
			l := 12;
			j := 0;
			WHILE url[i] # 0X DO
				IF j < l THEN
					str[j] := url[i];
					INC(j)
				END;
				INC(i)
			END;
			str[j] := 0X;
			Strings.StrToInt(str, artnr)
		ELSE
			artnr := 0
		END;
		key := RegisterNNTPAdr(group, artnr);
		RETURN key
	END SplitNNTPAdr;

	PROCEDURE DocHandler(D: Objects.Object; VAR M: Objects.ObjMsg);
	BEGIN
		WITH D: Documents.Document DO
			TextDocs.DocHandler(D, M)
		END
	END DocHandler;

(* Find the line containing pos. *)
	PROCEDURE FindBeg(T: Texts.Text; VAR pos: SIGNED32);
		VAR
			R: Texts.Reader;
			ch: CHAR;
	BEGIN
		Texts.OpenReader(R, T, pos);
		Texts.Read(R, ch);
		WHILE (pos > 0) & ((ch # Strings.CR) OR ~(R.lib IS Fonts.Font)) DO
			DEC(pos);
			Texts.OpenReader(R, T, pos);
			Texts.Read(R, ch)
		END;
		IF ch = Strings.CR THEN
			INC(pos)
		END
	END FindBeg;

	PROCEDURE LoadDoc(D: Documents.Document);
		VAR
			host: ARRAY NetTools.ServerStrLen OF CHAR;
			group, msgid: ARRAY NetTools.PathStrLen OF CHAR;
			T: Texts.Text;
			pos, artnr, artnr1: SIGNED32;
			date, time: SIGNED32;
			S: Session;
			obj, t: Objects.Object;
			F: Texts.Finder;
			article: BOOLEAN;
			sPos: SIGNED16;
	BEGIN
		S := NIL;
		article := FALSE;
		D.dsc := NIL;
		IF (D.name = "") OR (D.name = "subgroups") THEN
			TextDocs.InitDoc(D);
			NEW(T); Texts.Open(T, "");
			SubGroups(T);
			IF T.len = 0 THEN
				Texts.WriteString(W, "No subscribed groups");
				Texts.WriteLn(W);
				Texts.Append(T, W.buf)
			END;
			COPY("Subscribed Groups", D.name)
		ELSIF D.name = "newgroups" THEN
			IF Connect(S) THEN
				date := newgDate; time := newgTime;
				TextDocs.InitDoc(D);
				NEW(T);
				Texts.Open(T, "");
				NewGrp(S, T);
				IF T # NIL THEN
					IF T.len = 0 THEN
						Texts.WriteString(W, "No new groups since ")
					ELSE
						Texts.WriteString(W, "New groups since ")
					END;
					Texts.WriteDate(W, time, date); Texts.WriteLn(W);
					Texts.WriteLn(W); Texts.Insert(T, 0, W.buf)
				END;
				COPY("New Groups", D.name);
				Close(S)
			END
		ELSIF D.name = "news:" THEN
			IF Connect(S) THEN
				TextDocs.InitDoc(D);
				COPY("All Groups", D.name);
				AllGroups(S, T);
				Close(S)
			END
		ELSIF Strings.CAPPrefix("news:", D.name) THEN
			IF SplitNewsAdr(D.name, host, group) # HyperDocs.UndefKey THEN
				IF Connect(S) THEN
					TextDocs.InitDoc(D);
					curGrpNewOnly := FALSE;
					IF group = "" THEN
						COPY("All Groups", D.name);
						AllGroups(S, T)
					ELSIF host = "" THEN
						COPY(group, D.name);
						Articles(S, group, T, NetTools.QueryBool("NewsThreading"))
					ELSE
						(* news:<group>@<number[-<number>][\n] *)
						sPos := 0; Strings.StrToIntPos(host, artnr, sPos);
						IF artnr # 0 THEN (* a number was found *)
							IF host[sPos] = "-" THEN (* a range *)
								INC(sPos); Strings.StrToIntPos(host, artnr1, sPos)
								(* get articles #artnr to #artnr1 *)
							ELSE
								artnr1 := 0 (* get the artnr newest articles *)
							END;
							curGrpNewOnly :=  (host[sPos] = "\" ) & (host[sPos+1] = "n" );  (* look for option \n *)
							ArticleRange(S, group, T, NetTools.QueryBool("NewsThreading"), artnr, artnr1)
						ELSE (* a real host *)
							COPY(group, msgid);
							Strings.AppendCh(msgid, "@");
							Strings.Append(msgid, host);
							COPY(msgid, D.name);
							ArticleByMsgId(S, msgid, T);
							article := TRUE
						END
					END;
					Close(S)
				END
			END
		ELSIF Strings.CAPPrefix("nntp:", D.name) THEN
			IF SplitNNTPAdr(D.name, group, artnr) # HyperDocs.UndefKey THEN
				IF Connect(S) THEN
					TextDocs.InitDoc(D);
					ArticleByNr(S, group, artnr, T);
					COPY(group, D.name);
					Strings.AppendCh(D.name, ".");
					Strings.IntToStr(artnr, msgid);
					Strings.Append(D.name, msgid);
					article := TRUE;
					IF (S.res = Done) & (Gadgets.executorObj # NIL) & (Gadgets.executorObj IS TextGadgets.Control) THEN
						Links.GetLink(Gadgets.context, "Model", t);
						IF (t # NIL) & (t IS Texts.Text) THEN
							Texts.OpenFinder(F, t(Texts.Text), 0);
							pos := F.pos; Texts.FindObj(F, obj);
							WHILE ~F.eot DO
								IF obj = Gadgets.executorObj THEN
									artnr := pos; FindBeg(t(Texts.Text), artnr);
									Texts.ChangeLooks(t(Texts.Text), artnr, pos-1, {1}, NIL, SHORT(HyperDocs.linkC), 0)
								END;
								pos := F.pos; Texts.FindObj(F, obj)
							END
						END
					END;
					Close(S)
				END
			END
		ELSE
			HALT(99)
		END;
		IF (S # NIL) & (S.res # Done) THEN
			D.dsc := NIL;
			Texts.WriteString(W, S.reply);
			Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf)
		ELSE
			Links.SetLink(D.dsc, "Model", T);
			D.W := HyperDocs.docW; D.H := HyperDocs.docH;
			IF ~article THEN
				D.handle := DocHandler
			END
		END;
		IF HyperDocs.context # NIL THEN
			HyperDocs.context.replace := FALSE;
			HyperDocs.context.history := FALSE
		END
	END LoadDoc;

	PROCEDURE NewDoc*;
		VAR D: Documents.Document;
	BEGIN
		NEW(D);
		D.Load := LoadDoc;
		D.Store := NIL;
		D.handle := NIL;
		Objects.NewObj := D
	END NewDoc;

(** News.ShowAllGroups
		Show all newsgroups. *)
	PROCEDURE ShowAllGroups*;
		VAR doc: Documents.Document;
	BEGIN
		NewDoc();
		doc := Objects.NewObj(Documents.Document);
		doc.name := "news:";
		doc.Load(doc);
		IF (doc # NIL) & (doc.dsc # NIL) THEN
			Desktops.ShowDoc(doc)
		END
	END ShowAllGroups;

(** News.ShowNewGroups
		Show new groups since last access. *)
	PROCEDURE ShowNewGroups*;
		VAR doc: Documents.Document;
	BEGIN
		NewDoc();
		doc := Objects.NewObj(Documents.Document);
		doc.name := "newgroups";
		doc.Load(doc);
		IF (doc # NIL) & (doc.dsc # NIL) THEN
			Desktops.ShowDoc(doc)
		END
	END ShowNewGroups;

(** News.SubscribedGroups
		List subscribed groups. *)
	PROCEDURE SubscribedGroups*;
		VAR doc: Documents.Document;
	BEGIN
		NewDoc();
		doc := Objects.NewObj(Documents.Document);
		doc.name := "subgroups";
		doc.Load(doc);
		IF (doc # NIL) & (doc.dsc # NIL) THEN
			Desktops.ShowDoc(doc)
		END
	END SubscribedGroups;

	PROCEDURE NewsSchemeHandler(L: Objects.Object; VAR M: Objects.ObjMsg);
		VAR
			host: ARRAY NetTools.ServerStrLen OF CHAR;
			group: ARRAY NetTools.PathStrLen OF CHAR;
	BEGIN
		WITH L: HyperDocs.LinkScheme DO
			IF M IS HyperDocs.RegisterLinkMsg THEN
				WITH M: HyperDocs.RegisterLinkMsg DO
					M.key := SplitNewsAdr(M.link, host, group);
					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 := "News.NewNewsLinkScheme";
						M.res := 0
					ELSE
						HyperDocs.LinkSchemeHandler(L, M)
					END
				END
			ELSE
				HyperDocs.LinkSchemeHandler(L, M)
			END
		END
	END NewsSchemeHandler;

	PROCEDURE NewNewsLinkScheme*;
		VAR L: HyperDocs.LinkScheme;
	BEGIN
		NEW(L); L.handle := NewsSchemeHandler;
		L.usePath := FALSE;
		Objects.NewObj := L
	END NewNewsLinkScheme;

	PROCEDURE NNTPSchemeHandler(L: Objects.Object; VAR M: Objects.ObjMsg);
		VAR
			group: ARRAY NetTools.PathStrLen OF CHAR;
			artnr: SIGNED32;
	BEGIN
		WITH L: HyperDocs.LinkScheme DO
			IF M IS HyperDocs.RegisterLinkMsg THEN
				WITH M: HyperDocs.RegisterLinkMsg DO
					M.key := SplitNNTPAdr(M.link, group, artnr);
					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 := "News.NewNNTPLinkScheme";
						M.res := 0
					ELSE
						HyperDocs.LinkSchemeHandler(L, M)
					END
				END
			ELSE
				HyperDocs.LinkSchemeHandler(L, M)
			END
		END
	END NNTPSchemeHandler;

	PROCEDURE NewNNTPLinkScheme*;
		VAR L: HyperDocs.LinkScheme;
	BEGIN
		NEW(L); L.handle := NNTPSchemeHandler;
		L.usePath := FALSE;
		Objects.NewObj := L
	END NewNNTPLinkScheme;

	PROCEDURE SendArticle*(S: Session; T: Texts.Text; cont: MIME.Content);
		VAR
			s: Streams.Stream;
			h: MIME.Header;
			head: Texts.Text;
			R: Texts.Reader;
			end: SIGNED32;
			ch: CHAR;
	BEGIN
		NetSystem.WriteString(S.C, "POST");
		ReadResponse(S);
		IF S.status = 340 THEN
			s := TextStreams.OpenReader(T, 0);
			MIME.ReadHeader(s, NIL, h, end);
			NEW(head); Texts.Open(head, "");
			Texts.OpenReader(R, T, end); Texts.Read(R, ch);
			IF (ch = Strings.CR) OR (ch = Strings.LF) THEN
				WHILE (end > 0) & ((ch = Strings.CR) OR (ch = Strings.LF)) DO
					DEC(end); Texts.OpenReader(R, T, end); Texts.Read(R, ch)
				END;
				INC(end); IF end > T.len THEN end := T.len END
			END;
			Texts.Save(T, 0, end, W.buf); Texts.Append(head, W.buf);
			Texts.OpenReader(R, T, end); Texts.Read(R, ch);
			WHILE (ch = Strings.CR) OR (ch = Strings.LF) DO
				Texts.Read(R, ch); INC(end)
			END;
			Mail.GetSetting("EMail", S.from, FALSE);
			Mail.SendText(S, head, T, end-1, T.len, cont);
			ReadResponse(S);
			IF S.status = 240 THEN
				S.res := Done; Mail.SendReplyLine(S, cont)
			ELSE
				S.res := ErrPost
			END
		ELSE
			S.res := ErrPost
		END
	END SendArticle;

(** News.Send [mime] *
		Send article (the marked text), mime:
			ascii : text/plain, us-ascii
			iso : text/plain, iso 8bit
			oberon : text/plain with application/compressed/oberondoc attachment
			<no mime> :
				- Simple Text without different colors or fonts
					no Umlaut -> ascii
					Umlaut -> iso
				- Text without objects, but with different colors or fonts -> oberon
				- Text with objects -> ooberon *)
	PROCEDURE Send*;
		VAR
			T, sig: Texts.Text;
			cont: MIME.Content;
			Sc: Attributes.Scanner;
			S: Session;
			val: ARRAY 64 OF CHAR;
	BEGIN
		T := Oberon.MarkedText();
		IF T # NIL THEN
			NEW(cont); cont.typ := MIME.GetContentType("text/plain");
			Attributes.OpenScanner(Sc, Oberon.Par.text, Oberon.Par.pos);
			Sc.s := ""; Attributes.Scan(Sc);
			IF CAP(Sc.s[0]) = "O" THEN
				cont.typ := MIME.GetContentType(MIME.OberonMime); cont.encoding := MIME.EncAsciiCoderC
			ELSIF CAP(Sc.s[0]) = "A" THEN
				cont.encoding := MIME.EncBin
			ELSIF CAP(Sc.s[0]) = "I" THEN
				cont.encoding := MIME.Enc8Bit
			ELSE
				Mail.QueryContType(T, 0, cont)
			END;
			Mail.GetSetting("NewsSignature", 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;
			Texts.WriteString(W, "sending ");
			Texts.Append(Oberon.Log, W.buf);
			IF Connect(S) THEN
				SendArticle(S, T, cont)
			END;
			Texts.WriteString(W, S.reply);
			Close(S);
			Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf)
		END
	END Send;

(** News.Reply (selection)
	Compose a minimal followup article for the selected article. *)
	PROCEDURE Reply*;
		VAR
			T, text: Texts.Text;
			S: Attributes.Scanner;
			time, beg, end: SIGNED32;
			par, msgid, from: ARRAY 256 OF CHAR;
			R: Texts.Reader;
			lib: Objects.Library;
			grp, sub, frm: BOOLEAN;
	BEGIN
		lib := W.lib; Texts.SetFont(W, newsFont);
		grp := FALSE; sub := FALSE; frm := FALSE;
		Mail.GetSetting("EMail", EMail, FALSE);
		Attributes.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
		IF (S.class = Texts.Char) & (S.c = "^") THEN
			text := NIL; time := -1;
			Oberon.GetSelection(text, beg, end, time);
			IF time < 0 THEN text := NIL END
		ELSE
			text := Oberon.MarkedText(); beg := 0
		END;
		from := "nobody"; msgid := "<>";
		IF text # NIL THEN
			Texts.OpenReader(R, text, beg);
			ReadString(R, line);
			WHILE ~R.eot & (line # "") DO
				IF Strings.CAPPrefix("Message-ID:", line) THEN
					Strings.GetPar(line, msgid);
					Texts.WriteString(W, "References: ");
					Texts.WriteString(W, msgid);
					Texts.WriteLn(W)
				ELSIF Strings.CAPPrefix("Subject:", line) THEN
					sub := TRUE;
					Strings.GetPar(line, par);
					Texts.WriteString(W, "Subject: ");
					Mail.Re(W, par);
					Texts.WriteLn(W)
				ELSIF Strings.CAPPrefix("Newsgroups:", line) THEN
					grp := TRUE; frm := TRUE;
					Texts.WriteString(W, line);
					Texts.WriteLn(W);
					Strings.GetPar(line, par);
					Texts.WriteString(W, "Followup-To: ");
					Texts.WriteString(W, par);
					Texts.WriteLn(W)
				ELSIF Strings.CAPPrefix("From:", line) THEN
					Strings.GetPar(line, from)
				END;
				ReadString(R, line)
			END
		END;
		NEW(T); Texts.Open(T, "");
		Texts.Append(T, W.buf);
		IF ~grp THEN
			Texts.WriteString(W, "Newsgroups: ");
			Texts.WriteLn(W);
			Texts.Insert(T, 0, W.buf)
		END;
		IF ~frm THEN
			Texts.WriteString(W, "From: ");
			Texts.WriteString(W, EMail);
			Texts.WriteLn(W)
		END;
		IF ~sub THEN
			Texts.WriteString(W, "Subject: ");
			Texts.WriteLn(W)
		END;
		Texts.WriteLn(W);
		Texts.WriteString(W, "In article "); Texts.WriteString(W, msgid); Texts.WriteString(W, ", ");
		Texts.WriteString(W, from); Texts.WriteString(W, " wrote: "); Texts.WriteLn(W);
		IF text # NIL THEN
			Texts.WriteLn(W);
			Mail.CiteText(W, text, Texts.Pos(R), text.len)
		END;
		Texts.WriteLn(W); Texts.Append(T, W.buf);
		Texts.SetFont(W, lib);
		TextDocs.ShowText("Article.Text", T, HyperDocs.docW, HyperDocs.docH)
	END Reply;

BEGIN
	trace := NetTools.QueryBool("TraceNews");
	Texts.OpenWriter(W); Texts.OpenWriter(Wr);
	LoadInitText(); Modules.InstallTermHandler(storeInitText)
END News.

News.Read.Text

News.StoreInitText

System.Free News ~