Super Net 1/SUPERNET_1.iso/PC/OTROS/EXTRAS/UUCODE/UUCP/RSNU106A.ZIP/src/rusnmain.pas

Pascal/Delphi Source File | 1994-04-12 | 50.1 KB | 1,980 lines

unit rusnmain;

{

rusnmain.pas - rusnews main (to keep from recompiling huge rusnews.pas)

}

{$I rusn-def.pas}

interface

uses dos,crt,rusngenf,rusnfunc,rusnglob,rusnselb,rusntime,rusnio,
  rusnproc,rusnkill

{$ifdef mouse}

,mouse   {the mouse unit I have is from Turbo Technix}

{$endif}

;


procedure shutdown(exitcode: integer);
procedure usage;
procedure defaultlppcols;

{$ifdef mouse}
procedure handler     { Mouse event handler called by device driver }
   (flags, cs, ip, ax, bx, cx, dx, si, di, ds, es, bp: word);
interrupt;
{$endif}

procedure fixuplppcols;
procedure sethash(var h: hashedt; s: string);
procedure backupjoin;
procedure swapi(var i,j: integer);
procedure swapart(a,b: integer);
procedure sortitall;
procedure readinarts;
procedure groupinit;
procedure findhighest;
procedure initialize;

implementation

procedure shutdown;

begin
  if joinfn<>'' then
    close(joinf);
  if haskillfile then
    close(killf);
  if hasantikillfile then
    close(antikillf);

{$ifdef mouse}

  if hasmouse then
    begin
      mhide;
      mreset(themouse);
    end;

{$endif}

  xgotoxy(1,lpp);
  xwriteln;
  if console then
    begin
      textattr := oldtextattr;
      xwriteln;
    end;
  halt(exitcode);
end;

procedure usage;

begin
  xwritelnsss('usage: ',newsreadername,' [options]');
  xwritelns('  -u --user %A');
  xwritelns('  -n --newsgroup c.b.w (jumps directly to that newsgroup)');
  xwritelns('  -p --port 0 (uses that fossil port - 0=COM1, 1=COM2)');
  xwritelns('  -f --fullname Full_Name (underscores will become spaces)');
  xwritelns('  -e --editor d:/path/editor.exe (uses this editor)');
  xwritelns('  -o --editor-options !_w:\user\%A (editor non-filename options)');
  xwritelns('  -s --forum-set-list local_usenet (uses these forum sets only)');
  xwritelns('  -t --trusted (allows dialin users to edit articles)');
  xwritelns('  -v --waffle-version %V (specifies waffle version)');
  xwritelns('  -m --minutes %O (specifies minutes online time)');
  xwritelns('  -d --shadow 1 (shadows all COMx output to console)');
  xwritelns('  -r --rcfile w:/waffle/lib/rusnews.opt (reads in options)');
  xwriteln;
  xwritelns('see documentation for other configuration options');
  xwriteln;
  xwritelns('[e-mail] (931208)');
  shutdown(1);
end;

{$ifdef mouse}

procedure handler;

begin
  mousevent.event     := ax;
  mousevent.btnstatus := bx;
  mousevent.horiz     := cx;
  mousevent.vert      := dx;
  inline (        { Exit processing for far return to device driver }
       $8B/$E5/            { MOV  SP, BP }
       $5D/                { POP  BP }
       $07/                { POP  ES }
       $1F/                { POP  DS }
       $5F/                { POP  DI }
       $5E/                { POP  SI }
       $5A/                { POP  DX }
       $59/                { POP  CX }
       $5B/                { POP  BX }
       $58/                { POP  AX }
       $CB );              { RETF    }
end;

{$endif}

procedure defaultlppcols;

begin
  if console then
    begin
      if detectvideo then
        begin
          lpp := mem[$40:$84]+1;
          cols := mem[$40:$4a];
        end
      else
        begin
          lpp := 25;
          cols := 80
        end;
    end
  else
    begin
      lpp := 24;
      cols := 80;
    end;

end;

procedure fixuplppcols;

begin
  lpp := max(minlpp,min(lpp,maxlpp));
  cols := max(mincols,min(cols,maxcols));

{26 letters+10 digits for toggles}

  sellpp := min(lpp-selheaderlines-4,36);
end;

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 - [e-mail] 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 backupjoin;

var
  s: string;
  tempf: text;
  createjoined: boolean;

begin
  xwritelns('Backing up join file...');
  createjoined := (numjoined=0);
  assign(tempf,home+'\join.bak');
  reset(joinf);
  rewrite(tempf);
  while not eof(joinf) do
    begin
      readln(joinf,s);
      writeln(tempf,s);
      if createjoined and (numjoined<maxjoined) then
        begin
          inc(numjoined);
          joinedgroups[numjoined] := getfirstw(s);
        end;
    end;
  close(tempf);
  reset(joinf);
end;

procedure swapi;

var
  t: integer;

begin
  t := i;
  i := j;
  j := t;
end;

procedure swapart;

var
  tempsubj: subjstringt;
  tempfilename: fnstringt;
  tempdate: datet;
  tempindents: byte;
  tempsizeink: byte;
  tempfrom: fromstringt;

