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