(*******************************************************************)
(** Release history:                                              **)
(**    17th January 1985   version 1.0.0 First port to new world  **)
(*******************************************************************)
IMPLEMENTATION MODULE ScanS;
IMPORT Stop, WriteF, TextIO, Streams;
FROM Strings IMPORT String;
IMPORT Strings;
FROM SysStreams IMPORT sysErr;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM Strings IMPORT CopyCC, LengthC, FindC;

CONST MaxBuff = 1023;

TYPE
  AreaDescr = RECORD
    Start, End :[0..MaxBuff]
  END;

  BYTE  = CHAR;
   
CONST EndOfLineCh = 12C;

CONST
  MaxPatternSize                    = 255;
TYPE
  CaseSensitivityT                  =  (CaseInsensitive, CaseSensitive);
  SearchClasses                     =  ((* The order is used by DoReplace *)
    SearchMultiple,
    SearchMaximum,
    SearchNumeric,
    SearchAlphabetic,
    SearchAnythingBut,
    SearchAnything,
    SearchChoice,
    SearchCaseInsensitive,
    SearchEndPattern
  );
  SearchSet                         = SET OF SearchClasses;
  PatternSetP                       = POINTER TO PatternSetR;
  PatternSetR                       = RECORD
    Array                             :ARRAY  [0..7] OF BITSET;
  END;
  PatternR                          = RECORD
    Class                             :SearchSet;
    MatchedPosition                   :AreaDescr;
    CASE BOOLEAN OF
(*  |*)TRUE :
       Ch                             :BYTE;
    |  FALSE :
        Choice                         :PatternSetP;
    END (* case *);
  END;
VAR
  SearchFields                     :ARRAY  [0..8] OF CHAR ;
  Pattern                          :ARRAY  [0..MaxPatternSize] OF PatternR;
  PatternEnd                       : [0..MaxPatternSize] ;
  InitialSearchCaseSensitivity     :CaseSensitivityT;
  AllClasses                       :SearchSet;
  CurrentString                    :RECORD
    String                           :ARRAY  [0..255] OF CHAR;
    Index                            :CARDINAL;
    Length                           :CARDINAL;
    LiteralCh                        :BOOLEAN;
    UnexpectedEnd                    :BOOLEAN;
  END;

PROCEDURE Version (VAR V :ARRAY OF CHAR);
BEGIN
  CopyCC ("Actions/DoSearch        0.01/07  22 Nov 84 11:23:17", V);
END Version;

PROCEDURE NextCh() :BYTE;
   PROCEDURE GetCh() :CHAR;
   BEGIN
      IF CurrentString.Index < CurrentString.Length THEN
         INC (CurrentString.Index);
         RETURN CurrentString.String [CurrentString.Index - 1] ;
      ELSE
         CurrentString.UnexpectedEnd := TRUE;
         RETURN CHAR (0);
      END (* if *);
   END GetCh;

VAR
   Char               :CHAR;
BEGIN
   CurrentString.LiteralCh := FALSE;
   Char := GetCh();
   IF    Char = '\' THEN
      CurrentString.LiteralCh := TRUE;
      RETURN BYTE (GetCh());
   ELSIF Char = '|' THEN
      Char := GetCh();
      IF    InRange (BYTE (040H) , Char, BYTE (05FH) )  THEN
         RETURN BYTE (CARDINAL (Char)  - 040H);
      ELSIF InRange (BYTE (060H) , Char, BYTE (07EH) )  THEN
         RETURN BYTE (CARDINAL (Char)  - 060H);
      ELSIF Char = BYTE ('?')  THEN
         RETURN BYTE (07FH);
      ELSIF Char = '!' THEN
         Char := GetCh();
         IF Char = '|' THEN
            Char := GetCh();
            IF    InRange (BYTE (040H) , Char, BYTE (05FH) )  THEN
               RETURN BYTE (CARDINAL (Char)  - 040H + 080H);
            ELSIF InRange (BYTE (060H) , Char, BYTE (07EH) )  THEN
               RETURN BYTE (CARDINAL (Char)  - 060H + 080H);
            ELSIF Char = BYTE ('?')  THEN
               RETURN BYTE (0FFH);
            ELSE
               RETURN BYTE (CARDINAL (Char)  + 080H);
            END (* if *);
         ELSE
            RETURN BYTE ( (CARDINAL (Char)  + 080H)  MOD 100H);
         END (* if *);
      ELSE
         RETURN BYTE (Char);
      END (* if *);
   ELSE
      RETURN BYTE (Char);
   END (* if *);
