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