//=== File Prolog ============================================================
//	This code was developed by RiverSoftAVG (www.RiverSoftAVG.com).
//
//--- Notes ------------------------------------------------------------------
//
//--- Development History  ---------------------------------------------------
//
//      08/2003 T. Grubb
//              - Added Overloaded Parse(FileName) and Parse(Stream) methods
//      07/2001 T. Grubb
//              - Initial Version
//
//      File Contents:
//           TmwCachedPasLex    Descendant component of TmwPasLex by
//                              Martin.Waldenburg@T-Online.de which caches the
//                              tokens it finds, this allows later searches based
//                              on the tokens.
//                              This class requires modification of TmwPasLex:
//                               - descend from TPersistent instead of TObject
//                               - Make Init and Next methods virtual
//           TmwPascalToken     One token in the stream
//           TmwPascalTokens    Collection of tokens
//
// This object caches the tokens of the parse
// allowing searches to be made on the source code based on tokens (much more
// robust than searching for a string).  The following code shows how to use the
// new class to find the implementation section of the pascal file and then
// insert some code:
//
//        Lex := TmwCachedPasLex.Create;
//        try
//           // Parse the pascal file to be able to find the relevant parts
//           // of the file to insert our function
//           Lex.Origin := @UnitText[1];
//           Lex.Parse;
//           InsertString := NewLineString + NewLineString;
//           // find implementation
//           i := Lex.FindPattern( 0, 'implementation', Span, False );
//           if i = -1 then        // implementation not found!  try to find end of "initialization" statement
//           begin
//                i := Lex.FindPattern( 0, 'initialization', Span, False );
//                if i = -1 then   // no initialization either!  how about end.?
//                begin
//                     i := Lex.FindPattern( 0, 'end.', Span, False );
//                     if i = -1 then
//                     begin
//                          i := Lex.Tokens.Count - 1;
//                     end;
//                end
//                else           // initialization found, insert before
//                begin
//                     Dec(i);
//                end;
//                InsertString := InsertString + 'implementation' + NewLineString + NewLineString;
//           end
//           else // implementation found, if there is a uses clause, go to end
//           begin
//                j := Lex.FindPattern( i+1, 'uses', Span, False );
//                if j > -1 then
//                   while Lex.Tokens[i].TokenID <> ptSemiColon do
//                         Inc(i);
//           end;
//
//           InsertString := InsertString + UserFunctionDlg.UFDefinition.GetImplementationSection;
//           if i > -1 then
//           begin
//                i := Lex.Tokens[i+Span].TokenPos;
//                result := Copy(UnitText, 1, i);
//                result := result + InsertString + Copy( UnitText, i+1, MaxInt );
//           end
//           else
//               result := InsertString + UnitText;
//        finally
//           Lex.Free;
//        end;
//
//--- Warning ----------------------------------------------------------------
//    This file is distributed under the terms of the MOZILLA PUBLIC LICENSE, v1.1
//    at http://www.mozilla.org/MPL/MPL-1.1.html
//    This is in accordance with the original developer of TmwPasLex,
//         Martin.Waldenburg@T-Online.de
//
//      (c) 2001-2002, Thomas G. Grubb
//
//=== End File Prolog ========================================================
unit mwCachedPasLex;

interface

uses
  SysUtils, Classes, mwPasLex, mwPasLexTypes;

{$ifndef VER130} {$ifndef VER140} {$ifndef VER150} {$ObjExportAll on} {$endif} {$endif} {$endif}