END NextCh;



PROCEDURE LowerCase (Ch :CHAR)  :BYTE;
BEGIN
   IF  ('A' <= Ch)  AND  (Ch <= 'Z')  THEN
      RETURN BYTE (ORD (Ch)  +  (ORD ('a')  - ORD ('A') ) );
   ELSE
      RETURN BYTE (Ch);
   END (* if *);
END LowerCase;



PROCEDURE NewChoice (VAR Choice :PatternSetP);
VAR
   Index               : [0..7] ;
BEGIN
   NEW (Choice);
   IF Choice <> NIL THEN
      FOR Index := 0 TO 7 DO
         Choice^.Array [Index] := { };
      END (* for *);
   END (* if *);
END NewChoice;


PROCEDURE Include (VAR Choice :PatternSetP ; Ch :BYTE);
BEGIN
   INCL (Choice^.Array [CARDINAL (Ch)  DIV 32] , CARDINAL (Ch)  MOD 32);
END Include;


PROCEDURE In (Choice :PatternSetP ; Ch :BYTE)  :BOOLEAN;
BEGIN
   RETURN  (CARDINAL (Ch)  MOD 32)  IN Choice^.Array [CARDINAL (Ch)  DIV 32] ;
END In;



PROCEDURE InRange (Lower, Test, Upper :BYTE)  :BOOLEAN;
BEGIN
   RETURN  (Lower <= Test)  AND  (Test <= Upper);
END InRange;



PROCEDURE ParseSearchString (String :ARRAY OF CHAR(*;VAR Direction :INTEGER*))
                                                                    :BOOLEAN;
VAR
   Direction                       :INTEGER;
   PatternPosition                 :CARDINAL;
   RangePending                    :BOOLEAN;
   CaseSensitivity                 :CaseSensitivityT;
   Char                            :BYTE;
   PreviousPatternClass            :SearchSet;


   PROCEDURE AddMinusRange (VAR Choice :PatternSetP;
                            RangeStart :BYTE)  :BOOLEAN;
   VAR
      RangeEnd                        :BYTE;
      Char                            :BYTE;
   BEGIN
      Char := NextCh() ; (* Skip the '-' *)
      RangeEnd := NextCh();
      IF CARDINAL (RangeStart)  < CARDINAL (RangeEnd)  THEN
         FOR Char := RangeStart TO RangeEnd DO
            Include (Choice, Char);
         END (* for *);
      ELSE
         TextIO.WriteChars (sysErr, "Search range must be increasing*N");
         Stop.Stop (0)(*INTEGER (SearchRangeMustBeIncreasing) )*);
         RETURN FALSE;
      END (* if *);
      RETURN TRUE;
   END AddMinusRange;


   PROCEDURE ParseChoice() :PatternSetP;
   VAR
      Choice                       :PatternSetP;

      PROCEDURE AddRange (Start, End :CHAR);
      VAR
         Char                        :BYTE;
      BEGIN
         FOR Char := BYTE (Start)  TO BYTE (End)  DO
            Include (Choice, Char);
         END (* for *);
      END AddRange;

   VAR
      I                            : [0..7] ;
      Char                         :BYTE;
   BEGIN
      NewChoice (Choice);
      IF Choice <> NIL THEN
         LOOP
            IF CurrentString.Index < CurrentString.Length THEN
               Char := NextCh();
               IF CurrentString.String [CurrentString.Index] = '-' THEN
                  IF NOT AddMinusRange (Choice, Char)  THEN
                     DISPOSE (Choice);
                     RETURN NIL;
                  END (* if *);
               ELSE
                  CASE Char OF
                    '$' : Include (Choice, EndOfLineCh);
                  | '#' : AddRange ('0', '9');
                  | '@' : AddRange ('0', '9');
                           AddRange ('A', 'Z');
                           AddRange ('a', 'z');
                           Include (Choice, BYTE ('_') );
                  | ']' : EXIT;
                  ELSE
                     Include (Choice, BYTE (Char) );
                  END (* case *);
               END (* if *);
            ELSE
              TextIO.WriteChars (sysErr, 
                                    "Search unexpected end of choice*N");
               Stop.Stop (0)(*INTEGER (SearchUnexpectedEndOfChoice) )*);
               DISPOSE (Choice);
               RETURN NIL;
            END (* if *);
         END (* loop *);
         RETURN Choice;
      END (* if *);
   END ParseChoice;


