Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume2/tools/part6

Internet Message Format | 1986-11-30 | 47.1 KB

From: ihnp4!mnetor!clewis (Chris Lewis)
Subject: Software Tools in Pascal (Part 5 of 6)
Newsgroups: mod.sources
Approved: [e-mail]

Mod.sources:  Volume 2, Issue 11
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)

#!/bin/sh
echo 'Start of pack.out, part 05 of 06:'
echo 'x - append.pascal'
sed 's/^X//' > append.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Append -- append lines after "line" }
Xsegment Append;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Append;
Xvar
X    inLine: StringType;
X    stat: STCode;
X    done: Boolean;
Xbegin
X    if (glob) then
X        stat := ERR
X    else begin
X        curLn := line;
X        stat := OK;
X        done := false;
X        while (not done) and (stat = OK) do
X            if (not GetLine(inLine, STDIN, MAXSTR)) then
X                stat := ENDDATA
X            else if (inLine[1] = PERIOD) and
X              (inLine[2] = NEWLINE) then
X                done := true
X            else if (PutTxt(inLine) = ERR) then
X                stat := ERR
X    end;
X    Append := stat
Xend;
/
echo 'x - catsub.pascal'
sed 's/^X//' > catsub.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ CatSub -- add replacement text to end of new }
Xsegment CatSub;
X%include swtools
X%include subdef
X%include metadef
Xprocedure CatSub;
Xvar
X    i,j: Integer;
X    junk: Boolean;
X    l: Integer;
Xbegin
X    i := 1;
X    while (sub[i] <> ENDSTR) do begin
X        if (sub[i] = DITTO) then begin
X            l := Ord(sub[i+1]);
X            if (l in [0..9]) then begin
X                for j := metaTable[l].first to metaTable[l].last -1 do
X                    junk := AddStr(lin[j], new, k, maxNew);
X                i := i + 1
X            end
X            else
X                for j := s1 to s2-1 do
X                   junk := AddStr(lin[j], new, k, maxNew)
X        end
X        else
X            junk := AddStr(sub[i], new, k, maxNew);
X        i := i + 1
X    end
Xend;
/
echo 'x - ckp.pascal'
sed 's/^X//' > ckp.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ CkP -- check for "p" after command }
Xsegment CkP;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction CkP;
Xbegin
X    SkipBl(lin, i);
X    if (lin[i] = PCMD) then begin
X        i := i + 1;
X        pFlag := true
X    end
X    else
X        pFlag := false;
X    if (lin[i] = NEWLINE) then
X        status := OK
X    else
X        status := ERR;
X    CkP := status
Xend;
/
echo 'x - cscopy.pascal'
sed 's/^X//' > cscopy.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ CSCopy -- copy cb[i]... to string s }
Xsegment CSCopy;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure CSCopy;
Xvar
X    j: Integer;
Xbegin
X    j := 1;
X    while (cb[i] <> ENDSTR) do begin
X        s[j] := cb[i];
X        i := i + 1;
X        j := j + 1
X    end;
X    s[j] := ENDSTR
Xend;
/
echo 'x - ctoi.pascal'
sed 's/^X//' > ctoi.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ CToI -- convert string at s[i] to integer, increment i }
Xsegment ctoi;
X%include swtools
Xfunction CToI;
Xvar
X    n, sign: Integer;
Xbegin
X    while (s[i] = BLANK) or (s[i] = TAB) do
X        i := i + 1;
X    if (s[i] = MINUS) then
X        sign := -1
X    else
X        sign := 1;
X    if (s[i] = MINUS) or (s[i] = PLUS) then
X        i := i + 1;
X    n := 0;
X    while(IsDigit(s[i])) do begin
X        n := 10 * n + Ord(s[i]) - Ord(DIG0);
X        i := i + 1;
X    end;
X    CToI := sign * n;
Xend;
/
echo 'x - dochq.pascal'
sed 's/^X//' > dochq.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoChq -- Change quote characters }
Xsegment DoChq;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoChq;
Xvar
X    temp: StringType;
X    n: Integer;
Xbegin
X    CsCopy(evalStk, argStk[i+2], temp);
X    n := StrLength(temp);
X    if (n <= 0) then begin
X        lQuote := GRAVE;
X        rQuote := ACUTE;
X    end {elseif}
X    else if (n = 1) then begin
X        lQuote := temp[1];
X        rQuote := lQuote
X    end {elseif}
X    else begin
X        lQuote := temp[1];
X        rQuote := temp[2]
X    end {if}
Xend {DoCkq};
/
echo 'x - dodef.pascal'
sed 's/^X//' > dodef.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoDef -- install definition in table }
Xsegment DoDef;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoDef;
Xvar
X    temp1, temp2: StringType;
Xbegin
X    if (j - i > 2) then begin
X        CsCopy(evalStk, argStk[i+2], temp1);
X        CsCopy(evalStk, argStk[i+3], temp2);
X        Install(temp1, temp2, MACTYPE)
X    end {if};
Xend {DoDef};
/
echo 'x - doglob.pascal'
sed 's/^X//' > doglob.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoGlob -- do command at lin[i] on all marked lines }
Xsegment DoGlob;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoGlob;
Xvar
X    count, iStart, n: Integer;
Xbegin
X    status := OK;
X    count := 0;
X    n := line1;
X    iStart := i;
X    repeat
X        if (GetMark(n)) then begin
X            PutMark(n, false);
X            curLn := n;
X            curSave := curLn;
X            i := iStart;
X            if (GetList(lin, i, status) = OK) then
X                if (DoCmd(lin, i, true, status) = OK) then
X                    count := 0;
X        end
X        else begin
X            n := NextLn(n);
X            count := count + 1
X        end
X    until (count > lastLn) or (status <> OK);
X    DoGlob := status
Xend;
/
echo 'x - doif.pascal'
sed 's/^X//' > doif.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoIf -- Select one of two arguments }
Xsegment DoIf;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoIf;
Xvar
X    temp1, temp2, temp3: StringType;
Xbegin
X    if (j - i >= 4) then begin
X        CsCopy(evalStk, argStk[i+2], temp1);
X        CsCopy(evalStk, argStk[i+3], temp2);
X        if (Equal(temp1, temp2)) then
X            CsCopy(evalStk, argStk[i+4], temp3)
X        else if (j - i >= 5) then
X            CsCopy(evalStk, argStk[i+5], temp3)
X        else
X            temp3[1] := ENDSTR;
X        PBStr(temp3)
X    end {if}
Xend {DoIf};
/
echo 'x - dolen.pascal'
sed 's/^X//' > dolen.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoLen -- Return length of argument }
Xsegment DoLen;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoLen;
Xvar
X    temp: StringType;
Xbegin
X    if (j - i > 1) then begin
X        CsCopy(evalStk, argStk[i+2], temp);
X        PBNum(StrLength(temp))
X    end {then}
X    else
X        PBNum(0)
Xend {DoLen};
/
echo 'x - dolprint.pascal'
sed 's/^X//' > dolprint.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoLPrint -- print lines n1 thru n2 unambiguously }
Xsegment DoLPrint;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include chardef
Xfunction DoLPrint;
Xvar
X    lp: Integer;
X    i: Integer;
X    line: StringType;
Xbegin
X    if (n1 < 0) then
X        DoLPrint := ERR
X    else begin
X        for i := n1 to n2 do begin
X            GetTxt(i, line);
X            if OptIsOn(numFlag) then begin
X                PutDec(i, 5);
X                PutC(BLANK)
X            end;
X            for lp := 1 to StrLength(line) do begin
X                if CharClass(line[lp]) <> [] then
X                    PutC(line[lp])
X                else if line[lp] = NEWLINE then
X                    PutC(NEWLINE)
X                else begin
X                    PutC(BACKSLASH);
X                    PutDec(Ord(line[lp]), 3)
X                end
X           end
X        end;
X        curLn := n2;
X        DoLPrint := OK
X    end
Xend;
/
echo 'x - doprint.pascal'
sed 's/^X//' > doprint.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoPrint -- print lines n1 thru n2 }
Xsegment DoPrint;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoPrint;
Xvar
X    i: Integer;
X    line: StringType;
Xbegin
X    if (n1 < 0) then
X        DoPrint := ERR
X    else begin
X        for i := n1 to n2 do begin
X            GetTxt(i, line);
X            if OptIsOn(numFlag) then begin
X                PutDec(i, 5);
X                PutC(BLANK)
X            end;
X            PutStr(line, STDOUT)
X        end;
X        curLn := n2;
X        DoPrint := OK
X    end
Xend;
/
echo 'x - dowrite.pascal'
sed 's/^X//' > dowrite.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoWrite -- write lines n1..n2 into file }
Xsegment DoWrite;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoWrite;
Xvar
X    i: Integer;
X    fd: FileDesc;
X    line: StringType;
Xbegin
X    fd := FCreate(fil, IOWRITE);
X    if (fd = IOERROR) then
X        DoWrite := ERR
X    else begin
X        for i := n1 to n2 do begin
X            GetTxt(i, line);
X            PutStr(line,fd)
X        end;
X        FClose(fd);
X        PutDec(n2-n1+1, 1);
X        PutC(NEWLINE);
X        DoWrite := OK
X    end
Xend;
/
echo 'x - esc.pascal'
sed 's/^X//' > esc.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Esc -- map s(i) into escaped characters, increment i }
Xsegment Esc;
X%include swtools
Xfunction Esc;
Xbegin
X    if (s[i] <> ESCAPE) then
X        Esc := s[i]
X    else if (s[i+1] = ENDSTR) then { @ not special at end }
X        Esc := ESCAPE
X    else begin
X        i := i + 1;
X        if (s[i] = LETN) or (s[i] = BIGN) then
X            Esc := NEWLINE
X        else if (s[i] = TAB) then
X            Esc := TAB
X        else
X            Esc := s[i]
X    end
Xend;
/
echo 'x - expr.pascal'
sed 's/^X//' > expr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Expr -- Recursive expression evaluation }
Xsegment Expr;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Expr;
Xvar
X    v: Integer;
X    t: CharType;
Xbegin
X    v := Term(s, i);
X    t := GNBChar(s, i);
X    while (t in [PLUS, MINUS]) do begin
X        i := i + 1;
X        if (t = PLUS) then
X            v := v + Term(s, i)
X        else
X            v := v - Term(s, i);
X        t := GNBChar(s, i)
X    end {while};
X    Expr := v
Xend {Expr};
/
echo 'x - factor.pascal'
sed 's/^X//' > factor.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Factor -- Evaluate factor of arithmetic expression }
Xsegment Factor;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Factor;
Xbegin
X    if (GNBChar(s, i) = LPAREN) then begin
X        i := i + 1;
X        Factor := Expr(s, i);
X        if (GNBChar(s, i) = RPAREN) then
X            i := i + 1
X        else
X            Message('Macro: missing paren in expr')
X    end {then}
X    else
X        Factor := CToI(s, i)
Xend {Factor};
/
echo 'x - getccl.pascal'
sed 's/^X//' > getccl.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetCCL -- expand char class at arg[i] into pat[j  }
Xsegment GetCCL;
X%include swtools
X%include patdef
Xfunction GetCCL;
Xvar
X    jStart: Integer;
X    junk: Boolean;
Xbegin
X    i := i + 1; {skip over CCL}
X    if (arg[i] = NEGATE) then begin
X        junk := AddStr(NCCL, pat, j, MAXPAT);
X        i := i + 1
X    end
X    else
X        junk := AddStr(CCL, pat, j, MAXPAT);
X    jStart := j;
X    junk := AddStr(ENDSTR, pat, j, MAXPAT);  {make room for count}
X    DoDash(CCLEND, arg, i, pat, j, MAXPAT);
X    { putting an integer into a char only works if the number is les
X         than 255}
X    pat[jStart] := Chr(j - jStart - 1);
X    GetCCL := (arg[i] = CCLEND)
Xend;
/
echo 'x - getpbc.pascal'
sed 's/^X//' > getpbc.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetPBC -- get a (possibly pushed back) character }
Xsegment GetPBC;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction GetPBC;
Xbegin
X    if (bp > 0) then
X        c := buf[bp]
X    else begin
X        bp := 1;
X        buf[bp] := GetC(c);
X    end;
X    if (c <> ENDFILE) then
X        bp := bp - 1;
X    GetPBC := c
Xend;
/
echo 'x - getrhs.pascal'
sed 's/^X//' > getrhs.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetRHS -- get right hand side of "s" command }
Xsegment GetRHS;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include subdef
Xfunction GetRHS;
Xbegin
X    GetRHS := OK;
X    if (lin[i] = ENDSTR) then
X        GetRHS := ERR
X    else if (lin[i+1] = ENDSTR) then
X        GetRHS := ERR
X    else begin
X        i := MakeSub(lin, i+1, lin[i], sub);
X        if (i = 0) then
X            GetRHS := ERR
X        else if (lin[i+1] = LETG) then begin
X            i := i + 1;
X            gFlag := true
X        end
X        else
X            gFlag := false
X    end
Xend;
/
echo 'x - gettok.pascal'
sed 's/^X//' > gettok.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetTok -- get token for define }
Xsegment GetTok;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction GetTok;
Xvar
X    i: Integer;
X    done: Boolean;
X    junk: CharType;
Xbegin
X    i := 1;
X    done := false;
X    while (not done) and (i < tokSize) do begin
X        token[i] := GetPBC(junk);
X        if (IsAlphaNum(token[i])) then
X            i := i + 1
X        else
X            done := true
X    end;
X    if (i >= tokSize) then
X        Error('define: token too long');
X    if (i > 1) then begin    { some alpha was seen }
X        PutBack(token[i]);
X        i := i - 1
X    end;
X    { else single non-alphanumeric }
X    token[i+1] := ENDSTR;
X    GetTok := token[1]
Xend;
/
echo 'x - getword.pascal'
sed 's/^X//' > getword.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ getword -- get word form s(i) into out }
Xsegment GetWord;
X%include swtools
Xfunction GetWord;
Xvar
X    j: Integer;
Xbegin
X    while (s[i] in [BLANK,TAB,NEWLINE]) do
X        i := i + 1;
X    j := 1;
X    while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin
X        out[j] := s[i];
X        i := i + 1;
X        j := j + 1
X    end;
X    out[j] := ENDSTR;
X    if (j = 1) then
X        GetWord := 0
X    else
X        GetWord := i
Xend;
/
echo 'x - grep.pascal'
sed 's/^X//' > grep.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Grep -- Globally look for Regular Expressions and Print }
Xprogram Grep;
X%include swtools
X%include patdef
X%include matchdef
Xvar
X    arg, lin, pat: StringType;
X    returnCode: Integer;
Xbegin
X    ToolInit;
X    returnCode := 4;
X    if (not GetArg(1, arg, MAXSTR)) then
X        Error('Usage: Grep pattern');
X    if (not GetPat(arg, pat)) then
X        Error('Grep: illegal pattern');
X    while (GetLine(lin, STDIN, MAXSTR)) do
X        if (Match(lin, pat)) then begin
X            returnCode := 0;
X            PutStr(lin, STDOUT)
X        end;
X    ProgExit(returnCode)
Xend.
/
echo 'x - includ.pascal'
sed 's/^X//' > includ.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Includ -- replace include file by contents }
XProgram Includ;
X%include swtools
Xvar incl: StringType;
X{ FInclude -- include file desc f }
Xprocedure FInclude(f: FileDesc);
Xvar
X    line,strg: StringType;
X    loc, i:   Integer;
X    f1: FileDesc;
Xbegin
X    while(GetLine(line,f,MAXSTR)) do begin
X        loc := GetWord(line,1,strg);
X        if (not Equal(strg,incl)) then
X            PutStr(line,STDOUT)
X        else begin
X            if GetFid(line, loc, strg) then begin
X                f1 := MustOpen(strg,IOREAD);
X                FInclude(f1);
X                FClose(f1);
X            end
X            else
X                Error('Bad file name');
X        end
X    end
Xend;
Xbegin
X    ToolInit;
X    CvtSST('#include', incl);
X    FInclude(STDIN)
Xend.
/
echo 'x - initmacr.pascal'
sed 's/^X//' > initmacr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ InitMacro -- initialize variables for macro }
Xsegment InitMacro;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure InitMacro;
Xbegin
X    null[1] := ENDSTR;
X    CvtSST('define', defName);
X    CvtSST('substr', subName);
X    CvtSST('expr', exprName);
X    CvtSST('ifelse', ifName);
X    CvtSST('len', lenName);
X    CvtSST('changeq', chqName);
X    bp := 0;  { push back buffer pointer }
X    traceing := false;
X    if NArgs > 0 then traceing := true;
X    InitHash;
X    lQuote := GRAVE;
X    rQuote := ACUTE;
Xend {InitMacro};
/
echo 'x - kwic.exec'
sed 's/^X//' > kwic.exec << '/'
X&CONTROL OFF
X&IF &1 EQ ? &GOTO -EXPLAIN
XSTATE &1 &2 *
X&IF &RETCODE NE 0 &GOTO -NOFILE
XKWIC < &1 &2 > KWIC TEMP1 A
X&IF &RETCODE NE 0 &GOTO -DIED
XBNRSORT KWIC TEMP1 KWIC TEMP2 AP 1 20
X&IF &RETCODE NE 0 &GOTO -DIED
XUNROTATE < KWIC TEMP2 > &1 KWIC A
X&IF &RETCODE NE 0 &GOTO -DIED
XERASE KWIC TEMP1
XERASE KWIC TEMP2
X&EXIT 0
X-NOFILE
X&TYPE FILE &1 &2 DOES NOT EXIST
X&EXIT 4
X-DIED
XERASE KWIC TEMP1
XERASE KWIC TEMP2
X&TYPE ONE OF THE KWIC PASSES DIED
X&EXIT 8
X-EXPLAIN
X&BEGTYPE
X    KWIC INNAME INTYPE
X
X       Kwic is an EXEC that produces a "Keyword in Context" Index.
X    Kwic takes the file specified by inFile inType and creates
X    the index in a file called "inFile KWIC"
X
X       The first "inName inFile" encountered in your search path is
X    used.  "inFile KWIC" is created on your A disk.
X
X       It is recommended that you never "KWIC" a "KWIC" file.
X&END
/
echo 'x - lndelete.pascal'
sed 's/^X//' > lndelete.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ LnDelete -- delete lines n1 thru n2 }
Xsegment LnDelete;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction LnDelete;
Xbegin
X    if (n1 <= 0) then
X        status := ERR
X    else begin
X        BlkMove(n1, n2, lastLn);
X        lastLn := lastLn - (n2 - n1 + 1);
X        curLn := PrevLn(n1);
X        status := OK
X    end;
X    LnDelete := status
Xend;
/
echo 'x - locate.pascal'
sed 's/^X//' > locate.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Locate -- look for c in character class at pat[offset] }
Xsegment Locate;
X%include swtools
X%include matchdef
Xfunction Locate;
Xvar
X    i: Integer;
Xbegin
X    { size of class is at pat[offset], characters follow }
X    Locate := false;
X    i := offset + Ord(pat[offset]);   { last position }
X    while (i > offset) do
X        if (c = pat[i]) then begin
X            locate := true;
X            i := offset { force loop termination }
X        end
X        else
X            i := i - 1
Xend;
/
echo 'x - lookup.pascal'
sed 's/^X//' > lookup.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Lookup -- locate name, get defn and type from table }
Xsegment Lookup;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction Lookup;
Xvar
X    p: ndPtr;
Xbegin
X    p := HashFind(name);
X    if (p = nil) then
X        Lookup := false
X    else begin
X        Lookup := true;
X        CSCopy(NDTable, p->.defn, defn);
X        t := p->.kind
X    end
Xend;
/
echo 'x - match.pascal'
sed 's/^X//' > match.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Match -- find match anywhere on line + support fcns }
Xsegment Match;
X%include swtools
X%include patdef
X%include matchdef
Xfunction Match;
Xvar
X    i, pos: Integer;
Xbegin
X    pos := 0;
X    i := 1;
X    while (lin[i] <> ENDSTR) and (pos = 0) do begin
X        pos := AMatch(lin, i, pat, 1);
X        i := i + 1;
X    end;
X    Match := (pos > 0)
Xend;
/
echo 'x - move.pascal'
sed 's/^X//' > move.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Move -- move line1 thru line2 after line3 }
Xsegment Move;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Move;
Xbegin
X    if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
X        Move := ERR
X    else begin
X        BlkMove(line1, line2, line3);
X       if (line3 > line1) then
X           curLn := line3
X       else
X           curLn := line3 + (line2 - line1 + 1);
X       Move := OK
X    end
Xend;
/
echo 'x - nextln.pascal'
sed 's/^X//' > nextln.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ NextLn/PrevLn -- get next/previous line number }
Xsegment NextLn;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction NextLn;
Xbegin
X    if (n >= lastLn) then
X        nextLn := 0
X    else
X        nextLn := n + 1
Xend;
Xfunction PrevLn;
Xbegin
X    if (n <= 0) then
X        PrevLn := lastLn
X    else
X        PrevLn := n - 1
Xend;
/
echo 'x - optpat.pascal'
sed 's/^X//' > optpat.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ OptPat -- get optional pattern from lin[i], increment i }
Xsegment OptPat;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include patdef
Xfunction OptPat;
Xbegin
X    if (lin[i] = ENDSTR) then
X        i := 0
X    else if (lin[i + 1] = ENDSTR) then
X        i := 0
X    else if (lin[I + 1] = lin[i]) then { leave existing pattern alone }
X        i := i + 1
X    else
X        i := MakePat(lin, i+1, lin[i], pat);
X    if (pat[1] = ENDSTR) then
X        i := 0;
X    if (i = 0) then begin
X        pat[1] := ENDSTR;
X        OptPat := ERR
X    end
X    else
X        OptPat := OK
Xend;
/
echo 'x - patscan.pascal'
sed 's/^X//' > patscan.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PatScan -- find next occurance of pattern after line n }
Xsegment PatScan;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
Xfunction PatScan;
Xvar
X    done: Boolean;
X    line: StringType;
Xbegin
X    n := curLn;
X    PatScan := ERR;
X    done := false;
X    repeat
X        if (way = SCAN) then
X            n := NextLn(n)
X        else
X            n := PrevLn(n);
X        GetTxt(n, line);
X        if (Match(line, pat)) then begin
X            PatScan := OK;
X            done := true
X        end
X    until (n = curLn) or (done)
Xend;
/
echo 'x - patsize.pascal'
sed 's/^X//' > patsize.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PatSize -- returns size of pattern entry at pat[n] }
Xsegment PatSize;
X%include swtools
X%include patdef
X%include matchdef
X%include metadef
Xfunction PatSize;
Xbegin
X    case pat[n] of
X        LITCHAR:
X            PatSize := 2;
X        BOL, EOL, ANY, BOM, EOM:
X            PatSize := 1;
X        CCL, NCCL:
X            PatSize := Ord(pat[n+1]) + 2;
X        CLOSURE:
X            PatSize := CLOSIZE
X        otherwise
X            Error('in PatSize: Can''t happen');
X    end
Xend;
/
echo 'x - putchr.pascal'
sed 's/^X//' > putchr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutChr -- put single char on output or eval stack }
Xsegment PutChr;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PutChr;
Xbegin
X    if (cp <= 0) then
X        PutC(c)
X    else begin
X        if (ep > EVALSIZE) then
X            Error('Macro: evaluation stack overflow');
X        evalStk[ep] := c;
X        ep := ep + 1
X    end {if}
Xend {PutChr};
/
echo 'x - putstr.pascal'
sed 's/^X//' > putstr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutStr -- put string out on file }
Xsegment PutStr;
X%include swtools
X%include ioref
Xprocedure PutStr;
Xvar
X    i: Integer;
X    j: integer;
X    len: Integer;
X    outString: StringType;
Xbegin
X    i := 1;
X    j := 1;
X    len := StrLength(str);
X    while i <= len do begin
X        if str[i] = NEWLINE then begin
X            if j = 1 then WriteLn(openList[fd].fileVar)
X                     else WriteLn(openList[fd].fileVar, outString:j-1);
X            j := 1;
X        end {then}
X        else begin
X            outString[j] := str[i];
X            j := j + 1;
X        end; {if}
X        i := i + 1
X    end; {while}
X    if j <> 1 then write(openList[fd].fileVar, outString:j-1);
Xend; {PutStr}
/
echo 'x - putsub.pascal'
sed 's/^X//' > putsub.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutSub -- output substitution text }
Xsegment PutSub;
X%include swtools
X%include subdef
Xprocedure PutSub;
Xvar
X    i, j: Integer;
X    junk: Boolean;
Xbegin
X    i := 1;
X    while (sub[i] <> ENDSTR) do begin
X        if (sub[i] = DITTO) then
X            for j := s1 to s2-1 do
X                PutC(lin[j])
X        else
X            PutC(sub[i]);
X        i := i + 1
X    end
Xend;
/
echo 'x - sccopy.pascal'
sed 's/^X//' > sccopy.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ SCCopy -- copy string s to cb[i] }
Xsegment SCCopy;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure SCCopy;
Xvar
X    j: Integer;
Xbegin
X    j := 1;
X    while (s[j] <> ENDSTR) do begin
X        cb[i] := s[j];
X        j := j + 1;
X        i := i + 1
X    end;
X    cb[i] := ENDSTR
Xend;
/
echo 'x - screen.pascal'
sed 's/^X//' > screen.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Screen -- line printer character test }
Xprogram Screen;
X%include swtools
X%include ioref
Xvar i: Integer;
X    first: Integer;
Xbegin
XToolInit;
XWriteLn(openList[STDOUT].fileVar, '     C H A R A C T E R  S E T');
XPutC(NEWLINE);
XWriteLn(openList[STDOUT].FileVar,
X     '     0 1 2 3 4 5 6 7 8 9 A B C D E F');
Xfor i := 0 to 255 do begin
X    if i mod 16 = 0 then begin
X        PutC(NEWLINE);
X        PutC(NEWLINE);
X        first := i div 16;
X        if first >= 10 then
X            PutC(Chr(first + Ord(BIGA) - 10))
X        else
X            PutC(Chr(i div 16 + Ord(DIG0)));
X        PutC(DIG0);
X        PutC(BLANK);
X        PutC(BLANK);
X    end;
X    Write(openList[STDOUT].fileVar, ' ', Chr(i))
Xend
Xend.
/
echo 'x - stclose.pascal'
sed 's/^X//' > stclose.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ StClose -- insert closure entry at pat[j] }
Xsegment STClose;
X%include swtools
X%include patdef
Xprocedure StClose;
Xvar
X    jp, jt: Integer;
X    junk: Boolean;
Xbegin
X    for jp := j-1 downto lastJ do begin
X        jt := jp + CLOSIZE;
X        junk := AddStr(pat[jp], pat, jt, MAXPAT)
X    end;
X    j := j + CLOSIZE;
X    pat[lastJ] := CLOSURE { where original pattern began }
Xend;
/
echo 'x - strindex.pascal'
sed 's/^X//' > strindex.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ StrIndex -- find position of character c in string s }
Xsegment StrIndex;
X%include swtools
Xfunction StrIndex;
Xvar
X    i: Integer;
Xbegin
X    i := 1;
X    while (s[i] <> c) and (s[i] <> ENDSTR) do
X        i := i + 1;
X    if (s[i] = ENDSTR) then
X        StrIndex := 0
X    else
X        StrIndex := i
Xend;
/
echo 'x - subline.pascal'
sed 's/^X//' > subline.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ SubLine -- substitute sub for pat in lin and print }
Xsegment SubLine;
X%include swtools
X%include patdef
X%include subdef
X%include matchdef
Xprocedure SubLine;
Xvar
X    i, lastm, m: Integer;
X    junk: Boolean;
Xbegin
X    lastm := 0;
X    i := 1;
X    while (lin[i] <> ENDSTR) do begin
X        m := AMatch(lin, i, pat, 1);
X        if (m > 0) and (lastm <> m) then begin
X            { replace substituted text }
X            PutSub(lin, i, m, sub);
X            lastm := m
X        end;
X        if (m = 0) or (m = i) then begin
X            { no match or null match }
X            PutC(lin[i]);
X            i := i + 1
X        end
X        else        { skip matched text }
X            i := m
X    end
Xend;
/
echo 'x - swch.pascal'
sed 's/^X//' > swch.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Change -- change "from" into "to" on each line }
Xprogram swch;
X%include swtools
X%include patdef
X%include matchdef
X%include subdef
Xvar
X    lin, pat, sub, arg: StringType;
Xbegin
X    ToolInit;
X    if (not GetArg(1, arg, MAXSTR)) then
X        Error('usage: change from <to>');
X    if (not GetPat(arg, pat)) then
X        Error('change: illegal "from" pattern');
X    if (not GetArg(2, arg, MAXSTR)) then
X        arg[1] := ENDSTR;
X    if (not GetSub(arg, sub)) then
X        Error('change: illegal "to" string');
X    while (GetLine(lin, STDIN, MAXSTR)) do
X        SubLine(lin, pat, sub)
Xend;
/
echo 'x - swprint.exec'
sed 's/^X//' > swprint.exec << '/'
X&TRACE OFF
XCP SPOOL PRT CONT HOLD FORM LW1T
XERASE CMS EXEC A
XEXECUTIL WRITE CMS EXEC A  (&TRACE OFF)
XLISTFILE * PASCAL C (APPEND
XEXEC CMS EXEC SWPRIN1
XERASE CMS EXEC A
XERASE SWTOOLS LDATE C
XEXECUTIL WRITE SWTOOLS LDATE C (JUNK)
XERASE CMS EXEC
XCP SPOOL PRT CLOSE
/
echo 'x - term.pascal'
sed 's/^X//' > term.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Term -- Evaluate term of arithmetic expression }
Xsegment Term;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Term;
Xvar
X    v: Integer;
X    t: CharType;
Xbegin
X    v := Factor(s, i);
X    t := GNBChar(s, i);
X    while (t in [STAR, SLASH, PERCENT]) do begin
X        i := i + 1;
X        case t of
X            STAR:
X                v := v * Factor(s, i);
X            SLASH:
X                v := v div Factor(s, i);
X            PERCENT:
X                v := v mod Factor(s, i)
X        end {case};
X        t := GNBChar(s, i)
X    end {while};
X    Term  := v
Xend { Term };
/
echo 'x - wc.pascal'
sed 's/^X//' > wc.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Wc -- Word Counting program }
Xprogram Wc;
X%include SWTOOLS
Xvar
X    buffer: StringType;
X    numChars: Integer;
X    numWords: Integer;
X    numLines: Integer;
X    i: Integer;
X    lineLength: Integer;
X    inWord: Boolean;
Xbegin
X    ToolInit;
X    numChars := 0;
X    numWords := 0;
X    numLines := 0;
X    while (GetLine(buffer, STDIN, MAXSTR)) do begin
X        inWord := false;
X        numLines := numLines + 1;
X        lineLength := StrLength (buffer);
X        numChars := numChars + lineLength;
X        for i := 1 to lineLength do
X            if (buffer[i] = BLANK) then
X                inWord := false
X            else if (not inWord) then begin
X                inWord := true;
X                numWords := numWords + 1;
X            end; {if}
X    end; {while}
X    PutDec(numChars, 7);
X    PutDec(numWords, 7);
X    PutDec(numLines, 7);
Xend; {Wc}
/
echo 'Part 05 of pack.out complete.'
exit