Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!cmcl2!rna!rocky2!reintom
From: reintom@rocky2.UUCP (Tom Reingold)
Newsgroups: net.sources
Subject: Software Tools in Pascal for Turbo Pascal (part 2/3)
Message-ID: <258@rocky2.UUCP>
Date: Fri, 19-Sep-86 01:15:35 EDT
Article-I.D.: rocky2.258
Posted: Fri Sep 19 01:15:35 1986
Date-Received: Sat, 20-Sep-86 02:45:28 EDT
Organization: Rockefeller Univ., N.Y.C. 10021
Lines: 1741

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	chapter5.pas
#	chapter6.pas
#	chapter7.pas
# This archive created: Thu Sep 18 14:27:33 1986
export PATH; PATH=/bin:$PATH
if test -f 'chapter5.pas'
then
	echo shar: will not over-write existing file "'chapter5.pas'"
else
cat << \SHAR_EOF > 'chapter5.pas'
{chapter5.pas}

{
        Copyright (c) 1981
        By:     Bell Telephone Laboratories, Inc. and
                Whitesmith's Ltd.,

        This software is derived from the book
                "Software Tools in Pascal", by
                Brian W. Kernighan and P. J. Plauger
                Addison-Wesley, 1981
                ISBN 0-201-10342-7

        Right is hereby granted to freely distribute or duplicate this
        software, providing distribution or duplication is not for profit
        or other commercial gain and that this copyright notice remains
        intact.
}

CONST
  MAXPAT=MAXSTR;
  CLOSIZE=1;
  CLOSURE=STAR;
  BOL=PERCENT;
  EOL=DOLLAR;
  ANY=QUESTION;
  CCL=LBRACK;
  CCLEND=RBRACK;
  NEGATE=CARET;
  NCCL=EXCLAM;
  LITCHAR=67;

FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  
FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;

FUNCTION MAKEPAT;
VAR
  I,J,LASTJ,LJ:INTEGER;
  DONE,JUNK:BOOLEAN;

FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
VAR
  JSTART:INTEGER;
  JUNK:BOOLEAN;

PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  VAR I:INTEGER; VAR DEST:XSTRING;
  VAR J:INTEGER; MAXSET:INTEGER);
CONST ESCAPE=ATSIGN;
VAR K:INTEGER;
JUNK:BOOLEAN;

FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
BEGIN
  IF(S[I]<>ESCAPE) THEN
    ESC:=S[I]
  ELSE IF (S[I+1]=ENDSTR) THEN
    ESC:=ESCAPE
  ELSE BEGIN
    I:=I+1;
    IF (S[I]=ORD('N')) THEN
      ESC:=NEWLINE
    ELSE IF (S[I]=ORD('T')) THEN
      ESC:=TAB
    ELSE
      ESC:=S[I]
    END
END;

BEGIN
  WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
    IF(SRC[I]=ESCAPE)THEN
      JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
    ELSE IF (SRC[I]<>DASH) THEN
      JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
    ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
      JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
    ELSE IF (ISALPHANUM(SRC[I-1]))
      AND (ISALPHANUM(SRC[I+1]))
      AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
        FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
          JUNK:=ADDSTR(K,DEST,J,MAXSET);
            I:=I+1
    END
    ELSE
      JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
    I:=I+1
  END
END;

BEGIN
  I:=I+1;
  IF(ARG[I]=NEGATE) THEN BEGIN
    JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
    I:=I+1
  END
  ELSE
    JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  JSTART:=J;
  JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  PAT[JSTART]:=J-JSTART-1;
  GETCCL:=(ARG[I]=CCLEND)
END;

PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  LASTJ:INTEGER);
VAR
  JP,JT:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
    JT:=JP+CLOSIZE;
    JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  END;
  J:=J+CLOSIZE;
  PAT[LASTJ]:=CLOSURE
END;
 
BEGIN
  J:=1;
  I:=START;
  LASTJ:=1;
  DONE:=FALSE;
  WHILE(NOT DONE) AND (ARG[I]<>DELIM)
    AND (ARG[I]<>ENDSTR) DO BEGIN
      LJ:=J;
      IF(ARG[I]=ANY) THEN
        JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
      ELSE IF (ARG[I]=BOL) AND (I=START) THEN
        JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
      ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
        JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
      ELSE IF (ARG[I]=CCL) THEN
        DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
      ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
        LJ:=LASTJ;
        IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
          DONE:=TRUE
        ELSE
          STCLOSE(PAT,J,LASTJ)
      END
      ELSE BEGIN
        JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
        JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
      END;
      LASTJ:=LJ;
      IF(NOT DONE) THEN
        I:=I+1
    END;
    IF(DONE) OR (ARG[I]<>DELIM) THEN
      MAKEPAT:=0
    ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
      MAKEPAT:=0
    ELSE
      MAKEPAT:=I
  END;
  

FUNCTION AMATCH;


VAR I,K:INTEGER;
   DONE:BOOLEAN;


FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
VAR
  ADVANCE:-1..1;


FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  OFFSET:INTEGER):BOOLEAN;
VAR
  I:INTEGER;
BEGIN
  LOCATE:=FALSE;
  I:=OFFSET+PAT[OFFSET];
  WHILE(I>OFFSET) DO
    IF(C=PAT[I]) THEN BEGIN
      LOCATE :=TRUE;
      I:=OFFSET
    END
    ELSE
      I:=I-1