BEGIN
   CopyCC (String, CurrentString.String);
   CurrentString.Length := LengthC (String);
   CurrentString.UnexpectedEnd := FALSE;
   PatternPosition := 0;
   RangePending := FALSE;
   CaseSensitivity := InitialSearchCaseSensitivity;
   CurrentString.Index := 0;
   Direction := +1;
   WHILE CurrentString.Index < CurrentString.Length DO
      Char := NextCh();
      IF CurrentString.LiteralCh THEN
         Pattern [PatternPosition] .Ch := Char;
         INC (PatternPosition);
      ELSIF CurrentString.String [CurrentString.Index] = '-' THEN
         (* we have range c-x *)
         IF Pattern [PatternPosition] .Class <> SearchSet{ } THEN
            TextIO.WriteChars (sysErr, "search range badly formed*N");
            Stop.Stop (0)(*INTEGER (SearchRangeBadlyFormed) )*);
            RETURN FALSE;
         ELSE
            WITH Pattern [PatternPosition] DO
               NewChoice (Choice);
               IF NOT AddMinusRange (Choice, Char)  THEN
                  RETURN FALSE;
               END (* if *);
               Class := SearchSet{ SearchChoice };
            END (* with *);
         END (* if *);
      ELSE
         WITH Pattern [PatternPosition] DO
            CASE Char OF
              '`' : IF CaseSensitivity = CaseSensitive THEN
                        CaseSensitivity := CaseInsensitive;
                     ELSE
                        CaseSensitivity := CaseSensitive;
                     END (* if *);
            | '$' : Ch := EndOfLineCh;
                     INC (PatternPosition);
            | '.' : INCL (Class, SearchAnything);
                     INC (PatternPosition);
            | '~' : IF SearchAnythingBut IN Class THEN
                        EXCL (Class, SearchAnythingBut);
                     ELSE
                        INCL (Class, SearchAnythingBut);
                     END (* end *);
            | '#' : INCL (Class, SearchNumeric);
                     INC (PatternPosition);
            | '@' : INCL (Class, SearchAlphabetic);
                     INC (PatternPosition);
            | '[' : Choice := ParseChoice();
                     IF Choice = NIL THEN
                        RETURN FALSE;
                     END (* if *);
                     INCL (Class, SearchChoice);
                     INC (PatternPosition);
            | '*' :
               WITH Pattern [PatternPosition] DO
                  IF SearchMultiple IN Class THEN
                     TextIO.WriteChars (sysErr,
                                          "search multiple illegal*N");
                     Stop.Stop (0)(*INTEGER(SearchMultipleMultipleIllegal))*);
                     RETURN FALSE;
                  ELSIF SearchMaximum IN Class THEN
                     TextIO.WriteChars (sysErr,
                                         "search multiple maximum illegal*N");
                     Stop.Stop (0)(*INTEGER (SearchMultipleMaximumIllegal))*);
                     RETURN FALSE;
                  ELSE
                     INCL (Class, SearchMultiple);
                  END (* if *);
               END (* with *);
            | '^' :
               WITH Pattern [PatternPosition] DO
                  IF SearchMaximum IN Class THEN
                     TextIO.WriteChars (sysErr,
                                          "search maximum maximum illegal*N");
                     Stop.Stop (0)(*INTEGER (SearchMaximumMaximumIllegal) )*);
                     RETURN FALSE;
                  ELSIF SearchMultiple IN Class THEN
                     TextIO.WriteChars (sysErr,
                                         "search maximum multiple illegal*N");
                     Stop.Stop (0)(*INTEGER(SearchMaximumMultipleIllegal))*);
                     RETURN FALSE;
                  ELSE
                     INCL (Class, SearchMaximum);
                  END (* if *);
               END (* with *);
            ELSE
               IF  (CaseSensitivity = CaseInsensitive)  AND
                   ( ( ('A' <= Char)  AND  (Char <= 'Z') )  OR
                     ( ('a' <= Char)  AND  (Char <= 'z') ) )  THEN
                  INCL (Class, SearchCaseInsensitive);
                  Ch := LowerCase (Char);
               ELSE
                  Ch := BYTE (Char);
               END (* if *);
               INC (PatternPosition);
            END (* case *);
         END (* with *);
      END (* if *);
      IF PatternPosition > MaxPatternSize THEN
         TextIO.WriteChars (sysErr, "search string too long*N");
         Stop.Stop (0)(*INTEGER (SearchStringTooLong) )*);
         RETURN FALSE;
      END (* if *);
   END (* while *);
   IF SearchAnythingBut IN Pattern [PatternPosition] .Class THEN
      (* Strictly an error, but we assume '\~' was meant *)
      EXCL (Pattern [PatternPosition] .Class, SearchAnythingBut);
      Pattern [PatternPosition] .Ch := BYTE ('~');
      INC (PatternPosition);
   END (* if *) ;   
   IF CurrentString.UnexpectedEnd THEN
      TextIO.WriteChars (sysErr, "search unexpected end*N");
      Stop.Stop (0)(*INTEGER (SearchUnexpectedEnd) )*);
      RETURN FALSE;
   END (* if *) ;   
   INCL (Pattern [PatternPosition] .Class, SearchEndPattern);
   PatternEnd := PatternPosition;
   RETURN TRUE;
