[INHERIT('SCREENHANDLERS','UTILITYOPS','ARGOPS',
'TREEANDLISTOPS','FLAGOPS','CONVERSION'), environment('dsrops')]

MODULE DSROPS;


CONST
    
   indexofpagecommand = 38;

VAR
    
    totallines             : [EXTERNAL] integer;
    totalgooddsrcommands : [EXTERNAL] integer;
    totalbaddsrcommands  : [EXTERNAL] integer;





[GLOBAL] FUNCTION listispagecommand( list : arglist ) : boolean;
var
   s : pckstr;
begin 
   listispagecommand := false;
   if arglistlength(list) = 1 then
   begin
      s := argliteral(firstarg(list), TRUE );
      if s = 'PAGE' then
        listispagecommand := true
   end 
end;


                              
[GLOBAL] PROCEDURE checkfordsrcommand( var infile, outfile : text; 
	                         var dsrcommand : boolean );
var
  gotten : boolean;
begin
  if flagclass(currentchar) = control then
  begin           
    getnextchar(infile, gotten);
    if gotten then
    begin
      if (flagclass(currentchar) <> comment) and (currentchar <> blank) then
          dsrcommand := true
    end
    else
    begin
      dsrcommand := false;   
      texwrite(outfile, currentchar)
    end                     
  end
  else
    dsrcommand := false
end;




[GLOBAL] PROCEDURE parsedsrcommand( var infile, outfile : text; var list :
	                              arglist; var anothercommand : boolean;
	                              var carrychar : boolean; var charcarried : char);
const                                                          
   dontwritethem = false;
type
   charidentity = (letter, separator, number, semicolon, quote, commentchar,newdsrcommand);
var                                    
   quotedchar : char;
   argread : argument;   
   currentargclass : charidentity;
   done, gotten, atseparator, endofdsrcommand : boolean;
   i : integer;

   function charclass( ch : char ) : charidentity;
   label
      localexit;
   begin
      charclass := separator;                                       
      if flagclass( ch ) = control then
      begin
         charclass := newdsrcommand;      
         goto localexit
      end;
      if ch in ['a'..'z','A'..'Z'] then
      begin
         charclass := letter;
         goto localexit
      end;
      if ch in ['+','-','0'..'9'] then
      begin                                                                    
         charclass := number;
	 goto localexit
      end;
      if ch in [chr(34), chr(39)] then
      begin
         charclass := quote;
         goto localexit
      end;
      if flagclass(currentchar) = comment then
      begin
         charclass := commentchar;
         goto localexit
      end;
      if ch = ';' then
        charclass := semicolon;                        
      localexit : nullstatement
   end;
                                                                               
   procedure startarg( ch : char; var arg : argument; startset : setofargtype);
   begin
      initarg(arg, startset, ch, indexofunknowntexcommand, false);
   end;

