Relay-Version: version B 2.10.3 4.3bsd-beta 6/6/85; site seismo.UUCP
Posting-Version: version B 2.10.2 9/3/84; site genrad.UUCP
Path: seismo!harvard!think!mit-eddie!genrad!sources-request
From: sources-request@genrad.UUCP
Newsgroups: mod.sources
Subject: Software Tools in Pascal (Part 4 of 6)
Message-ID: <941@genrad.UUCP>
Date: 13 Jul 85 12:36:50 GMT
Sender: john@genrad.UUCP
Lines: 1698
Approved: john@genrad.UUCP

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

#!/bin/sh
echo 'Start of pack.out, part 04 of 06:'
echo 'x - ckglob.pascal'
sed 's/^X//' > ckglob.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{ CkGlob -- if global prefix, mark lines to be affected }
Xsegment CkGlob;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
Xfunction CkGlob;
Xvar
X    n: Integer;
X    gFlag: Boolean;
X    temp: StringType;
Xbegin
X    if (lin[i] <> GCMD) and (lin[i] <> XCMD) then
X        status := ENDDATA
X    else begin
X        gFlag := (lin[i] = GCMD);
X        i := i + 1;
X        if (OptPat(lin, i) = ERR) then
X            status := ERR
X        else if (Default(1, lastLn, status) <> ERR) then begin
X            i := i + 1;   { mark affected lines }
X            for n := line1 to line2 do begin
X                GetTxt(n, temp);
X                PutMark(n, (Match(temp, pat) = gFlag))
X            end;
X            for n := 1 to line1-1 do { erase other marks }
X                PutMark(n, false);
X            for n := line2+1 to lastLn do
X                PutMark(n, false);
X            status := OK
X        end
X    end;
X    CkGlob := status
Xend;
/
echo 'x - define.pascal'
sed 's/^X//' > define.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{ Define -- simple string replacement macro processor }
Xprogram Define;
X%include swtools
X%include defdef
X%include defvar
X%include defproc
X{ InitDef -- initialize variables for define }
Xprocedure InitDef;
Xbegin
X    CvtSST('define', defName);
X    bp := 0;        { push back buffer pointer }
X    InitHash
Xend;
Xbegin
X    ToolInit;
X    null[1] := ENDSTR;
X    InitDef;
X    Install(defName, null, DEFTYPE);
X    while (GetTok(token, MAXTOK) <> ENDFILE) do
X        if (not IsLetter(token[1])) then
X            PutStr(token, STDOUT)
X        else if (not Lookup(token, defn, tokType)) then
X            PutStr(token, STDOUT)   { undefined }
X        else if (tokType = DEFTYPE) then begin { defn }
X            GetDef(token, MAXTOK, defn, MAXDEF);
X            Install(token, defn, MACTYPE)
X        end
X        else
X            PBStr(defn)      { push back replacement string }
Xend.
/
echo 'x - dodash.pascal'
sed 's/^X//' > dodash.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{ DoDash -- expand set at src(i) into dest(j), stop at delim }
Xsegment DoDash;
X%include swtools
X%include patdef
Xprocedure DoDash;
Xvar
X    k: CharType;
X    junk: Boolean;
Xbegin
X    while (src[i] <> delim) and (src[i] <> ENDSTR) do begin
X        if (src[i] = ESCAPE) then
X            junk := AddStr(Esc(src,i), dest, j, maxSet)
X        else if (src[i] <> DASH) then
X            junk := AddStr(src[i], dest, j, maxSet)
X        else if (j <= 1) or (src[i+1] = ENDSTR) then
X            junk := AddStr(DASH, dest, j, maxSet) { literal -}
X        else if IsAlphaNum(src[i-1]) and
X          IsAlphaNum(src[i+1]) and
X          (src[i-1] <= src[i+1]) then begin
X            for k := Succ(src[i-1]) to src[i+1] do
X                { the following obscenity is due to EBCDIC "holes" }
X                if IsAlphaNum(k) then begin
X                    junk := AddStr(k, dest, j, maxSet);
X                end;
X            i := i + 1
X        end
X        else
X            junk := AddStr(DASH, dest, j, maxSet);
X        i := i + 1
X    end
Xend;
/
echo 'x - dooption.pascal'
sed 's/^X//' > dooption.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{ DoOption -- build options for the swtools editor }
Xsegment DoOption;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xdef
X    optionFlags: set of promptFlag..numFlag;
Xvalue
X    optionFlags := [];
Xfunction DoOption;
Xvar
X    optSel: promptFlag..numFlag;
X    setting: Boolean;
Xbegin
X    DoOption := OK;   { error handling done here }
X    i := i + 1;
X    if (lin[i] = NEWLINE) or (lin[i+1] = NEWLINE) then
X        Message('Bad option string')
X    else begin
X        if lin[i+1] in [LETS, BIGS] then      setting := true
X        else if lin[i+1] in [LETC, BIGC] then setting := false
X        else begin
X            Message('You must [s]et or [c]lear the option');
X            return
X        end;
X        case lin[i] of
X            LETP, BIGP:
X                optSel := promptFlag;
X            LETM, BIGM:
X                optSel := noMetaFlag;
X            LETV, BIGV:
X                optSel := verboseFlag;
X            LETN, BIGN:
X                optSel := numFlag
X            otherwise
X                begin
X                     Message('You gave an illegal option');
X                     Message('available options are:');
X                     Message('ps/pc: turn on/off prompting');
X                     Message('vs/vc: turn on/off verbose mode');
X                     Message('ns/nc: turn on/off line numbers');
X                     Message('ms/mc: turn on/off stupid matching');
X                     return
X                end
X        end;
X        if setting then
X            optionFlags := optionFlags + [optSel]
X        else
X            optionFlags := optionFlags - [optSel]
X    end
Xend;
Xfunction OptIsOn;
Xbegin
X    if flag in optionFlags then OptIsOn := true
X                           else OptIsOn := false
Xend;
/
echo 'x - doread.pascal'
sed 's/^X//' > doread.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{ DoRead -- read "fil" after line n }
Xsegment DoRead;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoRead;
Xvar
X    count: Integer;
X    t: Boolean;
X    stat: STCode;
X    fd: FileDesc;
X    inLine: StringType;
Xbegin
X    fd := FOpen(fil, IOREAD);
X    if (fd = IOERROR) then
X        stat := ERR
X    else begin
X        curLn := n;
X        stat := OK;
X        count := 0;
X        repeat
X            t := GetLine(inLine, fd, MAXSTR);
X            if (t) then begin
X                stat := PutTxt(inLine);
X                if (stat <> ERR) then
X                    count := count + 1
X            end
X        until (stat <> OK) or (t = false);
X        FClose(fd);
X        PutDec(count, 1);
X        PutC(NEWLINE);
X    end;
X    DoRead := stat
Xend;
/
echo 'x - dosub.pascal'
sed 's/^X//' > dosub.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{ DoSub -- Select substring }
Xsegment DoSub;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoSub;
Xvar
X    ap, fc, k, nc: Integer;
X    temp1, temp2: StringType;
Xbegin
X    if (j - i >= 3) then begin
X        if (j - i < 4) then
X            nc := MAXTOK
X        else begin
X            CsCopy(evalStk, argStk[i+4], temp1);
X            k := 1;
X            nc := Expr(temp1, k)
X        end {if};
X        CsCopy(evalStk, argStk[i+3], temp1); { origin }
X        ap := argStk[i+2];   { target string }
X        k := 1;
X        fc := ap + Expr(temp1, k) - 1;  { first char }
X        CsCopy(evalStk, ap, temp2);
X        if (fc >= ap) and (fc < ap + StrLength(temp2)) then begin
X            CsCopy(evalStk, fc, temp1);
X            for k := fc + Min(nc, StrLength(temp1))-1 downto fc do
X                PutBack(evalStk[k])
X        end {if}
X    end {if}
Xend {DoSub};
/
echo 'x - expand.pascal'
sed 's/^X//' > expand.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{ Expand -- Expand a file by a specified factor }
Xprogram Expand;
X%include swtools
Xconst maxWidth = 2000;
Xvar
X    arguments: StringType;
X    outBuffer: array [1..maxWidth] of Char;
X    inPtr: Integer;
X    anchor: Integer;
X    i: Integer;
X    factor: Integer;
X    index: Integer;
X    j: Integer;
Xbegin
X    ToolInit;
X    index := 1;
X    if GetArg(1, arguments, MAXSTR) then begin
X        factor := CToI(arguments, index);
X        if factor = 0 then
X            Error('Argument to Expand should be numeric, > 0');
X    end
X    else
X        factor := 1;
X    while true do begin
X        inPtr := 1;
X        { read an input line, expanding on the fly }
X        while (GetC(outBuffer[inPtr]) <> ENDFILE) do begin
X            if outBuffer[inPtr] = NEWLINE then leave;
X            anchor := inPtr;
X            for j := 1 to factor - 1 do begin
X                inPtr := inPtr + 1;
X                outBuffer[inPtr] := outBuffer[anchor];
X            end; {for}
X            inPtr := inPtr + 1;
X        end; {while}
X        if outBuffer[inPtr] = ENDFILE then leave;
X        { output expanded array twice }
X        for j := 1 to factor do
X            for i := 1 to inPtr do
X                PutC(outBuffer[i]);
X    end; {while}
Xend. {Expand}
/
echo 'x - fopen.pascal'
sed 's/^X//' > fopen.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{ FOpen -- open a file }
Xsegment FOpen;
X%include swtools
X%include cms
X%include ioref
Xfunction FOpen;
Xvar
X    returnCode: Integer;
X    cmsString: String(MAXSTR);
X    sName: String(MAXSTR);
X    f: FileDesc;
X    i: 1..MAXSTR;
X    fixedName: StringType;
Xbegin
X    if mode = IOREAD then begin
X        cmsString := 'STATE ';
X        for i := 1 TO StrLength(name) do
X            if name[i] in [NEWLINE, PERIOD] then
X                cmsString := cmsString || Str(' ')
X            else
X                cmsString := cmsString || Str(name[i]);
X        Cms(cmsString, returnCode);
X        if returnCode <> 0 then begin
X            FOpen := IOERROR;
X            return
X        end;
X    end;
X    i := 1;
X    if (not GetFid(Name, i, fixedName)) then
X        Error('Bad file name');
X    CvtSTS(fixedName, sName);
X    f := FDAlloc;
X    if f = IOERROR then
X        Error('Out of file descriptors')
X    else begin
X        openList[f].mode := mode;
X        if mode = IOREAD then
X            Reset(openList[f].fileVar, 'name=' || sName)
X        else begin
X            Remove(fixedName);
X            ReWrite(openList[f].fileVar, 'name=' || sName);
X        end;
X        if ERRORIO then begin
X            openList[f].mode := IOAVAIL;
X            f := IOERROR;
X            ERRORIO := false;
X        end
X    end;
X    FOpen := f
Xend;
/
echo 'x - getdef.pascal'
sed 's/^X//' > getdef.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{ GetDef -- get name and definition }
Xsegment GetDef;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure GetDef;
Xvar
X    i, nlPar: Integer;
X    c: CharType;
Xbegin
X    token[1] := ENDSTR;     { in case of bad input }
X    defn[1] := ENDSTR;
X    if (GetPBC(c) <> LPAREN) then
X        Message('define: missing left paren')
X    else if (not IsLetter(GetTok(token, tokSize))) then
X        Message('define: non-alphanumeric name')
X    else if (GetPBC(c) <> COMMA) then
X        Message('define: missing comma in define')
X    else begin      { got '(name,' so far }
X        while (GetPBC(c) = BLANK) do
X            ; { skip leading blanks }
X        PutBack(c);   { went one too far }
X        nlPar := 0;
X        i := 1;
X        while (nlPar >= 0) do begin
X            defn[i] := GetPBC(c);
X            if (i >= defSize) then
X                Error('define: definition too long')
X            else if (c = ENDFILE) then
X                Error('define: missing right paren')
X            else if (c = LPAREN) then
X                nlPar := nlPar + 1
X            else if (c = RPAREN) then
X                nlPar := nlPar - 1;
X            { else normal char in defn[i] }
X            i := i + 1
X        end;
X        defn[i-1] := ENDSTR
X    end
Xend;
/
echo 'x - getfid.pascal'
sed 's/^X//' > getfid.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{ GetFid -- convert a string into a file name }
Xsegment GetFid;
X%include swtools
X%include ioref
Xfunction GetFid;
Xvar
X    nameIndex: 1..MAXSTR;
X    temp: StringType;
X    fMode: StringType;
X    fType: StringType;
X    i: 0..MAXSTR;
X    j: 0..MAXSTR;
Xbegin
X    SCopy(line, idx, temp, 1);
X    for nameIndex := 1 to StrLength(temp) do
X        if (not (line[nameIndex] in
X           [DOLLAR, LETA..LETZ, BIGA..BIGZ, DIG0..DIG9, BLANK])) then
X            temp[nameIndex] := BLANK;
X    i := GetWord(temp, 1, fileName);
X    if i = 0 then begin
X        GetFid := false;
X        return;
X    end;
X    j := GetWord(temp, i, fType);
X    if j = 0 then begin
X        CvtSST('TEMP', fType);
X        CvtSST('*', fMode);
X    end
X    else begin
X        j := GetWord(temp, j, fMode);
X        if j = 0 then
X            CvtSST('*', fMode);
X    end;
X    i := StrLength(fileName);
X    fileName[i+1] := PERIOD;
X    SCopy(fType, 1, fileName, i + 2);
X    i := StrLength(fileName);
X    fileName[i+1] := PERIOD;
X    SCopy(fMode, 1, fileName, i + 2);
X    getFid := true;
Xend;
/
echo 'x - getfn.pascal'
sed 's/^X//' > getfn.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{ GetFn -- get file name from lin[i] .... }
Xsegment GetFn;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetFn;
Xvar
X    k: Integer;
X    stat: STCode;
Xbegin
X    stat := ERR;
X    if (lin[i+1] = BLANK) then begin
X        Scopy(lin, i+2, fil, 1);
X        if fil[StrLength(fil)] = NEWLINE then
X            fil[StrLength(fil)] := ENDSTR;
X        stat := OK
X    end
X    else if (lin[i+1] = NEWLINE) and (saveFile[1] <> ENDSTR) then begin
X        Scopy(saveFile, 1, fil, 1);
X        stat := OK
X    end;
X    if (stat = OK) and (saveFile[1] = ENDSTR) then
X       Scopy(fil, 1, saveFile, 1);    { save if no old one }
X    k := 1;
X    if stat = Ok then
X        if (not GetFid(saveFile, k, saveFile)) then
X            stat := ERR;
X    GetFn := stat
Xend;
/
echo 'x - getline.pascal'
sed 's/^X//' > getline.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{ GetLine-- put string out on file }
Xsegment GetLine;
X%include swtools
X%include ioref
Xref termInput: Boolean;
Xfunction GetKeyBoard(var str: StringType; maxSize: Integer): Boolean;
X    forward;
Xfunction GetLine;
Xvar
X    i: Integer;
Xbegin
X    if (fd < STDIN) or (fd > MAXOPEN) or
X      (openList[fd].mode <> IOREAD) then
X        Error('Getline with unopen or bad fd')
X    else if (fd = STDIN) and (termInput) then
X        GetLine := GetKeyBoard(str, maxSize)
X    else begin
X        i := 1;
X        GetLine := false;
X        if Eof(openList[fd].fileVar) then begin
X            str[1] := NEWLINE;
X            str[2] := ENDSTR;
X            return;
X        end;
X        Readln(openList[fd].fileVar, str);
X        i := maxSize;
X        while (i > 0) do begin
X            if (str[i] <> BLANK) then leave;
X            i := i - 1
X        end;
X        str[i+1] := NEWLINE;
X        str[i+2] := ENDSTR;
X        GetLine := true
X    end
Xend;
Xfunction GetKeyBoard;
Xvar
X    i: Integer;
Xbegin
X    ReadLn(openList[STDIN].fileVar, str);
X    if Eof(openList[STDIN].fileVar) then begin
X        TermIn(openList[STDIN].fileVar);
X        i := 0
X    end
X    else begin
X        i := maxSize;
X        while (i > 0) do begin
X            if str[i] <> BLANK then leave;
X            i := i - 1
X        end
X    end;
X    str[i + 1] := NEWLINE;
X    str[i + 2] := ENDSTR;
X    if (str[1] = ATSIGN) and (str[2] = NEWLINE) then
X        GetKeyBoard := false
X    else
X        GetKeyBoard := true
Xend;
/
echo 'x - getlist.pascal'
sed 's/^X//' > getlist.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{ GetList -- Get list of line numbers at lin[i], increment i }
Xsegment GetList;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetList;
Xvar
X    num: Integer;
X    done: Boolean;
Xbegin
X    line2 := 0;
X    nLines := 0;
X    done := (GetOne(lin, i, num, status) <> OK);
X    if done and (lin[i] = COMMA) then begin
X        done := false;
X        num := 1
X    end; {if}
X    while (not done) do begin
X        line1 := line2;
X        line2 := num;
X        nLines := nLines + 1;
X        if (lin[i] = SEMICOL) then
X            curLn := num;
X        if (lin[i] = COMMA) or (lin[i] = SEMICOL) then begin
X            i := i + 1;
X            done := (GetOne(lin, i, num, status) <> OK);
X            if done then begin
X                num := lastLn;
X                done := false
X            end {if}
X        end
X        else
X            done := true
X    end;
X    nLines := Min(nLines, 2);
X    if (nLines = 0) then
X        line2 := curLn;
X    if (nLines <= 1) then
X        line1 := line2;
X    if (status <> ERR) then
X        status := OK;
X    GetList := status
Xend;
/
echo 'x - getnum.pascal'
sed 's/^X//' > getnum.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{ GetNum -- get single line number component }
Xsegment GetNum;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetNum;
Xbegin
X    status := OK;
X    SkipBl(lin, i);
X    if (IsDigit(lin[i])) then begin
X        num := CToI(lin, i);
X        i := i - 1   { move back, to be advanced at end }
X    end
X    else if (lin[i] = PLUS) or (lin[i] = MINUS) then begin
X        num := curLn;
X        i := i - 1; {don't eat the plus or minus sign}
X    end
X    else if (lin[i] = CURLINE) then
X        num := curLn
X    else if (lin[i] = LASTLINE) then
X        num := lastLn
X    else if (lin[i] = SCAN) or (lin[i] = BACKSCAN) then begin
X        if (OptPat(lin,i) = ERR) then { build pattern }
X            status := ERR
X        else
X            status := PatScan(lin[i], num)
X    end
X    else
X        status := ENDDATA;
X    if (status = OK) then
X        i := i + 1; { advance to next character }
X    GetNum := status
Xend;
/
echo 'x - getone.pascal'
sed 's/^X//' > getone.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{ GetOne -- get one line number expression }
Xsegment GetOne;
X%include swtools
X%include editcons
X%include edittype
X%include editref
X%include editproc
Xfunction GetOne;
Xvar
X    iStart, mul, pNum: Integer;
Xbegin
X    iStart := i;
X    num := 0;
X    if (GetNum(lin, i, num, status) = OK) then { 1st term }
X        repeat { + or - terms }
X            SkipBl(lin, i);
X            if (lin[i] <> PLUS) and (lin[i] <> MINUS) then
X                status := ENDDATA
X            else begin
X                if (lin[i] = PLUS) then
X                    mul := 1
X                else
X                    mul := -1;
X                i := i + 1;
X                if (GetNum(lin, i, pNum, status) = OK) then
X                    num := num + mul * pNum;
X                if (status = ENDDATA) then
X                    status := ERR
X            end
X        until (status <> OK);
X    if (num < 0) or (num > lastLn) then
X        status := ERR;
X    if (status <> ERR) then begin
X        if (i <= iStart) then
X            status := ENDDATA
X        else
X            status := OK
X    end;
X    GetOne := status
Xend;
/
echo 'x - getpat.pascal'
sed 's/^X//' > getpat.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{ GetPat -- get pattern from lin, increment i }
Xsegment GetPat;
X%include swtools
X%include patdef
Xfunction GetPat;
Xbegin
X    GetPat := (MakePat(arg, 1, ENDSTR, pat) > 0)
Xend;
/
echo 'x - install.pascal'
sed 's/^X//' > install.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{ Install -- add name, definition and type to table }
Xsegment Install;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure Install;
Xvar
X    h, dlen, nlen: Integer;
X    p: NDPtr;
Xbegin
X    nlen := StrLength(name) + 1;   { 1 for ENDSTR }
X    dlen := StrLength(defn) + 1;
X    if (nextTab + nlen + dlen > MAXCHARS) then begin
X        PutStr(name, STDERR);
X        Error(': too many definitions')
X    end
X    else begin
X        h := Hash(name);
X        new(p);
X        p->.nextPtr := hashTab[h];
X        hashTab[h] := p;
X        p->.name := nextTab;
X        SCCopy(name, ndTable, nextTab);
X        nextTab := nextTab + nlen;
X        p->.defn := nextTab;
X        SCCopy(defn, ndTable, nextTab);
X        nextTab := nextTab + dlen;
X        p->.kind := t
X    end
Xend;
/
echo 'x - kopy.pascal'
sed 's/^X//' > kopy.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{ Kopy -- move line1 thru line2 after line3 }
Xsegment Kopy;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Kopy;
Xvar
X    i: Integer;
X    curSave, lastSave: Integer;
X    tempLine: StringType;
Xbegin
X    if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
X        Kopy := ERR
X    else begin
X        curSave := curLn;
X        lastSave := lastLn;
X        curLn := lastLn;
X        for i := line1 to line2 do begin
X            GetTxt(i, tempLine);
X            if PutTxt(tempLine) = ERR then begin
X                curLn := curSave;
X                lastLn := lastSave;
X                Kopy := ERR;
X                return
X           end
X       end; {if}
X        BlkMove(lastSave+1, lastSave+1+line2-line1, line3);
X       if (line3 > line1) then
X           curLn := line3
X       else
X           curLn := line3 + (line2 - line1 + 1);
X       Kopy := OK
X    end
Xend;
/
echo 'x - makesub.pascal'
sed 's/^X//' > makesub.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{ MakeSub -- make substitution string from arg into sub }
Xsegment MakeSub;
X%include swtools
X%include patdef
X%include subdef
X%include metadef
Xvalue
X    nullMetaTable := MetaTableType(
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0),
X        MetaElementType(0,0));
Xfunction MakeSub;
Xvar
X    k: Integer;
X    i, j: Integer;
X    l: Integer;
X    junk: Boolean;
Xbegin
X    j := 1;
X    i := from;
X    k := from;
X    while (arg[k] <> delim) and (k <= (MAXSTR - 2)) do
X        if (arg[k] = NEWLINE) or (arg[k] = ENDSTR) then begin
X            arg[k] := delim;
X            arg[k+1] := NEWLINE;
X            arg[k+2] := ENDSTR;
X        end
X        else
X            k := k + 1;
X    while (arg[i] <> delim) and (arg[i] <> ENDSTR) do begin
X        if (arg[i] = AMPER) then begin
X            junk := AddStr(DITTO, sub, j, MAXPAT);
X            { &n handler for meta brackets }
X            if (arg[i+1] in [DIG0..DIG9]) then begin
X                i := i + 1;
X                junk := AddStr(Chr(Ord(arg[i]) - Ord(DIG0)),
X                    sub, j, MAXPAT)
X            end
X        end
X        else
X            junk := AddStr(Esc(arg,i), sub, j, MAXPAT);
X        i := i + 1
X    end;
X    if (arg[i] <> delim) then   { missing delim }
X        MakeSub := 0
X    else if (not AddStr(ENDSTR, sub, j, MAXPAT)) then
X        MakeSub := 0
X    else
X        MakeSub := i
Xend;
/
echo 'x - mputstr.pascal'
sed 's/^X//' > mputstr.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{ MPutStr -- put meta'd string out on file }
Xsegment MPutStr;
X%include swtools
X%include ioref
Xprocedure MPutStr;
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] = DOLLAR then begin
X            i := i + 1;
X            if (str[i] = BIGN) or (str[i] = LETN) then begin
X                if j = 1 then WriteLn(openList[fd].fileVar,' ')
X                         else WriteLn(openList[fd].fileVar,
X                              outString:j-1);
X                j := 1
X            end
X            else if (str[i] = BIGE) or (str[i] = LETE) then
X                return
X            else
X                i := i - 1
X        end else
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; {MPutStr}
/
echo 'x - omatch.pascal'
sed 's/^X//' > omatch.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{ OMatch -- match one pattern element at pat[j] }
Xsegment OMatch;
X%include swtools
X%include matchdef
X%include patdef
X%include metadef
Xfunction OMatch;
Xvar
X    advance: -1..1;
X    mIndex: Integer;
Xbegin
X    advance := -1;
X    if (lin[i] = ENDSTR) then
X        OMatch := false
X    else
X        case pat[j] of
X            LITCHAR:
X                if (lin[i] = pat[j+1]) then
X                    advance := 1;
X            BOM:
X                if (metaStackPointer <= 9) and
X                  (metaIndex <= 9) then begin
X                    metaStack[metaStackPointer] := metaIndex;
X                    metaTable[metaIndex].first := i;
X                    metaIndex := metaIndex + 1;
X                    metaStackPointer := metaStackPointer + 1;
X                    advance := 0
X                end
X                else
X                    Error('OMatch/meta: can''t happen');
X            EOM:
X                if (metaStackPointer >= 1) then begin
X                    metaStackPointer := metaStackPointer - 1;
X                    mIndex := metaStack[metaStackPointer];
X                    metaTable[mIndex].last := i;
X                    advance := 0
X                end
X                else
X                    Error('OMatch/meta/EOM can''t happen');
X            BOL:
X                if (i = 1) then
X                    advance := 0;
X            ANY:
X                if (lin[i] <> NEWLINE) then
X                    advance := 1;
X            EOL:
X                if (lin[i] = NEWLINE) then
X                    advance := 0;
X            CCL:
X                if (Locate(lin[i], pat, j+1)) then
X                    advance := 1;
X            NCCL:
X                if (lin[i] <> NEWLINE) and
X                  (not Locate(lin[i], pat, j+1)) then
X                    advance := 1
X            otherwise
X                Error('in omatch: can''t happen')
X        end;
X    if (advance >= 0) then begin
X        i := i + advance;
X        OMatch := true
X    end
X    else
X        OMatch := false
Xend;
/
echo 'x - onerror.pascal'
sed 's/^X//' > onerror.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{ OnError -- intercept pascalvs run-time errors }
Xsegment OnError;
Xdef ERRORIO: Boolean;
Xdef ATTENTION: Boolean;
Xdef OUTOFSPACE: Boolean;
Xvalue
X    ERRORIO := false;
X    ATTENTION := false;
X    OUTOFSPACE := false;
X%include onerror
Xprocedure OnError;
Xvar
X    statementNumber: String(10);
X    procName: String(10);
X    errorNo: String(10);
Xbegin
X    if (FERROR in [41..53,75..78]) then begin
X        ERRORIO := true;
X        FACTION := [];
X    end
X    else if FERROR = 30 then begin
X        ATTENTION := true;
X        FACTION := [];
X    end
X    else if (FERROR = 64) and (not OUTOFSPACE) then begin
X        OUTOFSPACE := true;
X        FACTION := []
X    end
X    else if FERROR = 36 then begin
X        FACTION := [XUMSG,XTRACE,XHALT];
X        WriteStr(statementNumber, FSTMTNO:5);
X        WriteStr(procName, FPROCNAME:8);
X        WriteStr(errorNo, FERROR:5);
X        FRETMSG := 'SWTOOLS ASSERT FAILURE: RID=' || PROCNAME||
X                   '; S#=' || statementNumber ||
X                   '; EID' || errorNo || ';';
X    end
X    else begin
X        FACTION := [XUMSG,XTRACE];
X        WriteStr(statementNumber, FSTMTNO:5);
X        WriteStr(procName, FPROCNAME:8);
X        WriteStr(errorNo, FERROR: 5);
X        FRETMSG := '***SWTOOLS error: RID=' || procName
X                   || '; S#=' || statementNumber ||
X                   '; EID=' || errorNo || ';';
X    end
Xend;
/
echo 'x - rot.pascal'
sed 's/^X//' > rot.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{ Rot -- Rotate a file 90 degrees clockwise }
Xprogram Rot;
X%include swtools
Xconst
X    maxWidth = 2000;
X    maxHeight = 130;
Xvar
X    buffers: array [1..maxHeight] of array
X       [1..maxWidth] of Char;
X    i: Integer;
X    j: Integer;
X    maxReadWidth: Integer;
X    maxReadHeight: Integer;
Xbegin
X    ToolInit;
X    i := 1;
X    j := 1;
X    maxReadWidth := 0;
X    while (GetC(buffers[i,j]) <> ENDFILE) do begin
X        if (buffers[i,j] = NEWLINE) then begin
X            maxReadWidth := Max(maxReadWidth,j);
X            for j := j to maxWidth do
X                buffers[i,j] := BLANK;
X            j := 1;
X            i := i + 1;
X        end
X        else
X            j := j + 1;
X        if (i > maxHeight) or (j > maxWidth) then begin
X            Message('input file too big');
X            leave
X        end
X    end;
X    maxReadHeight := i - 1;
X    for i := 1 to maxReadWidth do begin
X        for j := maxReadHeight downto 1 do
X             PutC (buffers[j,i]);
X        PutC (NEWLINE)
X    end;
Xend.
/
echo 'x - subst.pascal'
sed 's/^X//' > subst.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{ SubSt -- substitute "sub" for occurrences of pattern }
Xsegment SubSt;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
X%include subdef
Xfunction SubSt;
Xvar
X    new, old: StringType;
X    j, k, lastm, line, m: Integer;
X    stat: STCode;
X    done, subbed, junk: Boolean;
Xbegin
X    if (glob) then
X        stat := OK
X    else
X        stat := ERR;
X    done := (line1 <= 0);
X    line := line1;
X    while (not done) and (line <= line2) do begin
X        j := 1;
X        subbed := false;
X        GetTxt(line, old);
X        lastm := 0;
X        k := 1;
X        while (old[k] <> ENDSTR) do begin
X            if (gFlag) or (not subbed) then
X                m := AMatch(old, k, pat, 1)
X            else
X                m := 0;
X            if (m > 0) and (lastm <> m) then begin
X                { replace matched text }
X                subbed := true;
X                CatSub(old, k, m, sub, new, j, MAXSTR);
X                lastm := m
X            end;
X            if (m = 0) or (m = k) then begin
X                { no match or null match }
X                junk := AddStr(old[k], new, j, MAXSTR);
X                k := k + 1
X            end
X            else
X                { skip matched text }
X                k := m
X        end;
X        if (subbed) then begin
X            if (not AddStr(ENDSTR, new, j, MAXSTR)) then begin
X                stat := ERR;
X                done := true
X            end
X            else begin
X                stat := LnDelete(line, line, stat);
X                stat := PutTxt(new);
X                line2 := line2 + curLn - line;
X                line := curLn;
X                if (stat = ERR) then
X                    done := true
X                else
X                    stat := OK
X            end
X        end;
X        line := line + 1
X    end;
X    SubSt := stat
Xend;
/
echo 'x - sw.pascal'
sed 's/^X//' > sw.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{ SW[edit] -- main routine for text editor }
Xprogram SW;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xvar
X    curSave, i: Integer;
X    status: STCode;
X    more: Boolean;
X    argIndex: Integer;
Xdef line1: Integer;   { first line number }
Xdef line2: Integer;   { second line number }
Xdef nLines: Integer;  { # lines in buffer }
Xdef curLn: Integer;  { current line: value of dot }
Xdef lastLn: Integer; { last line: value of $ }
Xdef pat: StringType; { pattern }
Xdef lin: StringType; { input line }
Xdef saveFile: StringType; { file name }
Xvalue
X    line1 := 0;
X    line2 := 0;
X    nLines := 0;
Xbegin
X    ToolInit;
X    SetBuf;
X    pat[1] := ENDSTR;
X    saveFile[1] := ENDSTR;
X    i := 1;
X    for argIndex := 1 to Nargs do
X        if GetArg(argIndex, lin, MAXSTR) then begin
X            SCopy (lin, 1, saveFile, i);
X            i := StrLength(saveFile) + 2;
X            saveFile[i-1] := BLANK
X        end;
X    i := 1;
X    if saveFile[1] <> ENDSTR then
X        if (not GetFid(saveFile, i, saveFile)) then
X            saveFile[1] := ENDSTR;
X    if saveFile[1] <> ENDSTR then
X        if (DoRead(0, saveFile) = ERR) then
X            Message('Cannot open input file');
X    if (OptIsOn(promptFlag)) then begin
X        PutC(COLON);
X        PutC(NEWLINE)
X    end;
X    more := GetLine(lin, STDIN, MAXSTR);
X    while (more) do begin
X        i := 1;
X        curSave := curLn;
X        if (GetList(lin, i, Status) = OK) then begin
X            if (CKGlob(lin, i, status) = OK) then
X                status := DoGlob(lin, i, curSave, status)
X            else if (status <> ERR) then
X                status := DoCmd(lin, i, false, status)
X            { else error - do nothing }
X        end;
X        if (status = ERR) then begin
X            Message('eh?');
X            curLn := Min(curSave, lastLn)
X        end
X        else if (status = ENDDATA) then
X            more := false;
X        { else ok }
X        if (more) then begin
X            if OptIsOn(promptFlag) then begin
X                PutC(COLON);
X                PutC(NEWLINE)
X            end;
X            more := GetLine(lin, STDIN, MAXSTR)
X        end
X    end;
X    ClrBuf
Xend.
/
echo 'x - swtr.pascal'
sed 's/^X//' > swtr.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{ Translit -- map characters }
Xprogram SWTr;
X%include swtools
X%include patdef
Xvar
X    arg, fromSet, toSet: StringType;
X    c: CharType;
X    i, lastTo: 0..MAXSTR;
X    allBut, squash: Boolean;
X{ XIndex -- conditionally invert value from strindex }
Xfunction XIndex (var inSet: StringType; c: CharType;
X        allBut: Boolean; lastTo: Integer): Integer;
Xbegin
X    if (c = ENDFILE) then
X        XIndex := 0
X    else if (not allBut) then
X        XIndex := StrIndex(inSet,c)
X    else if (StrIndex(inSet,c) > 0) then
X        XIndex := 0
X    else
X        XIndex := lastTo + 1
Xend;
Xbegin
X    ToolInit;
X    if (not GetArg(1, arg, MAXSTR)) then
X        Error('usage: translit from to');
X    allBut := (arg[1] = NEGATE);
X    if allBut then
X        i := 2
X    else
X        i := 1;
X    if (not MakeSet(arg, i, fromSet, MaxStr)) then
X        Error('translit: "from" set too large');
X    if (not GetArg(2,arg, MAXSTR)) then
X        toSet[1] := ENDSTR
X    else if (not MakeSet(arg, 1, toSet, MAXSTR)) then
X        Error('translit: "to" set too large')
X    else if (StrLength(fromSet) < StrLength(toSet)) then
X        Error('Translit: "from" shorter than "to"');
X    lastTo := StrLength(toSet);
X    squash := (StrLength(fromSet) > lastTo) or (allBut);
X    repeat
X        i := XIndex(fromSet, GetC(c), allBut, lastTo);
X        if (squash) and (i >= lastTo) and (lastTo > 0) then begin
X            PutC(toSet[lastTo]);
X            repeat
X                i := XIndex(fromSet, GetC(c), allBut, lastTo)
X            until (i < lastTo)
X        end;
X        if (c <> ENDFILE) then begin
X            if (i > 0) and (lastTo > 0) then { translate }
X                PutC(toSet[i])
X            else if (i = 0) then { copy }
X                PutC(c)
X            { else delete (don't print) }
X        end
X    until (c = ENDFILE)
Xend;
/
echo 'x - unique.pascal'
sed 's/^X//' > unique.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{ Unique -- strip adjacent duplicate lines in a file }
Xprogram Unique;
X%include swtools
Xvar
X    buffer: array [0..1] of StringType;
X    bufNum: 0..1;
X    sameRecCount: Integer;
X    counts: Boolean;
X    lastRec: StringType;
Xbegin
X    ToolInit;
X    buffer[1,1] := ENDSTR;
X    buffer[0,1] := NEWLINE;   { just so's they're different }
X    lastRec := buffer[1];
X    counts := NArgs > 0;
X    bufNum := 0;
X    sameRecCount := 0;
X    while(GetLine(buffer[bufNum], STDIN, MAXSTR)) do begin
X        if (not Equal(buffer[0], buffer[1])) then begin
X            if counts and (sameRecCount <> 0) then begin
X                PutDec(sameRecCount, 6);
X                PutC(BLANK)
X            end;
X            if sameRecCount <> 0 then
X                PutStr(lastRec, STDOUT);
X            lastRec := buffer[bufNum];
X            sameRecCount := 1
X        end
X        else
X            sameRecCount := sameRecCount + 1;
X        bufNum := (1 - bufNum)
X    end;
X    if sameRecCount <> 0 then begin
X        if counts then begin
X            PutDec(sameRecCount, 6);
X            PutC(BLANK)
X        end;
X        PutStr(lastRec, STDOUT)
X    end
Xend.
/
echo 'x - unrotate.pascal'
sed 's/^X//' > unrotate.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{ UnRotate -- Unrotate lines rotated by first half of KWIC }
XProgram UnRotate;
X%include swtools
Xconst
X    MAXOUT = 80;
X    MIDDLE = 40;
X    FOLD = DOLLAR;
Xvar
X    inBuf, outBuf: StringType;
X    tempFile2: FileDesc;
X    i, j, f: Integer;
Xbegin
X    ToolInit;
X    tempFile2 := STDIN;
X    while (GetLine(inBuf, tempFile2, MAXSTR)) do begin
X        for i := 1 to MAXOUT -1 do
X             outBuf[i] := BLANK;
X        f := StrIndex(inBuf, FOLD);
X        j := MIDDLE - 1;
X        for i := StrLength(inBuf)-1 downto f+1 do begin
X             outBuf[j] := inBuf[i];
X             j := j - 1;
X             if (j <= 0) then
X                 j := MAXOUT - 1
X        end;
X        j := MIDDLE + 3;
X        for i := 1 to f-1 do begin
X             outBuf[j] := inBuf[i];
X             j := j mod (MAXOUT - 1) + 1
X        end;
X        for j := 1 to MAXOUT - 1 do
X             if (outBuf[j] <> BLANK) then
X                 i := j;
X        outBuf[i+1] := ENDSTR;
X        PutStr(outBuf, STDOUT);
X        PutC(NEWLINE)
X    end
Xend;
/
echo 'Part 04 of pack.out complete.'
exit