END ParseSearchString;


PROCEDURE DisplayPattern;
VAR
   pos :CARDINAL;
BEGIN
   TextIO.WriteChars (sysErr,"DisplayPattern :*N");
   FOR pos := 0 TO PatternEnd DO
      WriteF.WriteF3 (sysErr,"Pattern [%I].MatchedPosition=[%I..%I]",
                        pos,Pattern [pos].MatchedPosition.Start,
                        Pattern [pos].MatchedPosition.End);
      DescribeClass (Pattern [pos].Class);
(*    IF SearchChoice IN Pattern [pos] .Class THEN
         IF Pattern [pos] .Choice = NIL THEN
            Debug.WriteS (" Choice = NIL !!");
         ELSE
            Debug.WriteS ("*NChoice = ");
            Debug.WriteHex (Pattern [pos] .Choice^.Array [0] , 8);
            Debug.WriteHex (Pattern [pos] .Choice^.Array [1] , 8);
            Debug.Wrch (' ');
            Debug.WriteHex (Pattern [pos] .Choice^.Array [2] , 8);
            Debug.WriteHex (Pattern [pos] .Choice^.Array [3] , 8);
            Debug.Wrch (' ');
            Debug.WriteHex (Pattern [pos] .Choice^.Array [4] , 8);
            Debug.WriteHex (Pattern [pos] .Choice^.Array [5] , 8);
            Debug.Wrch (' ');
            Debug.WriteHex (Pattern [pos] .Choice^.Array [6] , 8);
            Debug.WriteHex (Pattern [pos] .Choice^.Array [7] , 8);
         END (* if *);
      ELSE*)
         WriteF.WriteF1 (sysErr,", Ch='%C'*N", Pattern [pos] .Ch);
(*      END (* if *) ;   *)
   END (* for *);
END DisplayPattern;


PROCEDURE DoSearch (Data :String;
                    StringLength :CARDINAL)  :BOOLEAN;
VAR
   PatternPosition                 : [0..MaxPatternSize] ;
   SearchFinish                    :CARDINAL;

   PROCEDURE Match (Pointer :CARDINAL;
                    Ch :BYTE ; AllowedSet :SearchSet)  :BOOLEAN;
   VAR
      Target                     :PatternR;
      SavedPointerValue          :CARDINAL;
      SavedPatternPosition       : [0..MaxPatternSize] ;

      PROCEDURE UpdateMultipleMatchedArea;
      VAR
         Start                                 :INTEGER;
         End                                   :INTEGER;
      BEGIN
         IF SavedPatternPosition > 0 THEN
            Start := Pattern [SavedPatternPosition - 1] .MatchedPosition.End;
         ELSE
            Start := 0;
         END (* if *);
         IF SavedPatternPosition < MaxPatternSize THEN
            End := Pattern [SavedPatternPosition +1] .MatchedPosition.Start;
         ELSE
            End := StringLength;
         END (* if *);
         Pattern [SavedPatternPosition] .MatchedPosition.Start := Start;
         Pattern [SavedPatternPosition] .MatchedPosition.End := End;
      END UpdateMultipleMatchedArea;

   BEGIN
      Target := Pattern [PatternPosition] ;
      Target.Class := Target.Class * AllowedSet;
      WITH Pattern [PatternPosition + 1] .MatchedPosition DO
         Start := Pattern [PatternPosition] .MatchedPosition.End;
         End := Start + 1;
      END (* with *);
      IF  (Target.Ch = Ch)  AND  (Target.Class = SearchSet{ })  THEN
         INC (PatternPosition);
         RETURN TRUE;
      END (* if *);
      IF SearchMultiple IN Target.Class THEN
         SavedPatternPosition := PatternPosition;
         SavedPointerValue := Pointer;
         INC (PatternPosition);
         WITH Pattern [PatternPosition] .MatchedPosition DO
            (* Assume this pattern matches nothing initially *)
            Start := Pointer;
            End := Pointer + 1;
         END (* with *);
         IF MatchRest (Pointer)  THEN
            UpdateMultipleMatchedArea;
            RETURN TRUE;
         END (* if *);
         PatternPosition := SavedPatternPosition;
         Pointer := SavedPointerValue;
