Software Tools in Pascal 2/8
jp at lanl.ARPA
jp at lanl.ARPA
Sun Oct 6 14:57:34 AEST 1985
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ AddStr -- put c in outSet[j] if it fits, increment j }
segment AddStr;
%include swtools
function Addstr;
begin
if (j > maxSet) then
AddStr := false
else begin
outSet[j] := c;
j := j + 1;
AddStr := true
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ AMatch -- look for match of pat[i]... at lin[offset]... }
segment AMatch;
%include swtools
%include patdef
%include matchdef
%include metadef
function RAMatch (var lin: StringType; offset: Integer;
var pat: StringType; j: Integer): Integer;
forward;
function AMatch;
var
k: Integer;
begin
metaStackPointer := 1;
metaIndex := 1;
metaTable := nullMetaTable;
metaTable[0].first := offset;
k := RAMatch(lin, offset, pat, j);
metaTable[0].last := k;
AMatch := k;
end;
{ RAMatch -- new AMatch with metas }
function RAMatch;
var
i, k: Integer;
metaStackTemp: Integer;
done: Boolean;
begin
done := false;
while (not done) and (pat[j] <> ENDSTR) do
if (pat[j] = CLOSURE) then begin
metaStackTemp := metaStackPointer;
j := j + PatSize(pat, j);
i := offset;
{match as many as possible }
while (not done) and (lin[i] <> ENDSTR) do
if (not OMatch(lin, i, pat, j)) then begin
metaStackPointer := metaStackTemp;
done := true;
end
else
metaStackTemp := metaStackPointer;
{ i points to input character that made us fail }
{ match rest of pattern against rest of input }
{ shrink closure by 1 after each failure }
done := false;
while (not done) and (i >= offset) do begin
metaStackTemp := metaStackPointer;
k := RAMatch(lin, i, pat, j+PatSize(pat, j));
if (k > 0) then { matched rest of pattern}
done := true
else begin
metaStackPointer := metaStackTemp;
i := i - 1
end
end;
offset := k; { if k = 0 failure, else success }
done := true
end
else if (not OMatch(lin, offset, pat, j)) then begin
offset := 0;
done := true
end
else { OMatch succeeded on this pattern element }
j := j + PatSize(pat, j);
RAMatch := offset
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Append -- append lines after "line" }
segment Append;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function Append;
var
inLine: StringType;
stat: STCode;
done: Boolean;
begin
if (glob) then
stat := ERR
else begin
curLn := line;
stat := OK;
done := false;
while (not done) and (stat = OK) do
if (not GetLine(inLine, STDIN, MAXSTR)) then
stat := ENDDATA
else if (inLine[1] = PERIOD) and
(inLine[2] = NEWLINE) then
done := true
else if (PutTxt(inLine) = ERR) then
stat := ERR
end;
Append := stat
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CatSub -- add replacement text to end of new }
segment CatSub;
%include swtools
%include subdef
%include metadef
procedure CatSub;
var
i,j: Integer;
junk: Boolean;
l: Integer;
begin
i := 1;
while (sub[i] <> ENDSTR) do begin
if (sub[i] = DITTO) then begin
l := Ord(sub[i+1]);
if (l in [0..9]) then begin
for j := metaTable[l].first to metaTable[l].last -1 do
junk := AddStr(lin[j], new, k, maxNew);
i := i + 1
end
else
for j := s1 to s2-1 do
junk := AddStr(lin[j], new, k, maxNew)
end
else
junk := AddStr(sub[i], new, k, maxNew);
i := i + 1
end
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CharClass -- definition of character table }
segment CharClass;
%include swtools
%include chardef
value
CharTable := ChTable(
[] { 00 }, [] { 01 }, [] { 02 }, [] { 03 },
[] { 04 }, [] { 05 }, [] { 06 }, [] { 07 },
[] { 08 }, [] { 09 }, [] { 0a }, [] { 0b },
[] { 0c }, [] { 0d }, [] { 0e }, [] { 0f },
[] { 10 }, [] { 11 }, [] { 12 }, [] { 13 },
[] { 14 }, [] { 15 }, [] { 16 }, [] { 17 },
[] { 18 }, [] { 19 }, [] { 1a }, [] { 1b },
[] { 1c }, [] { 1d }, [] { 1e }, [] { 1f },
[] { 20 }, [] { 21 }, [] { 22 }, [] { 23 },
[] { 24 }, [] { 25 }, [] { 26 }, [] { 27 },
[] { 28 }, [] { 29 }, [] { 2a }, [] { 2b },
[] { 2c }, [] { 2d }, [] { 2e }, [] { 2f },
[] { 30 }, [] { 31 }, [] { 32 }, [] { 33 },
[] { 34 }, [] { 35 }, [] { 36 }, [] { 37 },
[] { 38 }, [] { 39 }, [] { 3a }, [] { 3b },
[] { 3c }, [] { 3d }, [] { 3e }, [] { 3f },
[ChSpecial] { 40 },
[] { 41 }, [] { 42 }, [] { 43 },
[] { 44 }, [] { 45 }, [] { 46 }, [] { 47 },
[] { 48 }, [] { 49 },
[ChSpecial] { 4a }, [ChSpecial] { 4b },
[ChSpecial] { 4c }, [ChSpecial] { 4d },
[ChSpecial] { 4e }, [ChSpecial] { 4f },
[ChSpecial] { 50 },
[] { 51 }, [] { 52 }, [] { 53 },
[] { 54 }, [] { 55 }, [] { 56 }, [] { 57 },
[] { 58 }, [] { 59 },
[ChSpecial] { 5a }, [ChSpecial] { 5b },
[ChSpecial] { 5c }, [ChSpecial] { 5d },
[ChSpecial] { 5e }, [ChSpecial] { 5f },
[ChSpecial] { 60 }, [ChSpecial] { 61 },
[] { 62 }, [] { 63 },
[] { 64 }, [] { 65 }, [] { 66 }, [] { 67 },
[] { 68 }, [] { 69 }, [] { 6a },
[ChSpecial] { 6b },
[ChSpecial] { 6c }, [ChSpecial] { 6d },
[ChSpecial] { 6e }, [ChSpecial] { 6f },
[] { 70 }, [] { 71 }, [] { 72 }, [] { 73 },
[] { 74 }, [] { 75 }, [] { 76 }, [] { 77 },
[] { 78 }, [] { 79 },
[ChSpecial] { 7a }, [ChSpecial] { 7b },
[ChSpecial] { 7c }, [ChSpecial] { 7d },
[ChSpecial] { 7e }, [ChSpecial] { 7f },
[] { 80 },
[ChLetter,ChLower] { 81 },
[ChLetter,ChLower] { 82 }, [ChLetter,ChLower] { 83 },
[ChLetter,ChLower] { 84 }, [ChLetter,ChLower] { 85 },
[ChLetter,ChLower] { 86 }, [ChLetter,ChLower] { 87 },
[ChLetter,ChLower] { 88 }, [ChLetter,ChLower] { 89 },
[] { 8a },
[ChSpecial] { 8b },
[] { 8c }, [] { 8d }, [] { 8e }, [] { 8f },
[] { 90 },
[ChLetter,ChLower] { 91 },
[ChLetter,ChLower] { 92 }, [ChLetter,ChLower] { 93 },
[ChLetter,ChLower] { 94 }, [ChLetter,ChLower] { 95 },
[ChLetter,ChLower] { 96 }, [ChLetter,ChLower] { 97 },
[ChLetter,ChLower] { 98 }, [ChLetter,ChLower] { 99 },
[] { 9a },
[ChSpecial] { 9b },
[] { 9c }, [] { 9d }, [] { 9e }, [] { 9f },
[] { a0 }, [] { a1 },
[ChLetter,ChLower] { a2 }, [ChLetter,ChLower] { a3 },
[ChLetter,ChLower] { a4 }, [ChLetter,ChLower] { a5 },
[ChLetter,ChLower] { a6 }, [ChLetter,ChLower] { a7 },
[ChLetter,ChLower] { a8 }, [ChLetter,ChLower] { a9 },
[] { aa }, [] { ab },
[] { ac },
[ChSpecial] { ad },
[] { ae }, [] { af },
[] { b0 }, [] { b1 }, [] { b2 }, [] { b3 },
[] { b4 }, [] { b5 }, [] { b6 }, [] { b7 },
[] { b8 }, [] { b9 }, [] { ba }, [] { bb },
[] { bc },
[ChSpecial] { bd },
[] { be }, [] { bf },
[] { c0 },
[ChLetter,ChUpper] { c1 },
[ChLetter,ChUpper] { c2 }, [ChLetter,ChUpper] { c3 },
[ChLetter,ChUpper] { c4 }, [ChLetter,ChUpper] { c5 },
[ChLetter,ChUpper] { c6 }, [ChLetter,ChUpper] { c7 },
[ChLetter,ChUpper] { c8 }, [ChLetter,ChUpper] { c9 },
[] { ca }, [] { cb },
[] { cc }, [] { cd }, [] { ce }, [] { cf },
[] { d0 },
[ChLetter,ChUpper] { d1 },
[ChLetter,ChUpper] { d2 }, [ChLetter,ChUpper] { d3 },
[ChLetter,ChUpper] { d4 }, [ChLetter,ChUpper] { d5 },
[ChLetter,ChUpper] { d6 }, [ChLetter,ChUpper] { d7 },
[ChLetter,ChUpper] { d8 }, [ChLetter,ChUpper] { d9 },
[] { da }, [] { db },
[] { dc }, [] { dd }, [] { de }, [] { df },
[] { e0 }, [] { e1 },
[ChLetter,ChUpper] { e2 }, [ChLetter,ChUpper] { e3 },
[ChLetter,ChUpper] { e4 }, [ChLetter,ChUpper] { e5 },
[ChLetter,ChUpper] { e6 }, [ChLetter,ChUpper] { e7 },
[ChLetter,ChUpper] { e8 }, [ChLetter,ChUpper] { e9 },
[] { ea }, [] { eb },
[] { ec }, [] { ed }, [] { ee }, [] { ef },
[ChDigit] { f0 }, [ChDigit] { f1 },
[ChDigit] { f2 }, [ChDigit] { f3 },
[ChDigit] { f4 }, [ChDigit] { f5 },
[ChDigit] { f6 }, [ChDigit] { f7 },
[ChDigit] { f8 }, [ChDigit] { f9 },
[] { fa }, [] { fb },
[] { fc }, [] { fd }, [] { fe }, [] { ff }
);
function CharClass;
begin
CharClass := CharTable[Ord(tIndex)]
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CkGlob -- if global prefix, mark lines to be affected }
segment CkGlob;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
%include matchdef
function CkGlob;
var
n: Integer;
gFlag: Boolean;
temp: StringType;
begin
if (lin[i] <> GCMD) and (lin[i] <> XCMD) then
status := ENDDATA
else begin
gFlag := (lin[i] = GCMD);
i := i + 1;
if (OptPat(lin, i) = ERR) then
status := ERR
else if (Default(1, lastLn, status) <> ERR) then begin
i := i + 1; { mark affected lines }
for n := line1 to line2 do begin
GetTxt(n, temp);
PutMark(n, (Match(temp, pat) = gFlag))
end;
for n := 1 to line1-1 do { erase other marks }
PutMark(n, false);
for n := line2+1 to lastLn do
PutMark(n, false);
status := OK
end
end;
CkGlob := status
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CkP -- check for "p" after command }
segment CkP;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function CkP;
begin
SkipBl(lin, i);
if (lin[i] = PCMD) then begin
i := i + 1;
pFlag := true
end
else
pFlag := false;
if (lin[i] = NEWLINE) then
status := OK
else
status := ERR;
CkP := status
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CSCopy -- copy cb[i]... to string s }
segment CSCopy;
%include swtools
%include defdef
%include defref
%include defproc
procedure CSCopy;
var
j: Integer;
begin
j := 1;
while (cb[i] <> ENDSTR) do begin
s[j] := cb[i];
i := i + 1;
j := j + 1
end;
s[j] := ENDSTR
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CToI -- convert string at s[i] to integer, increment i }
segment ctoi;
%include swtools
function CToI;
var
n, sign: Integer;
begin
while (s[i] = BLANK) or (s[i] = TAB) do
i := i + 1;
if (s[i] = MINUS) then
sign := -1
else
sign := 1;
if (s[i] = MINUS) or (s[i] = PLUS) then
i := i + 1;
n := 0;
while(IsDigit(s[i])) do begin
n := 10 * n + Ord(s[i]) - Ord(DIG0);
i := i + 1;
end;
CToI := sign * n;
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CvtSST -- assign pascalvs string to StringType }
segment CvtSST;
%include swtools
procedure CvtSST;
var
i: 1..MAXSTR;
begin
for i := 1 to Length(src) do
dest[i] := src[i];
dest[Length(src) + 1] := ENDSTR;
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ CvtStS -- convert swtools StringType to Pascalvs String }
segment cvtsts;
%include swtools
procedure cvtsts;
begin
WriteStr(dest, src:StrLength(src));
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Default -- set Defaulted line numbers }
segment Default;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function Default;
begin
if (nLines = 0) then begin
line1 := def1;
line2 := def2
end;
if (line1 > line2) or (line1 <= 0) then
status := ERR
else
status := OK;
Default := status
end;
More information about the Comp.sources.unix
mailing list