jclparseuses.pas

East make Tray Icon in delphi

unit JclParseUses;

{$I jcl.inc}

interface

uses
  Classes, SysUtils;

type
  EUsesListError = class(Exception);

  TUsesList = class
  private
    FText: string;
    function GetCount: Integer;
    function GetItems(Index: Integer): string;
  public
    constructor Create(const AText: PChar);
    function Add(const UnitName: string): Integer;
    function IndexOf(const UnitName: string): Integer;
    procedure Insert(Index: Integer; const UnitName: string);
    procedure Remove(Index: Integer);
    property Text: string read FText;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: string read GetItems; default;
  end;

  TCustomGoal = class
  public
    constructor Create(Text: PChar); virtual; abstract;
  end;

  TProgramGoal = class(TCustomGoal)
  private
    FTextAfterUses: string;
    FTextBeforeUses: string;
    FUsesList: TUsesList;
  public
    constructor Create(Text: PChar); override;
    destructor Destroy; override;
    property TextAfterUses: string read FTextAfterUses;
    property TextBeforeUses: string read FTextBeforeUses;
    property UsesList: TUsesList read FUsesList;
  end;

  TLibraryGoal = class(TCustomGoal)
  private
    FTextAfterUses: string;
    FTextBeforeUses: string;
    FUsesList: TUsesList;
  public
    constructor Create(Text: PChar); override;
    destructor Destroy; override;
    property TextAfterUses: string read FTextAfterUses;
    property TextBeforeUses: string read FTextBeforeUses;
    property UsesList: TUsesList read FUsesList;
  end;

  TUnitGoal = class(TCustomGoal)
  private
    FTextAfterImpl: string;
    FTextAfterIntf: string;
    FTextBeforeIntf: string;
    FUsesImpl: TUsesList;
    FUsesIntf: TUsesList;
  public
    constructor Create(Text: PChar); override;
    destructor Destroy; override;
    property TextAfterImpl: string read FTextAfterImpl;
    property TextAfterIntf: string read FTextAfterIntf;
    property TextBeforeIntf: string read FTextBeforeIntf;
    property UsesImpl: TUsesList read FUsesImpl;
    property UsesIntf: TUsesList read FUsesIntf;
  end;

function CreateGoal(Text: PChar): TCustomGoal;

implementation

uses
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RtlConsts;
  {$ELSE}
  Consts;
  {$ENDIF HAS_UNIT_RTLCONSTS}