(* ??? *)
         WITH Pattern [PatternPosition] .MatchedPosition DO
            End := Pointer + 1;
         END (* with *);

         EXCL (Target.Class, SearchMultiple);
         IF Match (Pointer, Ch, Target.Class)  THEN
            PatternPosition := SavedPatternPosition;
            RETURN TRUE;
         END (* if *);
         RETURN FALSE;
      END (* if *);

      IF SearchMaximum IN Target.Class THEN

         EXCL (Target.Class, SearchMaximum);
         SavedPatternPosition := PatternPosition;
         SavedPointerValue := Pointer;
         LOOP
            PatternPosition := SavedPatternPosition;
            IF Match (Pointer,
                      Data^ [Pointer] ,
                      Target.Class)  AND
                (Pointer <> StringLength)  THEN
               INC (Pointer);
            ELSE
               EXIT;
            END (* if *);
         END (* loop *);

         Pattern [SavedPatternPosition] .MatchedPosition.Start
            := SavedPointerValue;
         Pattern [SavedPatternPosition] .MatchedPosition.End
            := Pointer;
         PatternPosition := SavedPatternPosition + 1;
         IF Pointer = SavedPointerValue THEN
            RETURN FALSE;
         END (* if *);
         Pattern [PatternPosition].MatchedPosition.Start := Pointer;
         Pattern [PatternPosition].MatchedPosition.End   := Pointer + 1;
         IF MatchRest (Pointer)  THEN
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END (* if *);
      END (* if *);
      IF SearchAnythingBut IN Target.Class THEN
         EXCL (Target.Class, SearchAnythingBut);
         RETURN NOT Match (Pointer, Ch, Target.Class);
      END (* if *);
      IF SearchCaseInsensitive IN Target.Class THEN
         INC (PatternPosition);
         IF  ( ( (BYTE ('A')  <= Ch)  AND  (Ch <= BYTE ('Z') ) )  OR
               ( (BYTE ('a')  <= Ch)  AND  (Ch <= BYTE ('z') ) ) )  THEN
            RETURN Target.Ch = LowerCase (Ch);
         END (* if *);
         RETURN FALSE;
      END (* if *);
      IF SearchNumeric IN Target.Class THEN
         INC (PatternPosition);
         RETURN  (BYTE ('0')  <= Ch)  AND  (Ch <= BYTE ('9') );
      END (* if *);
      IF SearchAlphabetic IN Target.Class THEN
         INC (PatternPosition);
         RETURN  ( ( (BYTE ('A')  <= Ch)  AND  (Ch <= BYTE ('Z') ) )  OR
                   ( (BYTE ('0')  <= Ch)  AND  (Ch <= BYTE ('9') ) )  OR
                   ( BYTE ('_') = Ch )                                OR
                   ( (BYTE ('a')  <= Ch)  AND  (Ch <= BYTE ('z') ) ) );
      END (* if *);
      IF SearchAnything IN Target.Class THEN
         INC (PatternPosition);
         RETURN TRUE;
      END (* if *);
      IF SearchChoice IN Target.Class THEN
         INC (PatternPosition);
         RETURN In (Target.Choice, Ch);
      END (* if *);
      RETURN  (SearchEndPattern IN Target.Class);
   END Match;


   PROCEDURE MatchRest (Pointer :CARDINAL)  :BOOLEAN;
   BEGIN
      LOOP
         WITH Pattern [PatternPosition] DO
            IF SearchEndPattern IN Class THEN
               RETURN TRUE;
            END (* if *);
            IF Pointer = StringLength THEN
               RETURN FALSE;
            END (* if *);
            IF NOT Match (Pointer,
                          Data^ [Pointer] ,
                          AllClasses)  THEN
               RETURN FALSE;
            END (* if *);
            INC (Pointer);
         END (* with *);
      END (* loop *);
   END MatchRest;

