DP Tool Club 31/CDASC_31_1996_juillet_aout.iso/internet/rnr214.zip/RNRCREA.PAS

Pascal/Delphi Source File | 1996-04-01 | 59KB | 2,153 lines

unit rnrcrea;  {formerly from rnrselb}

{$I rnr-def.pas}


interface

uses rnrglob,rnrconf,genericf,rnrfunc,rnrproc,rnrio,rnrfile,rnrmous,rnrart

{$ifdef charset}
,rnrchar
{$endif}

;

procedure delivermail(mailfn: string);
procedure sendnewsasmail(infn: string; addr: string);
procedure injnews(newartfn: string; newsgroups, originalnewsgroups: string);
procedure copylocalmessage(localfn: string; newfn: string);


procedure createpostorcancel(iscancel: boolean;
 newsgroups, originalnewsgroups, followupto, subject,
 references, author, originalauthor: string; includedfile: string);

procedure createcancel(newsgroups, subject, references,
 originalauthor: string);

procedure createpost(newsgroups, originalnewsgroups, followupto, subject,
 references, author, originalauthor: string; includedfile: string);


procedure editanddeliver(subject,inreplyto,replyaddr,replyname,ccaddr,
 originalfrom,author: string; defaultreply: boolean; includedfile: string;
 justremail: boolean);

procedure editandinjnews(newsgroups, originalnewsgroups, author: string);


procedure post;
procedure mail;
procedure postfile;
procedure mailfile;

implementation

{ assumes setsendencoding() has already been called }
procedure copylocalmessage(localfn: string; newfn: string);

var
  localf: text;
  newf: text;
  emptylinefound: boolean;
  oneline: string;

begin
  safereset(localf,localfn);
  saferewrite(newf,newfn);

  emptylinefound := false;
  while not eof(localf) do
    begin
      readln(localf,oneline);
      if oneline='' then
        emptylinefound := true;

{$ifdef charset}
      if uselocalcharset then
        if emptylinefound then
          localtoline(oneline);
{$endif}

      writeln(newf,oneline);
    end;

  close(localf);
  close(newf);
end;

procedure execrmail(addrlist: string; lffn: string);

begin
  if pos('%f',mailcmdline)=0 then
    execviacomspec(extwafexpand(mailcmdline,addrlist,'')+' < '+lffn)
  else
    execviacomspec(extwafexpand(mailcmdline,addrlist,lffn));
end;

procedure delivermailtolist(mailfn: string; addrlist: string);

var
  builtin: boolean;

  realaddrlist: string;
  mangledaddrlist: string;
  oneaddress: string;

  firstinlist: boolean;