type
  TmwCachedPasLex = class;
  TmwPascalTokens = class;
  TmwPascalToken = class(TCollectionItem)
  { Purpose: To hold ONE token in the parsed stream }
  private
    { Private Declarations }
    FTokenPos: Integer;
    FToken: String;
    FTokenID: TptTokenKind;
    FExId: TptTokenKind;
    function GetCollection: TmwPascalTokens;
  protected
    { Protected Declarations }
    function GetDisplayName: string; override;
    procedure SetCollection(const Value: TmwPascalTokens); reintroduce;
  public
    { Public Declarations }
    procedure Assign(Source: TPersistent); override;
    function Equals( const AToken: TmwPascalToken; const CaseSensitive: Boolean = True ): Boolean; virtual;
    function ToString: String; virtual;
    property Collection: TmwPascalTokens read GetCollection write SetCollection;
  published
    { Published Declarations }
    property ExId: TptTokenKind read FExId write FExId;
    property Token: String read FToken write FToken;
    property TokenID: TptTokenKind read FTokenID write FTokenID;
    property TokenPos: Integer read FTokenPos write FTokenPos;
  end; { TmwPascalToken }

  TmwPascalTokens = class(TOwnedCollection)
  { Purpose: To hold ALL tokens in the parsed stream }
  private
    { Private Declarations }
    function GetItem(Index: Integer): TmwPascalToken;
    function GetLex: TmwCachedPasLex;
    procedure SetItem(Index: Integer; const Value: TmwPascalToken);
  protected
    { Protected Declarations }
    procedure AssignTo(Dest: TPersistent); override;
    procedure Update(Item: TCollectionItem); override;
  public
    { Public Declarations }
    function Add: TmwPascalToken;
    function IndexOf(const TokenID: TptTokenKind): Integer; overload;
    function IndexOf(const Index: Integer; const TokenID: TptTokenKind): Integer; overload; virtual;
    function IndexOf(const Token: string): Integer; overload;
    function IndexOf(const Index: Integer; const Token: string): Integer; overload; virtual;
    property Items[Index: Integer]: TmwPascalToken read GetItem write SetItem; default;
    property Lex: TmwCachedPasLex read GetLex;
  published
    { Published Declarations }
  end; { TmwPascalTokens }

  TmwCachedPasLex = class(TmwPasLex)
  { Purpose: To parse a string into tokens.  Tokens are saved so that you can
    search for patterns later.  This class requires modification of TmwPasLex:
           - descend from TPersistent instead of TObject
           - Make Init and Next methods virtual
     }
  private
    { Private Declarations }
    FTokens: TmwPascalTokens;
    procedure SetTokens(const Value: TmwPascalTokens);
  protected
    { Protected Declarations }
    procedure UpdateToken(Item: TmwPascalToken); virtual;
    procedure UpdateTokens; virtual;
  public
    { Public Declarations }
    constructor Create; virtual;
    destructor Destroy; override;

    function CreateTokens( const Pattern: String ): TmwPascalTokens; 
    function FindPattern( const Index: Integer; Pattern: String; var Span: Integer;
                          const CaseSensitive: Boolean = True): Integer; overload; virtual;
    function FindPattern( const Index: Integer; Pattern: String;
                          const CaseSensitive: Boolean = True): Integer; overload;
    procedure Next; override;
    procedure Init; override;
    procedure Parse; overload; virtual;
    procedure Parse( const FileName: String ); overload;
    procedure Parse( const Stream: TStream ); overload;
  published
    { Published Declarations }
    property Tokens: TmwPascalTokens read FTokens write SetTokens;
  end; { TmwCachedPasLex }

implementation

{ TmwPascalToken }

procedure TmwPascalToken.Assign(Source: TPersistent);
begin
     if Source is TmwPascalToken then
     begin
          FExID := TmwPascalToken(Source).ExID;
          FTokenPos := TmwPascalToken(Source).TokenPos;
          FToken := TmwPascalToken(Source).Token;
          FTokenID := TmwPascalToken(Source).TokenID;
          Exit;
     end;
     inherited Assign( Source );
end;

function TmwPascalToken.Equals(const AToken: TmwPascalToken; const CaseSensitive: Boolean = True ): Boolean;
begin
     // Check if equals EXCEPT for Pos
     if CaseSensitive then
        result := (ExID = AToken.ExID) and
               (Token = AToken.Token) and
               (TokenID = AToken.TokenID)
     else
        result := (ExID = AToken.ExID) and
               (CompareText(Token, AToken.Token) = 0) and
               (TokenID = AToken.TokenID)
end;

function TmwPascalToken.GetCollection: TmwPascalTokens;
begin
     result := TmwPascalTokens(inherited Collection);
end;

function TmwPascalToken.GetDisplayName: string;
begin
     result := Token;
     if result = '' then result := inherited GetDisplayName;
end;

procedure TmwPascalToken.SetCollection(const Value: TmwPascalTokens);
begin
     inherited Collection := Value;
end;

function TmwPascalToken.ToString: String;
begin
     if TokenID = ptIdentifier then
        result := IntToStr(TokenPos) + ', ' + Token + ', ' + ptTokenName(TokenID) + ', ' + ptTokenName(ExID)
     else
        result := IntToStr(TokenPos) + ', ' + Token + ', ' + ptTokenName(TokenID);
end;

{ TmwPascalTokens }

function TmwPascalTokens.Add: TmwPascalToken;
begin
     result := TmwPascalToken(inherited Add);
end;

procedure TmwPascalTokens.AssignTo(Dest: TPersistent);
var
   i: Integer;
begin
     if Dest is TStrings then
     begin
          TStrings(Dest).BeginUpdate;
          try
             TStrings(Dest).Clear;
             for i := 0 to Count - 1 do
                 TStrings(Dest).AddObject( Items[i].ToString, Items[i] );
          finally
             TStrings(Dest).EndUpdate;
          end;
          Exit;
     end;
     inherited AssignTo(Dest);
end;

function TmwPascalTokens.GetItem(Index: Integer): TmwPascalToken;
begin
     result := TmwPascalToken(inherited Items[Index])
end;

function TmwPascalTokens.GetLex: TmwCachedPasLex;
begin
     result := TmwCachedPasLex(GetOwner);