{don't need to worry about hashing stuff - by this time, not needed}

begin
  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;

var
  i,j: integer;
  dateptrs,subjptrs,finalptrs,revfinalptrs: array[1..maxarts] of integer;
  dateptrsdone: integer;
  finalptrsdone: integer;
  finalstart: integer;
  currsubjptr: integer;
  foundnewsubj: boolean;
  currsubj: subjstringt;

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)}

  for i := 1 to numarts-1 do
    for j := i+1 to numarts do
      if (datesp^[dateptrs[i]]>datesp^[dateptrs[j]]) then
        swapi(dateptrs[i],dateptrs[j])
      else if ( (datesp^[dateptrs[i]]=datesp^[dateptrs[j]]) and
       firstsubjg(basesubjs[dateptrs[i]],basesubjs[dateptrs[j]]) ) then
        swapi(dateptrs[i],dateptrs[j]);

  for i := 1 to numarts do
    subjptrs[i] := i;

  for i := 1 to numarts-1 do
    for j := i+1 to numarts do
      if firstsubjg(basesubjs[subjptrs[i]],basesubjs[subjptrs[j]]) then
        swapi(subjptrs[i],subjptrs[j]);

{sort via finalptrs indirection to prevent extra swapping}

  dateptrsdone := 0;
  finalptrsdone := 0;
  while finalptrsdone<numarts do
    begin
      inc(dateptrsdone);

      if dateptrs[dateptrsdone]>0 then
        begin

          currsubj := basesubjs[dateptrs[dateptrsdone]];

          currsubjptr := 1;
          while firstsubjg(currsubj,basesubjs[subjptrs[currsubjptr]]) do
            inc(currsubjptr);

          finalstart := finalptrsdone+1;
          foundnewsubj := false;
          while (finalptrsdone<numarts) and not foundnewsubj do
            begin
              if subjseq(currsubj,basesubjs[subjptrs[currsubjptr]]) then
                begin
                  inc(finalptrsdone);
                  finalptrs[finalptrsdone] := subjptrs[currsubjptr];
                  inc(currsubjptr);
                end
              else
                foundnewsubj := true;
            end;

{$ifdef testsort}
write('now have: ');
for i := finalstart to finalptrsdone do
  write(finalptrs[i],' ');
writeln;
xwrites('pausing...');
xwritelns(xreadkey);
{$endif}

          for i := finalstart to finalptrsdone-1 do
            for j := i+1 to finalptrsdone do
              if not firstartfirst(finalptrs[i],finalptrs[j]) then
                swapi(finalptrs[i],finalptrs[j]);

          for i := 1 to numarts do
            if subjseq(basesubjs[dateptrs[i]],currsubj) then
              dateptrs[i] := -dateptrs[i];

        end;
    end;

  for i := 1 to numarts do
    revfinalptrs[finalptrs[i]] := i;

  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;

end;

procedure readinarts;

var
  sawanyclose: boolean;
  wroteanything: boolean;
  lowfilenum: word;
  fileinfo: searchrec;
  doserr: integer;
  subject: string;
  from: string;
  newsgroups: string;
  messageid: string;
  references: string;
  inreplyto: string;
  filename: string;
  filenum: word;
  datestr: string;
  bufferedkey: char;
  i: integer;
  workwithit: boolean;
  readnomore: boolean;
  highestfile: word;
  mangledsubject: string;
  mailgroup: boolean;
  waskilled: boolean;
  possgroup: string;

begin
  sawanyclose := false;
  wroteanything := false;
  if readallarts then
    lowfilenum := 0
  else if readpagesback<>0 then
    lowfilenum := max(alreadyread-readpagesback*sellpp,0)
  else
    lowfilenum := alreadyread;
  readallarts := false;
  readpagesback := 0;
  nextwhilereading := false;
  readnomore := false;
  highestart := 0;
  highestfile := 0;

  bufferedkey := ' ';

  findfirst(basedir+'*.*',archive,fileinfo);
  doserr := doserror;
  if doserr<>0 then
    sawanyclose := true;  {if there's no files at ALL, that's close enough}

  while (doserr=0) and (numarts<maxarts) 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;
              alreadyingroup := true;
              currgroup := '';
            end;
        end;

      filenum := atow(fileinfo.name);

      if (filenum>=lowfilenum) and
       (fileinfo.name[1]>='0') and (fileinfo.name[1]<='9') then
        sawanyclose := true;

      if not nextwhilereading and not readnomore and
       (filenum>lowfilenum) and
       (fileinfo.name[1]>='0') and (fileinfo.name[1]<='9') then
        begin

{some people put tabs in the Subject: line!  ick!}

          filename := basedir+fileinfo.name;
          subject := expand(getheaderline(filename,'subject:'));

          from := getheaderline(filename,'from:');
          newsgroups := getheaderline(filename,'newsgroups:');

          if justdots then
            xwrites('.')
          else
            xwrites(fileinfo.name);

          wroteanything := true;

