program detroff;

{ Does minimal troff to ascii conversion for S-PLUS help files }

uses objects,dos,  { Standard BP 7 units }
     foreach,      { A unit for iterating across file sets }
     opstring,opdos; { Object Professional units }

procedure Syntax_Exit;
begin
  writeln('Syntax:   DETROFF fileset  [fileset]... backupdir');
  writeln('  This will convert the S-PLUS help files in the fileset');
  writeln('  from nroff/troff form to formatted ASCII form, to use in');
  writeln('  S-PLUS for Windows.  Original files will be copied into');
  writeln('  the backup directory.');
  halt(99);
end;

type
  TTroff = (none, BG,FN,TL,DN,CS,RA,OA,AG,RT,SE,DT,SH,SA,EX,KW,WR,RC,GE,ME,XY,
                  GR,Tl2,AO,NA,PP,IP,BP,
                  comment,br,ul,Cs2,Ce);

function troffcommand(word:string):TTroff;
const
  commands =    '_BG_FN_TL_DN_CS_RA_OA_AG_RT_SE_DT_SH_SA_EX_KW_WR_RC_GE_ME_XY_'
                +'GR_Tl_AO_NA_PP_IP_BP_'
                +'\"_br_ul_Cs_Ce';
var
  result : TTroff;
begin
  if (length(word) = 3) and (word[1] = '.') then
  begin
    word[1] :='_';
    result := TTroff( (pos(word,commands) + 2) div 3);
    troffcommand := result;
  end
  else
    troffcommand := none;
end;

var
  inbuf,outbuf : array[1..8192] of byte;
  backupdir : string;

procedure Process(const infilename,outfilename:string);
var
  line,word,leftover : string;
  infile,outfile: text;
  wrapping : boolean;
  indent : integer;
  cmd : TTroff;
  spacepos : integer;
const
  width = 72;

  procedure FinishParagraph;
  begin
    if length(leftover) > 0 then
    begin
      writeln(outfile,'':indent,leftover);
      leftover := '';
    end;
  end;

  procedure StartSection(const title:string);
  begin
    writeln(outfile);
    writeln(outfile,title);
  end;

  procedure Put(line:string);
  begin
    if wordcount(line,[' ']) = 0 then
    begin
      finishparagraph;
      writeln(outfile);
    end
    else if wrapping then
    begin
      repeat
        wordwrap(leftover+line,line,leftover,width-indent,false);
        if leftover = '' then
          break;
        writeln(outfile,'':indent,line);
        line := '';
      until false;
      if length(line) > 0 then
        leftover := line+' ';
    end
    else
      writeln(outfile,'':indent,line);
  end;

begin
  leftover := '';
  wrapping := false;   { Set defaults so non TROFF isn't changed }
  indent := 0;
  assign(infile,infilename);
  settextbuf(infile,inbuf);
  reset(infile);
  assign(outfile,outfilename);
  settextbuf(outfile,outbuf);
  rewrite(outfile);

  while not eof(infile) do
  begin
    readln(infile,line);
    spacepos := pos(' ',line);
    if spacepos > 0 then
      word := copy(line,1,spacepos-1)
    else
      word := line;
    cmd := troffcommand(word);
    if cmd in [BG..BP] then  { All the S-PLUS specific ones }
    begin
      finishparagraph;
      wrapping := true;
      indent := 8;
    end;
    case cmd of
      BG, FN, KW, WR, ul, comment : begin {ignore } end;
      TL : indent := 0;
      DN : StartSection('DESCRIPTION:');
      CS : begin
             StartSection('USAGE:');
             wrapping := false;
           end;
      RA : StartSection('REQUIRED ARGUMENTS:');
      OA : StartSection('OPTIONAL ARGUMENTS:');
   AG,RC : writeln(outfile,' ',copy(line,wordposition(2,line,[' ']),255),':');
      RT : StartSection('VALUE:');
      SE : StartSection('SIDE EFFECTS:');
      DT : StartSection('DETAILS:');
      SH : StartSection(copy(line,wordposition(2,line,[' ']),255)+':');
      SA : StartSection('SEE ALSO:');
      EX : begin
             StartSection('EXAMPLES:');
             wrapping := false;
           end;
      GE : begin
             put('This function is generic (see Methods); method functions can be');
             put('written to handle specific classes of data.  Classes which already');
             put('have methods for this function include:');
           end;
      ME : begin
             put('This function is a method for the generic function');
             put(extractword(2,line,[' ']));
             put('for class');
             put(extractword(3,line,[' '])+'. ');
             put('It can be invoked by calling');
             put(extractword(2,line,[' ']));
             put('for an object of the appropriate class, or directly by calling');
             put(extractword(2,line,[' '])+'.'+extractword(3,line,[' ']));
             put('regardless of the class of the object.');
           end;
      XY : begin
             put('coordinates of points.  The coordinates can be given by two');
             put('arguments that are vectors, or by a single argument x which');
             put('is a univariate time series, a complex vector, a matrix with');
             put('2 columns, or a list containing components named x and y.');
           end;
      GR : begin
             put('Graphical parameters may also be supplied as arguments to this');
             put('function (see  par).');
           end;
      Tl2 : begin
             put('In addition, the high-level graphics arguments described under');
             put('par and the arguments to title may be supplied to this function.');
           end;
      AO : begin
             put('Arguments for function ');
             put(extractword(2,line,[' ']));
             put('can also be supplied to this function.');
           end;
      NA : put('Missing values (NAs) are allowed.');
      PP : put('');
      IP : begin
             FinishParagraph;
             leftover := '    ';
           end;
      BP : begin
             FinishParagraph;
             write(outfile,^L);
           end;
      br : FinishParagraph;
      Cs2 : begin
             FinishParagraph;
             wrapping := false;
           end;
      Ce : wrapping := true;
      else
        Put(line);
    end;
  end;
  finishparagraph;
  close(infile);
  close(outfile);
end;

procedure Convertfile(const Path:string;const S:Searchrec;dummy:word); far;
var
  oldname,newname : string;
  s1,s2: TBufStream;
begin
  begin
    oldname := path+s.name;
    newname := backupdir+s.name;
    if existfile(newname) then
      writeln('Skipped ',oldname,'; ',newname,' already exists.')
    else
    begin
      write('Converting ',oldname,' ...');
      s1.init(oldname,stOpenRead,4096);
      s2.init(newname,stCreate,4096);
      s2.copyfrom(s1,s1.getsize);
      s1.done;
      s2.done;
      process(newname,oldname);
      writeln(' done.');
    end;
  end;
end;

var
  i : Integer;
begin
  writeln('DETROFF - Convert S-PLUS help files to ASCII format');
  writeln('Written in 1994 by D.J. Murdoch for the public domain.');
  if paramcount < 2 then
    Syntax_exit;
  backupdir := paramstr(paramcount);
  if not (backupdir[length(backupdir)] in ['\',':']) then
    backupdir := backupdir + '\';
  for i:=1 to paramcount-1 do
    foreachfile(paramstr(i),0,0,false,@Convertfile);
end.