begin   
    list := nulllist;
    atseparator := false;
    endofdsrcommand := false;
    anothercommand := false;                        
    carrychar := false;
    repeat
         currentargclass := charclass(currentchar);
         case currentargclass of 
       	    letter  : begin
	                atseparator := false;
	                startarg(currentchar, argread, [dsrverb,stylespecifier, textpckstr,character]);
                        done := false;
                        repeat
	                    getnextchar(infile, gotten);
                            if gotten then                                    
	                    begin
	                        if charclass(currentchar) = letter then
                                    appendchartoarg(currentchar, argread)
                                else
                                    done := true
                            end
	                    else
                            begin
                                done := true;
	                        endofdsrcommand :=  true
	                    end
	                until done;
	                appendargonlist(list, argread )
                     end;
       	    number  : begin
	                atseparator := false;
	                startarg(currentchar, argread, [int,signedint,textpckstr,nulltype]);
                        done := false;
                        repeat
	                    getnextchar(infile, gotten);
                            if gotten then                                    
	                    begin
	                        if charclass(currentchar) = number then
                                    appendchartoarg(currentchar, argread)
                                else
                                    done := true
                            end
	                    else
                            begin
                                done := true;
	                        endofdsrcommand :=  true
	                    end
	                until done;
	                appendargonlist(list, argread )
                     end;                                           
	 separator : begin                                        
	                passblanks(infile, outfile, dontwritethem);
	                if (atseparator) and (currentchar <> lastinputchar) then
	                begin
	                    startarg(blank, argread, [nulltype]);
	                    appendargonlist(list, argread);
                            atseparator := false
	                end
	                else
	                begin
                            if flagclass(currentchar) = control then
	                      endofdsrcommand := true
                            else
                              if charclass(currentchar) = separator then
                              begin
                                getnextchar(infile, gotten);
	                        if gotten then
                                   atseparator := true
	                        else
                                begin
                                   atseparator := false;
	                           startarg(blank, argread, [nulltype]);
	                           appendargonlist(list, argread);
	                           endofdsrcommand := true         
                                end
                              end
	                end
	             end;                                                             
	semicolon : begin
                       endofdsrcommand := true;
	               getnextchar(infile, gotten);
	               if charclass(currentchar) = newdsrcommand then
	                  currentargclass := newdsrcommand
	               else
	               begin
	                 carrychar := true;
	                 charcarried := currentchar
	               end
	             end;
	    quote  : begin       
	                quotedchar := currentchar;
	                getnextchar(infile, gotten);
                        if gotten then
	                begin
	                   startarg(currentchar, argread, [quotedpckstr]);
	                   done := false;
	                   repeat
	                      getnextchar(infile, gotten);
	                      if gotten then
	                      begin
	                        if charclass(currentchar) = quote then
	                        begin
	                            getnextchar(infile, gotten);
	                            done := true;
	                            if not gotten then
	                                endofdsrcommand := true
	                        end
	                        else
	                            appendchartoarg(currentchar, argread)
	                      end                                              
                              else
	                      begin
	                        endofdsrcommand := true;
	                        done := true
	                      end
	                   until done
	                end
	                else                                           
	                  startarg(quotedchar, argread,[textpckstr,character]);
                        appendargonlist(list, argread)
                     end;
      commentchar : begin
	               endofdsrcommand := true
                     end;
   newdsrcommand : begin
                       endofdsrcommand := true;  
                     end
      end; {case}
    until endofdsrcommand;                    
    if currentargclass <> newdsrcommand then
      newline( infile, outfile, false)           
    else
      anothercommand := true
end;
	                               
      
                                     
PROCEDURE parsefile( var infile, outfile : text; textree : argtree );
const                 
   nocrlf = false;
   putcrlf = true;                              
var
   dsrcommandfound      : boolean;
   chargotten            : boolean;
   dsrarguments          : arglist;
   texcommandindex      : integer;
   nextcommandtowrite  : integer;                             
   successfulparse       : boolean;
   depthofsearch        : integer;                                         
   anothercommand        : boolean;
   carrychar             : boolean;
   charcarried, copychar : char;
begin     
  ttywritestring('Translating input ...');                         
  totalgooddsrcommands := 0;
  totalbaddsrcommands := 0;
  nextcommandtowrite := indexofunknowntexcommand;
  anothercommand := false;
  repeat                                    
    putsecondarytexcommand( outfile, nextcommandtowrite);
    repeat
      checkfordsrcommand( infile, outfile, dsrcommandfound );
      if dsrcommandfound then
      begin
        parsedsrcommand( infile, outfile, dsrarguments, anothercommand,carrychar,charcarried);
        if listispagecommand( dsrarguments) then
        begin
          successfulparse := true;
          texcommandindex := indexofpagecommand
        end
        else
          searchtreeforlist( textree, dsrarguments,successfulparse, texcommandindex,
          depthofsearch);            
        if successfulparse then
        begin
          totalgooddsrcommands := totalgooddsrcommands + 1;
          puttexcommand(outfile, texcommandindex, dsrarguments, nextcommandtowrite);
          if carrychar then
          begin
	     copychar := currentchar;
	     currentchar := charcarried;
	     writecurrentchar( infile, outfile );
	     currentchar := copychar
          end
        end
        else
        begin
          totalbaddsrcommands := totalbaddsrcommands + 1;
          write(outfile,'%Unidentified RUNOFF command "');
          dumpthelist(outfile, dsrarguments);
          writeln(outfile,'"')
        end
      end
      else
        anothercommand := false
    until (not dsrcommandfound) and (not anothercommand);
    repeat
      writecurrentchar( infile, outfile );
      getnextchar(infile, chargotten)
    until not chargotten;
    newline(infile, outfile, putcrlf)
  until eof(infile)
end;



END.