{LF file -- empty if there's no need for a LF file this pass}
  lffn: string;
  lff: text;

{file the mail's currently in}
  mailf: text;

{new sequence #}
  seqstr: string;

{outbox copy}
  outboxfn: string;
  outboxf: text;

{--outgoing-mail folder copy}
  folderfn: string;
  folderf: text;

  emptylinefound: boolean;
  oneline: string;

{whether to fake rmail-single (in case of a long list)}
  usingrmailsingle: boolean;

  basesite: string;

begin
  builtin := mailcmdline=builtincookie;

  usingrmailsingle := rmailsingle;

  realaddrlist := expandmail(addrlist);

  if length(realaddrlist)>64 then
    usingrmailsingle := true;

  firstinlist := true;

  mangledaddrlist := realaddrlist;
  while mangledaddrlist<>'' do
    begin
      oneaddress := chopfirstaddr(mangledaddrlist);

      basesite := copy(basesitename(oneaddress),1,8);
      outboxfn := withbackslash(outboxdir)+basesite;

{getuniqfext makes sure it's not a device}

{}{}{}{} {getuniqfile doesn't quite!}

      if outform='flat' then
        outboxfn := getuniqfext(outboxfn)
      else
        begin
          mkhier(outboxfn);
          outboxfn := getuniqfile(outboxfn);
        end;

      lffn := '';
      if builtin then
        begin
          maybemkhier(smarthostdir);

          seqstr := integertozstring(newseqnumber,4);
          lffn := withbackslash(smarthostdir)+seqstr+'.dat';
        end
      else if firstinlist or usingrmailsingle then
        begin
          lffn := withbackslash(temporarydir)+userid+'.nl';
        end;

      saferewrite(outboxf,outboxfn);
      if fileresult<>0 then
        begin
          xwritelnss('could not write to ',outboxfn);
          shutdown(1);
        end;

      if lffn<>'' then
        begin
          saferewrite(lff,lffn);
          if fileresult<>0 then
            begin
              xwritelnss('could not write to ',lffn);
              shutdown(1);
            end;
        end;

      safereset(mailf,mailfn);
      if fileresult<>0 then
        begin
          xwritelnss('could not read ',mailfn);
          shutdown(1);
        end;

      emptylinefound := false;
      while not eof(mailf) do
        begin
          readln(mailf,oneline);
          if oneline='' then
            emptylinefound := true;

{$ifdef charset}
          if uselocalcharset then
            if emptylinefound then
              localtoline(oneline);
{$endif}

          if not trusted then
            if not emptylinefound then
              if makesame(oneline,'From: ',mailfrom) then
                begin end;

          writeln(outboxf,oneline);
          if lffn<>'' then
            write(lff,oneline,lf);
        end;

      close(mailf);
      close(outboxf);
      if lffn<>'' then
        close(lff);

      if builtin then
        begin {builtin}

{once .DAT is written, create .XQT}

          lffn := withbackslash(smarthostdir)+seqstr+'.xqt';
          saferewrite(lff,lffn);
          write(lff,'U ',fromuserid,' ',uucpname,lf);
          write(lff,'Z',lf);
          write(lff,'F D.',uucpname,seqstr,lf);
          write(lff,'I D.',uucpname,seqstr,lf);
          write(lff,'C rmail ',oneaddress,lf);
          close(lff);

{once .DAT and .XQT are written, create .CMD}

          lffn := withbackslash(smarthostdir)+seqstr+'.cmd';
          saferewrite(lff,lffn);
          writeln(lff,'S ',seqstr,'.DAT D.',uucpname,seqstr,' ',
           fromuserid,' - ',seqstr,'.DAT 0600');
          writeln(lff,'S ',seqstr,'.XQT X.',uucpname,seqstr,' ',
           fromuserid,' - ',seqstr,'.XQT 0600');
          close(lff);

        end {builtin}
      else if usingrmailsingle then
        begin {usingrmailsingle}

          mouseshutdown;

          execrmail(oneaddress,lffn);

          mouseinit;

          if execresult<>0 then
            warnerr(mailcmdline,execresult);

        end {usingrmailsingle}
      else if firstinlist then
        begin {firstinlist}

          mouseshutdown;

          execrmail(uncomma(realaddrlist),lffn);

          mouseinit;

          if execresult<>0 then
            warnerr(mailcmdline,execresult);

        end; {firstinlist}

      firstinlist := false;
    end;
end;

procedure delivermail;

var
  toaddr: string;
  ccaddr: string;

{the --outgoing-mail should only get one copy, even with two lists}
  outgoingmaildir: string;
  outgoingmailfn: string;
  outgoingmailf: text;

begin
{two :mail commands in a row don't work without this!}
  headerinmem := '';

{$ifdef charset}

{ Must do this _before_ opening mailfile with reset(), or it will fail }
{ for the poor users who have share loaded                             }

  if uselocalcharset then
    setsendencoding(
     getheaderline(mailfn,'content-type:'),
     getheaderline(mailfn,'content-transfer-encoding:'));
{$endif}

  toaddr := getheaderline(mailfn,'to:');
  ccaddr := getheaderline(mailfn,'cc:');

  if toaddr=couldnotreadfilecookie then
    begin
      warn('not sent -- could not read '+mailfn+'!');
    end
  else if ccaddr=couldnotreadfilecookie then
    begin
      warn('not sent -- could not read '+mailfn+'!');
    end
  else
    begin
      delivermailtolist(mailfn,toaddr);
      if ccaddr<>'' then
        delivermailtolist(mailfn,ccaddr);

      if outgoingmail<>'' then
        begin
          outgoingmaildir := getgroupdir(outgoingmail);
          if outgoingmaildir='' then
            warn('could not find a directory for '+outgoingmail)
          else
            begin
              mkhier(outgoingmaildir);
              outgoingmailfn := getuniqfile(outgoingmaildir);
              xclreolxy(1,lpp);
              xwritesss('Saving a copy in ',outgoingmailfn,'...');
              copylocalmessage(mailfn,outgoingmailfn);
            end;
        end;
    end;

  {caller will refresh}
end;

procedure sendnewsasmail;

var
  inf: text;
  tempfn: string;
  tempf: text;
  oneline: string;
  toseen: boolean;
  emptylinefound: boolean;
  ccaddrfound: string;
  isccline: boolean;
  toaddr: string;
  ccaddr: string;

begin
  warn('mailing to '+copy(addr,1,50));

  toaddr := '';
  ccaddr := '';

  xwrites('mailing...');

  safereset(inf,infn);

  tempfn := withbackslash(temporarydir)+userid+'.n2m';
  saferewrite(tempf,tempfn);

  if not nomailfrom then
    writeln(tempf,'From ',fromuserid,'  ',copy(cdow,1,3),', ',
     dayofmonth,' ',copy(monthname,1,3),' ',year,' ',currenttimestring,' ',
     timezone,' ','remote from ',uucpname);

  if not isheaderinlist('Received:',nomailheaders) then
    begin
      writeln(tempf,'Received: by ',fqdn,' ('+newsreadername+')');
      writeln(tempf,'       via ',newsreadername,'; ',copy(cdow,1,3),', ',
       dayofmonth,' ',copy(monthname,1,3),' ',year,' ',
       currenttimestring,' ',timezone);
    end;

{ supress CC:s until very end -- if there was a To: then give up the CC: }
{ unchanged; otherwise change the CC: to a To: so there's one for uupc }

  toseen := false;
  emptylinefound := false;
  ccaddrfound := '';

  while not eof(inf) do
    begin
      readln(inf,oneline);
      isccline := false;

      if not emptylinefound then  {must write it before the empty line!}
        begin
          if lower(copy(ltrim(oneline),1,3))='to:' then
            begin
              toseen := true;
              oneline := ltrim(copy(ltrim(oneline),4,255));
              if (oneline='poster') or (oneline='sender') then
                oneline := addr;
              toaddr := expandmail(oneline);
              oneline := 'To: '+toaddr;
            end;
          if lower(copy(ltrim(oneline),1,3))='cc:' then
            begin
              ccaddrfound := ltrim(copy(ltrim(oneline),4,255));
              isccline := true;
            end;

          if oneline='' then
            emptylinefound := true;

          if emptylinefound then  {it must have _just_ become true}
            begin

              if not isheaderinlist('Comments:',nomailheaders) then
                begin
                  writeln(tempf,'Comments: ',
                   'this message originated as a public newsgroup posting');
                end;

              if toseen then  {was a To: -- print out the CC: we suppressed}
                begin
                  if ccaddrfound<>'' then
                    begin
                      if (ccaddrfound='poster') or (ccaddrfound='sender') then
                        ccaddrfound := addr;
                      ccaddrfound := expandmail(ccaddrfound);
                      ccaddr := ccaddrfound;
                      writeln(tempf,'CC: ',ccaddr);
                    end;
                end
              else
                begin
                  if ccaddrfound='' then
                    ccaddrfound := addr;
                  if (ccaddrfound='poster') or (ccaddrfound='sender') then
                    ccaddrfound := addr;
                  ccaddrfound := expandmail(ccaddrfound);
                  toaddr := ccaddrfound;
                  writeln(tempf,'To: ',toaddr);
                  toseen := true;
                end;

              if indicatepostedmailinbody then
                begin
                  {finish headers}
                  writeln(tempf);

                  writeln(tempf,
              '[ this message originated as a public newsgroup posting ]');
                  {empty line (the first one!) will follow}
                end;
            end;
        end;

      if not isccline then
        writeln(tempf,oneline);
    end;

  close(inf);
  close(tempf);

  delivermail(tempfn);

end;

{}{} {should be a three-part process!}

procedure injnews;

var
  goingtomail: boolean;
  newartf: text;
  newartlffn: string;
  newartlff: text;
  emptylinefound: boolean;
  oneline: string;
  newnewsgroups: string;
  mungedgroups: string;
  firstnewsgroup: string;
  firstcommapos: integer;
  newfrom: string;
  newapproved: string;
  outgoinggroup: string;
  outgoingdir: string;
  outgoingfn: string;
  outgoingf: text;
  fromfound: boolean;
  moderatoraddr: string;
  onlylf: boolean;

begin
  goingtomail := false;

  headerinmem := '';

{ Must do this _before_ opening mailfile with reset(), or it will fail }
{ for the poor users who have share loaded                             }

{$ifdef charset}
  if uselocalcharset then
    setsendencoding(
     getheaderline(newartfn,'content-type:'),
     getheaderline(newartfn,'content-transfer-encoding:'));
{$endif}

  newnewsgroups := getheaderline(newartfn,'newsgroups:');

  newfrom := getheaderline(newartfn,'from:');
  newapproved := getheaderline(newartfn,'approved:');

  safereset(newartf,newartfn);

{copy to outgoing directory if asked -- just pick the first one found}

  outgoingfn := '';
  outgoinggroup := '';

{first:  try to find an outgoing group for any group it was posted to}

{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}

  mungedgroups := newnewsgroups+',done';

  while (outgoinggroup='') and (numoccur(',',mungedgroups)>0) do
    begin
      firstcommapos := pos(',',mungedgroups);
      firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
      mungedgroups := copy(mungedgroups,firstcommapos+1,255);
      outgoinggroup := groupsattr(firstnewsgroup,'/spy=');
    end;

{second:  try to find an outgoing group for any group before editing}

{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}

  mungedgroups := newsgroups+',done';

  while (outgoinggroup='') and (numoccur(',',mungedgroups)>0) do
    begin
      firstcommapos := pos(',',mungedgroups);
      firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
      mungedgroups := copy(mungedgroups,firstcommapos+1,255);
      outgoinggroup := groupsattr(firstnewsgroup,'/spy=');
    end;

{finally:  try to find an outgoing group for any group before Followup-To: }

{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}

  mungedgroups := originalnewsgroups+',done';

  while (outgoinggroup='') and (numoccur(',',mungedgroups)>0) do
    begin
      firstcommapos := pos(',',mungedgroups);
      firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
      mungedgroups := copy(mungedgroups,firstcommapos+1,255);
      outgoinggroup := groupsattr(firstnewsgroup,'/spy=');
    end;

  if outgoinggroup='' then
    outgoinggroup := outgoingnews;

  if outgoinggroup='' then
    begin
      if not quiet then
        warn('(there is no outgoing group copy for this post)');
    end
  else
    begin
      outgoingdir := getgroupdir(outgoinggroup);
      if outgoingdir='' then
        begin
          warn('no dir found for outgoing group '+outgoinggroup+' !');
        end
      else
        begin
          outgoingfn := getuniqfile(outgoingdir);
        end;
    end;

{check if any group on the list is moderated}

{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}

  mungedgroups := newnewsgroups+',done';
  moderatoraddr := '';

  while (moderatoraddr='') and (numoccur(',',mungedgroups)>0) do
    begin
      firstcommapos := pos(',',mungedgroups);
      firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
      mungedgroups := copy(mungedgroups,firstcommapos+1,255);
      if ismoderated(firstnewsgroup) then
        begin
          moderatoraddr := groupsattr(firstnewsgroup,'/mod=');
          if moderatoraddr='' then
            begin
{1996-02-15 -- this crepl caused a stack overflow}
              moderatoraddr := crepl(firstnewsgroup,'.','-');
              moderatoraddr := moderatoraddr+'@'+backbone;
            end;
        end;
    end;

{
  allow only trusted users to issue Control: messages, post to alt.hackers,
  be group moderators, etc.
}

  if trusted then
    if newapproved<>'' then
      moderatoraddr := '';

  goingtomail := (moderatoraddr<>'');

{use LF for posts, CRLF for mail}

  onlylf := not goingtomail;

  newartlffn := withbackslash(temporarydir)+userid+'.nl';
  saferewrite(newartlff,newartlffn);

  if outgoingfn<>'' then
    begin
      mkhier(outgoingdir);

      saferewrite(outgoingf,outgoingfn);

      if fileresult<>0 then
        begin
          warn('could not write to outgoing file '+outgoingfn);
          outgoingfn := '';
        end;
    end;

  emptylinefound := false;
  reset(newartf);
  while not eof(newartf) do
    begin
      readln(newartf,oneline);

{$ifdef charset}
      if (uselocalcharset) then
        if emptylinefound then
          localtoline(oneline);
{$endif}

      if not trusted then
        if not emptylinefound then
          if makesame(oneline,'From: ',mailfrom) then
            begin end;

      if not emptylinefound then
        if copy(oneline,1,6)='From: ' then
          fromfound := true;

      if oneline='' then
        begin
          if not emptylinefound then  {this must be the first empty line}
            begin
              if not fromfound then
                begin
                  if onlylf then
                    write(newartlff,'From: ',newsfrom,lf)
                  else
                    writeln(newartlff,'From: ',newsfrom);

                  if outgoingfn<>'' then
                    writeln(outgoingf,'From: ',newsfrom);

                  fromfound := true;
                end;
            end;
          emptylinefound := true;
        end;

      if onlylf then
        write(newartlff,oneline,lf)
      else
        writeln(newartlff,oneline);

      if outgoingfn<>'' then
        writeln(outgoingf,oneline);
    end;
  close(newartf);
  close(newartlff);
  if outgoingfn<>'' then
    close(outgoingf);

  if goingtomail then
    begin
      sendnewsasmail(newartlffn,moderatoraddr);
    end
  else
    begin

{}{} {should use rnews in bin directory only?}

      mouseshutdown;

      if pos('%f',newscmdline)=0 then
        execviacomspec(wafexpand(newscmdline)+' < '+newartlffn)
      else
        execviacomspec(extwafexpand(newscmdline,'',newartlffn));

      mouseinit;

{}{} {waffle's rnews sometimes displays random error message on low memory}
     {but then doesn't exit with an error return code!}

      waitnseconds(1);

      if execresult<>0 then
        warnerr(newscmdline,execresult);

    end;
end;

procedure createpostorcancel;

{ if author<>'', opens then closes artf }

var
  newartfn: string;
  newartf: text;
  refline: string;
  wref: string;
  nextref: string;
  ref1,ref2: string;
  emptylinefound: boolean;
  sigfn: string;
  sigf: text;
  oneline: string;
  ccaddr: string;

begin

{ don't propogate errors in the Newsgroups: line if you can help it }

  newsgroups := unspace(newsgroups);
  followupto := unspace(followupto);

  newartfn := withbackslash(temporarydir)+userid+'.fol';
  saferewrite(newartf,newartfn);

{this done since waf164 didn't handle newsname like waf165 does}

  if not isheaderinlist('Path:',nonewsheaders) then
    writeln(newartf,'Path: ',newsname,'!',pathuserid);

  writeln(newartf,'Newsgroups: ',newsgroups);
  if (originalnewsgroups<>'') and (originalnewsgroups<>newsgroups) then
    writeln(newartf,'X-Original-Newsgroups: ',originalnewsgroups);
  if followupto<>'' then
    writeln(newartf,'Followup-To: ',followupto);
  if originalauthor<>'' then
    writeln(newartf,'X-Original-Article-From: ',originalauthor);

  if iscancel then
    begin
      if newsfrom=originalauthor then
        begin
          writeln(newartf,'From: ',newsfrom);
          writeln(newartf,'Sender: ',newsfrom);
        end
      else
        begin
          writeln(newartf,'From: ',originalauthor);
          writeln(newartf,'Sender: ',newsfrom);
        end;
    end
  else
    begin
      writeln(newartf,'From: ',newsfrom);
    end;

  if replyto<>'' then
    writeln(newartf,'Reply-To: ',replyto);

  writeln(newartf,'Subject: ',subject);

  if not isheaderinlist('Message-ID:',nonewsheaders) then
    writeln(newartf,'Message-ID: ',newmessageid);

  writeln(newartf,'Date: ',copy(cdow,1,3),', ',dayofmonth,' ',
   copy(monthname,1,3),' ',year,' ',currenttimestring,' ',timezone);

  if references<>'' then
    begin

{$ifdef rnewscontbroken}
      writeln(newartf,'References: ',references);
{$else}

{ wref is the space-terminated string of references that are yet to be }
{ written out - it starts with two spaces if need be (other than line one) }

      wref := 'References: ';
      while references<>'' do
        begin
          references := ltrim(references);
          nextref := chopfirstw(references);
          if length(wref+nextref)>70 then
            begin
              writeln(newartf,wref);
              wref := '  '+nextref+' ';
            end
          else
            wref := wref+nextref+' ';
        end;
      if wref<>'' then
        writeln(newartf,trim(wref));
{$endif}

    end;

  if organ<>'' then
    writeln(newartf,'Organization: ',organ);

{$ifdef charset}
  if uselocalcharset then
    begin
      writeln(newartf,'MIME-Version: 1.0');
      writeln(newartf,'Content-Type: text/plain; charset=',mailingsetname);
      writeln(newartf,'Content-Transfer-Encoding: ',mailxfername);
    end;
{$endif}

  if iscancel then
    writeln(newartf,'Control: ','cancel ',references);

  if not isheaderinlist('X-Newsreader:',nonewsheaders) then
    writeln(newartf,'X-Newsreader: ',newsreadername,' ',newsreaderversion);

  writeln(newartf);

  if iscancel then
    writeln(newartf,'cancelled within ',newsreadername)
  else if includedfile<>'' then
    begin
      writeln(newartf,'encoded file ',includedfile,' follows:');
      writeln(newartf);
      close(newartf);
      appendencodedfile(newartfn,includedfile);
      assign(newartf,newartfn);
      append(newartf);
      writeln(newartf);
    end
  else if author='' then
    writeln(newartf,newsmarkerline)
  else
    begin
      writeln(newartf,author,' writes:');
      writeln(newartf);

      emptylinefound := false;

      artreset;
      while not arteof and not emptylinefound do
        begin
          getartl(oneline,255,notoscreen);
          if oneline='' then
            emptylinefound := true;
        end;

      while not arteof do
        begin

{don't use just cols here, to be polite}

          getartl(oneline,min(cols,80)-3,notoscreen);

{$ifdef charset}
          if uselocalcharset then
             linetolocal(oneline);
{$endif}

          if oneline='' then
            writeln(newartf,'>')
          else if (copy(oneline,1,1)='>') and not quotewithspace then
            writeln(newartf,'>',expand(oneline))
          else
            writeln(newartf,'> ',expand(oneline));

        end;
      artclose;
    end;

  sigfn := unslash(getconfig('signature'));
  if sigfn='' then
    sigfn := 'sig';
  if numoccur('\',sigfn)=0 then
    sigfn := withbackslash(home)+sigfn;

  safereset(sigf,sigfn);
  if fileresult=0 then
    begin
      readln(sigf,oneline);
      if oneline<>'-- ' then
        writeln(newartf,'-- ');
      reset(sigf);
      while not eof(sigf) do
        begin
          readln(sigf,oneline);
          writeln(newartf,oneline);
        end;
      close(sigf);
    end;
  close(newartf);
end;

procedure createcancel;

begin
  createpostorcancel(true,newsgroups,'','',subject,
   references,'',originalauthor,'');
end;

procedure createpost;

begin
  createpostorcancel(false,newsgroups,originalnewsgroups,followupto,
   subject,references,author,originalauthor,includedfile);
end;

procedure editandinjnews;

var
  newartfn: string;
  sendeditvspellquit: char;
  ccaddr: string;

  cansend: boolean;
  sendprompt: string;
  sendchar: char;
  invalidmessage: string;

  anyunknowngroups: boolean;
  anymailgroups: boolean;

  newsgroupsline: string;
  onenewsgroup: string;
  onenewsgroupwithdesc: string;
  onenewsgroupwithdescline: integer;

  groupwidth: integer;
  descwidth: integer;

begin

{ don't propogate errors in the Newsgroups: line if you can help it }

  newsgroups := unspace(newsgroups);

  newartfn := withbackslash(temporarydir)+userid+'.fol';

{edit the first time around}
  sendeditvspellquit := 'e';

  while (sendeditvspellquit<>'s') and (sendeditvspellquit<>'q') do
    begin
      if not trusted then
        if sendeditvspellquit='E' then
          sendeditvspellquit := 'e';

      if sendeditvspellquit='v' then
        begin
          mouseshutdown;
          execp(vspeller,vspelleroptions+' '+newartfn);
          mouseinit;

          if execresult<>0 then
            warnerr(vspeller,execresult);

          if editaftervspell then
            sendeditvspellquit := 'e';
        end;

      if sendeditvspellquit='e' then
        begin
          mouseshutdown;
          execp(editor,editoroptions+' '+newartfn);
          mouseinit;

          if execresult<>0 then
            warnerr(editor,execresult);
        end;

      if sendeditvspellquit='E' then
        begin
          mouseshutdown;
          execp(editor,editoroptions+' '+newartfn+' '+artfn);
          mouseinit;

          if execresult<>0 then
            warnerr(editor,execresult);
        end;


{}{} {check headers and headers-ran-into-body messages}
     {invalid format of Newsgroups: line (spaces, etc.)}
     {warn if any groups in Newsgroups: not in forum set}
     {delete any duplicates from Newsgroups: line}
     {check From:}
     {check for /solo groups}
     {a Lines: header might be polite.  maybe not}

      headerinmem := '';  {invalidate cache from last getheaderline}

      cansend := true;

      xclreolxy(1,lpp);
      xwrites('checking headers...');

      if cansend then
        if getheaderline(newartfn,'from:')=couldnotreadfilecookie then
          begin
            warn('not sent -- could not read '+newartfn+'!');
            cansend := false;
          end;

      if cansend then
        if trim(getheaderline(newartfn,'from:'))='' then
          begin
            warn('no From: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        if not trusted then
          if getfromaddr(getheaderline(newartfn,'from:'))<>
           getfromaddr(newsfrom) then
            begin
              warn('changed From: header -- cannot send');
              cansend := false;
            end;

      if cansend then
        if trim(getheaderline(newartfn,'subject:'))='' then
          begin
            warn('no Subject: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        if lower(trim(getheaderline(newartfn,'subject:')))='re:' then
          begin
            warn('no Subject: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        begin
          newsgroupsline := getheaderline(newartfn,'newsgroups:');
          newsgroupsline := ltrim(trim(newsgroupsline));
          newsgroupsline := crepl(newsgroupsline,tab,' ');
        end;

      if cansend then
        if newsgroupsline='' then
          begin
            warn('no Newsgroups: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        if numoccur(' ',newsgroupsline)<>0 then
          begin
            warn('no spaces are allowed in Newsgroups: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        begin
          invalidmessage := findproblemwithmessage(newartfn);
          if invalidmessage<>'' then
            begin
              warn2(invalidmessage,'cannot send');
              cansend := false;
            end;
        end;

      if cansend then
        if toomuchquoting(newartfn) then
          begin
            warn('lots of quoting, not much new material -- please edit');
            if not trusted then
              cansend := false;
          end;

      if cansend then
        if not trusted then
          if trim(getheaderline(newartfn,'approved:'))<>'' then
            begin
              warn('without --trusted, cannot send approved articles');
              cansend := false;
            end;

      if cansend then
        if toolongline(newartfn,255) then
          begin

{}{}{}{} {should offer to word-wrap in place instead}
            warn('some line is very long, and will be lost');
            cansend := false;
          end;

      if cansend then
        if toolongline(newartfn,80) then
          begin
            warn2('some lines are >80 chars, which people with really old',
            'or poorly-planned software will have problems seeing');
          end;

{don't let trusted users post to more than 3 groups (2 commas)}
      if cansend then
        if numoccur(',',newsgroupsline)>2 then
          begin
            warn('massive crossposting -- please edit');
            if not trusted then
              cansend := false;
          end;


      if cansend then
        begin
          anyunknowngroups := false;
          anymailgroups := false;

          onenewsgroupwithdescline := lpp-2;

{ the message will go on lpp, so clear lpp-1 to start }
          xclreolxy(1,lpp-1);

{ clear space for the first description }
          xclreolxy(1,onenewsgroupwithdescline);

{
  there are cols-1 useful columns
  groupwidth and its trailing space are already used
}

          groupwidth := max(cols div 2-10,10);
          descwidth := cols-1 - (groupwidth+1);

          newsgroupsline := uncomma(newsgroupsline);

          while newsgroupsline<>'' do
            begin
              onenewsgroup := chopfirstw(newsgroupsline);

              if ismailgroup(onenewsgroup) then
                anymailgroups := true;

              if getgroupdir(onenewsgroup)='' then
                anyunknowngroups := true;

              if onenewsgroupwithdescline>4 then
                begin
                  onenewsgroupwithdesc :=
                   leftjustify(right(onenewsgroup,groupwidth),groupwidth,' ')+
                   ' '+
                   copy(sourcedesc(onenewsgroup,sourcegroup),1,descwidth);

{ clear the line above to make it stand out }
                  xclreolxy(1,onenewsgroupwithdescline-1);

{
 this line must already be clear then, either from the pre-loop
 code or the previous iteration
}
                  writexy(1,onenewsgroupwithdescline,onenewsgroupwithdesc);

                  dec(onenewsgroupwithdescline);
                end;
            end;

          if anymailgroups then
            begin
              warn('cannot crosspost to a private mail pseudo-group!');
              cansend := false;
            end
          else if anyunknowngroups then
            warn('some groups not on this site -- might be invalid');
        end;

      if cansend then
        begin
          sendprompt := '{s}end ';  {note trailing space}
          sendchar := 's';
        end
      else
        begin
          sendprompt := '';
          sendchar := 'q';  {can always quit}
        end;

      if author='' then
        sendeditvspellquit :=
         onekey('Public: '+sendprompt+'{e}dit {v}spell {q}uit',
          sendchar+'evq')
      else
        sendeditvspellquit :=
         onekey('Public: '+sendprompt+'{e}dit {E}dit-both {v}spell {q}uit',
         sendchar+'eEvq');

      if sendeditvspellquit='s' then
        xwrites('sending...')
      else if sendeditvspellquit='e' then
        xwrites('editing...')
      else if sendeditvspellquit='E' then
        xwrites('editing both...')
      else if sendeditvspellquit='v' then
        xwrites('vspelling...')
      else if sendeditvspellquit='q' then
        xwrites('quit');

    end;

  if sendeditvspellquit='s' then
    begin
      headerinmem:= '';  { In case user edited headers ... }

      injnews(newartfn,newsgroups,originalnewsgroups);
      ccaddr := getheaderline(newartfn,'cc:');

      if ccaddr<>'' then
        begin
          if (ccaddr='poster') or (ccaddr='sender') then
            ccaddr := author;

          sendnewsasmail(newartfn,ccaddr);
        end;

    end;

{leave refresh and artf re-opening to the caller}

end;

procedure post;

var
  nsubject: string;
  ngroups: string;
  postforgetit: char;

begin
  ngroups := internalcmdlineparams;

  if ngroups<>'' then
    if not isavalidgroup(ngroups) then
      if joinedtogroup(ngroups) then
        ;

  if ngroups='' then
    begin
      if currsourcekind=sourcegroup then
        ngroups := currsource
      else
        ngroups := 'misc.misc';
    end;

  if not maypost then
    warn('you do not have access to post this way')
  else
    begin
      if ismoderated(ngroups) then
        warn(ngroups+' group is moderated');

      postforgetit := 'p';
      if ismailgroup(ngroups) then
        begin
          ngroups := 'misc.misc';
          postforgetit :=
           onekeydef('this is a mail group - {p}ost {f}orget it','pf','f');
        end;

      if postforgetit='p' then
        begin
          xclreolxy(1,lpp-3);
          xclreolxy(1,lpp-2);
          xwrites(sourcedesc(ngroups,sourcegroup));
          xclreolxy(1,lpp-1);
          xclreolxy(1,lpp);
          xwrites('Subject: ');
          xreadlns(nsubject,max(cols-10,70),nopreserve);
          xclreolxy(1,lpp);
          xwrites('Newsgroups: ');
          xreadlns(ngroups,max(cols-15,70),yespreserve);

          if ngroups='' then
            ngroups := 'misc.misc';

          if not isavalidgroup(ngroups) then
            if joinedtogroup(ngroups) then
              ;

          createpost(ngroups,'','',nsubject,'','','','');
          editandinjnews(ngroups,'','');
        end;
    end;

{ caller must refresh }

end;

procedure postfile;

var
  nsubject: string;
  ngroups: string;
  postforgetit: char;
  includedfile: string;
  cannotusemsg: string;

begin
  ngroups := internalcmdlineparams;

  if ngroups<>'' then
    if not isavalidgroup(ngroups) then
      if joinedtogroup(ngroups) then
        ;

  if ngroups='' then
    begin
      if currsourcekind=sourcegroup then
        ngroups := currsource
      else
        ngroups := 'misc.misc';
    end;

  if not trusted then
    warn('you do not have access to post files this way')
  else if not maypost then
    warn('you do not have access to post this way')
  else
    begin
      if ismoderated(ngroups) then
        warn(ngroups+' group is moderated');

      postforgetit := 'p';
      if ismailgroup(ngroups) then
        begin
          ngroups := 'misc.misc';
          postforgetit :=
           onekeydef('this is a mail group - {p}ost {f}orget it','pf','f');
        end;

      if postforgetit='p' then
        begin
          xclreolxy(1,lpp-6);
          xclreolxy(1,lpp-5);
          xwritehighlights(
           'do {NOT} post large files to discussion groups!  almost');
          xclreolxy(1,lpp-4);
          xwrites('any group with ".binaries." in the name should be ok;');
          xclreolxy(1,lpp-3);
          xwritehighlights(
           'any other is almost definitely not -- {PLEASE BE CAREFUL}');
          xclreolxy(1,lpp-2);
          xclreolxy(1,lpp-1);
          warn('this is the last warning you will receive');

          xclreolxy(1,lpp-3);
          xclreolxy(1,lpp-2);
          xwrites(sourcedesc(ngroups,sourcegroup));
          xclreolxy(1,lpp-1);

          includedfile := '';

          cannotusemsg := '(no file entered yet!)';
          while cannotusemsg<>'' do
            begin
              getexistingfilename(
               includedfile,'(blank to exit) File:',includedfile);

              includedfile := unslash(includedfile);

              cannotusemsg := '';

              if includedfile<>'' then
                if illegalfn(includedfile) then
                  cannotusemsg := 'illegal filename';

              if (includedfile<>'') and not trusted and (cannotusemsg='') then
                if suspiciousfn(includedfile) then
                  cannotusemsg := 'without -t/--trusted';

              if (includedfile<>'') and (cannotusemsg='') then
                if isdev(includedfile) then
                  cannotusemsg := 'reserved device name';

              if (includedfile<>'') and (cannotusemsg='') then
                if not fexists(includedfile) then
                  cannotusemsg := 'file does not exist';

              if (includedfile<>'') and (cannotusemsg<>'') then
                warn('unable to use: '+cannotusemsg);
            end;

          if (includedfile<>'') and (cannotusemsg='') then
            begin
              nsubject := 'included file: '+includedfile;

              if not trusted then
                includedfile := withbackslash(home)+includedfile;

              xclreolxy(1,lpp);
              xwrites('Subject: ');
              xreadlns(nsubject,max(cols-10,70),yespreserve);

              xclreolxy(1,lpp);
              xwrites('Newsgroups: ');
              xreadlns(ngroups,max(cols-15,70),yespreserve);

              if ngroups='' then
                ngroups := 'misc.misc';

              if not isavalidgroup(ngroups) then
                if joinedtogroup(ngroups) then
                  ;

              createpost(ngroups,'','',nsubject,'','','',includedfile);
              editandinjnews(ngroups,'','');
            end;
        end;
    end;

{ caller must refresh }

end;

procedure editanddeliver;

{ expects artf to be closed;  will open and close if author<>'' }

var
  groupormail: string;
  mailfn: string;
  mailf: text;
  mailcheckedfn: string;
  mailcheckedf: text;
  emptylinefound: boolean;
  fromfound: boolean;
  sigfn: string;
  sigf: text;
  oneline: string;
  sendeditvspellquit: char;
  outmailfn: string;
  outmailf: text;
  basesite: string;

  cansend: boolean;
  sendprompt: string;
  sendchar: char;
  invalidmessage: string;

begin
  if ismailgroup(currsource) then
    groupormail := 'mail'
  else if currsourcekind=sourcegroup then
    groupormail := currsource
  else
    groupormail := 'somewhere mysterious';

  mailfn := withbackslash(temporarydir)+userid+'.mai';
  saferewrite(mailf,mailfn);

  if not nomailfrom then
    writeln(mailf,'From ',fromuserid,'  ',copy(cdow,1,3),', ',
     dayofmonth,' ',copy(monthname,1,3),' ',year,' ',currenttimestring,' ',
     timezone,' ','remote from ',uucpname);

  if not isheaderinlist('Received:',nomailheaders) then
    begin
      writeln(mailf,'Received: by ',fqdn,' ('+newsreadername+')');
      writeln(mailf,'       via ',newsreadername,'; ',copy(cdow,1,3),', ',
       dayofmonth,' ',copy(monthname,1,3),' ',year,' ',
       currenttimestring,' ',timezone);
    end;

{ don't bother with this line anymore -- makes future expansion easier }

{
  writeln(mailf,'       for ',replyaddr);
}

  write(mailf,'To: ',replyaddr);
  if replyname='' then
    writeln(mailf)
  else if (pos(',',replyname)<>0)
   or (pos('(',replyname)<>0)
   or (pos(')',replyname)<>0)
   or (pos('<',replyname)<>0)
   or (pos('>',replyname)<>0) then
    writeln(mailf,' ("',replyname,'")')
  else
    writeln(mailf,' (',replyname,')');

  if ccaddr<>'' then
    writeln(mailf,'CC: ',ccaddr);

  if originalfrom<>'' then
    writeln(mailf,'X-Original-Article-From: ',originalfrom);

  writeln(mailf,'Subject: ',subject);
  writeln(mailf,'From: ',mailfrom);

  if replyto<>'' then
    writeln(mailf,'Reply-To: ',replyto);

  if not isheaderinlist('Message-ID:',nomailheaders) then
    writeln(mailf,'Message-ID: ',newmessageid);

  writeln(mailf,'Date: ',copy(cdow,1,3),', ',dayofmonth,' ',
   copy(monthname,1,3),' ',year,' ',currenttimestring,' ',timezone);

{$ifdef charset}
  if uselocalcharset then
    begin
      writeln(mailf,'MIME-Version: 1.0');
      writeln(mailf,'Content-Type: text/plain; charset=',postingsetname);
      writeln(mailf,'Content-Transfer-Encoding: 8bit');
    end;
{$endif}

  if inreplyto<>'' then
    writeln(mailf,'In-Reply-To: ',inreplyto);

  if organ<>'' then
    writeln(mailf,'Organization: ',organ);

  if not isheaderinlist('X-Newsreader:',nomailheaders) then
    writeln(mailf,'X-Newsreader: ',newsreadername,' ',newsreaderversion);

  writeln(mailf);

  if includedfile<>'' then
    begin
      writeln(mailf,'encoded file ',includedfile,' follows:');
      writeln(mailf);
      close(mailf);
      appendencodedfile(mailfn,includedfile);
      assign(mailf,mailfn);
      append(mailf);
      writeln(mailf);
    end
  else if justremail then
    begin
      writeln(mailf,'[re-mailed to you from ',groupormail,']');
      if getfromaddr(author)<>getfromaddr(mailfrom) then
        if getfromaddr(author)<>getfromaddr(newsfrom) then
          writeln(mailf,'[the original seemed to come from ',author,']');
      writeln(mailf);

      emptylinefound := false;

      artreset;
      while not arteof and not emptylinefound do
        begin
          getartl(oneline,255,notoscreen);
          if oneline='' then
            emptylinefound := true;
        end;

      while not arteof do
        begin

{don't use just cols here, to be polite}

          getartl(oneline,min(cols,80)-3,notoscreen);

{$ifdef charset}
          if (uselocalcharset) then
            linetolocal(oneline);
{$endif}

          writeln(mailf,expand(oneline));
        end;
      artclose;
    end
  else if author='' then
    writeln(mailf,mailmarkerline)
  else
    begin
      if defaultreply and (ccaddr='') then
        writeln(mailf,'In ',groupormail,' you write:')
      else
        if length(groupormail)+length(author)<60 then
          writeln(mailf,'In ',groupormail,', ',author,' writes:')
        else
          writeln(mailf,'In ',groupormail,', ',
           copy(author,1,max(60-length(groupormail),20)),'... writes:');
      writeln(mailf);

      emptylinefound := false;

      artreset;
      while not arteof and not emptylinefound do
        begin
          getartl(oneline,255,notoscreen);
          if oneline='' then
            emptylinefound := true;
        end;

      while not arteof do
        begin

{don't use just cols here, to be polite}

          getartl(oneline,min(cols,80)-3,notoscreen);

{$ifdef charset}
          if (uselocalcharset) then
            linetolocal(oneline);
{$endif}

          if oneline='' then
            writeln(mailf,'>')
          else if (copy(oneline,1,1)='>') and not quotewithspace then
            writeln(mailf,'>',expand(oneline))
          else
            writeln(mailf,'> ',expand(oneline));

        end;
      artclose;
    end;

  sigfn := unslash(getconfig('signature'));
  if sigfn='' then
    sigfn := 'mailsig';
  if numoccur('\',sigfn)=0 then
    sigfn := withbackslash(home)+sigfn;

  safereset(sigf,sigfn);
  if fileresult<>0 then
    begin
      sigfn := withbackslash(home)+'sig';
      safereset(sigf,sigfn);
    end;

  if fileresult=0 then
    begin
      readln(sigf,oneline);
      if oneline<>'-- ' then
        writeln(mailf,'-- ');
      reset(sigf);
      while not eof(sigf) do
        begin
          readln(sigf,oneline);
          writeln(mailf,expand(oneline));
        end;
      close(sigf);
    end;

  close(mailf);

{edit the first time around}
  sendeditvspellquit := 'e';

  while (sendeditvspellquit<>'s') and (sendeditvspellquit<>'q') do
    begin
      if not trusted then
        if sendeditvspellquit='E' then
          sendeditvspellquit := 'e';

      if sendeditvspellquit='v' then
        begin
          mouseshutdown;
          execp(vspeller,vspelleroptions+' '+mailfn);
          mouseinit;

          if execresult<>0 then
            warnerr(vspeller,execresult);

          if editaftervspell then
            sendeditvspellquit := 'e';
        end;

      if sendeditvspellquit='e' then
        begin
          mouseshutdown;
          execp(editor,editoroptions+' '+mailfn);
          mouseinit;

          if execresult<>0 then
            warnerr(editor,execresult);
        end;

      if sendeditvspellquit='E' then
        begin
          mouseshutdown;
          execp(editor,editoroptions+' '+mailfn+' '+artfn);
          mouseinit;

          if execresult<>0 then
            warnerr(editor,execresult);
        end;

      headerinmem := '';  {invalidate cache from last getheaderline}

      cansend := true;

      xclreolxy(1,lpp);
      xwrites('checking headers...');

      if cansend then
        if getheaderline(mailfn,'from:')=couldnotreadfilecookie then
          begin
            warn('not sent -- could not read '+mailfn+'!');
            cansend := false;
          end;

      if cansend then
        if trim(getheaderline(mailfn,'from:'))='' then
          begin
            warn('no From: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        if not trusted then
          if getfromaddr(getheaderline(mailfn,'from:'))<>
           getfromaddr(mailfrom) then
            begin
              warn('changed From: header -- cannot send');
              cansend := false;
            end;

      if cansend then
        if trim(getheaderline(mailfn,'subject:'))='' then
          begin
            warn('no Subject: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        if lower(trim(getheaderline(mailfn,'subject:')))='re:' then
          begin
            warn('no Subject: header -- cannot send');
            cansend := false;
          end;

      if cansend then
        if trim(getheaderline(mailfn,'to:'))='' then
          if trim(getheaderline(mailfn,'cc:'))='' then
            begin
              warn('no To: header and no CC: header -- cannot send');
              cansend := false;
            end;

      if cansend then
        begin
          invalidmessage := findproblemwithmessage(mailfn);
          if invalidmessage<>'' then
            begin
              warn2(invalidmessage,'cannot send');
              cansend := false;
            end;
        end;

      if cansend then
        if toomuchquoting(mailfn) then
          begin
            warn('lots of quoting, not much new material -- please edit');
            if not trusted then
              cansend := false;
          end;

{looks silly for mail, but prevents problems at stupid mail<->news gateways}
      if cansend then
        if not trusted then
          if trim(getheaderline(mailfn,'approved:'))<>'' then
            begin
              warn('without --trusted, cannot send approved articles');
              cansend := false;
            end;

      if cansend then
        if toolongline(mailfn,255) then
          begin

{}{}{}{} {should offer to word-wrap in place instead}
            warn('some line is very long, and will be lost');
            cansend := false;
          end;

      if cansend then
        if toolongline(mailfn,80) then
          begin
            warn2('some lines are >80 chars, which people with really old',
            'or poorly-planned software will have problems seeing');
          end;


      xclreolxy(1,lpp-1);

      if cansend then
        begin
          sendprompt := '{s}end ';  {note trailing space}
          sendchar := 's';
        end
      else
        begin
          sendprompt := '';
          sendchar := 'q';  {can always quit}
        end;

      sendeditvspellquit :=
       onekey('Private: '+sendprompt+'{e}dit {E}dit-both {v}spell {q}uit',
       sendchar+'eEvq');

      if sendeditvspellquit='s' then
        xwrites('sending...')
      else if sendeditvspellquit='e' then
        xwrites('editing...')
      else if sendeditvspellquit='E' then
        xwrites('editing both...')
      else if sendeditvspellquit='v' then
        xwrites('vspelling...')
      else if sendeditvspellquit='q' then
        xwrites('quit');

    end;

  if sendeditvspellquit='s' then
    begin

      mailcheckedfn := withbackslash(temporarydir)+userid+'.chk';

      { here copy mailf to mailcheckedf }

      saferewrite(mailcheckedf,mailcheckedfn);

      safereset(mailf,mailfn);

{check for changed From: lines on non-trusted users and replace}

{must make sure a From: line is actually found!}

      emptylinefound := false;
      fromfound := false;

      while not eof(mailf) do
        begin
          read(mailf,oneline);
          if eoln(mailf) then
            readln(mailf);

          if not trusted then
            begin
              if oneline='' then
                begin
                  emptylinefound := true;
                  if not fromfound then
                    begin
                      writeln(mailcheckedf,'From: ',mailfrom);
                      fromfound := true;
                    end;
                end
              else if not emptylinefound then
                begin
                  if getfirstw(oneline)='From:' then
                    fromfound := true;
                  if makesame(oneline,'From: ',mailfrom) then
                    begin
                      warn3
                       (
                       'From: line was changed back to '+mailfrom,
                       '(the default).  the -t flag is required to change the',
                       'From: line.  adding a Reply-To: is probably better.'
                       );
{
                      xclreolxy(1,1);
                      xclreolxy(1,2);
                      xclreolxy(1,3);
                      xclreolxy(1,4);
                      xclreolxy(1,5);
                      xclreolxy(1,6);
                      xclreolxy(1,7);
                      writexy(1,1,'From: line was changed from');
                      writexy(1,2,oneline+' to');
                      writexy(1,3,mailfrom);
                      writexy(1,4,'and has been changed back.  if you need');
                      writexy(1,5,'to change From:, run as a trusted user.');
                      writexy(1,6,'adding a Reply-To: is probably better');
}
                    end;
                end;
            end;
          writeln(mailcheckedf,oneline);
        end;

      close(mailf);
      close(mailcheckedf);

      delivermail(mailcheckedfn);

    end;

{leave refresh and re-opening of artf to caller}

end;

procedure mail;

var
  toaddr: string;
  ccaddr: string;
  nsubject: string;
  afullname: string;

begin
  if not maymail then
    warn('you may not mail -- check your configuration')
  else
    begin
      toaddr := internalcmdlineparams;

      xclreolxy(1,lpp);
      xwrites('To: ');
      xreadlns(toaddr,max(cols-5,75),yespreserve);
      toaddr := expandmail(toaddr);

      if toaddr<>'' then
        begin
          if not quiet then
            begin
              xclreolxy(1,lpp-1);
              xclreolxy(1,lpp-2);
              if (pos('!',toaddr)=0) and
               (pos('@',toaddr)=0) and
               (pos(',',toaddr)=0) then
                begin
                  afullname := getfullnameforuser(lower(toaddr));
                  if afullname='' then
                    afullname := ' (local, unknown name)'
                  else
                    afullname := ', '+afullname;
                  xwritesss('To: ',toaddr,afullname)
                end
              else
                xwritess('To: ',toaddr);
            end;

          xclreolxy(1,lpp);
          xwrites('CC: ');
          xreadlns(ccaddr,max(cols-5,75),nopreserve);
          ccaddr := expandmail(ccaddr);

          if (ccaddr<>'') and not quiet then
            begin
              xclreolxy(1,lpp-1);
              xclreolxy(1,lpp-2);
              if (pos('!',ccaddr)=0) and
               (pos('@',ccaddr)=0) and
               (pos(',',ccaddr)=0) then
                begin
                  afullname := getfullnameforuser(lower(ccaddr));
                  if afullname='' then
                    afullname := ' (local, unknown name)'
                  else
                    afullname := ', '+afullname;
                  xwritesss('CC: ',ccaddr,afullname)
                end
              else
                xwritess('CC: ',ccaddr);
            end;

          xclreolxy(1,lpp);
          xwrites('Subject: ');
          xreadlns(nsubject,max(cols-10,70),nopreserve);

          editanddeliver(
          {subject        }  nsubject,
          {inreplyto      }  '',
          {replyaddr      }  toaddr,
          {replyname      }  '',
          {ccaddr         }  ccaddr,
          {originalfrom   }  '',
          {author         }  '',
          {defaultreply   }  false,
          {includedfile   }  '',
          {justremail     }  false
                        );
        end;
    end;

{ caller must refresh }

end;

procedure mailfile;

var
  toaddr: string;
  ccaddr: string;
  nsubject: string;
  includedfile: string;
  cannotusemsg: string;
  afullname: string;

begin
  if not trusted then
    warn('you may not mail files this way')
  else if not maymail then
    warn('you may not mail -- check your configuration')
  else
    begin
      toaddr := internalcmdlineparams;

      xclreolxy(1,lpp-6);
      xclreolxy(1,lpp-5);
      xwritehighlights(
       'do {NOT} mail large files unless you are sure all recipients');
      xclreolxy(1,lpp-4);
      xwrites('can handle them, and it will not cause any network problems');
      xclreolxy(1,lpp-3);
      xwritehighlights(
        'between you and any of the recipients -- {PLEASE BE CAREFUL}');
      xclreolxy(1,lpp-2);
      xclreolxy(1,lpp-1);
      warn('this is the last warning you will receive');

      xclreolxy(1,lpp);
      xwrites('To: ');
      xreadlns(toaddr,max(cols-5,75),yespreserve);
      toaddr := expandmail(toaddr);

      if toaddr<>'' then
        begin
          if not quiet then
            begin
              xclreolxy(1,lpp-1);
              xclreolxy(1,lpp-2);
              if (pos('!',toaddr)=0) and
               (pos('@',toaddr)=0) and
               (pos(',',toaddr)=0) then
                begin
                  afullname := getfullnameforuser(lower(toaddr));
                  if afullname='' then
                    afullname := ' (local, unknown name)'
                  else
                    afullname := ', '+afullname;
                  xwritesss('To: ',toaddr,afullname)
                end
              else
                xwritess('To: ',toaddr);
            end;

          xclreolxy(1,lpp);
          xwrites('CC: ');
          xreadlns(ccaddr,max(cols-5,75),nopreserve);
          ccaddr := expandmail(ccaddr);

          if (ccaddr<>'') and not quiet then
            begin
              xclreolxy(1,lpp-1);
              xclreolxy(1,lpp-2);
              if (pos('!',ccaddr)=0) and
               (pos('@',ccaddr)=0) and
               (pos(',',ccaddr)=0) then
                begin
                  afullname := getfullnameforuser(lower(ccaddr));
                  if afullname='' then
                    afullname := ' (local, unknown name)'
                  else
                    afullname := ', '+afullname;
                  xwritesss('CC: ',ccaddr,afullname)
                end
              else
                xwritess('CC: ',ccaddr);
            end;

          xclreolxy(1,lpp);

          includedfile := '';

          cannotusemsg := '(no file entered yet!)';
          while cannotusemsg<>'' do
            begin
              getexistingfilename(
               includedfile,'(blank to exit) File:',includedfile);

              includedfile := unslash(includedfile);

              cannotusemsg := '';

              if includedfile<>'' then
                if illegalfn(includedfile) then
                  cannotusemsg := 'illegal filename';

              if (includedfile<>'') and not trusted and (cannotusemsg='') then
                if suspiciousfn(includedfile) then
                  cannotusemsg := 'without -t/--trusted';

              if (includedfile<>'') and (cannotusemsg='') then
                if isdev(includedfile) then
                  cannotusemsg := 'reserved device name';

              if (includedfile<>'') and (cannotusemsg='') then
                if not fexists(includedfile) then
                  cannotusemsg := 'file does not exist';

              if (includedfile<>'') and (cannotusemsg<>'') then
                warn('unable to use: '+cannotusemsg);
            end;

          if (includedfile<>'') and (cannotusemsg='') then
            begin
              nsubject := 'included file: '+includedfile;

              if not trusted then
                includedfile := withbackslash(home)+includedfile;

              xclreolxy(1,lpp);
              xwrites('Subject: ');
              xreadlns(nsubject,max(cols-10,70),yespreserve);

              editanddeliver(
              {subject        }  nsubject,
              {inreplyto      }  '',
              {replyaddr      }  toaddr,
              {replyname      }  '',
              {ccaddr         }  ccaddr,
              {originalfrom   }  '',
              {author         }  '',
              {defaultreply   }  false,
              {includedfile   }  includedfile,
              {justremail     }  false
                            );

            end;
        end;
    end;

{ caller must refresh }

end;

end.