VAR
   SearchPointer                :CARDINAL;
BEGIN
   PatternPosition := 0;
   IF 0 >= StringLength THEN
      RETURN FALSE;
   END (* if *);
   SearchPointer := 0;
   SearchFinish := StringLength;
   WHILE SearchPointer <> SearchFinish DO
      PatternPosition := 0;
      WITH Pattern [PatternPosition] DO
         MatchedPosition.Start := SearchPointer;
         MatchedPosition.End := SearchPointer + 1;
      END (* with *) ;   
      IF Match (SearchPointer,
                Data^ [SearchPointer] ,
                AllClasses)  THEN
         IF MatchRest (SearchPointer + 1)  THEN
            RETURN TRUE;
         END (* if *);
      END (* if *);
      INC (SearchPointer, 1);
   END (* while *);
(* DisplayPattern ();*)
   RETURN FALSE;
END DoSearch;



PROCEDURE DoReplace (Data :String;
                     StringLength :CARDINAL;
                     ReplaceString :ARRAY OF CHAR;
                 VAR Result :String)  :BOOLEAN;
VAR NextOutpos :INTEGER;
    LocalBuff :ARRAY [0..MaxBuff] OF CHAR;
   PROCEDURE Instr (Allowed :ARRAY OF CHAR ; Attempt :BYTE)  :BOOLEAN;
   VAR
      Index                  :CARDINAL;
   BEGIN
      Index := 0;
      RETURN FindC (Allowed, CHAR (Attempt) , Index);
   END Instr;

   PROCEDURE ReplaceWanted() :BOOLEAN;
   VAR
      ReplacementStart                  :CARDINAL;

      PROCEDURE Insert (Ch :BYTE);
      BEGIN
         LocalBuff [NextOutpos] := Ch; INC (NextOutpos);
         IF NextOutpos > MaxBuff THEN
            TextIO.WriteChars (sysErr, "replace - result too large:*N");
            TextIO.WriteChars (sysErr, LocalBuff)
         END (* if *);
      END Insert;

      PROCEDURE InsertArea (Start, End :CARDINAL);
      VAR
         Index                  :CARDINAL;
      BEGIN
         Index := Start;
         WHILE Index < End DO
            Insert (Data^ [Index] );
            INC (Index);
         END (* while *);
      END InsertArea;


      PROCEDURE InsertWildArea (RequiredItem :CARDINAL;
                                RequiredClasses :SearchSet)  :BOOLEAN;
      VAR
         Item                        :CARDINAL;
         Position                    : [0..MaxPatternSize] ;
      BEGIN
         Position := 0;
         Item := 0;
         WHILE Position < PatternEnd DO
            WITH Pattern [Position] DO
               IF Class * RequiredClasses <> SearchSet{} THEN
                  IF Item = RequiredItem THEN
                     InsertArea (MatchedPosition.Start, MatchedPosition.End);
                     RETURN TRUE;
                  END (* if *);
                  INC (Item);
               END (* if *);
            END (* with *);
            INC (Position);
         END (* while *);
         TextIO.WriteChars (sysErr, "replace field not present*N");
         Stop.Stop (0)(*INTEGER (ReplaceFieldNotPresent) )*);
         RETURN FALSE;
      END InsertWildArea;

   VAR
      Ch                     :BYTE;
      NthItem                :CARDINAL;
      WildType               :CARDINAL;
      WildSet                :SearchSet;
   BEGIN
      NextOutpos := 0; Result := NIL;
      CopyCC (ReplaceString, CurrentString.String);
      CurrentString.Length := LengthC (ReplaceString);
      CurrentString.UnexpectedEnd := FALSE;
      CurrentString.Index := 0;
      WHILE CurrentString.Index < CurrentString.Length DO
         Ch := NextCh();
         IF CurrentString.LiteralCh THEN
            Insert (Ch);
         ELSE
            IF Ch = BYTE ('$')  THEN
               Insert (EndOfLineCh);
            ELSIF Ch = BYTE ('&')  THEN
               InsertArea (Pattern [0] .MatchedPosition.Start,
                           Pattern [PatternEnd] .MatchedPosition.Start);
            ELSIF Ch = BYTE ('%')  THEN
               Ch := NextCh();
               WildType := 0;
               IF InRange (BYTE ('0') , Ch, BYTE ('9') )  THEN
                  NthItem := CARDINAL (Ch)  - CARDINAL ('0');
                  IF NOT InsertWildArea (NthItem,
                                         SearchSet{ SearchMultiple,
                                                    SearchMaximum,
                                                    SearchNumeric,
                                                    SearchAlphabetic,
                                                    SearchAnythingBut,
                                                    SearchAnything,
                                                    SearchChoice 
                                                  })  THEN
                     RETURN FALSE;
                     END (* if *);
               ELSIF FindC (SearchFields, CHAR (Ch) , WildType)  THEN
                  IF Ch = BYTE ('[')  THEN
                     DEC (WildType)  ; (* '[' is synonymous with '-' *)
                  END (* if *);
                  Ch := NextCh();
                  IF InRange (BYTE ('0') , Ch, BYTE ('9') )  THEN
                     NthItem := CARDINAL (Ch)  - CARDINAL ('0');
                  ELSE
                     NthItem := 0;
                  END (* if *);
                  WildSet := SearchSet{ };
                  INCL (WildSet, VAL (SearchClasses, WildType) );
                  IF NOT InsertWildArea (NthItem, WildSet)  THEN
                     RETURN FALSE;
                  END (* if *);
               ELSE
                  TextIO.WriteChars (sysErr,
                                 "replace bad field specifier*N");
                  Stop.Stop (0)(*INTEGER (ReplaceBadFieldSpecifier) )*);
                  RETURN FALSE;
               END (* if *);
            ELSE
               Insert (Ch);
            END (* if *);
         END (* if *);
      END (* while *);
      IF CurrentString.UnexpectedEnd THEN
         TextIO.WriteChars (sysErr, "search unexpected end of replace*N");
         Stop.Stop (0)(*INTEGER (SearchUnexpectedEndOfReplace) )*);
         RETURN FALSE;
      END (* if *);
      LocalBuff [NextOutpos] := 0C;
      Result := Strings.CopyCS (LocalBuff);
      RETURN TRUE;
   END ReplaceWanted;

