summaryrefslogtreecommitdiff
path: root/support/rnototex/argops.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/argops.pas
Initial commit
Diffstat (limited to 'support/rnototex/argops.pas')
-rw-r--r--support/rnototex/argops.pas293
1 files changed, 293 insertions, 0 deletions
diff --git a/support/rnototex/argops.pas b/support/rnototex/argops.pas
new file mode 100644
index 0000000000..8123892abf
--- /dev/null
+++ b/support/rnototex/argops.pas
@@ -0,0 +1,293 @@
+{ MODULE FOR LIST AND TREE OPERATIONS ARGUMENTS }
+{ RANDALL VENHOLA JULY 8, 1987 }
+
+
+[INHERIT('SCREENHANDLERS','UTILITYOPS'), environment('argops')]
+
+MODULE ARGOPS;
+
+CONST
+
+ maxchars = 31; {# of chars in arg literal }
+ maxargsinarray = 30; {for conversion to an array of args}
+ indexofunknowntexcommand = 0;
+
+TYPE
+
+ pckstr = VARYING [ maxchars ] of char;
+
+ comparisons = (notvalid, lessthan, equal, greaterthan);
+
+ setofcomparisons = set of comparisons;
+
+ argtype = ( dsrverb, int, signedint, stylespecifier,
+ textpckstr, character, quotedpckstr, nulltype);
+
+ setofargtype = set of argtype;
+
+ argument = record
+ source : pckstr;
+ isgeneralization : boolean;
+ texindex : integer;
+ class : setofargtype
+ end;
+
+ argarray = array[1..maxargsinarray] of argument;
+
+
+
+
+[GLOBAL] FUNCTION argliteral( arg : argument; smooth : boolean ) : pckstr;
+
+var
+ s : pckstr;
+ i,j, firstchar, lastchar : integer;
+ ch : char;
+
+ procedure findfirstchar( s : pckstr; var firstchar : integer);
+ begin
+ firstchar := 1;
+ while (firstchar < s.length) and (s.body[firstchar] <= blank) do
+ firstchar := firstchar + 1
+ end;
+
+ procedure findlastchar( s : pckstr; var lastchar : integer );
+ begin
+ lastchar := s.length;
+ while (lastchar > 1) and (s.body[lastchar] <= blank) do
+ lastchar := lastchar - 1
+ end;
+
+begin
+ if smooth then
+ begin
+ findfirstchar( arg.source, firstchar);
+ findlastchar( arg.source, lastchar);
+ j := 0;
+ for i := firstchar to lastchar do
+ begin
+ ch := arg.source.body[i];
+ if ch < blank then ch := blank;
+ if ch in ['a'..'z'] then ch := chr(ord(ch) - ord(blank));
+ j := j + 1;
+ s.body[j] := ch
+ end;
+ if (j = 1) and (s.body[1] = blank) then
+ s.length := 0
+ else
+ s.length := j
+ end
+ else
+ s := arg.source;
+ argliteral := s
+end;
+
+
+
+
+
+[GLOBAL] FUNCTION pckstrisgeneralization( s : pckstr ) : boolean;
+ label
+ routineexit;
+ var
+ flag : boolean;
+ begin
+ flag := false;
+ if s = '[N]' then
+ begin
+ flag := true;
+ goto routineexit
+ end;
+ if s = '[C]' then
+ begin
+ flag := true;
+ goto routineexit
+ end;
+ if s = '[Y]' then
+ begin
+ flag := true;
+ goto routineexit
+ end;
+ if s = '[T]' then
+ begin
+ flag := true;
+ goto routineexit
+ end;
+ if s = '[Q]' then
+ begin
+ flag := true;
+ goto routineexit
+ end;
+ routineexit : pckstrisgeneralization := flag
+end;
+
+
+
+
+[GLOBAL] FUNCTION argisgeneralization( arg : argument ) : boolean;
+begin
+ argisgeneralization := arg.isgeneralization
+end;
+
+
+
+
+[GLOBAL] FUNCTION textualmatch( arg1, arg2 : argument) : boolean;
+begin
+ textualmatch := false;
+ if (arg1.source = '[T]') and (textpckstr in arg2.class) then
+ textualmatch := true
+ else
+ if (arg2.source = '[T]') and (textpckstr in arg1.class) then
+ textualmatch := true
+end;
+
+
+
+
+[GLOBAL] FUNCTION compareargs( leftarg, rightarg : argument ) : comparisons;
+label
+ routineexit;
+var
+ lefts, rights : pckstr;
+ equalpckstrs : boolean;
+ comp : comparisons;
+
+ procedure greaterorlessthancompare;
+ begin
+ if lefts < rights then
+ comp := lessthan
+ else
+ comp := greaterthan
+ end;
+
+ procedure checktexindex;
+ begin
+ if (leftarg.texindex = indexofunknowntexcommand) or
+ (rightarg.texindex = indexofunknowntexcommand) then
+ comp := equal
+ else
+ if leftarg.texindex = rightarg.texindex then
+ comp := equal
+ else
+ greaterorlessthancompare
+ end;
+
+begin
+ if textualmatch( leftarg, rightarg) then
+ begin
+ comp := equal;
+ goto routineexit
+ end;
+ if (leftarg.class = [nulltype]) or (rightarg.class = [nulltype]) then
+ begin
+ comp := equal;
+ goto routineexit
+ end;
+ lefts := argliteral(leftarg, TRUE);
+ rights := argliteral(rightarg, TRUE);
+ equalpckstrs := (lefts = rights);
+ comp := notvalid;
+ if leftarg.class * rightarg.class <> [] then
+ begin
+ if equalpckstrs then
+ comp := equal
+ else
+ if (leftarg.isgeneralization) or (rightarg.isgeneralization) then
+ checktexindex
+ else
+ greaterorlessthancompare
+ end
+ else
+ greaterorlessthancompare;
+ routineexit : compareargs := comp
+end;
+
+
+
+
+[GLOBAL] FUNCTION argtexindex( arg : argument ) : integer;
+begin
+ argtexindex := arg.texindex
+end;
+
+
+
+
+[GLOBAL] FUNCTION argclass( arg : argument ) : setofargtype;
+begin
+ argclass := arg.class
+end;
+
+
+
+
+[GLOBAL] PROCEDURE initarg( var arg : argument; classification : setofargtype;
+ lit : pckstr; index : integer; general : boolean );
+begin
+ arg.source := lit;
+ arg.class := classification;
+ arg.texindex := index;
+ arg.isgeneralization := general
+end;
+
+
+
+
+[GLOBAL] PROCEDURE reassignargclass( var arg : argument; newclass : setofargtype);
+begin
+ arg.class := newclass
+end;
+
+
+
+
+[GLOBAL] PROCEDURE reassignargtexindex( var arg : argument; newindex:integer);
+begin
+ arg.texindex := newindex
+end;
+
+
+
+[GLOBAL] PROCEDURE reassignarggeneralization( var arg : argument;general:boolean);
+begin
+ arg.isgeneralization := general
+end;
+
+
+
+
+[GLOBAL] PROCEDURE appendchartoarg( ch : char; var arg : argument );
+begin
+ if arg.source.length = maxchars then
+ warningmessage('appendchartoarg','argument too long')
+ else
+ begin
+ arg.source.length := arg.source.length + 1;
+ arg.source.body[arg.source.length] := ch
+ end
+end;
+
+
+
+
+[GLOBAL] PROCEDURE extractintegerfromargument( arg : argument; var successful : boolean;
+ var int : integer;
+ var signed : boolean );
+var
+ s : pckstr;
+begin
+ s := argliteral( arg, TRUE);
+ readv( s, int, error := continue );
+ if statusv <> 0 then
+ successful := false
+ else
+ begin
+ successful := true;
+ signed := (s.body[1] = '+') or (s.body[1] = '-')
+ end
+end;
+
+
+
+END.