Category : Pascal Source Code
Archive   : SOFTOOLS.ZIP
Filename : 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 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 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 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 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;