home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
internet
/
rnr214.zip
/
RNRMAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-02-01
|
40KB
|
1,469 lines
unit rnrmain;
{
rnrmain.pas - rnr main (to keep from recompiling huge rnr.pas)
}
{$I rnr-def.pas}
interface
uses dos,crt,genericf,rnrglob,rnrconf,rnrfunc,rnrselb,rnrio,
rnrproc,rnrkill,rnrfile,rnrnov
{$ifdef timeout}
,rnrtime
{$endif}
{$ifdef charset}
,rnrchar
{$endif}
{$ifdef mouse}
,mouse {see rnrmous.pas}
{$endif}
;
procedure sethash(var h: hashedt; s: string);
procedure swapi(var i,j: integer);
procedure swapart(a,b: integer);
procedure sortitall;
procedure readinarts;
procedure groupinit;
implementation
procedure sethash;
var
i: integer;
atat: integer;
{$ifdef oldhash}
ls,rs: integer;
{$endif}
leng: integer;
l: integer;
startaft: integer;
begin
{$ifdef oldhash}
for i := 1 to 6 do
h[i] := 0;
atat := pos('@',s);
if atat=0 then
begin
{leave malformed ones alone}
end
else
begin
{assume all message-ids are at least 6 chars long - a@b.cd is}
ls := atat-6;
rs := atat+1;
{handle these specially - the last bunch of stuff is always the same!}
if pos(newsreadername,s)>0 then
ls := 10;
if ls<1 then
ls := 1;
if atat>length(s)-5 then
rs := length(s)-5;
for i := 1 to 3 do
h[i] := 16*( (ord(s[ls+i*2-1])) and 15)+( (ord(s[ls+i*2])) and 15);
for i := 1 to 3 do
h[i+3] := 16*( (ord(s[rs+i*2-1])) and 15)+( (ord(s[rs+i*2])) and 15);
end;
{$endif}
h[1] := 0;
h[2] := 0;
atat := pos('@',s);
if atat=0 then
begin
{leave malformed ones alone}
end
else
begin
leng := length(s);
l := min(16,leng);
for i := 1 to l do
if odd(ord(s[i])) then
h[1] := (h[1] shl 1)+1
else
h[1] := h[1] shl 1;
l := min(16,leng);
startaft := leng-l;
if startaft>atat then
startaft := atat;
for i := 1 to l do
if odd(ord(s[startaft+i])) then
h[2] := (h[2] shl 1)+1
else
h[2] := h[2] shl 1;
end;
{$ifdef testhash}
{
writeln('hashed "',s,'" to ',h[1]:5,' ',h[2]:5);
}
{$endif}
end;
procedure swapi;
var
t: integer;
begin
t := i;
i := j;
j := t;
end;
procedure swapart;
var
temparticlep: articlept;
{
tempsubj: subjstringt;
tempfilename: fnstringt;
tempdate: datet;
tempindents: byte;
tempsizeink: byte;
tempfrom: fromstringt;
}
{don't need to worry about hashing or canon stuff - by this time, not needed}
begin
temparticlep := articles[a];
articles[a] := articles[b];
articles[b] := temparticlep;
{
tempsubj := basesubjs[a];
tempfilename := filenamesp^[a];
tempdate := datesp^[a];
tempindents := indents[a];
tempsizeink := sizeink[a];
tempfrom := fromsp^[a];
basesubjs[a] := basesubjs[b];
filenamesp^[a] := filenamesp^[b];
datesp^[a] := datesp^[b];
indents[a] := indents[b];
sizeink[a] := sizeink[b];
fromsp^[a] := fromsp^[b];
basesubjs[b] := tempsubj;
filenamesp^[b] := tempfilename;
datesp^[b] := tempdate;
indents[b] := tempindents;
sizeink[b] := tempsizeink;
fromsp^[b] := tempfrom;
}
end;
procedure sortitall;
type
intptrst=array[1..maxarts] of integer;
var
i,j: integer;
currart: integer;
dateptrs,subjptrs,finalptrs,revfinalptrs: intptrst;
dateptrlookingat: integer;
finalptrsdone: integer;
thisthreadfirstfinalptr: integer;
currsubjptr: integer;
foundnewsubj: boolean;
currsubj: subjstringt;
currcanonfirstchar: char;
step: integer;
base: integer;
lowpos: integer;
highpos: integer;
numartsdivstep: integer;
{$ifdef testsort}
debugf: text;
debugfn: string;
{$endif}
begin
{first sort by date, then for each oldest article, take the rest of the}
{articles in that thread together, sorting within the thread only}
for i := 1 to numarts do
dateptrs[i] := i;
{the dates equal but subjects not test is for comp.sources.* etc. v29i033}
{hopefully will help part 1/6 posts too (eg alt.sources)}
{$define bubble}
{$undef bubble}
{$ifdef bubble}
for i := 1 to numarts-1 do
for j := i+1 to numarts do
if (articles[dateptrs[i]]^.date>articles[dateptrs[j]]^.date) then
swapi(dateptrs[i],dateptrs[j])
else if
(
(articles[dateptrs[i]]^.date=articles[dateptrs[j]]^.date)
and
xfirstsubjg
(
articles[dateptrs[i]]^.canonfirstchar,
articles[dateptrs[j]]^.canonfirstchar,
articles[dateptrs[i]]^.basesubject,
articles[dateptrs[j]]^.basesubject
)
) then
swapi(dateptrs[i],dateptrs[j]);
{$else}
{ 2047 is the lowest (power of 2)-1 which is > maxarts }
step := 2047;
while step>0 do
begin
if not quiet and (numarts>step) then
begin
xwritei(step);
xwrites('.');
end;
numartsdivstep := numarts div step;
for base := 1 to step do
for i := 0 to numartsdivstep-1 do
for j := i+1 to numartsdivstep do
begin
lowpos := base+i*step;
highpos := base+j*step;
if highpos<=numarts then
begin
if
articles[dateptrs[lowpos]]^.date
>
articles[dateptrs[highpos]]^.date then
swapi(dateptrs[lowpos],dateptrs[highpos])
else
if
(articles[dateptrs[lowpos]]^.date=
articles[dateptrs[highpos]]^.date)
and
xfirstsubjg
(
articles[dateptrs[lowpos]]^.canonfirstchar,
articles[dateptrs[highpos]]^.canonfirstchar,
articles[dateptrs[lowpos]]^.basesubject,
articles[dateptrs[highpos]]^.basesubject
)
then
swapi(dateptrs[lowpos],dateptrs[highpos]);
end;
end;
step := step div 2; {it's vital that 1 div 2=0 here}
end;
{$endif}
notquiets(':');
{$ifdef testsort}
if showdebug('sort') then
begin
debugfn := '\debug.th';
writeln('using ',debugfn);
assign(debugf,debugfn);
rewrite(debugf);
writeln(debugf,'date ordering:');
for i := 1 to numarts do
writeln(debugf,dateptrs[i]:5,' ',
articles[dateptrs[i]]^.filename:5,' ',
articles[dateptrs[i]]^.basesubject);
writeln(debugf);
writeln(debugf);
end;
{$endif}
for i := 1 to numarts do
subjptrs[i] := i;
{$ifdef bubble}
for i := 1 to numarts-1 do
begin
notquiets('.');
for j := i+1 to numarts do
begin
if xfirstsubjg
(
articles[subjptrs[i]]^.canonfirstchar,
articles[subjptrs[j]]^.canonfirstchar,
articles[subjptrs[i]]^.basesubject,
articles[subjptrs[j]]^.basesubject
) then
swapi(subjptrs[i],subjptrs[j]);
end;
end;
{$else}
{ 2047 is the lowest (power of 2)-1 which is > maxarts }
step := 2047;
while step>0 do
begin
if not quiet and (numarts>step) then
begin
xwritei(step);
xwrites('.');
end;
numartsdivstep := numarts div step;
for base := 1 to step do
for i := 0 to numartsdivstep-1 do
for j := i+1 to numartsdivstep do
begin
lowpos := base+i*step;
highpos := base+j*step;
if highpos<=numarts then
if xfirstsubjg
(
articles[subjptrs[lowpos]]^.canonfirstchar,
articles[subjptrs[highpos]]^.canonfirstchar,
articles[subjptrs[lowpos]]^.basesubject,
articles[subjptrs[highpos]]^.basesubject
) then
swapi(subjptrs[lowpos],subjptrs[highpos]);
end;
step := step div 2; {it's vital that 1 div 2=0 here}
end;
{$endif}
notquiets(':');
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf,'subject ordering:');
for i := 1 to numarts do
writeln(debugf,subjptrs[i]:5,' ',
articles[subjptrs[i]]^.filename:5,' ',
articles[subjptrs[i]]^.basesubject);
writeln(debugf);
writeln(debugf);
end;
{$endif}
{sort via finalptrs indirection to prevent extra swapping}
{$ifdef testsort}
for i := 1 to numarts do
finalptrs[i] := -1;
for i := 1 to numarts do
revfinalptrs[i] := -1;
{$endif}
{major sort: oldest article first, and all in its thread}
dateptrlookingat := 0;
finalptrsdone := 0;
while finalptrsdone<numarts do
begin
inc(dateptrlookingat);
{skip over ones we've flagged as done}
if dateptrs[dateptrlookingat]>0 then
begin
notquiets('.');
{dateptrs[dateptrlookingat] now points to oldest article not yet done}
currsubj := articles[dateptrs[dateptrlookingat]]^.basesubject;
currcanonfirstchar := canonicalfirstchar(currsubj);
{and currsubj is its subject -- now find all that match it}
{$ifdef testsort}
if showdebug('sort') then
writeln(debugf,'(oldest) curr (canon)subj=',
'(',currcanonfirstchar,')',currsubj);
{$endif}
currsubjptr := 1;
currart := 0;
while currart<numarts do
begin
inc(currart);
{if <= currsubj, then set the pointer -- to the first that matches}
{since subjptrs is the sorted subjects, it must match}
{$ifdef testsort}
{$ifdef verbosetestsort}
if showdebug('sort') then
writeln(debugf,'currsubjptr--is it ',currart,'? comparing:',
copy(articles[subjptrs[currart]]^.basesubject,1,32),'...',
right(articles[subjptrs[currart]]^.basesubject,8));
{$endif}
{$endif}
if not xfirstsubjg
(
currcanonfirstchar,
articles[subjptrs[currart]]^.canonfirstchar,
currsubj,
articles[subjptrs[currart]]^.basesubject
) then
begin
currsubjptr := currart;
currart := numarts;
end;
end;
thisthreadfirstfinalptr := finalptrsdone+1;
foundnewsubj := false;
while (finalptrsdone<numarts) and not foundnewsubj do
begin
{$ifdef testsort}
if showdebug('sort') then
begin
if currsubjptr>numarts then
writeln(debugf,'gone off the end! must be done this pass')
else
begin
if not subjseq(currsubj,
articles[subjptrs[currsubjptr]]^.basesubject) then
writeln(debugf,'method 1: found a new subject');
if not xsubjseq(currcanonfirstchar,
articles[subjptrs[currsubjptr]]^.canonfirstchar,
currsubj,
articles[subjptrs[currsubjptr]]^.basesubject) then
writeln(debugf,'method 2: found a new subject');
if subjseq(currsubj,
articles[subjptrs[currsubjptr]]^.basesubject)
<>
xsubjseq(currcanonfirstchar,
articles[subjptrs[currsubjptr]]^.canonfirstchar,
currsubj,
articles[subjptrs[currsubjptr]]^.basesubject) then
writeln(debugf,'ERROR method 1 and 2 disagree');
if xsubjseq(currcanonfirstchar,
articles[subjptrs[currsubjptr]]^.canonfirstchar,
currsubj,
articles[subjptrs[currsubjptr]]^.basesubject) then
begin
writeln(debugf,'found equal: 1=',
'(',currcanonfirstchar,')',currsubj);
writeln(debugf,' 2=','(',
articles[subjptrs[currsubjptr]]^.canonfirstchar,')',
articles[subjptrs[currsubjptr]]^.basesubject);
end;
end;
end;
{$endif}
if currsubjptr>numarts then
foundnewsubj := true
else if not xsubjseq
(
currcanonfirstchar,
articles[subjptrs[currsubjptr]]^.canonfirstchar,
currsubj,
articles[subjptrs[currsubjptr]]^.basesubject
) then
foundnewsubj := true
else
begin
{$ifdef testsort}
if revfinalptrs[subjptrs[currsubjptr]]<>-1 then
begin
writeln('already used subjptrs[',currsubjptr,']=',
subjptrs[currsubjptr]);
writeln(articles[subjptrs[currsubjptr]]^.basesubject);
halt(1);
end;
{$endif}
inc(finalptrsdone);
finalptrs[finalptrsdone] := subjptrs[currsubjptr];
inc(currsubjptr);
{$ifdef testsort}
if showdebug('sort') then
writeln(debugf,'subject matches--add #',
finalptrsdone,' ',finalptrs[finalptrsdone],', fn ',
articles[finalptrs[finalptrsdone]]^.filename);
{$endif}
end;
end;
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf,'currsubj=',currsubj);
writeln(debugf,'this chain, pre-ordering:');
for i := thisthreadfirstfinalptr to finalptrsdone do
write(debugf,finalptrs[i]:5,' ');
writeln(debugf);
for i := thisthreadfirstfinalptr to finalptrsdone do
write(debugf,articles[finalptrs[i]]^.filename:5,' ');
end;
{$endif}
for i := thisthreadfirstfinalptr to finalptrsdone-1 do
for j := i+1 to finalptrsdone do
if not firstartfirst(finalptrs[i],finalptrs[j]) then
swapi(finalptrs[i],finalptrs[j]);
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf);
writeln(debugf,'this chain, post-ordering:');
for i := thisthreadfirstfinalptr to finalptrsdone do
write(debugf,finalptrs[i]:5,' ');
writeln(debugf);
for i := thisthreadfirstfinalptr to finalptrsdone do
write(debugf,articles[finalptrs[i]]^.filename:5,' ');
writeln(debugf);
end;
{$endif}
{
notquiets('<');
}
{
for the longest time, I didn't have the ``dateptrs[i]>0'' test in
here, which was really stupid.
}
for i := 1 to numarts do
if dateptrs[i]>0 then
if xsubjseq
(
currcanonfirstchar,
articles[dateptrs[i]]^.canonfirstchar,
currsubj,
articles[dateptrs[i]]^.basesubject
) then
begin
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf,'>>>');
writeln(debugf,
'setting dateptrs[',i,'] to ',-dateptrs[i]);
writeln(debugf,' curr=',currsubj);
writeln(debugf,
' date=',articles[dateptrs[i]]^.basesubject);
writeln(debugf,'<<<');
end;
{$endif}
dateptrs[i] := -dateptrs[i];
end;
{
notquiets('>');
}
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf);
writeln(debugf,'----------------');
writeln(debugf);
end;
{$endif}
end;
end;
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf,'the whole thing, pre-sorted:');
for i := 1 to numarts do
writeln(debugf,finalptrs[i]:5,' ',
articles[finalptrs[i]]^.filename:5,' ',
articles[finalptrs[i]]^.basesubject);
writeln(debugf);
writeln(debugf,'----------------');
writeln(debugf);
for i := 1 to numarts do
begin
if (finalptrs[i]<1) or (finalptrs[i]>numarts) then
write(debugf,'ERROR: ');
writeln(debugf,'finalptrs[',i,']=',finalptrs[i]);
end;
{$endif}
for i := 1 to numarts do
revfinalptrs[i] := -1;
for i := 1 to numarts do
revfinalptrs[finalptrs[i]] := i;
{$ifdef testsort}
if showdebug('sort') then
for i := 1 to numarts do
writeln(debugf,'revfinalptrs[',i,']=',revfinalptrs[i]);
if showdebug('sort') then
writeln(debugf);
{$endif}
for i := 1 to numarts do
if revfinalptrs[i]<0 then
begin
writeln('ERROR: revfinalptrs[',i,']=',revfinalptrs[i]);
{$ifdef testsort}
if showdebug('sort') then
close(debugf);
{$endif}
halt(1);
end;
for i := 1 to numarts-1 do
if finalptrs[i]<>i then
begin
swapart(i,finalptrs[i]);
finalptrs[revfinalptrs[i]] := finalptrs[i];
revfinalptrs[finalptrs[i]] := revfinalptrs[i];
finalptrs[i] := i;
revfinalptrs[i] := i;
end;
{$ifdef testsort}
if showdebug('sort') then
begin
writeln(debugf,'the whole thing, sorted:');
for i := 1 to numarts do
writeln(debugf,i:5,' ',
articles[i]^.filename:5,' ',
articles[i]^.basesubject);
writeln(debugf);
writeln(debugf,'----------------');
writeln(debugf);
writeln('closing ',debugfn);
close(debugf);
end;
{$endif}
end;
procedure readinarts;
var
dotnewsreadernamedot: string;
highestseen: articlefilenametype;
wroteanything: boolean;
fileinfo: searchrec;
iscaughtup: boolean;
rewoundapage: boolean;
startedwhereleftoff: boolean;
morearticles: boolean;
subject: string;
from: string;
headerto: string;
newsgroups: string;
messageid: string;
references: string;
inreplyto: string;
basefilename: string;
filename: string;
filenum: articlefilenametype;
filesize: longint;
datestr: string;
mailgroup: boolean;
bufferedkey: char;
i: integer;
workwithit: boolean;
readnomore: boolean;
highestfile: articlefilenametype;
mangledsubject: string;
trysource: string;
trysourcekind: sourcetype;
upsearchtext: string;
worthalook: boolean;
catchupunreadlastpageignore: char;
ignorestring: string;
hasoverview: boolean;
waskilled: boolean;
wasantikilled: boolean;
function searchsubjname: boolean;
var
result: boolean;
begin {function searchsubjname}
result := false;
{only subject and from and date are known at the point this is called}
if not result then
if searchinsubj then
result := textintext(upsearchtext,upper(subject));
if not result then
if searchinname then
result := textintext(upsearchtext,upper(from));
searchsubjname := result;
end; {function searchsubjname}
procedure showarticleprefix(basefilename: string);
begin {showarticleprefix}
wroteanything := true;
if justdots then
xwrites('.')
else
xwrites(basefilename);
end; {showarticleprefix}
procedure showarticlesuffix;
begin {showarticlesuffix}
if not justdots then
if wanderingnumbers then
xwrites(' ')
else
xwritess(' ',^M);
end; {showarticlesuffix}
begin {procedure readinarts}
dotnewsreadernamedot := '.'+newsreadername+'.';
unscannedarts := false;
highestseen := 0;
wroteanything := false;
startedwhereleftoff := false;
if lowestartsearched=impossiblylargeart then
begin
if readpagesback<>0 then
lowestartsearched := lmax(alreadyread-readpagesback*sellpp,0)
else
begin
lowestartsearched := alreadyread;
startedwhereleftoff := true;
end;
end;
bufferedkey := ' ';
upsearchtext := upper(searchtext);
mailgroup := ismailgroup(currsource);
if not mailgroup then
if currsourcekind=sourcegroup then
if entergroupcommand<>'' then
begin
notquietlns('running '+entergroupcommand+' '+currdir);
execviacomspec(entergroupcommand+' '+currdir);
{}{}{}{}{ignore execresult?}
notquietlns('back from '+entergroupcommand);
end;
rewoundapage := false;
if mailagent and mailgroup then
begin
iscaughtup := true;
{note -- for mail groups, ignore the overview file}
findfirst(withbackslash(currdir)+articlefilenamepattern,
archive,fileinfo);
{empty folders don't count -- if we couldn't find even ONE file, ignore}
if doserror<>0 then
iscaughtup := false;
while (doserror=0) and iscaughtup do
begin
filenum := atol(fileinfo.name);
if (filenum>lowestartsearched) and isdigit(fileinfo.name[1]) then
iscaughtup := false;
findnext(fileinfo);
end;
if iscaughtup then
begin
rewoundapage := true;
readpagesback := 1;
lowestartsearched := lmax(alreadyread-readpagesback*sellpp,0);
if not quiet then
begin
xwrites('(1 page) ');
wroteanything := true;
end;
end;
end;
readpagesback := 0;
nextwhilereading := false;
readnomore := false;
highestart := 0;
highestfile := 0;
if mailgroup or (currsourcekind<>sourcegroup) then
readunfiltered := true;
if mailgroup then
antikilledonly := false;
if not dexists(currdir) then
xwritelnsss('directory ',currdir,' does not exist');
hasoverview := false;
{note -- for mail groups, ignore the overview file}
if currsourcekind=sourcegroup then
if not mailgroup then
begin
overviewreset(currdir);
if fileresult=0 then
begin
hasoverview := true;
notquietlns('(using overview file)');
end;
end;
if hasoverview then
begin
morearticles := not eofoverview;
end
else
begin
findfirst(withbackslash(currdir)+articlefilenamepattern,
archive,fileinfo);
morearticles := (doserror=0);
end;
while morearticles and
(numarts<allocatedarts) and
not nextwhilereading and
not readnomore do
begin
if xkeypressed then
begin
bufferedkey := xreadkey;
if bufferedkey='N' then
nextwhilereading := true
else if bufferedkey='O' then
readnomore := true
else if (bufferedkey='!') and trusted then
begin
shellout;
end
else if bufferedkey='Q' then
begin
{}{} {should it use confirmquit here?}
nextwhilereading := true;
needtofindnextgroup := false;
currsource := '';
end;
end;
if hasoverview then
readoverviewline;
if hasoverview then
basefilename := nextoverviewitem
else
basefilename := fileinfo.name;
filenum := atol(basefilename);
filename := withbackslash(currdir)+basefilename;
if filenum>highestseen then
highestseen := filenum;
worthalook := false;
if not nextwhilereading and not readnomore and
(filenum>lowestartsearched) and isdigit(basefilename[1]) then
worthalook := true;
{need date for searchthedate possibly}
subject := '(internal error)';
from := '(internal error)';
datestr := '(internal error)';
if worthalook then
begin
if hasoverview then
begin
subject := nextoverviewitem;
from := nextoverviewitem;
datestr := nextoverviewitem;
end
else
begin
subject := getheaderline(filename,'subject:');
from := getheaderline(filename,'from:');
datestr := getheaderline(filename,'date:');
end
end;
{+24 is to handle different time zones}
if worthalook and searchthedate then
begin
if (rfcdateheadertodate(datestr)<searchdatelow) or
(rfcdateheadertodate(datestr)>searchdatehigh+24) then
worthalook := false;
{if not worthalook, then it was just date-searching that took it out}
if not worthalook then
begin
showarticleprefix(basefilename);
xwrites('d');
showarticlesuffix;
end;
end;
if worthalook and (searchinsubj or searchinname) then
begin
worthalook := searchsubjname;
{if not worthalook, then it was just searching that took it out}
if not worthalook then
begin
showarticleprefix(basefilename);
if not highlightsearchhits then
xwrites('n');
showarticlesuffix;
end;
end;
if worthalook and (searchinheaders or searchinbody) then
begin
worthalook := false;
if searchinheaders then
worthalook := searchart(filename,upsearchtext,yesheadersearch);
{don't search body unless not found in headers}
if not worthalook and searchinbody then
worthalook := searchart(filename,upsearchtext,noheadersearch);
{if not worthalook, then it was just searching that took it out}
if not worthalook then
begin
showarticleprefix(basefilename);
if not highlightsearchhits then
xwrites('n');
showarticlesuffix;
end;
end;
if worthalook then
begin
messageid := '(internal error)';
references := '(internal error)';
if hasoverview then
begin
messageid := nextoverviewitem;
references := nextoverviewitem;
filesize := atol(nextoverviewitem);
ignorestring := nextoverviewitem; {lines}
{
get newsgroups if you can, but don't be drastic
and go to disk and search the article itself unless necessary
}
newsgroups := getoverviewheader('newsgroups:');
if (newsgroups='') and not readunfiltered then
newsgroups := getheaderline(filename,'newsgroups:');
end
else
begin
newsgroups := getheaderline(filename,'newsgroups:');
filesize := fileinfo.size;
end;
{some people put tabs in the Subject: line! ick!}
subject := expand(subject);
if highlightsearchhits then
begin
if searchinheaders or searchinbody or
searchinsubj or searchinname then
xhighvideo;
end;
showarticleprefix(basefilename);
if highlightsearchhits then
begin
if searchinheaders or searchinbody or
searchinsubj or searchinname then
xlowvideo;
end;
{if there's from and newsgroups, but no subject, keep it in search}
mangledsubject := nore(subject);
if (mangledsubject='') and (from<>'') and (newsgroups<>'') then
subject := 'No Subject - From '+from;
if readunfiltered and (filesize<>0) and (mangledsubject='') then
subject := 'No Subject - From '+from;
if (mangledsubject='') and missingsubjectisok then
subject := 'No Subject - From '+from;
waskilled := false;
wasantikilled := false;
workwithit := true;
{ if we can't find a subject at all, even a faked one, just ignore it }
if subject='' then
begin
workwithit := false;
xwrites('e');
end;
if workwithit and not readunfiltered then
begin
if alreadyseen(newsgroups) then
begin
workwithit := false;
xwrites('s');
end
else
begin
waskilled := artkilled(subject,from,'',filename);
workwithit := not waskilled;
if waskilled then
xwrites('k');
if antikillevenkilled then
workwithit := true;
end;
end;
if workwithit then
begin
{
might have to undo this if it was killed and not antikilled, or if
antikilled only but it wasn't antikilled
}
inc(numarts);
articles[numarts]^.filename := basefilename;
{
use mangledsubject instead of articles[numarts]^.basesubject to prevent
incorrect thread separation when Re: makes it go beyond subjstringt length
}
{ changed 'Re: ' to 'Re:' - a LOT of broken systems out there! }
mangledsubject := subject;
articles[numarts]^.indents := 0;
while upper(copy(mangledsubject,1,3))='RE:' do
begin
inc(articles[numarts]^.indents);
mangledsubject := ltrim(copy(mangledsubject,4,255));
end;
articles[numarts]^.basesubject := mangledsubject;
articles[numarts]^.canonfirstchar :=
canonicalfirstchar(articles[numarts]^.basesubject);
headerto := '';
if (from=mailfrom) or (from=newsfrom) then
headerto := getheaderline(filename,'to:');
if headerto=couldnotreadfilecookie then
headerto := '';
if ((from=mailfrom) or (from=newsfrom)) and (headerto<>'') then
begin
articles[numarts]^.from := trim(ltrim(getfromname(headerto)));
if articles[numarts]^.from='' then
articles[numarts]^.from := getfromaddr(headerto)
else if length(articles[numarts]^.from)<=8 then
articles[numarts]^.from :=
articles[numarts]^.from+', '+getfromaddr(headerto);
articles[numarts]^.from := 'To:'+articles[numarts]^.from;
end
else
begin
articles[numarts]^.from := trim(ltrim(getfromname(from)));
if articles[numarts]^.from='' then
articles[numarts]^.from := getfromaddr(from)
else if length(articles[numarts]^.from)<=8 then
articles[numarts]^.from :=
articles[numarts]^.from+', '+getfromaddr(from);
end;
{ if size is too big, just store 255, otherwise round up to nearest kilobyte }
if filesize>255*1024 then
articles[numarts]^.sizeink := 255
else
articles[numarts]^.sizeink :=
longint(filesize+1023) div longint(1024);
if not hasoverview then
datestr := getheaderline(filename,'date:');
articles[numarts]^.date := rfcdateheadertodate(datestr);
if not hasoverview then
messageid := getheaderline(filename,'message-id:');
sethash(articles[numarts]^.hmessageid,messageid);
if not hasoverview then
references := getheaderline(filename,'references:');
{ Andrew system non-compliance, looks like }
if not hasoverview then
begin
inreplyto := getheaderline(filename,'in-reply-to:');
inreplyto := getfirstw(inreplyto);
if length(references)+length(inreplyto)<250 then
if enclosedin(inreplyto,'<','>') then
if pos(inreplyto,references)=0 then
references := references+' '+inreplyto;
end;
{ don't wipe out Re:'s 1 with a 0 just because there's nothing in the header }
if numoccur('<',references)>0 then
articles[numarts]^.indents := numoccur('<',references);
if not mailgroup then
begin
if not readunfiltered then
if artkilled(subject,from,references,filename) then
waskilled := true;
{for use with auto-select key - start of antikill}
if antikillreferences then
if pos(fqdn,references)<>0 then
wasantikilled := true;
{ for author's use to make sure everything's working on other sites }
if not wasantikilled then
if antikillthisnewsreader then
if pos(dotnewsreadernamedot,messageid)<>0 then
wasantikilled := true
else if pos(oldnewsreadername,messageid)<>0 then
wasantikilled := true;
if not wasantikilled then
if artantikilled(subject,from,references,filename) then
wasantikilled := true;
if wasantikilled then
begin
articles[numarts]^.indents :=
articles[numarts]^.indents or 128;
xhighvideo;
xwrites('a');
xlowvideo;
end;
end;
if waskilled and not wasantikilled then
begin
{if was killed, only antikilling can bring it back}
dec(numarts);
end
else if antikilledonly and not wasantikilled then
begin
{if only antikilled to be shown, only antikilling can keep it}
dec(numarts);
end
else
begin
while numoccur('>',references)>numhashedrefs do
ignorestring := chopfirstw(references);
sethash(articles[numarts]^.hreferences[1],
chopfirstw(references));
sethash(articles[numarts]^.hreferences[2],
chopfirstw(references));
sethash(articles[numarts]^.hreferences[3],
chopfirstw(references));
sethash(articles[numarts]^.hreferences[4],
chopfirstw(references));
if filenum>highestart then
highestart := filenum;
end
end;
showarticlesuffix;
if not readnomore then
if filenum>highestfile then
highestfile := filenum;
end;
if hasoverview then
begin
morearticles := not eofoverview;
end
else
begin
findnext(fileinfo);
morearticles := (doserror=0);
end;
end;
if numarts=0 then
begin
if wroteanything then
xwriteln;
if nextwhilereading then
begin end
else if searchinheaders or
searchinbody or
searchthedate or
searchinsubj or
searchinname then
warn('no articles in selected range matched')
else
xwritelns('no new articles');
end
else if wanderingnumbers then
xwriteln;
if rewoundapage and (numarts<>0) and not nextwhilereading then
begin
warn2
(
'all mail from '+currsource,
'has been read. the last page will be shown'
);
end;
{if there's no files at ALL, that's close enough}
if (highestseen<>0) and (highestseen<alreadyread) and
not nextwhilereading and not readnomore and startedwhereleftoff then
begin
warn3
(
'there ARE articles for this group on disk, but none close to the',
'entry in your join file. you may want to check for re-sequenced',
'or missing news files.'
);
catchupunreadlastpageignore := onekeydef(
'{c}atch up, mark all as {u}nread, {l}ast page only, {i}gnore',
'culi','i');
xwriteln;
if catchupunreadlastpageignore='c' then
begin
warn('can only ignore or mark as unread now, sorry');
end
else if catchupunreadlastpageignore='u' then
begin
alreadyread := -1; {for updatejoin}
updatejoin(0);
alreadyread := 0;
end
else if catchupunreadlastpageignore='l' then
begin
warn('can only ignore or mark as unread now, sorry');
end
else
begin
{ignore}
end;
end;
{if all were read but filtered, show them as read to avoid scanning next time}
if
(numarts=0) and
not nextwhilereading and
not readnomore and
not antikilledonly and
not searchinheaders and
not searchinbody and
not searchthedate and
not searchinsubj and
not searchinname and
startedwhereleftoff then
updatejoin(highestfile);
readunfiltered := false;
antikilledonly := false;
searchinheaders := false;
searchinbody := false;
searchthedate := false;
searchinsubj := false;
searchinname := false;
lowestartsearched := impossiblylargeart;
if morearticles and (numarts>=allocatedarts) then
unscannedarts := true;
{handle 'G'oto while scanning already-read groups where O doesn't work}
if xkeypressed then
bufferedkey := xreadkey;
if bufferedkey='G' then
begin
trysource := '';
pickasource(trysource,trysourcekind);
xclreolxy(1,lpp);
if trysource<>'' then
begin
nextwhilereading := true;
currsource := trysource;
currsourcekind := trysourcekind;
needtofindnextgroup := false;
end;
end
else if bufferedkey='Q' then
begin
{}{} {should it use confirmquit here?}
nextwhilereading := true;
needtofindnextgroup := false;
currsource := '';
end;
if hasoverview then
closeoverview;
end; {procedure readinarts}
procedure groupinit;
begin { groupinit }
numarts := 0;
headerinmem := '';
highestread := 0;
currdir := '';
if currsourcekind=sourcegroup then
currdir := getgroupdir(currsource)
else if currsourcekind=sourcedir then
currdir := currsource
else if currsourcekind=sourcefolder then
warn('cannot yet <G>oto a folder');
if currdir='' then
begin
if haltonunknowngroups then
begin
xwritelns('could not find /dir= entry for this group - location of');
xwritelns(' news unknown. make sure you are using the new DEFAULT');
xwritelns(' lines instead of the old (v1.63 and lower) FORUM lines');
xwriteln;
xwritelns('also make sure you have not missed any forum sets if you');
xwritelns(' used the -s or --forum-set-list options');
shutdown(1);
end
else
begin
xwritelns('could not find directory for this group... continuing');
end;
end
else
begin
notquietlnss('searching directory ',currdir);
groupinitkills;
groupinitantikills;
end;
end;
end.