END;BEGIN
  ADVANCE:=-1;
  IF(LIN[I]=ENDSTR) THEN
    OMATCH:=FALSE
  ELSE IF (NOT( PAT[J] IN
   [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
     ERROR('IN OMATCH:CAN''T HAPPEN')
  ELSE
    CASE PAT[J] OF
    LITCHAR:
      IF (LIN[I]=PAT[J+1]) THEN
        ADVANCE:=1;
    BOL:
      IF (I=1) THEN
        ADVANCE:=0;
    ANY:
      IF (LIN[I]<>NEWLINE) THEN
        ADVANCE:=1;
    EOL:
      IF(LIN[I]=NEWLINE) THEN
        ADVANCE:=0;
    CCL:
      IF(LOCATE(LIN[I],PAT,J+1)) THEN
        ADVANCE:=1;
    NCCL:
      IF(LIN[I]<>NEWLINE)
        AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
          ADVANCE:=1
        END;
    IF(ADVANCE>=0) THEN BEGIN
      I:=I+ADVANCE;
      OMATCH:=TRUE
    END
    ELSE
      OMATCH:=FALSE
  END;
  
FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
BEGIN
  IF(NOT (PAT[N] IN
   [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
    ERROR('IN PATSIZE:CAN''T HAPPEN')
  ELSE
    CASE PAT[N] OF
      LITCHAR:PATSIZE:=2;
      BOL,EOL,ANY:PATSIZE:=1;
      CCL,NCCL:PATSIZE:=PAT[N+1]+2;
      CLOSURE:PATSIZE:=CLOSIZE
    END
END;

BEGIN
  DONE:=FALSE;
  WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
    IF(PAT[J]=CLOSURE) THEN BEGIN
      J:=J+PATSIZE(PAT,J);
      I:=OFFSET;
      WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
        IF (NOT OMATCH(LIN,I,PAT,J)) THEN
          DONE:=TRUE;
      DONE:=FALSE;
      WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
        K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
        IF(K>0) THEN
          DONE:=TRUE
        ELSE
          I:=I-1
      END;
      OFFSET:=K;
      DONE:=TRUE
    END
    ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
      THEN BEGIN
      OFFSET :=0;
      DONE:=TRUE
    END
    ELSE
      J:=J+PATSIZE(PAT,J);
  AMATCH:=OFFSET
END;
FUNCTION MATCH;

VAR
  I,POS:INTEGER;

  
                                                                               
BEGIN
  POS:=0;
  I:=1;
  WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
    POS:=AMATCH(LIN,I,PAT,1);
    I:=I+1
  END;
  MATCH:=(POS>0)
END;




PROCEDURE FIND;
  
VAR
  ARG,LIN,PAT:XSTRING;

FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;

  

BEGIN
  GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
END;


BEGIN
  IF(NOT GETARG(2,ARG,MAXSTR))THEN
    ERROR('USAGE:FIND PATTERN');
  IF (NOT GETPAT(ARG,PAT)) THEN
    ERROR('FIND:ILLEGAL PATTERN');
  WHILE(GETLINE(LIN,STDIN,MAXSTR))DO
    IF (MATCH(LIN,PAT))THEN
      PUTSTR(LIN,STDOUT)
END;
 
PROCEDURE CHANGE;
CONST
  DITTO=255;
VAR
  LIN,PAT,SUB,ARG:XSTRING;

FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;

  

BEGIN
  GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
END;
FUNCTION GETSUB(VAR ARG,SUB:XSTRING):BOOLEAN;

FUNCTION MAKESUB(VAR ARG:XSTRING; FROM:INTEGER;
  DELIM:CHARACTER; VAR SUB:XSTRING):INTEGER;
VAR I,J:INTEGER;
   JUNK:BOOLEAN;
BEGIN
  J:=1;
  I:=FROM;
  WHILE (ARG[I]<>DELIM) AND (ARG[I]<>ENDSTR) DO BEGIN
    IF(ARG[I]=ORD('&')) THEN
      JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
    ELSE
      JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
    I:=I+1
  END;
  IF (ARG[I]<>DELIM) THEN
    MAKESUB:=0
  ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT)) THEN
    MAKESUB:=0
  ELSE
    MAKESUB:=I
END;

BEGIN
  GETSUB:=(MAKESUB(ARG,1,ENDSTR,SUB)>0)
END;

PROCEDURE SUBLINE(VAR LIN,PAT,SUB:XSTRING);
VAR
  I, LASTM, M:INTEGER;
  JUNK:BOOLEAN;


PROCEDURE PUTSUB(VAR LIN:XSTRING; S1,S2:INTEGER;
  VAR SUB:XSTRING);
VAR
  I,J:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  I:=1;
  WHILE (SUB[I]<>ENDSTR) DO BEGIN
    IF(SUB[I]=DITTO) THEN
      FOR J:=S1 TO S2-1 DO
        PUTC(LIN[J])
      ELSE
        PUTC(SUB[I]);
      I:=I+1
  END
END;

BEGIN
  LASTM:=0;
  I:=1;
  WHILE(LIN[I]<>ENDSTR) DO BEGIN
    M:=AMATCH(LIN,I,PAT,1);
    IF (M>0) AND (LASTM<>M) THEN BEGIN
      PUTSUB(LIN,I,M,SUB);
      LASTM:=M
    END;
    IF (M=0) OR (M=I) THEN BEGIN
      PUTC(LIN[I]);
      I:=I+1
    END
    ELSE
      I:=M
    END
END;

BEGIN
  IF(NOT GETARG(2,ARG,MAXSTR)) THEN
    ERROR('USAGE:CHANGE FROM [TO]');
  IF (NOT GETPAT(ARG,PAT)) THEN
    ERROR('CHANGE:ILLEGAL "FROM" PATTERN');
  IF (NOT GETARG(3,ARG,MAXSTR)) THEN
    ARG[1]:=ENDSTR;
  IF(NOT GETSUB(ARG,SUB)) THEN
    ERROR('CHANGE:ILLEGAL "TO" STRING');
  WHILE (GETLINE(LIN,STDIN,MAXSTR)) DO
    SUBLINE(LIN,PAT,SUB)
END;



SHAR_EOF
if test 8365 -ne "`wc -c < 'chapter5.pas'`"
then
	echo shar: error transmitting "'chapter5.pas'" '(should have been 8365 characters)'
fi
fi # end of overwriting check
if test -f 'chapter6.pas'
then
	echo shar: will not over-write existing file "'chapter6.pas'"
else
cat << \SHAR_EOF > 'chapter6.pas'
{chapter6.pas}

{
        Copyright (c) 1981
        By:     Bell Telephone Laboratories, Inc. and
                Whitesmith's Ltd.,

        This software is derived from the book
                "Software Tools in Pascal", by
                Brian W. Kernighan and P. J. Plauger
                Addison-Wesley, 1981
                ISBN 0-201-10342-7

        Right is hereby granted to freely distribute or duplicate this
        software, providing distribution or duplication is not for profit
        or other commercial gain and that this copyright notice remains
        intact.
}

PROCEDURE EDIT;
CONST
  MAXLINES=1000;
  DITTO=255;
  CURLINE=PERIOD;
  LASTLINE=DOLLAR;
  SCAN=47;
  BACKSCAN=92;
  ACMD=97;
  CCMD=99;
  DCMD=100;
  ECMD=101;
  EQCMD=EQUALS;
  FCMD=102;
  GCMD=103;
  ICMD=105;
  MCMD=109;
  PCMD=112;
  QCMD=113;
  RCMD=114;
  SCMD=115;
  WCMD=119;
  XCMD=120;

TYPE
  STCODE=(ENDDATA,ERR,OK);
  BUFTYPE=RECORD
    TXT:INTEGER;
    MARK:BOOLEAN;
  END;

VAR
  EDITFID:FILE OF CHARACTER;
  BUF:ARRAY[0..MAXLINES]OF BUFTYPE;
  RECIN:INTEGER;
  RECOUT:INTEGER;
  LINE1,LINE2,NLINES,CURLN,LASTLN:INTEGER;
  PAT,LIN,SAVEFILE:XSTRING;
  CURSAVE,I:INTEGER;
  STATUS:STCODE;
  MORE:BOOLEAN;







PROCEDURE GETTXT(N:INTEGER;VAR S:XSTRING);
VAR
  ch:char;JUNK:BOOLEAN;I:INTEGER;
BEGIN
  IF(N=0) THEN
    S[1]:=ENDSTR
  ELSE BEGIN
    i:=0;
    SEEK(EDITFID,BUF[N].TXT);
    repeat
      i:=succ(i);
      READ(EDITFID,s[i]);
      RECIN:=RECIN+1;
    until S[I]=ENDSTR;
  END
END;


FUNCTION GETMARK(N:INTEGER):BOOLEAN;
BEGIN
  GETMARK:=BUF[N].MARK
END;

PROCEDURE PUTMARK(N:INTEGER;M:BOOLEAN);
BEGIN
  BUF[N].MARK:=M
END;

FUNCTION DOPRINT(N1,N2:INTEGER):STCODE;
VAR
  I:INTEGER;
  LINE:XSTRING;
BEGIN
  IF(N1<=0)THEN
    DOPRINT:=ERR
  ELSE BEGIN
    FOR I:=N1 TO N2 DO BEGIN
      GETTXT(I,LINE);
      PUTSTR(LINE,STDOUT)
    END;
    CURLN:=N2;
    DOPRINT:=OK
  END
END;

FUNCTION DEFAULT(DEF1,DEF2:INTEGER;
  VAR STATUS:STCODE):STCODE;
BEGIN
  IF(NLINES=0)THEN BEGIN
    LINE1:=DEF1;
    LINE2:=DEF2
  END;
  IF(LINE1 > LINE2)OR(LINE1 <=0)THEN
    STATUS:=ERR
  ELSE
    STATUS:=OK;
  DEFAULT:=STATUS
END;

FUNCTION PREVLN(N:INTEGER):INTEGER;
BEGIN
  IF(N<=0)THEN
    PREVLN:=LASTLN
  ELSE
    PREVLN:=N-1
END;

FUNCTION NEXTLN(N:INTEGER):INTEGER;
BEGIN
  IF(N>=LASTLN)THEN
    NEXTLN:=0
  ELSE
    NEXTLN:=N+1
END;

FUNCTION PATSCAN(WAY:CHARACTER;VAR N:INTEGER):STCODE;
VAR
  DONE:BOOLEAN;
  LINE:XSTRING;
BEGIN
  N:=CURLN;
  PATSCAN:=ERR;
  DONE:=FALSE;
  REPEAT
    IF(WAY=SCAN)THEN
      N:=NEXTLN(N)
    ELSE
      N:=PREVLN(N);
    GETTXT(N,LINE);
    IF(MATCH(LINE,PAT))THEN BEGIN
      PATSCAN:=OK;
      DONE:=TRUE
    END
  UNTIL(N=CURLN)OR(DONE)
END;

FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
BEGIN
  IF(S[I]<>ESCAPE) THEN
    ESC:=S[I]
  ELSE IF (S[I+1]=ENDSTR) THEN
    ESC:=ESCAPE
  ELSE BEGIN
    I:=I+1;
    IF (S[I]=ORD('N')) THEN
      ESC:=NEWLINE
    ELSE IF (S[I]=ORD('T')) THEN
      ESC:=TAB
    ELSE
      ESC:=S[I]
    END
END;
FUNCTION OPTPAT(VAR LIN:XSTRING;VAR I:INTEGER):STCODE;
BEGIN
  IF(LIN[I]=ENDSTR)THEN
    I:=0
  ELSE IF(LIN[I+1]=ENDSTR)THEN
    I:=0
  ELSE IF(LIN[I+1]=LIN[I])THEN
    I:=I+1
  ELSE
    I:=MAKEPAT(LIN,I+1,LIN[I],PAT);
  IF(PAT[1]=ENDSTR)THEN
    I:=0;
  IF(I=0)THEN BEGIN
    PAT[1]:=ENDSTR;
    OPTPAT:=ERR
  END
  ELSE
    OPTPAT:=OK
END;

PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
BEGIN
  WHILE(S[I]=BLANK)OR(S[I]=TAB)DO
    I:=I+1
END;

FUNCTION GETNUM(VAR LIN:XSTRING;VAR I,NUM:INTEGER;
  VAR STATUS:STCODE):STCODE;
BEGIN
  STATUS:=OK;
  SKIPBL(LIN,I);
  IF(ISDIGIT(LIN[I]))THEN BEGIN
    NUM:=CTOI(LIN,I);
      I:=I-1
  END
  ELSE IF(LIN[I]=CURLINE)THEN
    NUM:=CURLN
  ELSE IF(LIN[I]=LASTLINE)THEN
    NUM:=LASTLN
  ELSE IF(LIN[I]=SCAN)OR(LIN[I]=BACKSCAN)THEN BEGIN
    IF(OPTPAT(LIN,I)=ERR)THEN
      STATUS:=ERR
    ELSE
      STATUS:=PATSCAN(LIN[I],NUM)
  END
  ELSE
    STATUS:=ENDDATA;
  IF(STATUS=OK)THEN
    I:=I+1;
  GETNUM:=STATUS
END;

FUNCTION GETONE(VAR LIN:XSTRING;VAR I,NUM:INTEGER;
  VAR STATUS:STCODE):STCODE;
  VAR
    ISTART,MUL,PNUM:INTEGER;
  BEGIN
    ISTART:=I;
    NUM:=0;
    IF(GETNUM(LIN,I,NUM,STATUS)=OK)THEN
      REPEAT
        SKIPBL(LIN,I);
        IF(LIN[I]<>PLUS)AND(LIN[I]<>MINUS)THEN
          STATUS:=ENDDATA
        ELSE BEGIN
          IF(LIN[I]=PLUS)THEN
            MUL:=+1
          ELSE
            MUL:=-1;
          I:=I+1;
          IF(GETNUM(LIN,I,PNUM,STATUS)=OK)THEN
            NUM:=NUM+MUL*PNUM;
          IF(STATUS=ENDDATA)THEN
            STATUS:=ERR
        END
      UNTIL(STATUS<>OK);
    IF(NUM<0)OR(NUM > LASTLN)THEN
      STATUS:=ERR;
    IF(STATUS<>ERR)THEN BEGIN
      IF(I<=ISTART)THEN
        STATUS:=ENDDATA
      ELSE
        STATUS:=OK
    END;
    GETONE:=STATUS
  END;
  
        
FUNCTION GETLIST(VAR LIN:XSTRING;VAR I:INTEGER;
  VAR STATUS:STCODE):STCODE;
VAR
  NUM:INTEGER;
  DONE:BOOLEAN;
BEGIN
  LINE2:=0;
  NLINES:=0;
  DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK);
  WHILE(NOT DONE)DO BEGIN
    LINE1:=LINE2;
    LINE2:=NUM;
    NLINES:=NLINES+1;
    IF(LIN[I]=SEMICOL)THEN
      CURLN:=NUM;
    IF(LIN[I]=COMMA)OR(LIN[I]=SEMICOL)THEN BEGIN
      I:=I+1;
      DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK)
    END
    ELSE
      DONE:=TRUE
  END;
  NLINES:=MIN(NLINES,2);
  IF(NLINES=0)THEN
    LINE2:=CURLN;
  IF(NLINES<=1)THEN
    LINE1:=LINE2;
  IF(STATUS<>ERR)THEN
    STATUS:=OK;
  GETLIST:=STATUS
END;

PROCEDURE REVERSE(N1,N2:INTEGER);
VAR
  TEMP:BUFTYPE;
BEGIN
  WHILE(N1<N2)DO BEGIN
    TEMP:=BUF[N1];
    BUF[N1]:=BUF[N2];
    BUF[N2]:=TEMP;
    N1:=N1+1;
    N2:=N2-1
  END
END;
PROCEDURE BLKMOVE(N1,N2,N3:INTEGER);
BEGIN
  IF(N3<N1-1)THEN BEGIN
    REVERSE(N3+1,N1-1);
    REVERSE(N1,N2);
    REVERSE(N3+1,N2)
  END
  ELSE IF(N3>N2)THEN BEGIN
    REVERSE(N1,N2);
    REVERSE(N2+1,N3);
    REVERSE(N1,N3)
  END
END;

FUNCTION MOVE(LINE3:INTEGER):STCODE;
BEGIN
  IF(LINE1<=0)OR((LINE3>=LINE1)AND(LINE3<LINE2))THEN
    MOVE:=ERR
  ELSE BEGIN
    BLKMOVE(LINE1,LINE2,LINE3);
    IF(LINE3>LINE1)THEN
      CURLN:=LINE3
    ELSE
       CURLN:=LINE3+(LINE2-LINE1+1);
     MOVE:=OK
   END
 END;
 
FUNCTION LNDELETE(N1,N2:INTEGER;VAR STATUS:STCODE):
STCODE;
BEGIN
  IF(N1<=0)THEN
    STATUS:=ERR
  ELSE BEGIN
    BLKMOVE(N1,N2,LASTLN);
    LASTLN:=LASTLN-(N2-N1+1);
    CURLN:=PREVLN(N1);
    STATUS:=OK
  END;
  LNDELETE:=STATUS
END;

FUNCTION CKP(VAR LIN:XSTRING;I:INTEGER;
  VAR PFLAG:BOOLEAN;VAR STATUS:STCODE):STCODE;
BEGIN
  SKIPBL(LIN,I);
  IF(LIN[I]=PCMD)THEN BEGIN
    I:=I+1;
    PFLAG:=TRUE
  END
  ELSE
    PFLAG:=FALSE;
  IF(LIN[I]=NEWLINE)THEN
    STATUS:=OK
  ELSE
    STATUS:=ERR;
  CKP:=STATUS
END;

FUNCTION PUTTXT(VAR LIN:XSTRING):STCODE;
VAR I:INTEGER;
BEGIN
  PUTTXT:=ERR;
  IF(LASTLN<MAXLINES) THEN BEGIN
    i:=0;
    seek(editfid,recout);
    lastln:=lastln+1;
    buf[lastln].txt:=recout;
    repeat
      i:=succ(i);
      WRITE(EDITFID,lin[i]);
      recout:=recout+1
    until lin[i]=ENDSTR;
    write(editfid,lin[i]);
    PUTMARK(LASTLN,FALSE);
    BLKMOVE(LASTLN,LASTLN,CURLN);
    CURLN:=CURLN+1;
    PUTTXT:=OK
  END
END;

PROCEDURE SETBUF;
BEGIN
(*$I-*)
  ASSIGN(EDITFID,'EDTEMP');
  RESET(EDITFID);
  IF (IORESULT<>0) THEN REWRITE(EDITFID);
(*$I+*)

  RECOUT:=0;
  RECIN:=0;
  CURLN:=0;
  LASTLN:=0
END;


PROCEDURE CLRBUF;
BEGIN
  CLOSE(EDITFID);ERASE(EDITFID)
END;

FUNCTION APPEND(LINE:INTEGER;GLOB:BOOLEAN):STCODE;
VAR
  EINLINE:XSTRING;
  STAT:STCODE;
  DONE:BOOLEAN;
BEGIN
  IF(GLOB)THEN
    STAT:=ERR
  ELSE BEGIN
    CURLN:=LINE;
    STAT:=OK;
    DONE:=FALSE;
    WHILE(NOT DONE)AND(STAT=OK)DO
      IF(NOT GETLINE(EINLINE,STDIN,MAXSTR))THEN
        STAT:=ENDDATA
      ELSE IF(EINLINE[1]=PERIOD)
        AND(EINLINE[2]=NEWLINE)THEN
          DONE:=TRUE
      ELSE IF(PUTTXT(EINLINE)=ERR)THEN
        STAT:=ERR
  END;
  APPEND:=STAT
END;

FUNCTION DOWRITE(N1,N2:INTEGER;VAR FIL:XSTRING):STCODE;
VAR
  I:INTEGER;
  FD: FILEDESC;
  LINE: XSTRING;
BEGIN
  FD:=CREATE(FIL,IOWRITE);
  IF(FD=IOERROR)THEN
    DOWRITE:=ERR
  ELSE BEGIN
    FOR I:=N1 TO N2 DO BEGIN
      GETTXT(I,LINE);
      PUTSTR(LINE,FD)
    END;
    XCLOSE(FD);
    PUTDEC(N2-N1+1,1);
    PUTC(NEWLINE);
    DOWRITE:=OK
  END
END;

FUNCTION DOREAD(N:INTEGER;VAR FIL:XSTRING):STCODE;
VAR
  COUNT:INTEGER;
  T:BOOLEAN;
  STAT:STCODE;
  FD:FILEDESC;
  EINLINE:XSTRING;
BEGIN
  FD:=OPEN(FIL,IOREAD);
  IF(FD=IOERROR)THEN
    STAT:=ERR
  ELSE BEGIN
    CURLN:=N;
    STAT:=OK;
    COUNT:=0;
    REPEAT
      T:=GETLINE(EINLINE,FD,MAXSTR);
      IF(T)THEN BEGIN
        STAT:=PUTTXT(EINLINE);
        IF(STAT<>ERR)THEN
          COUNT:=COUNT+1
      END
    UNTIL(STAT<>OK)OR(T=FALSE);
    XCLOSE(FD);
    PUTDEC(COUNT,1);
    PUTC(NEWLINE)
  END;
  DOREAD:=STAT
END;

FUNCTION GETFN(VAR LIN:XSTRING;VAR I:INTEGER;
  VAR FIL:XSTRING):STCODE;
VAR
  K:INTEGER;
  STAT:STCODE;

FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:
  XSTRING):INTEGER;
VAR
  J:INTEGER;
BEGIN
  WHILE(S[I]IN [BLANK,TAB,NEWLINE])DO
    I:=I+1;
  J:=1;
  WHILE(NOT(S[I]IN [ENDSTR,BLANK,TAB,
    NEWLINE]))DO BEGIN
    OUT[J]:=S[I];
    I:=I+1;
    J:=J+1
  END;
  OUT[J]:=ENDSTR;
  IF(S[I]=ENDSTR)THEN
    GETWORD:=0
  ELSE
    GETWORD:=I
END;

BEGIN(*GETFN*)
  STAT:=ERR;
  IF(LIN[I+1]=BLANK)THEN BEGIN
    K:=GETWORD(LIN,I+2,FIL);
    IF(K>0)THEN
      IF(LIN[K]=NEWLINE)THEN
        STAT:=OK
  END
  ELSE IF(LIN[I+1]=NEWLINE)
    AND(SAVEFILE[1]<>ENDSTR)THEN BEGIN
      SCOPY(SAVEFILE,1,FIL,1);
      STAT:=OK;
  END;
  IF(STAT=OK)AND(SAVEFILE[1]=ENDSTR)THEN
    SCOPY(FIL,1,SAVEFILE,1);
  GETFN:=STAT
END;

PROCEDURE CATSUB(VAR LIN:XSTRING;S1,S2: INTEGER;
  VAR SUB: XSTRING;VAR NEW:XSTRING;
  VAR K:INTEGER;MAXNEW:INTEGER);
VAR
  I,J:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  I:=1;
  WHILE(SUB[I]<>ENDSTR)DO BEGIN
    IF(SUB[I]=DITTO)THEN
      FOR J:=S1 TO S2-1 DO
        JUNK:=ADDSTR(LIN[J],NEW,K,MAXNEW)
      ELSE
        JUNK:=ADDSTR(SUB[I],NEW,K,MAXNEW);
      I:=I+1
  END
END;

FUNCTION SUBST( VAR SUB:XSTRING;GFLAG,GLOB:BOOLEAN):STCODE;
VAR
  NEW,OLD:XSTRING;
  J,K,LASTM,LINE,M:INTEGER;
  STAT:STCODE;
  DONE,SUBBED,JUNK:BOOLEAN;
BEGIN
  IF(GLOB)THEN
    STAT:=OK
  ELSE
    STAT:=ERR;
    DONE:=(LINE1<=0);
    LINE:=LINE1;
    WHILE(NOT DONE)AND(LINE<=LINE2)DO BEGIN
      J:=1;
      SUBBED:=FALSE;
      GETTXT(LINE,OLD);
      LASTM:=0;
      K:=1;
      WHILE(OLD[K]<>ENDSTR)DO BEGIN
        IF(GFLAG)OR(NOT SUBBED)THEN
          M:=AMATCH(OLD,K,PAT,1)
        ELSE
          M:=0;
        IF(M>0)AND(LASTM<>M)THEN BEGIN
          SUBBED:=TRUE;
          CATSUB(OLD,K,M,SUB,NEW,J,MAXSTR);
          LASTM:=M
        END;
        IF(M=0)OR(M=K)THEN BEGIN
          JUNK:=ADDSTR(OLD[K],NEW,J,MAXSTR);
          K:=K+1
        END
        ELSE
          K:=M
      END;
      IF(SUBBED)THEN BEGIN
        IF(NOT ADDSTR(ENDSTR,NEW,J,MAXSTR))THEN BEGIN
          STAT:=ERR;
          DONE:=TRUE
        END
        ELSE BEGIN
          STAT:=LNDELETE(LINE,LINE,STATUS);
          STAT:=PUTTXT(NEW);
          LINE2:=LINE2+CURLN-LINE;
          LINE:=CURLN;
          IF(STAT=ERR)THEN
            DONE:=TRUE
          ELSE
            STAT:=OK
          END
        END;
        LINE:=LINE+1
      END;
      SUBST:=STAT
    END;
FUNCTION MAKESUB(VAR ARG:XSTRING;FROM:INTEGER;
  DELIM:CHARACTER;VAR SUB:XSTRING):INTEGER;
VAR I,J:INTEGER;
   JUNK:BOOLEAN;
BEGIN
  J:=1;
  I:=FROM;
  WHILE(ARG[I]<>DELIM)AND(ARG[I]<>ENDSTR)DO BEGIN
    IF(ARG[I]=ORD('&'))THEN
      JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
    ELSE
      JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
    I:=I+1
  END;
  IF(ARG[I]<>DELIM) THEN
    MAKESUB:=0
  ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT))THEN
    MAKESUB:=0
  ELSE
    MAKESUB:=I
