summaryrefslogtreecommitdiff
path: root/support/rnototex/dsrops.pas
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/rnototex/dsrops.pas
Initial commit
Diffstat (limited to 'support/rnototex/dsrops.pas')
-rw-r--r--support/rnototex/dsrops.pas323
1 files changed, 323 insertions, 0 deletions
diff --git a/support/rnototex/dsrops.pas b/support/rnototex/dsrops.pas
new file mode 100644
index 0000000000..c83fe24033
--- /dev/null
+++ b/support/rnototex/dsrops.pas
@@ -0,0 +1,323 @@
+[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.