[net.sources] Software Tools in Pascal 2/8

jp@lanl.ARPA (10/06/85)

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