end;

function TmwPascalTokens.IndexOf(const Index: Integer;
  const TokenID: TptTokenKind): Integer;
begin
     for result := Index to Count - 1 do
         if Items[result].TokenID = TokenID then Exit;
     result := -1;
end;

function TmwPascalTokens.IndexOf(const TokenID: TptTokenKind): Integer;
begin
     result := IndexOf(0, TokenID);
end;

function TmwPascalTokens.IndexOf(const Index: Integer;
  const Token: string): Integer;
begin
     for result := Index to Count - 1 do
         if Items[result].Token = Token then Exit;
     result := -1;
end;

function TmwPascalTokens.IndexOf(const Token: string): Integer;
begin
     result := IndexOf(0, Token);
end;

procedure TmwPascalTokens.SetItem(Index: Integer;
  const Value: TmwPascalToken);
begin
     inherited Items[Index] := Value;
end;

procedure TmwPascalTokens.Update(Item: TCollectionItem);
begin
     inherited Update(Item);
     if Lex = nil then Exit;
     if Item = nil then
        Lex.UpdateTokens
     else
         Lex.UpdateToken( TmwPascalToken(Item) );
end;

{ TmwCachedPasLex }

constructor TmwCachedPasLex.Create;
begin
     inherited Create;
     FTokens := TmwPascalTokens.Create( Self, TmwPascalToken );
end;

function TmwCachedPasLex.CreateTokens(
  const Pattern: String): TmwPascalTokens;
// Returns a collection of tokens representing the string... user is responsible
// for freeing the collection
var
   PasLex: TmwCachedPasLex;
begin
     // Parse the string
     PasLex := TmwCachedPasLex.Create;
     try
        PasLex.Origin := @Pattern[1];
        PasLex.Parse;
        // Delete the Null Token
        PasLex.Tokens.Delete(PasLex.Tokens.Count-1);
        result := TmwPascalTokens.Create( nil, TmwPascalToken );
        result.Assign( PasLex.Tokens );
     finally
        PasLex.Free;
     end;
end;

destructor TmwCachedPasLex.Destroy;
begin
     FTokens.Free;
     inherited Destroy;
end;

function TmwCachedPasLex.FindPattern(const Index: Integer; Pattern: String;
  var Span: Integer; const CaseSensitive: Boolean = True): Integer;
  function PatternEquals( Index: Integer; const ATokens: TmwPascalTokens; ATokensIndex: Integer ): Boolean;
  begin
       result := ATokensIndex >= ATokens.Count;
       if not result then
          result := Tokens[Index].Equals( ATokens[ATokensIndex], CaseSensitive ) and
                    PatternEquals( Index+1, ATokens, ATokensIndex+1 );
  end;
var
   PatternTokens: TmwPascalTokens;
begin
     // Parse the string
     PatternTokens := CreateTokens( Pattern );
     try
        Span := PatternTokens.Count;
        // Now, let's try to find the pattern
        for result := Index to Tokens.Count - PatternTokens.Count do
            // check first pattern
            if PatternEquals( result, PatternTokens, 0 ) then
               Exit;
        result := -1;
     finally
        PatternTokens.Free;
     end;
end;

function TmwCachedPasLex.FindPattern(const Index: Integer;
  Pattern: String; const CaseSensitive: Boolean = True): Integer;
var
   Span: Integer;
begin
     result := FindPattern(Index, Pattern, Span, CaseSensitive);
end;

procedure TmwCachedPasLex.Init;
begin
     inherited Init;
     Tokens.Clear;
end;

procedure TmwCachedPasLex.Next;
var
   AToken: TmwPascalToken;
begin
     inherited Next;
     AToken := Tokens.Add;
     AToken.ExID := ExID;
     AToken.Token := Token;
     AToken.TokenPos := TokenPos;
     AToken.TokenID := TokenID;
end;

procedure TmwCachedPasLex.Parse;
begin
     Tokens.BeginUpdate;
     try
        while TokenID <> ptNull do
              Next;
     finally
        Tokens.EndUpdate;
     end;
end;

procedure TmwCachedPasLex.Parse(const Stream: TStream);
var
   Text: String;
begin
     SetLength(Text, Stream.Size);
     Stream.Read(Text[1], Stream.Size);
     Origin := @Text[1];
     Parse;
end;

procedure TmwCachedPasLex.Parse(const FileName: String);
var
   FileStream: TFileStream;
begin
     FileStream := TFileStream.Create(FileName, fmOpenRead);
     try
        Parse( FileStream );
     finally
        FileStream.Free;
     end;
end;

procedure TmwCachedPasLex.SetTokens(const Value: TmwPascalTokens);
begin
     FTokens.Assign(Value);
end;

procedure TmwCachedPasLex.UpdateToken(Item: TmwPascalToken);
begin

end;

procedure TmwCachedPasLex.UpdateTokens;
begin

end;


end.