{if there's from and newsgroups, but no subject, let it pass}

          if (subject='') and (from<>'') and (newsgroups<>'') then
            subject := '(No subject - please provide one)';

          mailgroup := ismailgroup(currgroup);

          if mailgroup and (subject='') then
            subject := '(No subject)';

          if (subject='') and missingsubjectisok then
            subject := '(No subject - please provide one)';

          waskilled := false;
          workwithit := true;

          if not mailgroup then
            begin
              if subject='' then
                begin
                  workwithit := false;
                  xwrites('e');
                end
              else if alreadyseen(newsgroups) then
                begin
                  workwithit := false;
                  xwrites('s');
                end
              else
                begin
                  workwithit := not subjkilled(subject);
                  if workwithit then
                    workwithit := not fromkilled(from);
                  waskilled := not workwithit;
                  if waskilled then
                    xwrites('k');
                  if antikillevenkilled then
                    workwithit := true;
                end;
            end;

          if workwithit then
            begin
              inc(numarts);
              filenamesp^[numarts] := fileinfo.name;

{ use mangledsubject instead of basesubjs[numarts] to prevent accidental }
{ thread separation when Re: makes it go beyond subjstringt length }

{ changed 'Re: ' to 'Re:' - a LOT of broken systems out there! }

              mangledsubject := subject;
              indents[numarts] := 0;
              while upper(copy(mangledsubject,1,3))='RE:' do
                begin
                  inc(indents[numarts]);
                  mangledsubject := ltrim(copy(mangledsubject,4,255));
                end;
              basesubjs[numarts] := mangledsubject;

              fromsp^[numarts] := trim(ltrim(getfromname(from)));
              if fromsp^[numarts]='' then
                fromsp^[numarts] := getfromaddr(from);

              if fileinfo.size>255*1024 then
                sizeink[numarts] := 255
              else
                sizeink[numarts] :=
                 longint(fileinfo.size+1023) div longint(1024);

              datestr := getheaderline(filename,'date:');
              datesp^[numarts] := stringtodate(datestr);

              messageid := getheaderline(filename,'message-id:');
              sethash(hmessageidsp^[numarts],messageid);

              references := getheaderline(filename,'references:');

{ Andrew system non-compliance, looks like }

              inreplyto := getheaderline(filename,'in-reply-to:');

{ needs to only grab up to the next > char}

              if length(references)+length(inreplyto)<250 then
                if copy(inreplyto,1,1)='<' then
                  references := references+' '+inreplyto;

{ don't wipe out data with a 0 just because there's nothing in the header }
              if numoccur('<',references)>0 then
                indents[numarts] := numoccur('<',references);

              if not mailgroup then
                begin

{for use with auto-select key - start of antikill}
                  if antikillreferences then
                    if pos(node,references)<>0 then
                      indents[numarts] := indents[numarts] or 128;

{for author's use to make sure everything's working}
                  if antikillthisnewsreader then
                    if pos(newsreadername,messageid)<>0 then
                      indents[numarts] := indents[numarts] or 128;

                  if indents[numarts]<128 then
                    if subjantikilled(subject) then
                      indents[numarts] := indents[numarts] or 128
                    else if fromantikilled(from) then
                      indents[numarts] := indents[numarts] or 128;

                  if (indents[numarts] and 128)<>0 then
                    xwrites('a');

                end;

              if (indents[numarts]<128) and waskilled then
                begin
{if was killed, only antikilling can bring it back}
                  dec(numarts);
                end
              else
                begin
                  while numoccur('>',references)>4 do
                    messageid := chopfirstw(references);

                  sethash(hreferencesp[1]^[numarts],chopfirstw(references));
                  sethash(hreferencesp[2]^[numarts],chopfirstw(references));
                  sethash(hreferencesp[3]^[numarts],chopfirstw(references));
                  sethash(hreferencesp[4]^[numarts],chopfirstw(references));

                  if filenum>highestart then
                    highestart := filenum;
                end

            end;

          if not justdots then
            if wanderingnumbers then
              xwrites(' ')
            else
              xwritess('     ',^M);

          if not readnomore then
            if filenum>highestfile then
              highestfile := filenum;
        end;
      findnext(fileinfo);
      doserr := doserror;
    end;

  if numarts=0 then
    begin
      if wroteanything then
        xwriteln;
      xwritelns('no new articles');
    end
  else if wanderingnumbers then
    xwriteln;

  if not sawanyclose and not nextwhilereading and not readnomore then
    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');

{if all were read but filtered, show them as read to avoid scanning next time}

  if (numarts=0) and not nextwhilereading and not readnomore then
    updatejoin(highestfile);

  if (doserr=0) and (numarts=maxarts) then
    begin
      warn('not all articles read in!');
    end;

{handle 'G'oto while scanning already-read groups where O doesn't work}

  if xkeypressed then
    bufferedkey := xreadkey;

  if bufferedkey='G' then
    begin
      possgroup := '';
      pickagroup(possgroup);
      xclreolxy(1,lpp);
      if possgroup<>'' then
        begin
          nextwhilereading := true;
          currgroup := possgroup;
          alreadyingroup := true;
        end;
    end;

end;

procedure groupinit;

procedure groupinitkills;

var
  s: string;
  killgroup: string;
  inglobals: boolean;
  killline: integer;
  sizewarned: boolean;

function killeof: boolean;

begin
  if killfileinmem then
    killeof := (killline>=numkills)
  else
    killeof := eof(killf);
end;

function nextkillline: killstringt;

var
  s: string;

begin
  if killfileinmem then
    begin
      inc(killline);
      nextkillline := killtextp^[killline];
    end
  else
    begin
      readln(killf,s);
      nextkillline := s;
    end;
end;

begin

{read in kill file for this group}

  numsubjks := 0;
  numfromks := 0;
  nonglobalkills := false;

  killline := 0;
  inglobals := true;

  sizewarned := false;

  if haskillfile then
    begin
      if not killfileinmem then
        begin
          if not quiet then
            xwritelns('reading in kill file...');
          reset(killf);
        end;

{allow defaults to come before the first Newsgroups line}

      killgroup := currgroup;
      while not killeof do
        begin
          s := nextkillline;

{if it's a new Newsgroups: selection, then check it - otherwise, process}

          if parseheadername(s)='Newsgroups' then
            begin
              killgroup := parseheadervalue(s);
              inglobals := false;
            end
          else if killgroup=currgroup then
            begin

              if showsubjectkills and showfromkills then
                xwritelnss('kill: ',s)
              else
                begin
                  if showsubjectkills then
                    if parseheadername(s)='Subject' then
                      xwritelnss('kill: ',s);
                  if showfromkills then
                    if parseheadername(s)='From' then
                      xwritelnss('kill: ',s);
                end;

              if parseheadername(s)='Subject' then
                begin
                  if numsubjks<maxkills then
                    begin
                      inc(numsubjks);
                      killsubjsp^[numsubjks] := parseheadervalue(s);
                      if not inglobals then
                        nonglobalkills := true;
                    end
                  else
                    begin
{}{} {too many subject kills - ignore}
{}{} {should discard the oldest one}
                      if not sizewarned then
                        warn('kill file is larger than memory allows');
                      sizewarned := true;
                    end;
                end
              else if parseheadername(s)='From' then
                begin
                  if numfromks<maxkills then
                    begin
                      inc(numfromks);
                      killfromsp^[numfromks] := parseheadervalue(s);
                      if not inglobals then
                        nonglobalkills := true;
                    end
                  else
                    begin
{}{} {too many from kills - ignore}
{}{} {should discard the oldest one}
                      if not sizewarned then
                        warn('kill file is larger than memory allows');
                      sizewarned := true;
                    end;
                end
              else
                begin
{}{} {invalid entry in kill file}
                  warn('unrecognizable entry in kill file');
                  warn(copy(s,1,40));
                end;
            end;
        end;
    end;
end;

procedure groupinitantikills;

var
  s: string;
  antikillgroup: string;
  inglobals: boolean;
  antikillline: integer;
  sizewarned: boolean;

function antikilleof: boolean;

begin
  if antikillfileinmem then
    antikilleof := (antikillline>=numantikills)
  else
    antikilleof := eof(antikillf);
end;

function nextantikillline: killstringt;

var
  s: string;

begin
  if antikillfileinmem then
    begin
      inc(antikillline);
      nextantikillline := antikilltextp^[antikillline];
    end
  else
    begin
      readln(antikillf,s);
      nextantikillline := s;
    end;
end;

begin

{read in antikill file for this group}

  numsubjaks := 0;
  numfromaks := 0;
  nonglobalantikills := false;

  antikillline := 0;
  inglobals := true;

  sizewarned := false;

  if hasantikillfile then
    begin
      if not antikillfileinmem then
        begin
          if not quiet then
            xwritelns('reading in antikill file...');
          reset(antikillf);
        end;

{allow defaults to come before the first Newsgroups line}

      antikillgroup := currgroup;
      while not antikilleof do
        begin
          s := nextantikillline;

{if it's a new Newsgroups: selection, then check it - otherwise, process}

          if parseheadername(s)='Newsgroups' then
            begin
              antikillgroup := parseheadervalue(s);
              inglobals := false;
            end
          else if antikillgroup=currgroup then
            begin

              if showsubjectantikills and showfromantikills then
                xwritelnss('antikill: ',s)
              else
                begin
                  if showsubjectantikills then
                    if parseheadername(s)='Subject' then
                      xwritelnss('antikill: ',s);
                  if showfromantikills then
                    if parseheadername(s)='From' then
                      xwritelnss('antikill: ',s);
                end;

              if parseheadername(s)='Subject' then
                begin
                  if numsubjaks<maxkills then
                    begin
                      inc(numsubjaks);
                      antikillsubjsp^[numsubjaks] := parseheadervalue(s);
                      if not inglobals then
                        nonglobalantikills := true;
                    end
                  else
                    begin
{}{} {too many subject antikills - ignore}
{}{} {should discard the oldest one}
                      if not sizewarned then
                        warn('antikill file is larger than memory allows');
                      sizewarned := true;
                    end;
                end
              else if parseheadername(s)='From' then
                begin
                  if numfromaks<maxkills then
                    begin
                      inc(numfromaks);
                      antikillfromsp^[numfromaks] := parseheadervalue(s);
                      if not inglobals then
                        nonglobalantikills := true;
                    end
                  else
                    begin
{}{} {too many from antikills - ignore}
{}{} {should discard the oldest one}
                      if not sizewarned then
                        warn('antikill file is larger than memory allows');
                      sizewarned := true;
                    end;
                end
              else
                begin
{}{} {invalid entry in antikill file}
                  warn('unrecognizable entry in antikill file');
                  warn(copy(s,1,40));
                end;
            end;
        end;
    end;
end;

begin
  numarts := 0;
  headerinmem := '';
  highestread := 0;

  basedir := getbasedir(currgroup);
  if basedir='' 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
      if not quiet then
        xwritelnss('news directory=',basedir);

      groupinitkills;
      groupinitantikills;
    end;
end;

procedure findhighest;

const
  impossiblealreadyread=65535;
    {note: a word variable, needs to change to maxlongint}

var
  s: string;

begin
  reset(joinf);
  alreadyread := impossiblealreadyread;
  while (alreadyread=impossiblealreadyread) and not eof(joinf) do
    begin
      readln(joinf,s);
      if getfirstw(s)=currgroup then
        alreadyread := getalreadyread(s);
    end;

{ only needed for initial single-group stuff }

  if alreadyread=impossiblealreadyread then
    begin
      xwritelnss('not joined to ',currgroup);
      shutdown(1);
    end;

{ end of only needed part }

end;

procedure initialize;

var
  currparmi: integer;
  currparm: string;
  nextparm: string;
  colors: string;
  optf: text;
  opttag: string;
  optval: string;
  gotogroup: boolean;
  ch: char;

function handleoption(tag, value: string): boolean;

var
  usedarg: boolean;

procedure handlemap(cmdline: string);

var
  where: string;
  oldkey,newkey: char;
  newcmdline: string;

function whatch: char;

var
  result: char;
  donescan: boolean;

begin
  result := chr(0);
  if length(newcmdline)>0 then
    begin
      if (newcmdline[1]='\') and (length(newcmdline)>1) then
        begin
          result := newcmdline[2];
          newcmdline := chop(newcmdline,2);  {get rid of it and the backslash}
        end
      else if (newcmdline[1]='=') and (length(newcmdline)>1) then
        begin
          newcmdline := chop(newcmdline,1);  {get rid of the equals}
          donescan := false;
          while not donescan do
            begin
              if length(newcmdline)=0 then
                donescan := true     {no more to see}
              else if (newcmdline[1]<'0') or (newcmdline[1]>'9') then
                donescan := true     {no more digits, anyway}
              else
                begin
                  result := chr(10*ord(result)+ord(newcmdline[1])-ord('0'));
                  newcmdline := chop(newcmdline,1);   {get rid of digit}
                end;
            end;
        end
      else
        begin
          result := newcmdline[1];
          newcmdline := chop(newcmdline,1);
        end;
    end;
  whatch := result;
end;

begin
  newcmdline := cmdline;
  newkey := chr(0);
  oldkey := chr(0);
  where := chopfirstw(newcmdline);
  newcmdline := ltrim(newcmdline);
  oldkey := whatch;
  newcmdline := ltrim(newcmdline);
  newkey := whatch;

  if (oldkey<>chr(0)) and (newkey<>chr(0)) then
    begin
      if where='browse' then
        begin
          browsemap[oldkey] := newkey;
        end
      else if where='select' then
        begin
          selmap[oldkey] := newkey;
        end
      else if where='both' then
        begin
          browsemap[oldkey] := newkey;
          selmap[oldkey] := newkey;
        end
      else if where='main' then
        begin
          mainmap[oldkey] := newkey;
        end
      else
        begin
          warn('weird use of map - ignored');
        end;
    end
  else
    begin
      warn('weird use of map - ignored');
    end;
end;

begin
  usedarg := false;
  if tag='--map' then
    begin
      handlemap(value);
    end
  else if (tag='-u') or (tag='--user') then
    begin
      userid := value;
      usedarg := true;
    end
  else if (tag='-n') or (tag='--newsgroup') then
    begin
      currgroup := value;
      if currgroup<>'' then
        alreadyingroup := true;
      usedarg := true;
    end
  else if (tag='-g') or (tag='--goto') then
    begin
      gotogroup := true;
      if copy(value,1,1)<>'-' then
        begin
          currgroup := value;
          usedarg := true;
        end;
    end
  else if (tag='-p') or (tag='--port') then
    begin
      console := false;
      port := atoi(value);
      trusted := false;
      usedarg := true;
    end
  else if tag='--console' then
    begin
      console := true;
      port := -1;
      trusted := true;
      minutes := maxint;
    end
  else if (tag='-l') or (tag='--lines') then
    begin
      lpp := atoi(value);
    end
  else if (tag='-c') or (tag='--columns') then
    begin
      cols := atoi(value);
    end
  else if (tag='-f') or (tag='--fullname') then
    begin
      fullname := trim(ununderscore(value));
      usedarg := true;
    end
  else if (tag='-e') or (tag='--editor') then
    begin
      editor := value;
      usedarg := true;
    end
  else if (tag='-o') or (tag='--editor-options') then
    begin
      editoroptions := ununderscore(value);
      usedarg := true;
    end
  else if (tag='-s') or (tag='--forum-set-list') then
    begin
      forumsetl := ununderscore(value);
      usedarg := true;
    end
  else if (tag='-t') or (tag='--trusted') then
    begin
      trusted := true;
    end
  else if (tag='-v') or (tag='--waffle-version') then
    begin
      waffleversion := value;
      usedarg := true;
    end
  else if (tag='-m') or (tag='--minutes') then
    begin
      minutes := atoi(value);
      usedarg := true;
    end
  else if (tag='-d') or (tag='--shadow') then
    begin
      shadow := atoi(value);
      usedarg := true;
    end
  else if (tag='-r') or (tag='--rcfile') then
    begin
      optfn := unslash(value);
      usedarg := true;
    end
  else if tag='--vspeller' then
    begin
      vspeller := unslash(value);
      usedarg := true;
    end
  else if tag='--vspeller-options' then
    begin
      vspelleroptions := ununderscore(value);
      usedarg := true;
    end
  else if tag='--subjects-case-insensitive' then
    begin
      subjectscaseinsensitive := true;
    end
  else if tag='--subject-length' then
    begin
      if atoi(value)>0 then
        subjectlength := atoi(value);
      usedarg := true;
    end
  else if tag='--make-space-like-x' then
    begin
      makespacelikex := true;
    end
  else if tag='--make-return-like-asterisk' then
    begin
      handlemap('select =13 *');
    end
  else if tag='--hide-these-headers' then
    begin
      hideheaders := upper(value);
      usedarg := true;
    end
  else if tag='--show-only-these-headers' then
    begin
      showheaders := upper(value);
      usedarg := true;
    end
  else if tag='--highlight-these-headers' then
    begin
      highlightheaders := upper(value);
      usedarg := true;
    end
  else if tag='--wandering-numbers' then
    begin
      wanderingnumbers := true;
    end
  else if tag='--antikill-references' then
    begin
      antikillreferences := true;
    end
  else if tag='--show-subject-kills' then
    begin
      showsubjectkills := true;
    end
  else if tag='--show-from-kills' then
    begin
      showfromkills := true;
    end
  else if tag='--show-subject-antikills' then
    begin
      showsubjectantikills := true;
    end
  else if tag='--show-from-antikills' then
    begin
      showfromantikills := true;
    end
  else if tag='--auto-antikill' then
    begin
      autoantikill := true;
    end
  else if tag='--warn-auto-antikill' then
    begin
      warnautoantikill := true;
    end
  else if tag='--edit-after-vspell' then
    begin
      editaftervspell := true;
    end
  else if tag='--case-insensitive-kill' then
    begin
      caseinsensitivekill := true;
    end
  else if tag='--case-insensitive-antikill' then
    begin
      caseinsensitiveantikill := true;
    end
  else if tag='--substring-subject-kill' then
    begin
      substringsubjectkill := true;
    end
  else if tag='--substring-from-kill' then
    begin
      substringfromkill := true;
    end
  else if tag='--substring-subject-antikill' then
    begin
      substringsubjectantikill := true;
    end
  else if tag='--substring-from-antikill' then
    begin
      substringfromantikill := true;
    end
  else if tag='--quiet' then
    begin
      quiet := true;
    end
  else if tag='--ignore-environment' then
    begin
      ignoreenvironment := true;
    end
  else if tag='--confirm-next' then
    begin
      confirmnext := true;
    end
  else if tag='--confirm-quit' then
    begin
      confirmquit := true;
    end
  else if tag='--missing-subject-is-ok' then
    begin
      missingsubjectisok := true;
    end
  else if tag='--tilde-home' then
    begin
      tildehome := true;
    end
  else if tag='--antikill-this-newsreader' then
    begin
      antikillthisnewsreader := true;
    end
  else if tag='--clear-screen-between-groups' then
    begin
      clearscreenbetweengroups := true;
    end
  else if tag='--detect-video' then
    begin
      detectvideo := true;
      defaultlppcols;
    end
  else if tag='--antikill-even-killed' then
    begin
      antikillevenkilled := true;
    end
  else if tag='--mail-prefix' then
    begin
      mailprefix := value;
      usedarg := true;
    end
  else if tag='--ignore-mouse' then
    begin
      ignoremouse := true;
    end
  else if tag='--use-bios-for-screen' then
    begin
      usebiosforscreen := true;
    end
  else if tag='--hide-form-feeds' then
    begin
      hideformfeeds := true;
    end
  else if tag='--path-userid' then
    begin
      pathuserid := value;
      usedarg := true;
    end
  else if tag='--custom-static' then
    begin
      customstatic := value;
      usedarg := true;
    end
  else if tag='--halt-on-unknown-groups' then
    begin
      haltonunknowngroups := true;
    end
  else if tag='--mouse-chars-header' then
    begin
      mousecharsheader := value;
      usedarg := true;
    end
  else if tag='--just-dots' then
    begin
      justdots := true;
    end
  else if tag='--no-filemode' then
    begin
      nofilemode := true;
    end
{$ifdef uupc}
  else if tag='--uupc-mode' then
    begin
      uupcmode := true;
    end
{$endif}
  else
    begin


{$ifdef ignoreoldoptions}

{ compatability switch with earlier releases - now obsolete }

{try to make sure any error messages are going to be visible!}

      console := true;
      xwritesss(newsreadername,' ',newsreaderversion);
      xwritelnss(': unknown option: ',tag);
      usage;  {usage shuts down}

{$else}

      userid := tag;
      xwritelns('warning: obsolete usage of userid on the command line');
      xwritelns('use -u/--user instead');

{$endif}

    end;

  handleoption := usedarg;

end;

begin
  randomize;
  new(filenamesp);
  new(fromsp);
  new(datesp);
  new(killsubjsp);
  new(killfromsp);
  new(killtextp);
  new(antikillsubjsp);
  new(antikillfromsp);
  new(antikilltextp);
  new(hmessageidsp);
  new(hreferencesp[1]);
  new(hreferencesp[2]);
  new(hreferencesp[3]);
  new(hreferencesp[4]);
  userid := '';
  currgroup := '';
  forumsetl := '';
  waffleversion := '';

{set up things for clean shutdowns}

  haskillfile := false;
  hasantikillfile := false;
  killfileinmem := false;
  antikillfileinmem := false;
  joinfn := '';
  if console then
    oldtextattr := textattr;

{$ifdef tiny}
  console := false;
  port := 0;
  trusted := false;
  minutes := 60;
{$else}
  console := true;
  port := -1;
  trusted := true;
  minutes := maxint;
{$endif}

  fullname := '';
  editor := '';
  editoroptions := '';
  vspeller := '';
  vspelleroptions := '';
  shadow := 0;
  optfn := '';

  subjectscaseinsensitive := false;
  subjectlength := 50;
  makespacelikex := false;
  hideheaders := '';
  showheaders := '';
  highlightheaders := upper(':Subject:From:Date:');
  wanderingnumbers := false;
  antikillreferences := false;
  showsubjectkills := false;
  showfromkills := false;
  showsubjectantikills := false;
  showfromantikills := false;
  autoantikill := false;
  warnautoantikill := false;
  editaftervspell := false;
  caseinsensitivekill := false;
  caseinsensitiveantikill := false;
  substringsubjectkill := false;
  substringfromkill := false;
  substringsubjectantikill := false;
  substringfromantikill := false;
  quiet := false;
  ignoreenvironment := false;
  confirmnext := false;
  confirmquit := false;
  missingsubjectisok := false;
  tildehome := false;
  antikillthisnewsreader := false;
  clearscreenbetweengroups := false;
  detectvideo := false;
  antikillevenkilled := false;
  mailprefix := '';
  ignoremouse := false;
  usebiosforscreen := false;
  hideformfeeds := false;
  pathuserid := '';
  customstatic := '';
  haltonunknowngroups := false;
  mousecharsheader := '< > ^ $ * - + Q N @ ~ Z G ''';
  justdots := false;
  nofilemode := false;
{$ifdef uupc}
  uupcmode := false;
{$endif}

  alreadyingroup := false;
  readallarts := false;
  readpagesback := 0;

  gotogroup := false;

  lastfilen := '';

  defaultlppcols;

  for ch := chr(0) to chr(255) do
    begin
      browsemap[ch] := ch;
      selmap[ch] := ch;
      mainmap[ch] := ch;
    end;

  currparmi := 1;
  while currparmi<=paramcount do
    begin
      currparm := paramstr(currparmi);
      if currparmi<paramcount then
        nextparm := paramstr(currparmi+1)
      else
        nextparm := '';

      if handleoption(currparm,nextparm) then
        inc(currparmi);

      inc(currparmi);

    end;

  if optfn<>'' then
    begin

{waste of time - tpascal doesn't use filemode on text files!}

      oldfilemode := filemode;
      if not nofilemode then
        filemode := $40;   {read only, deny none}

      assign(optf,optfn);
      {$I-}
      reset(optf);
      {$I+}
      if ioresult<>0 then
        begin
          console := true;
          xwritelnss('could not open option file ',optfn);
          shutdown(1);
        end;
      optfn := '';
      while not eof(optf) do
        begin
          readln(optf,optval);
          opttag := chopfirstw(optval);
          if length(opttag)>0 then
            if opttag[1]<>'#' then
              begin
                if opttag[1]<>'-' then
                  opttag := '--'+opttag;
                if handleoption(opttag,optval) then
                  ;
              end;
        end;
      close(optf);

      filemode := oldfilemode;

      if optfn<>'' then
        xwritelns('cannot use -r/--rcfile inside an rcfile, sorry');
    end;

  if usebiosforscreen then
    directvideo := false;

{try to make sure any error messages are going to be visible!}

  if not console and (port<>0) and (port<>1) and (port<>2) and (port<>3) then
    begin
      console := true;
      xwritelns('error: -p/--port specified without valid port number');
      xwritelns('  valid numbers are 0 (COM1) and 1 (COM2)   (2=COM3 and');
      xwritelns('  3=COM4 allowed, your fossil may not support them)');
      shutdown(1);
    end;

{$ifdef debug}
  xwritelns('parameters:');
  for currparmi := 1 to paramcount do
    xwritelns(paramstr(currparmi));
{$endif}

  xwritelnsss(newsreadername,' ',newsreaderversion);

  if (userid='') and not ignoreenvironment then
    userid := lower(getenv('NET_NAME'));
  if (userid='') and not ignoreenvironment then
    userid := lower(getenv('USER'));

  if userid='' then
    usage;

  xwritelnss('user: ',userid);

  if pathuserid='' then
    pathuserid := userid;

  wafenv := getenv('WAFFLE');
  if wafenv='' then
    begin
{$ifdef nowaffle}
      xwritelns('no WAFFLE environment variable - using `./static''.');
      wafenv := './static';
{$else}
      xwritelns('must set WAFFLE environment variable');
      shutdown(1);
{$endif}
    end;

  wafenv := unslash(wafenv);

  if (waffleversion='') and not ignoreenvironment then
    waffleversion := getenv('WAFFLEVERSION');
  if waffleversion='' then
    waffleversion := getstaticvalue('version');
  if waffleversion='' then
    waffleversion := '1.64';
  if (length(waffleversion)<>4) or (copy(waffleversion,2,1)<>'.') or
   (numoccur('.',waffleversion)<>1) then
    begin
      xwritelns('WAFFLEVERSION environment variable, or static file version:');
      xwritelns('setting, or -v/--waffle-version argument in wrong format');
      xwritelns('should be similar to `1.64'' (without the quotes)');
      xwritelnsss('it is currently set to: `',waffleversion,'''');
      shutdown(1);
    end;

  if not quiet then
    xwritelnss('waffle version: ',waffleversion);

  temporarydir := getstaticvalue('temporary');
  if not ignoreenvironment then
    begin
      temporarydir := default(getenv('TMP'),temporarydir);
      temporarydir := default(getenv('TEMP'),temporarydir);
    end;
  temporarydir := default('.',temporarydir);
  temporarydir := unslash(temporarydir);

  waffledir := getstaticvalue('waffle');
  if waffledir='' then
    waffledir := copy(wafenv,1,rposc(wafenv,'\')-1);
  waffledir := unslash(waffledir);

  spooldir := unslash(default(waffledir+'/spool',getstaticvalue('spool')));
  userdir := unslash(default(waffledir+'/user',getstaticvalue('user')));
  outboxdir := unslash(default(spooldir+'/outbox',getstaticvalue('outbox')));

  if fullname='' then
    begin
      if waffleversion='1.64' then
        fullname := trim(getpwinfo164(5))
      else if waffleversion>='1.65' then
        fullname := trim(getpwinfo165(3))
      else
        xwritelns(
        'only Waffle 1.64 and 1.65 (and beyond) password file formats known');
    end;
  if (fullname='') and not ignoreenvironment then
    fullname := trim(ununderscore(getenv('FULLNAME')));
  if fullname='' then
    begin
      xwritelnsss('user ',userid,' has no name in the password file');
      xwritelns('  that can be found, and environment variable FULLNAME');
      xwritelns('  not set, and option -f/--fullname not used');
      shutdown(1);
    end;

  if not quiet then
    xwritelnss('full name: ',fullname);

{}{} {needs to get editor entry from password and extern/_editors files}

  if (editor='') and not ignoreenvironment then
    editor := getenv('VISUAL');
  if (editor='') and not ignoreenvironment then
    editor := getenv('EDITOR');
  if editor='' then
    editor := 'vi.exe';

  if not quiet then
    xwritelnss('editor: ',editor);

  if (vspeller='') and not ignoreenvironment then
    vspeller := getenv('VSPELL');
  if (vspeller='') and not ignoreenvironment then
    vspeller := getenv('SPELL');
  if vspeller='' then
    vspeller := 'vspell.exe';

  if not quiet then
    xwritelnss('vspeller: ',vspeller);

  if not quiet then
    xwritelnsi('minutes left: ',minutes);

  uucpname := getstaticvalue('uucpname');
  node := getstaticvalue('node');
  smarthost := getstaticvalue('smarthost');
  organ := getstaticvalue('organ');
  netmail := getstaticvalue('netmail');
  netnews := getstaticvalue('netnews');
  replyto := getstaticvalue('replyto');
  newsname := default(uucpname,getstaticvalue('newsname'));

  if (uucpname='') or (smarthost='') or (organ='') then
    begin
      xwritelns('invalid uucpname, smarthost, or organ static variable');
      xwritelns('  none of these can be empty');
      xwritelns('  current values:');
      xwritelnss('  uucpname:  ',uucpname);
      xwritelnss('  smarthost: ',smarthost);
      xwritelnss('  organ:     ',organ);
      shutdown(1);
    end;

  if mailprefix='' then
    mailprefix := uucpname+'.mail';

{make life easier later - redefine mailprefix to include userid}

  mailprefix := mailprefix+'.'+userid;

  if not quiet then
    xwritelnss('mail groups begin with ',mailprefix);

  if netmail='' then
    netmail := '%A@%n (%W)';
  if netnews='' then
    netnews := netmail;

  mailfrom := wafexpand(netmail);
  newsfrom := wafexpand(netnews);
  if replyto<>'' then
    replyto := wafexpand(replyto);

  if (numoccur('.',node)=0) or (numoccur('@',newsfrom)<>1) or
   (numoccur('@',mailfrom)>1) or (numoccur('@',replyto)>1) or
   ( (numoccur('@',mailfrom)=0) and (numoccur('!',mailfrom)=0) ) then
    begin
      xwritelns('invalid node: or netmail:/netnews:/replyto: static entry');
      xwritelns('  the node entry needs at least one "."');
      xwritelns('  the netmail entry needs one "@" and/or at least one "!"');
      xwritelns('  the netnews entry needs one "@"');
      xwritelns('  the replyto entry (if any) can have at most one "@"');
      xwriteln;
      xwritelns('current settings:');
      xwritelnss('  node:     ',node);
      xwritelnss('  newsfrom: ',newsfrom);
      xwritelnss('  mailfrom: ',mailfrom);
      xwritelnss('  replyto:  ',replyto);
      shutdown(1);
    end;

  if not quiet then
    xwritelnss('mail from: ',mailfrom);
  if mailfrom<>newsfrom then
    if not quiet then
      xwritelnss('news from: ',newsfrom);
  if replyto<>'' then
    if not quiet then
      if replyto=mailfrom then
        xwritelnss('reply-to: ','(same as mail)')
      else if replyto=newsfrom then
        xwritelnss('reply-to: ','(same as news)')
      else
        xwritelnss('reply-to: ',replyto);

  if forumsetl='' then
    forumsetl := getstaticvalue('forums');

  forumsetl := ltrim(trim(forumsetl));

  if forumsetl='' then
    begin
      xwritelns('empty forum set list');
      shutdown(1);
    end;

  if not quiet then
    xwritelnss('forum set list: ',forumsetl);

  if not ignoreenvironment then
    timezone := getenv('TZ');

  if timezone='' then
    timezone := getstaticvalue('timezone');
  if timezone='' then
    timezone := 'MST';
  if pos(' ',timezone)>1 then
    timezone := copy(timezone,1,pos(' ',timezone)-1)
  else if (timezone[1]<>'+') and (timezone[1]<>'-') then
    timezone := copy(timezone,1,3);
{ handles TZ=GMT0BST and TZ=+1100 and TZ=BST-1 cases }

  if not quiet then
    xwritelnss('timezone: ',timezone);

{once joinfn is assigned to a nonempty string, it's open}

  home := userdir+'\'+userid;
  joinfn := home+'\join';
  assign(joinf,joinfn);
  {$I-}
  reset(joinf);
  {$I+}
  if ioresult<>0 then
    begin
      xwritelnsss('join file ',joinfn,' not found.');
      joinfn := '';
      shutdown(1);
    end;

  numjoined := 0;
  backupjoin;

  readinkill(true);
  readinantikill(true);

  if currgroup<>'' then
    if not joinedtogroup(currgroup) then
      begin
        xwritelnsss('not joined to ',currgroup,
         ' - starting at top of join file');
        currgroup := '';
        alreadyingroup := false;
      end;

  minstart := mitoday;

  fixuplppcols;

  if not quiet then
    begin
      xwritelnsi('lines per page: ',lpp);
      xwritelnsi('sel lines per page: ',sellpp);
      xwritelnsi('columns: ',cols);
      if usebiosforscreen then
        xwritelns('(using bios for screen writes)');
      if hideformfeeds then
        xwritelns('(hiding form feeds)');
    end;

{$ifdef mouse}

  hasmouse := false;

{$endif}

  if console then
    begin

      oldtextattr := textattr;
      lowcolor := 7;
      highcolor := 15;
      colors := getstaticvalue('colors');
      if colors='' then
        colors := getstaticvalue('colours');
      if colors<>'' then
        begin
          lowcolor := atoi(chopfirstw(colors));
          highcolor := atoi(getfirstw(colors));
        end;
      if (lowcolor mod 16)=(highcolor mod 16) then
        if (lowcolor mod 16)=7 then
          highcolor := 15
        else
          lowcolor := 7;
      xlowvideo;

{$ifdef mouse}

      if not ignoremouse then
        begin
          mreset(themouse);
          hasmouse := themouse.exists;
        end;

      if hasmouse then
        begin

          minsttask($14,seg(handler),ofs(handler));
          mousevent.event := 0;
          mshow;
        end;

{$endif}

    end;

  if gotogroup then
    begin

{ make sure last line had no valuable information }
      xgotoxy(1,lpp);
      xwriteln;

      pickagroup(currgroup);
      if currgroup<>'' then
        alreadyingroup := true;
    end;
end;

end.