END;
FUNCTION GETRHS(VAR LIN:XSTRING;VAR I:INTEGER;
  VAR SUB:XSTRING;VAR GFLAG:BOOLEAN):STCODE;
BEGIN
  GETRHS:=OK;
  IF(LIN[I]=ENDSTR)THEN
    GETRHS:=ERR
  ELSE IF(LIN[I+1]=ENDSTR)THEN
    GETRHS:=ERR
  ELSE BEGIN
    I:=MAKESUB(LIN,I+1,LIN[I],SUB);
    IF(I=0)THEN
      GETRHS:=ERR
    ELSE IF(LIN[I+1]=ORD('G'))THEN BEGIN
      I:=I+1;
      GFLAG:=TRUE
    END
    ELSE
      GFLAG:=FALSE
  END
END;

FUNCTION DOCMD(VAR LIN:XSTRING;VAR I:INTEGER;
  GLOB:BOOLEAN;VAR STATUS:STCODE):STCODE;
VAR
  FIL,SUB:XSTRING;
  LINE3:INTEGER;
  GFLAG,PFLAG:BOOLEAN;
BEGIN
  PFLAG:=FALSE;
  STATUS:=ERR;
  IF(LIN[I]=PCMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN 
      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
        STATUS:=DOPRINT(LINE1,LINE2)
  END
  ELSE IF(LIN[I]=NEWLINE)THEN BEGIN
    IF(NLINES=0)THEN
      LINE2:=NEXTLN(CURLN);
    STATUS:=DOPRINT(LINE2,LINE2)
  END
  ELSE IF(LIN[I]=QCMD)THEN BEGIN
    IF( LIN[I+1]=NEWLINE)AND(NLINES=0)AND(NOT GLOB)THEN
  STATUS:=ENDDATA
  END
  ELSE IF(LIN[I]=ACMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN
      STATUS:=APPEND(LINE2,GLOB)
  END
  ELSE IF(LIN[I]=CCMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN
      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
      IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN
        STATUS:=APPEND(PREVLN(LINE1),GLOB)
  END
  ELSE IF(LIN[I]=DCMD)THEN BEGIN
    IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN
     IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
     IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN
     IF(NEXTLN(CURLN)<>0)THEN
       CURLN:=NEXTLN(CURLN)
  END
  ELSE IF(LIN[I]=ICMD)THEN BEGIN
    IF(LIN[I+1]=NEWLINE)THEN BEGIN
      IF(LINE2=0)THEN
        STATUS:=APPEND(0,GLOB)
      ELSE
        STATUS:=APPEND(PREVLN(LINE2),GLOB)
    END
  END
  ELSE IF(LIN[I]=EQCMD)THEN BEGIN
    IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN BEGIN
      PUTDEC(LINE2,1);
      PUTC(NEWLINE)
    END
  END
  ELSE IF(LIN[I]=MCMD)THEN BEGIN
    I:=I+1;
    IF(GETONE(LIN,I,LINE3,STATUS)=ENDDATA)THEN
      STATUS:=ERR;
    IF(STATUS =OK)THEN
      IF(CKP(LIN,I,PFLAG,STATUS)=OK)THEN
      IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
        STATUS:=MOVE(LINE3)
  END
  ELSE IF(LIN[I]=SCMD)THEN BEGIN
    I:=I+1;
    IF(OPTPAT(LIN,I)=OK)THEN 
    IF(GETRHS(LIN,I,SUB,GFLAG)=OK)THEN
    IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN
    IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN
      STATUS:=SUBST(SUB,GFLAG,GLOB)
  END
  ELSE IF(LIN[I]=ECMD)THEN BEGIN
    IF(NLINES =0)THEN
      IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN
        SCOPY(FIL,1,SAVEFILE,1);
        CLRBUF;
        SETBUF;
        STATUS:=DOREAD(0,FIL)
      END
  END
  ELSE IF(LIN[I]=FCMD)THEN BEGIN
    IF(NLINES =0)THEN
      IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN
        SCOPY(FIL,1,SAVEFILE,1);
        PUTSTR(SAVEFILE,STDOUT);
        PUTC(NEWLINE);
        STATUS:=OK
    END
  END
  ELSE IF(LIN[I]=RCMD)THEN BEGIN
    IF(GETFN(LIN,I,FIL)=OK)THEN
      STATUS:=DOREAD(LINE2,FIL)
  END
  ELSE IF(LIN[I]=WCMD)THEN BEGIN
    IF(GETFN(LIN,I,FIL)=OK)THEN
      IF(DEFAULT(1,LASTLN,STATUS)=OK)THEN
        STATUS:=DOWRITE(LINE1,LINE2,FIL)
  END;
  IF(STATUS =OK)AND(PFLAG)THEN
    STATUS:=DOPRINT(CURLN,CURLN);
  DOCMD:=STATUS
END;(*DOCMD*)

FUNCTION CKGLOB(VAR LIN: XSTRING;VAR I:INTEGER;
  VAR STATUS:STCODE): STCODE;
VAR
  N:INTEGER;
  GFLAG:BOOLEAN;
  TEMP: XSTRING;
BEGIN
  IF(LIN[I]<>GCMD)AND(LIN[I]<>XCMD)THEN
    STATUS:=ENDDATA
  ELSE BEGIN
    GFLAG:=(LIN[I]=GCMD);
    I:=I+1;
    IF(OPTPAT(LIN,I)=ERR)THEN
      STATUS:=ERR
    ELSE IF( DEFAULT(1,LASTLN,STATUS)<>ERR)THEN BEGIN
      I:=I+1;
      FOR N:=LINE1 TO LINE2 DO BEGIN
        GETTXT(N,TEMP);
        PUTMARK(N,(MATCH(TEMP,PAT)=GFLAG))
      END;

      FOR N:=1 TO LINE1-1 DO
        PUTMARK(N,FALSE);
      FOR N:=LINE2+1 TO LASTLN DO
        PUTMARK(N,FALSE);
      STATUS:=OK
    END
  END;
  CKGLOB:=STATUS
END;

FUNCTION DOGLOB(VAR LIN:XSTRING;VAR I,CURSAVE:INTEGER;
  VAR STATUS: STCODE):STCODE;
VAR
  COUNT,ISTART,N: INTEGER;
BEGIN
  STATUS:=OK;
  COUNT:=0;
  N:=LINE1;
  ISTART:=I;
  REPEAT
    IF(GETMARK(N))THEN BEGIN
      PUTMARK(N,FALSE);
      CURLN:=N;
      CURSAVE:=CURLN;
      I:=ISTART;
      IF(DOCMD(LIN,I,TRUE,STATUS)=OK)THEN
        COUNT:=0
    END
    ELSE BEGIN
      N:=NEXTLN(N);
      COUNT:=COUNT + 1
    END
  UNTIL(COUNT > LASTLN)OR(STATUS <> OK);
  DOGLOB:=STATUS
END;

BEGIN
  SETBUF;
  PAT[1]:=ENDSTR;
  SAVEFILE[1]:=ENDSTR;
  IF(GETARG(2,SAVEFILE,MAXSTR))THEN
    IF(DOREAD(0,SAVEFILE)=ERR)THEN
      WRITELN('?');
  MORE:=GETLINE(LIN,STDIN,MAXSTR);
  WHILE(MORE)DO BEGIN
    I:=1;
    CURSAVE:=CURLN;
    IF(GETLIST(LIN,I,STATUS)=OK)THEN BEGIN
      IF(CKGLOB(LIN,I,STATUS)=OK)THEN
        STATUS:=DOGLOB(LIN,I,CURSAVE,STATUS)
      ELSE IF(STATUS<>ERR)THEN
        STATUS:=DOCMD(LIN,I,FALSE,STATUS)
    END;
    IF(STATUS=ERR)THEN BEGIN
      WRITELN('?');
      CURLN:=MIN(CURSAVE,LASTLN)
    END
    ELSE IF(STATUS=ENDDATA)THEN
      MORE:=FALSE;
    IF(MORE)THEN
      MORE:=GETLINE(LIN,STDIN,MAXSTR)
  END;
  CLRBUF
END;




SHAR_EOF
if test 16451 -ne "`wc -c < 'chapter6.pas'`"
then
	echo shar: error transmitting "'chapter6.pas'" '(should have been 16451 characters)'
fi
fi # end of overwriting check
if test -f 'chapter7.pas'
then
	echo shar: will not over-write existing file "'chapter7.pas'"
else
cat << \SHAR_EOF > 'chapter7.pas'
{chapter7.pas}

{
        Copyright (c) 1981
        By:     Bell Telephone Laboratories, Inc. and
                Whitesmith's Ltd.,

        This software is derived from the book
                "Software Tools in Pascal", by
                Brian W. Kernighan and P. J. Plauger
                Addison-Wesley, 1981
                ISBN 0-201-10342-7

        Right is hereby granted to freely distribute or duplicate this
        software, providing distribution or duplication is not for profit
        or other commercial gain and that this copyright notice remains
        intact.
}

PROCEDURE FORMAT;
CONST
  CMD=PERIOD;
  PAGENUM=SHARP;
  PAGEWIDTH=60;
  PAGELEN=66;
  HUGE=10000;
TYPE
  CMDTYPE=(BP,BR,CE,FI,FO,HE,IND,LS,NF,PL,
    RM,SP,TI,UL,UNKNOWN);
VAR
  CURPAGE,NEWPAGE,LINENO:INTEGER;
  PLVAL,M1VAL,M2VAL,M3VAL,M4VAL:INTEGER;
  BOTTOM:INTEGER;
  HEADER,FOOTER:XSTRING;
  
  FILL:BOOLEAN;
  LSVAL,SPVAL,INVAL,RMVAL,TIVAL,CEVAL,ULVAL:INTEGER;

  OUTP,OUTW,OUTWDS:INTEGER;
  OUTBUF:XSTRING;
  DIR:0..1;
  INBUF:XSTRING;
  
PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
BEGIN
  WHILE(S[I]=BLANK) OR(S[I]=TAB)DO
    I:=I+1
  END;
  
FUNCTION GETVAL(VAR BUF:XSTRING;VAR ARGTYPE:INTEGER):INTEGER;
VAR
  I:INTEGER;
BEGIN
  I:=1;
  WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
    I:=I+1;
  SKIPBL(BUF,I);
  ARGTYPE:=BUF[I];
  IF(ARGTYPE=PLUS) OR (ARGTYPE=MINUS) THEN
    I:=I+1;
  GETVAL:=CTOI(BUF,I)
END;

PROCEDURE SETPARAM(VAR PARAM:INTEGER;VAL,ARGTYPE,DEFVAL,MINVAL,MAXVAL:
  INTEGER);
BEGIN
  IF(ARGTYPE=NEWLINE)THEN
    PARAM:=DEFVAL
  ELSE IF (ARGTYPE=PLUS)THEN
    PARAM:=PARAM+VAL
  ELSE IF(ARGTYPE=MINUS) THEN
    PARAM:=PARAM-VAL
  ELSE PARAM:=VAL;
  PARAM:=MIN(PARAM,MAXVAL);
  PARAM:=MAX(PARAM,MINVAL)
END;

PROCEDURE SKIP(N:INTEGER);
VAR I:INTEGER;
BEGIN
  FOR I:=1 TO N DO
    PUTC(NEWLINE)
END;

PROCEDURE PUTTL(VAR BUF:XSTRING;PAGENO:INTEGER);
VAR I:INTEGER;
BEGIN
  FOR I:=1 TO XLENGTH(BUF) DO
    IF(BUF[I]=PAGENUM) THEN
      PUTDEC(PAGENO,1)
    ELSE
      PUTC(BUF[I])
END;

PROCEDURE PUTFOOT;
BEGIN
  SKIP(M3VAL);
  IF(M4VAL>0) THEN BEGIN
    PUTTL(FOOTER,CURPAGE);
    SKIP(M4VAL-1)
  END
END;

PROCEDURE PUTHEAD;
BEGIN
  CURPAGE:=NEWPAGE;
  NEWPAGE:=NEWPAGE+1;
  IF(M1VAL>0)THEN BEGIN
    SKIP(M1VAL-1);
    PUTTL(HEADER,CURPAGE)
  END;
  SKIP(M2VAL);
  LINENO:=M1VAL+M2VAL+1
END;

PROCEDURE PUT(VAR BUF:XSTRING);
VAR
  I:INTEGER;
BEGIN
  IF(LINENO<=0) OR(LINENO>BOTTOM) THEN
    PUTHEAD;
  FOR I:=1 TO INVAL+TIVAL DO
    PUTC(BLANK);
  TIVAL:=0;
  PUTSTR(BUF,STDOUT);
  SKIP(MIN(LSVAL-1,BOTTOM-LINENO));
  LINENO:=LINENO+LSVAL;
  IF(LINENO>BOTTOM)THEN PUTFOOT
END;


PROCEDURE BREAK;
BEGIN
  IF(OUTP>0) THEN BEGIN
    OUTBUF[OUTP]:=NEWLINE;
    OUTBUF[OUTP+1]:=ENDSTR;
    PUT(OUTBUF)
  END;
  OUTP:=0;
  OUTW:=0;
  OUTWDS:=0
END;

FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  VAR OUT:XSTRING):INTEGER;
VAR
  J:INTEGER;
BEGIN
  WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
    I:=I+1;
  J:=1;
  WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
    OUT[J]:=S[I];
    I:=I+1;
    J:=J+1
  END;
  OUT[J]:=ENDSTR;
  IF(S[I]=ENDSTR) THEN
    GETWORD:=0
  ELSE
    GETWORD:=I
END;

PROCEDURE LEADBL(VAR BUF:XSTRING);
VAR I,J:INTEGER;
BEGIN
  BREAK;
  I:=1;
  WHILE(BUF[I]=BLANK) DO
    I:=I+1;
  IF(BUF[I]<>NEWLINE) THEN
    TIVAL:=TIVAL+I-1;
  FOR J:=I TO XLENGTH(BUF)+1 DO
    BUF[J-I+1]:=BUF[J]
END;

PROCEDURE GETTL(VAR BUF,TTL:XSTRING);
VAR
  I:INTEGER;
BEGIN
  I:=1;
  WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
    I:=I+1;
  SKIPBL(BUF,I);
  IF(BUF[I]=SQUOTE) OR(BUF[I]=DQUOTE)THEN
    I:=I+1;
  SCOPY(BUF,I,TTL,1)
END;

PROCEDURE SPACE(N:INTEGER);
BEGIN
  BREAK;
  IF (LINENO<=BOTTOM) THEN BEGIN
    IF(LINENO<=0)THEN
      PUTHEAD;
    SKIP(MIN(N,BOTTOM+1-LINENO));
    LINENO:=LINENO+N;
    IF(LINENO>BOTTOM) THEN
      PUTFOOT
  END
END;

PROCEDURE PAGE;
BEGIN
  BREAK;
  IF(LINENO>0) AND (LINENO<=BOTTOM) THEN BEGIN
    SKIP(BOTTOM+1-LINENO);putfoot
  END;
  LINENO:=0
END;

FUNCTION WIDTH(VAR BUF:XSTRING):INTEGER;
VAR
  I,W:INTEGER;
BEGIN
  W:=0;
  I:=1;
  WHILE(BUF[I]<>ENDSTR) DO BEGIN
    IF (BUF[I] = BACKSPACE) THEN
      W:=W-1
    ELSE IF (BUF[I]<>NEWLINE) THEN
      W:=W+1;I:=I+1
  END;
  WIDTH:=W
END;

PROCEDURE SPREAD(VAR BUF:XSTRING;
OUTP,NEXTRA,OUTWDS:INTEGER);
VAR
  I,J,NB,NHOLES:INTEGER;
BEGIN
  IF(NEXTRA>0) AND (OUTWDS>1) THEN BEGIN
    DIR:=1-DIR;
    NHOLES:=OUTWDS-1;
    I:=OUTP-1;
    J:=MIN(MAXSTR-2,I+NEXTRA);
    WHILE(I<J) DO BEGIN
      BUF[J]:=BUF[I];
      IF(BUF[I]=BLANK) THEN BEGIN
        IF(DIR=0) THEN
          NB:=(NEXTRA-1) DIV NHOLES +1
        ELSE NB:=NEXTRA DIV NHOLES;
        NEXTRA:=NEXTRA - NB;
        NHOLES:=NHOLES-1;
        WHILE(NB>0) DO BEGIN
          J:=J-1;
          BUF[J]:=BLANK;
          NB:=NB-1
        END
      END;
      I:=I-1;
      J:=J-1
    END
  END
END;

PROCEDURE PUTWORD(VAR WORDBUF:XSTRING);
VAR
  LAST,LLVAL,NEXTRA,W:INTEGER;
BEGIN
  W:=WIDTH(WORDBUF);
  LAST:=XLENGTH(WORDBUF)+OUTP+1;
  LLVAL:=RMVAL-TIVAL-INVAL;
  IF(OUTP>0)
    AND ((OUTW+W>LLVAL) OR (LAST >=MAXSTR)) THEN BEGIN
      LAST:=LAST-OUTP;
      NEXTRA:=LLVAL-OUTW+1;
      IF(NEXTRA >0) AND(OUTWDS>1) THEN BEGIN
        SPREAD(OUTBUF,OUTP,NEXTRA,OUTWDS);
        OUTP:=OUTP+NEXTRA
      END;
      BREAK
    END;
    SCOPY(WORDBUF,1,OUTBUF,OUTP+1);
    OUTP:=LAST;
    OUTBUF[OUTP]:=BLANK;
    OUTW:=OUTW+W+1;
    OUTWDS:=OUTWDS+1
END;

PROCEDURE CENTER(VAR BUF:XSTRING);
BEGIN
  TIVAL:=MAX((RMVAL+TIVAL-WIDTH(BUF)) DIV 2,0)
END;

PROCEDURE UNDERLN (VAR BUF:XSTRING;SIZE:INTEGER);
VAR
  I,J:INTEGER;
  TBUF:XSTRING;
BEGIN
  J:=1;
  I:=1;
  WHILE(BUF[I]<>NEWLINE) AND (J<SIZE-1)DO BEGIN
    IF(ISALPHANUM(BUF[I])) THEN BEGIN
      TBUF[J]:=UNDERLINE;
      TBUF[J+1]:=BACKSPACE;
      J:=J+2
    END;
    TBUF[J]:=BUF[I];
    J:=J+1;
    I:=I+1
  END;
  TBUF[J]:=NEWLINE;
  TBUF[J+1]:=ENDSTR;
  SCOPY(TBUF,1,BUF,1)
END;

PROCEDURE TEXT(VAR INBUF:XSTRING);
VAR
  WORDBUF:XSTRING;
  I:INTEGER;
BEGIN
  IF(INBUF[1]=BLANK) OR (INBUF[1]=NEWLINE) THEN
    LEADBL(INBUF);
  IF(ULVAL>0) THEN BEGIN
    UNDERLN(INBUF,MAXSTR);
    ULVAL:=ULVAL-1
  END;
  IF(CEVAL>0)THEN BEGIN
    CENTER(INBUF);
    PUT(INBUF);
    CEVAL:=CEVAL-1
  END
  ELSE IF (INBUF[1]=NEWLINE)THEN
    PUT(INBUF)
  ELSE IF(NOT FILL) THEN
    PUT(INBUF)
  ELSE BEGIN
    I:=1;
    REPEAT
      I:=GETWORD(INBUF,I,WORDBUF);
      IF(I>0)THEN
        PUTWORD(WORDBUF)
      UNTIL(I=0)
    END
    
END;
  

PROCEDURE INITFMT;
BEGIN
  FILL:=TRUE;
  DIR:=0;
  INVAL:=0;
  RMVAL:=PAGEWIDTH;
  TIVAL:=0;
  LSVAL:=1;
  SPVAL:=0;
  CEVAL:=0;
  ULVAL:=0;
  LINENO:=0;
  CURPAGE:=0;
  NEWPAGE:=1;
  PLVAL:=PAGELEN;
  M1VAL:=3;M2VAL:=2;M3VAL:=2;M4VAL:=3;
  BOTTOM:=PLVAL-M3VAL-M4VAL;
  HEADER[1]:=NEWLINE;
  HEADER[2]:=ENDSTR;
  FOOTER[1]:=NEWLINE;
  FOOTER[2]:=ENDSTR;
  OUTP:=0;
  OUTW:=0;
  OUTWDS:=0
END;

FUNCTION GETCMD(VAR BUF:XSTRING):CMDTYPE;
VAR
  CMD:PACKED ARRAY[1..2] OF CHAR;
BEGIN
  CMD[1]:=CHR(BUF[2]);
  CMD[2]:=CHR(BUF[3]);
  IF(CMD='fi')THEN GETCMD:=FI
  ELSE IF (CMD='nf')THEN GETCMD:=NF
  ELSE IF (CMD='br')THEN GETCMD:=BR
  ELSE IF (CMD='ls')THEN GETCMD:=LS
  ELSE IF (CMD='bp')THEN GETCMD:=BP
  ELSE IF (CMD='sp')THEN GETCMD:=SP
  ELSE IF (CMD='in')THEN GETCMD:=IND
  ELSE IF (CMD='rm')THEN GETCMD:=RM
  ELSE IF (CMD='ce')THEN GETCMD:=CE
  ELSE IF (CMD='ti')THEN GETCMD:=TI
  ELSE IF (CMD='ul')THEN GETCMD:=UL
  ELSE IF (CMD='he') THEN GETCMD:=HE
  ELSE IF (CMD='fo') THEN GETCMD:=FO
  ELSE IF (CMD='pl') THEN GETCMD:=PL
  ELSE GETCMD:=UNKNOWN
END;

PROCEDURE COMMAND(VAR BUF:XSTRING);
VAR CMD:CMDTYPE;
ARGTYPE,SPVAL,VAL:INTEGER;
BEGIN
  CMD:=GETCMD(BUF);
  IF(CMD<>UNKNOWN)THEN
    VAL:=GETVAL(BUF,ARGTYPE);
    CASE CMD OF
    FI:BEGIN
       BREAK;
       FILL:=TRUE END;
    NF:BEGIN BREAK;
       FILL:=FALSE END;
    BR:BREAK;
    LS:SETPARAM(LSVAL,VAL,ARGTYPE,1,1,HUGE);
    CE:BEGIN BREAK;
       SETPARAM(CEVAL,VAL,ARGTYPE,1,0,HUGE) END;
    UL:SETPARAM(ULVAL,VAL,ARGTYPE,1,0,HUGE);
    HE:GETTL(BUF,HEADER);
    FO:GETTL(BUF,FOOTER);
    BP:BEGIN PAGE;
       SETPARAM(CURPAGE,VAL,ARGTYPE,CURPAGE+1,-HUGE,HUGE);
       NEWPAGE:=CURPAGE END;
    SP:BEGIN
       SETPARAM(SPVAL,VAL,ARGTYPE,1,0,HUGE);
       space(spval)
       END;
    IND:SETPARAM(INVAL,VAL,ARGTYPE,0,0,RMVAL-1);
    RM:SETPARAM(INVAL,VAL,ARGTYPE,PAGEWIDTH,
        INVAL+TIVAL+1,HUGE);
    TI:BEGIN BREAK;
       SETPARAM(TIVAL,VAL,ARGTYPE,0,-HUGE,RMVAL) END;
    PL:BEGIN
       SETPARAM(PLVAL,VAL,ARGTYPE,PAGELEN,
        M1VAL+M2VAL+M3VAL+M4VAL+1,HUGE);
       BOTTOM:=PLVAL-M3VAL-M4VAL END;
    UNKNOWN:
    END
  END;

       
       

BEGIN
  
  INITFMT;
  WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO
    IF(INBUF[1]=CMD) THEN
      COMMAND(INBUF)
    ELSE
      TEXT(INBUF);
    PAGE
END;



SHAR_EOF
if test 8627 -ne "`wc -c < 'chapter7.pas'`"
then
	echo shar: error transmitting "'chapter7.pas'" '(should have been 8627 characters)'
fi
fi # end of overwriting check
#	End of shell archive
exit 0