VAR
   Found                    :BOOLEAN;
BEGIN
   IF DoSearch (Data, StringLength) THEN
      RETURN (ReplaceWanted())
   END;
   RETURN (FALSE)
END DoReplace;



PROCEDURE DescribeClass (Class :SearchSet);
PROCEDURE SetElement (S :SearchSet; C :SearchClasses; Mon :ARRAY OF CHAR);
BEGIN
   IF C IN S THEN
      TextIO.WriteChars (sysErr, Mon); TextIO.WriteCHAR (sysErr, " ")
   END (* if *);
END SetElement;
BEGIN

   TextIO.WriteChars (sysErr, "{ ");
   SetElement (Class, SearchMultiple, "Multiple");
   SetElement (Class, SearchMaximum, "Maximum");
   SetElement (Class, SearchNumeric, "Numeric");
   SetElement (Class, SearchAlphabetic, "Alphabetic");
   SetElement (Class, SearchCaseInsensitive, "CaseInsensitive");
   SetElement (Class, SearchAnything, "Anything");
   SetElement (Class, SearchAnythingBut, "AnythingBut");
   SetElement (Class, SearchChoice, "Choice");
   SetElement (Class, SearchEndPattern, "EndPattern");
   TextIO.WriteChars (sysErr, " }*N");

END DescribeClass;


PROCEDURE Initialise;
VAR
   PatternPosition               :CARDINAL;
BEGIN
   FOR PatternPosition := 0 TO MaxPatternSize DO
      WITH Pattern [PatternPosition] DO
         Ch := BYTE(0);
         Class := SearchSet{ };
         MatchedPosition.Start := 0;
         MatchedPosition.End := 0;
      END;
   END (* for *);
   SearchFields := "*^#@~.-[";
   AllClasses := SearchSet{ SearchMultiple..SearchEndPattern };
END Initialise;


PROCEDURE Terminate;
VAR
   PatternPosition                 :CARDINAL;
BEGIN
   FOR PatternPosition := 0 TO MaxPatternSize DO
      WITH Pattern [PatternPosition] DO
         IF SearchChoice IN Class THEN
            DISPOSE (Choice);
         END (* if *);
         Class := SearchSet{ };
         MatchedPosition.Start := 0;
         MatchedPosition.End := 0;
         Ch := BYTE (0);
      END (* with *);
   END (* for *);
END Terminate;

