ujavaparser.pas

ESS-Model is a powerful, reverse engine, UML-tool for Delphi/Kylix and Java-files.

{
  ESS-Model
  Copyright (C) 2002  Eldean AB, Peter S鰀erman, Ville Krumlinde

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
}

unit uJavaParser;

interface

uses Classes, uCodeParser, uParseTree, uModel, uModelEntity, uIntegrator, uCodeProvider;

type
  TJavaImporter = class(TImportIntegrator)
  private
    procedure NeedPackageHandler(const AName: string; var AStream: TStream; OnlyLookUp: Boolean = False);
  public
    procedure ImportOneFile(const FileName : string); override;
    class function GetFileExtensions : TStringList; override;
  end;


  TJavaParser = class(TCodeParser)
  private
    FStream: TMemoryStream;
    FCurrPos: PChar;
    Token: string;
    FOM: TObjectModel;
    FUnit: TUnitPackage;
    Comment: string; // Accumulated comment string used for documentation of entities.
    ModAbstract : boolean;
    ModVisibility: TVisibility;
    ClassImports,FullImports : TStringList;
    NameCache : TStringList;

    function SkipToken(const what: string): Boolean;
    function SkipPair(const open, close: string): Boolean;
    function GetChar: char;

    procedure EatWhiteSpace;
    function GetNextToken: string;

    procedure ParseCompilationUnit;
    procedure ParseTypeDeclaration;
    procedure ParseModifiersOpt;
    procedure ParseClassDeclaration(IsInner : boolean = False; const ParentName : string = '');
    procedure ParseInterfaceDeclaration;

    procedure DoOperation(O: TOperation; const ParentName, TypeName: string);
    procedure DoAttribute(A: TAttribute; const TypeName: string);
    function GetTypeName : string;

    procedure SetVisibility(M: TModelEntity);
    function NeedClassifier(const CName: string; Force : boolean = True; TheClass: TModelEntityClass = nil): TClassifier;
    function NeedSource(const SourceName : string) : boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ParseStream(AStream: TStream; AModel: TAbstractPackage; AOM: TObjectModel); overload; override;
  end;

implementation

{$ifdef WIN32}
uses Windows, Dialogs, SysUtils, uError;
{$endif}
{$ifdef LINUX}
uses QDialogs, SysUtils, uError;
{$endif}


function ExtractPackageName(const CName: string): string;
var
  I : integer;
begin
  I := LastDelimiter('.',CName);
  if I=0 then
    Result := ''
  else
    Result := Copy(CName,1,I-1);
end;

function ExtractClassName(const CName: string): string;
var
  I : integer;
begin
  I := LastDelimiter('.',CName);
  if I=0 then
    Result := CName
  else
    Result := Copy(CName,I+1,255);
end;




{ TJavaImporter }


procedure TJavaImporter.ImportOneFile(const FileName : string);
var
  Str : TStream;
  Parser: TCodeParser;
begin
  Str := CodeProvider.LoadStream(FileName);
  if Assigned(Str) then
  begin
    Parser := TJavaParser.Create;
    try
      Parser.NeedPackage := NeedPackageHandler;
      Parser.ParseStream(Str, Model.ModelRoot, Model);
    finally
      Parser.Free;
    end;
  end;
end;

procedure TJavaImporter.NeedPackageHandler(const AName: string; var AStream: TStream; OnlyLookUp: Boolean = False);
var
  FileName: string;
begin
  AStream := nil;
  FileName := AName + '.java';
  FileName := CodeProvider.LocateFile(FileName);
  //Dont read same file twice
  if (not OnlyLookUp) and (FileName<>'') and (FilesRead.IndexOf(FileName)=-1) then
  begin
    AStream := CodeProvider.LoadStream(FileName);
    FilesRead.Add(FileName);
  end;
end;




class function TJavaImporter.GetFileExtensions: TStringList;
begin
  Result := TStringList.Create;
  Result.Values['.java'] := 'Java';
end;

{ TJavaParser }

constructor TJavaParser.Create;
begin
  inherited;
  ClassImports := TStringList.Create;
  FullImports := TStringList.Create;
  NameCache := TStringList.Create;
  NameCache.Sorted := True;
  NameCache.Duplicates := dupIgnore;
end;

destructor TJavaParser.Destroy;
begin
  inherited;
  if Assigned(FStream) then FreeAndNil(FStream);
  ClassImports.Free;
  FullImports.Free;
  NameCache.Free;
end;

function TJavaParser.SkipToken(const what: string): Boolean;
begin
  Result := False;
  GetNextToken;
  if Token = what then
  begin
    GetNextToken;
    Result := True;
  end;
end;

function TJavaParser.SkipPair(const open, close: string): Boolean;

  procedure InternalSkipPair(const open, close: string);
  begin
    while (Token <> close) and (Token<>'') do
    begin
      GetNextToken;
      while Token = open do
        InternalSkipPair(open, close);
    end;
    GetNextToken;
  end;

begin
  Result := False;
  InternalSkipPair(open, close);
  if Token <> '' then Result := True;
end;


procedure TJavaParser.EatWhiteSpace;
var
  inComment, continueLastComment, State: Boolean;

  procedure EatOne;
  begin
    if inComment then
      Comment := Comment + GetChar
    else
      GetChar;
  end;

  function EatWhite: Boolean;
  begin
    Result := False;
    while not (FCurrPos^ in [#0, #33..#255]) do
    begin
      Result := True;
      EatOne;
    end;
  end;

  function EatStarComment: Boolean;
  begin
    Result := True;
    while (not ((FCurrPos^ = '*') and ((FCurrPos + 1)^ = '/'))) or (FCurrPos^=#0) do
    begin
      Result := True;
      EatOne;
    end;
    continueLastComment := False;
    inComment := False;
    EatOne; EatOne;
  end;

  function EatSlashComment: Boolean;
  begin
    Result := True;
    while (FCurrPos^ <> #13) and (FCurrPos^ <> #10) and (FCurrPos^ <> #0) do
    begin
      Result := True;
      EatOne;
    end;
    continueLastComment := True;
    inComment := False;
    while FCurrPos^ in [#13,#10] do
      EatOne;
  end;

begin
  inComment := False;
  continueLastComment := False;
  State := True;
  while State do
  begin
    State := False;
    if (FCurrPos^ = #10) or ((FCurrPos^ = #13) and ((FCurrPos + 1)^ = #10)) then continueLastComment := False;
    if not (FCurrPos^ in [#0,#33..#255]) then State := EatWhite;
    if (FCurrPos^ = '/') and ((FCurrPos + 1)^ = '*') then
    begin
      Comment := '';
      EatOne; EatOne; // Skip slash star
      inComment := True;
      State := EatStarComment;
      inComment := False;
    end;
    if (FCurrPos^ = '/') and ((FCurrPos + 1)^ = '/') then
    begin
      if not continueLastComment then
        Comment := ''
      else
        Comment := Comment + #13#10;
      EatOne; EatOne; // Skip the double slashes
      inComment := True;
      State := EatSlashComment;
      inComment := False;
    end;
  end;
end;


function TJavaParser.GetNextToken: string;

  procedure AddOne;
  begin
    Token := Token + GetChar;
  end;

begin
//Hantera qualified id som en token
//'.' 鋜 en del av ett namn
//om f鰎sta tecken efter namn 鋜 [ s