const
  Blanks: TSysCharSet = [#9, #10, #13, ' '];
  SLibrary = 'library';
  SProgram = 'program';
  SUnit = 'unit';
  SUses = 'uses';

resourcestring
  SDuplicateUnit = 'Duplicate unit ''%s''';
  SInvalidLibrary = 'Invalid library';
  SInvalidProgram = 'Invalid program';
  SInvalidUnit = 'Invalid unit';
  SInvalidUses = 'Invalid uses clause';

function PeekKeyword(var P: PChar; Keyword: PChar): Boolean; forward;
function ReadIdentifier(var P: PChar): string; forward;
procedure SkipCommentsAndBlanks(var P: PChar); forward;

//----------------------------------------------------------------------------

function CheckIdentifier(var P: PChar): Boolean;
begin
  Result := P^ in ['A'..'Z', '_', 'a'..'z'];
  if Result then
  begin
    Inc(P);
    while P^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do
      Inc(P);
  end;
end;

//----------------------------------------------------------------------------

function CheckKeyword(var P: PChar; Keyword: PChar): Boolean;
var
  KeywordLen: Integer;
begin
  KeywordLen := StrLen(Keyword);
  Result := StrLComp(P, Keyword, KeywordLen) = 0;
  if Result then
    Inc(P, KeywordLen);
end;

//----------------------------------------------------------------------------

function CreateGoal(Text: PChar): TCustomGoal;
var
  P: PChar;
begin
  Result := nil;
  P := Text;

  SkipCommentsAndBlanks(P);
  if PeekKeyword(P, SProgram) then
    Result := TProgramGoal.Create(Text)
  else
  if PeekKeyword(P, SLibrary) then
    Result := TLibraryGoal.Create(Text)
  else
  if PeekKeyword(P, SUnit) then
    Result := TUnitGoal.Create(Text);
end;

//----------------------------------------------------------------------------

function PeekKeyword(var P: PChar; Keyword: PChar): Boolean;
var
  KeywordLen: Integer;
begin
  KeywordLen := StrLen(Keyword);
  Result := StrLComp(P, Keyword, KeywordLen) = 0;
end;

//----------------------------------------------------------------------------

function ReadIdentifier(var P: PChar): string;
var
  PStart: PChar;
begin
  Result := '';

  if P^ in ['A'..'Z', '_', 'a'..'z'] then
  begin
    PStart := P;
    
    Inc(P);
    while P^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do
      Inc(P);

    SetString(Result, PStart, P - PStart);
  end;
end;

//----------------------------------------------------------------------------

procedure SkipChars(var P: PChar; Chars: TSysCharSet);
begin
  while P^ in Chars do
    Inc(P);
end;

//----------------------------------------------------------------------------

procedure SkipComments(var P: PChar);
var
  Test: PChar;
begin
  if P^ = '{' then
  begin
    Test := StrScan(P, '}');
    if Test <> nil then
      P := Test + 1;
  end
  else
  if StrLComp(P, '(*', 2) = 0 then
  begin
    Test := StrPos(P, '*)');
    if Test <> nil then
      P := Test + 2;
  end
  else
  if StrLComp(P, '//', 2) = 0 then
  begin
    Test := StrPos(P, #13#10);
    if Test <> nil then
      P := Test + 2;
  end;
end;

//----------------------------------------------------------------------------

procedure SkipCommentsAndBlanks(var P: PChar);
var
  Test: PChar;
begin
  repeat
    Test := P;
    SkipChars(P, Blanks);
    SkipComments(P);
  until Test = P;
end;

//----------------------------------------------------------------------------
{ TUsesList private }
//----------------------------------------------------------------------------

function TUsesList.GetCount: Integer;
var
  P: PChar;
begin
  Result := 0;

  if FText = '' then
    Exit;

  P := PChar(FText);
  // an empty uses clause consisting of only blanks and comments
  // (resulting from removal of the last unit) is valid too
  SkipCommentsAndBlanks(P);
  if P^ = #0 then
    Exit;

  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);

  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);
    Inc(Result);
    SkipCommentsAndBlanks(P);

    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
        
      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',':
        Inc(P);
      ';':
        Break;
      else
        raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------

function TUsesList.GetItems(Index: Integer): string;
var
  P, PIdentifier: PChar;
  I: Integer;
begin
  Result := '';

  if (Index < 0) or (Index > Count - 1) then
    raise EUsesListError.CreateFmt(SListIndexError, [Index]);

  P := PChar(FText);
  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);
  I := -1;
  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    PIdentifier := P;
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);

    Inc(I);
    if I = Index then
    begin
      while PIdentifier^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do
      begin
        Result := Result + PIdentifier^;
        Inc(PIdentifier);
      end;
      Exit;
    end;
    SkipCommentsAndBlanks(P);

    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);

      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',':
        Inc(P);
      ';':
        Break;
      else
        raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------
{ TUsesList public }
//----------------------------------------------------------------------------

constructor TUsesList.Create(const AText: PChar);
var
  P, PStart: PChar;
begin
  inherited Create;
  FText := '';
  if AText = nil then
    Exit;
    
  PStart := PChar(AText);
  P := PStart;
  if CheckKeyword(P, SUses) then
  begin
    while P^ <> #0 do
    begin
      SkipCommentsAndBlanks(P);
      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);
      SkipCommentsAndBlanks(P);

      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        
        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
      end;

      case P^ of
        ',':
          Inc(P);
        ';':
          begin
            Inc(P);
            Break;
          end;
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
    end;

    SetString(FText, PStart, P - PStart);
  end;
end;

//----------------------------------------------------------------------------

function TUsesList.Add(const UnitName: string): Integer;
var
  I: Integer;
  P: PChar;
begin
  Result := -1;

  I := IndexOf(UnitName);
  if I <> -1 then
    raise EUsesListError.CreateFmt(SDuplicateUnit, [UnitName]);

  if FText = '' then
  begin
    FText := Format('%s'#13#10'  %s;'#13#10#13#10, [SUses, UnitName]);
    try
      Result := IndexOf(UnitName);
    except
      FText := '';
      raise;
    end;
  end
  else
  begin
    P := PChar(FText);
    if not CheckKeyword(P, SUses) then
      raise EUsesListError.Create(SInvalidUses);

    while P^ <> #0 do
    begin
      SkipCommentsAndBlanks(P);
      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);

      SkipCommentsAndBlanks(P);

      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);