PROCEDURE ParseF0 (Pattern :ARRAY OF CHAR; Data :String) :BOOLEAN;
VAR StringLength :CARDINAL;
BEGIN
   IF Data = NIL THEN RETURN (FALSE) END;
   StringLength := Strings.LengthS (Data);
   IF ParseSearchString (Pattern) THEN
      IF DoSearch (Data, StringLength) THEN
         Terminate (); RETURN (TRUE)
      END;
   END;
   Terminate (); RETURN (FALSE)
END ParseF0;

PROCEDURE ParseF1 (Pattern :ARRAY OF CHAR; Data :String;
                   Replace1 :ARRAY OF CHAR; VAR Result1 :String) :BOOLEAN;
VAR StringLength :CARDINAL; Temp1 :String;
BEGIN
   IF Data = NIL THEN RETURN (FALSE) END;
   StringLength := Strings.LengthS (Data);
   IF ParseSearchString (Pattern) THEN
      IF DoReplace (Data, StringLength, Replace1, Temp1) THEN
         Result1 := Temp1;
         Terminate (); RETURN (TRUE)
      END;
   END;
   Terminate (); RETURN (FALSE)
END ParseF1;

PROCEDURE ParseF2 (Pattern :ARRAY OF CHAR; Data :String;
                   Replace1 :ARRAY OF CHAR; VAR Result1 :String;
                   Replace2 :ARRAY OF CHAR; VAR Result2 :String
                   ) :BOOLEAN;
VAR StringLength :CARDINAL; Temp1, Temp2, Temp3, Temp4 :String;
BEGIN
   IF Data = NIL THEN RETURN (FALSE) END;
   StringLength := Strings.LengthS (Data);
   IF ParseSearchString (Pattern) THEN
      IF DoReplace (Data, StringLength, Replace1, Temp1) AND
         DoReplace (Data, StringLength, Replace2, Temp2) THEN
         Result1 := Temp1; Result2 := Temp2;
         Terminate (); RETURN (TRUE)
      END;
   END;
   Terminate (); RETURN (FALSE)
END ParseF2;

PROCEDURE ParseF3 (Pattern :ARRAY OF CHAR; Data :String;
                   Replace1 :ARRAY OF CHAR; VAR Result1 :String;
                   Replace2 :ARRAY OF CHAR; VAR Result2 :String;
                   Replace3 :ARRAY OF CHAR; VAR Result3 :String
                   ) :BOOLEAN;
VAR StringLength :CARDINAL; Temp1, Temp2, Temp3, Temp4 :String;
BEGIN
   IF Data = NIL THEN RETURN (FALSE) END;
   StringLength := Strings.LengthS (Data);
   IF ParseSearchString (Pattern) THEN
      IF DoReplace (Data, StringLength, Replace1, Temp1) AND
         DoReplace (Data, StringLength, Replace2, Temp2) AND
         DoReplace (Data, StringLength, Replace3, Temp3) THEN
         Result1 := Temp1; Result2 := Temp2; Result3 := Temp3;
         Terminate (); RETURN (TRUE)
      END;
   END;
   Terminate (); RETURN (FALSE)
END ParseF3;

PROCEDURE ParseF4 (Pattern :ARRAY OF CHAR; Data :String;
                   Replace1 :ARRAY OF CHAR; VAR Result1 :String;
                   Replace2 :ARRAY OF CHAR; VAR Result2 :String;
                   Replace3 :ARRAY OF CHAR; VAR Result3 :String;
                   Replace4 :ARRAY OF CHAR; VAR Result4 :String
                   ) :BOOLEAN;
VAR StringLength :CARDINAL; Temp1, Temp2, Temp3, Temp4 :String;
BEGIN
   IF Data = NIL THEN RETURN (FALSE) END;
   StringLength := Strings.LengthS (Data);
   IF ParseSearchString (Pattern) THEN
      IF DoReplace (Data, StringLength, Replace1, Temp1) AND
         DoReplace (Data, StringLength, Replace2, Temp2) AND
         DoReplace (Data, StringLength, Replace3, Temp3) AND
         DoReplace (Data, StringLength, Replace4, Temp4) THEN
         Result1 := Temp1; Result2 := Temp2;
         Result3 := Temp3; Result4 := Temp4;
         Terminate (); RETURN (TRUE)
      END;
   END;
   Terminate (); RETURN (FALSE)
END ParseF4;

BEGIN
   Initialise ();
END ScanS.