vclclxcvt.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: VclClxCvt.pas, released on 2004-05-19.

The Initial Developer of the Original Code is Andreas Hausladen
(Andreas dott Hausladen att gmx dott de)
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s): -

You may retrieve the latest version of this file at the Project JEDI's JVCL
home page, located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: VclClxCvt.pas,v 1.13 2005/02/14 22:02:45 ahuser Exp $

{$I jvcl.inc}

unit VclClxCvt;

interface

uses
  SysUtils, Classes, Contnrs, dpp_PascalParser, VclClxCvtUtils;

type
  TParseContext = record
    InImplementation, InInterfaceSection: Boolean;
    LastToken, CurToken: TTokenInfo;
  end;

  { TVCLConverter
    This class converts one file from VCL to CLX.

    If a unit name is found outside a VCL/VisualCLX block the unitname is
    translated by a TranslateUnit() call if it is not in the IgnoreUnits list.
    The TranslateUnit() method's default behaviour is to rename the unit by the
    UnitReplaceList[].

    The class searches for full qualified identifier (Unitname.unitmember), too.

    After the file is parsed it is stored with a filename returned by
    ChangeFileName() to the OutDirectory.
  }
  TVCLConverter = class(TObject)
  private
    FStatistics: TConverterStatistics;

    FIniDirectory: string;
    FKeepLines: Boolean;
    FReduceConditions: Boolean;
    FOutDirectory: string;
    FUnixLineBreak: Boolean;
    FForceOverwrite: Boolean;

    FIncludeFiles: TStringList;
    FUsesUnits: TStringList;
      { contains the units in the "uses" clause (sorted). This is used to find
        contructs like "type TMyType = MyUnit.TMyType;" or "JvJVCLUtils.func" }
    FLockedUsesUnits: TStringList; // if a UsesUnit's name is reused for a function, const, variable, ... (unsorted)
    FConditionStack: TConditionStack; // only valid while in Parse()
    FDefines: TStringList; // only valid while in Parse() (sorted)

    FUnitReplaceList: TUnitReplaceList;
    FIgnoreUnits: TStringList;
    FRemoveConditions: TStringList;
    FConvertProtected: TStringList; // list of Conditions where no unit names should be translated

    FFilename: string;
    FUnixPathDelim: Boolean; // currently parsed file

    procedure SetOutDirectory(const Value: string);
    procedure WriteFile(Lines: TStrings; const Filename: string; AllowBeforeSave: Boolean);

    procedure CheckDfmLine(var Line: string; const Control: string; Controls: TStrings);

    procedure CheckOption(Token: PTokenInfo);
      { Parses the compiler directives and allows the replacement of include
        file names. }
    procedure CheckCondition(Parser: TPascalParser; EndifToken: PTokenInfo);
      { Removes if necessary the condition blocks. }
    procedure CheckUses(Token: PTokenInfo; var Context: TParseContext);
      { Parses the uses-clause and allows the replacement of unit names.

        asn: the following is not required anymore. Required types are added to
             QWindows.

        If it finds a "Windows" in a non-IFDEF'ed area the "Types" unit will be
        added before the replaced "Windows"
        If no "Windows" unit is found the "Types" unit will be inserted before
        the replaced "Graphics" unit.
        "Types" will not be added when it already is in the uses list.
       }
    procedure CheckFileHead(Token: PTokenInfo; var Context: TParseContext);
      { Replaces the "unit", "program", ... name and adds the unit name to the
        UsedUnits list. }
    procedure CheckFunction(Token: PTokenInfo; var Context: TParseContext);
      { Parses procedure/function. }
    procedure CheckFunctionVarDecls(Token: PTokenInfo; var Context: TParseContext);
    function CaseParseContext(Token: PTokenInfo; var Context: TParseContext): Boolean;
    function GetLineBreak: string;
    function CheckFullQualifiedUnitIdentifier(Token: PTokenInfo;
      var Context: TParseContext): Boolean;
    function GetNextToken(Parser: TPascalParser; var Token: PTokenInfo;
      var Context: TParseContext): Boolean;
  protected
    procedure InitUnitReplaceList; virtual;
      { InitUnitReplaceList is called in the constructor after all sub objects
        are created. The function can load the unit replace list, ... }
    procedure TranslateUnit(var AName: string); virtual;
      { The parser calls TranslateInc() when ever a unit name is found in the
        source code. The method can change the unit name. The returned name
        should match the ChangeFileName() returned name for the unit itself. }
    procedure TranslateInc(var AName: string); virtual;
      { The parser calls TranslateInc() when it reaches an $I, $INCLUDE compiler
        directive. The method can change the included file name. }
    procedure TranslateResource(var AName: string); virtual;
      { TranslateResource is call when a {$R is found that is not encapsulated
        by a $IFDEF MSWINDOWS/LINUX $ENDIF. The AName contains all after the
        compiler directive name. }
    function ChangeFileName(const Name: string): string; virtual;
      { ChangeFileName() is called when the parser requires a CLX filename for
        the source code file. It is called twice. The first time when the
        "unit", "program", "library" and "packages" statements are parsed and
        the second time when the file is actually stored. }
    procedure BeforeSave(const Filename: string; Lines: TStrings); virtual;
      { BeforeSave() is called before the file is stored. Here you can modify
        the file lines. Time-dependend lines are not allowed. Filename is the
        CLX filename (changed by ChangeFileName). }
    procedure ChangeDfmLine(var Line: string; const Control: string; Controls: TStrings); virtual;

    procedure Parse(Parser: TPascalParser); virtual;

    function IsUnitIgnored(const AName: string): Boolean; virtual;
    function IsUsesUnit(const AName: string): Boolean;
    procedure ReplaceUnitName(Token: PTokenInfo);
    function IsProtectedByConditions: Boolean; virtual;
  public
    constructor Create(const AIniDirectory: string);
    destructor Destroy; override;

    procedure ParseDfmFile(const Filename: string);
    procedure ParsePasFile(const Filename: string);

    property Statistics: TConverterStatistics read FStatistics;
    property IniDirectory: string read FIniDirectory;
    property OutDirectory: string read FOutDirectory write SetOutDirectory;
      { Directory where the generated file should be stored. }

    property ReduceConditions: Boolean read FReduceConditions write FReduceConditions default True;
      { Removes VCL,COMPILER5,COMPILER6,BCB5,BCB6,BCB condition content and
        VisualCLX conditions. If False If False the ($I jvcl.inc) is replaced by
        ($I qjvcl.inc) }
    property KeepLines: Boolean read FKeepLines write FKeepLines default True;
      { In combination with ReduceConditions this will keep empty lines for the removed lines. }
    property UnitReplaceList: TUnitReplaceList read FUnitReplaceList;
      { Unit -> QUnit names e.g. Controls=QControls}
    property IgnoreUnits: TStringList read FIgnoreUnits;
      { These unit names are not touched. }
    property RemoveConditions: TStringList read FRemoveConditions;
      { All condition names that are in the RemoveConditions list will be swept
        out of the source code if ReduceConditions is True.
        A leading '!' char means the "NOT"-part should be removed. }
    property ConvertProtected: TStringList read FConvertProtected;
      { A list of Conditions where the unit names shouldn't be translated. }

    property UnixLineBreak: Boolean read FUnixLineBreak write FUnixLineBreak default False;
      { If UnixLineBreak is True the written files have #10 as line break else
        it uses #13#10. }
    property UnixPathDelim: Boolean read FUnixPathDelim write FUnixPathDelim default False;
      { Set UnixPathDelim to True if you want the converter to change every '\'
        in the "uses unitname in 'filename.pas'" filename to '/'. }
    property ForceOverwrite: Boolean read FForceOverwrite write FForceOverwrite default False;
      { If ForceOverwrite is True even unchanged files will be rewritten. }

    property Filename: string read FFilename; // currently parsed file
  end;

implementation

uses
  Utils, StrUtils;


{ TVCLConverter }

constructor TVCLConverter.Create(const AIniDirectory: string);
begin
  inherited Create;
  FStatistics := TConverterStatistics.Create;
  FIniDirectory := ExcludeTrailingPathDelimiter(AIniDirectory);

  FKeepLines := True;
  FReduceConditions := True;

  FIncludeFiles := TStringList.Create;
  FIncludeFiles.Sorted := True;
  FIncludeFiles.Duplicates := dupIgnore;

  FUsesUnits := TStringList.Create;
  FUsesUnits.Sorted := True;
  FUsesUnits.Duplicates := dupIgnore;
  // Must not be case sensetive under Linux !

  FLockedUsesUnits := TStringList.Create;
  // Must not be case sensetive under Linux !

  FIgnoreUnits := TStringList.Create;
  FIgnoreUnits.Sorted := True;
  FIgnoreUnits.Duplicates := dupIgnore;
  // Must not be case sensetive under Linux !

  FRemoveConditions := TStringList.Create;
  FRemoveConditions.Sorted := True;
  FRemoveConditions.Duplicates := dupIgnore;

  FUnitReplaceList := TUnitReplaceList.Create;
  FConvertProtected := TStringList.Create;
  InitUnitReplaceList;
end;

destructor TVCLConverter.Destroy;
begin
  FIncludeFiles.Free;
  FUsesUnits.Free;
  FLockedUsesUnits.Free;
  FIgnoreUnits.Free;
  FRemoveConditions.Free;
  FUnitReplaceList.Free;
  FConvertProtected.Free;
  FStatistics.Free;
  inherited Destroy;
end;

procedure TVCLConverter.SetOutDirectory(const Value: string);
begin
  FOutDirectory := ExcludeTrailingPathDelimiter(Value);
end;

function TVCLConverter.GetLineBreak: string;
begin
  if UnixLineBreak then
    Result := #10
  else
    Result := #13#10;
end;

procedure TVCLConverter.InitUnitReplaceList;
var
  Lines: TStrings;
  i: Integer;
  Filename: string;
begin
  Filename := IniDirectory + PathDelim + 'convertvcl.ini';
  if FileExists(Filename) then
    FUnitReplaceList.AddFromIni(Filename);
    
  Lines := TStringList.Create;
  try
    Filename := IniDirectory + PathDelim + 'convertprotected.ini';
    if FileExists(Filename) then
    begin
      Lines.LoadFromFile(Filename);
      for i := 0 to Lines.Count - 1 do
        if not IsEmptyStr(Lines[i]) then
          FConvertProtected.Add(Lines[i]);
    end;

    Filename := IniDirectory + PathDelim + 'ignorevcl.ini';
    if FileExists(Filename) then
    begin
      Lines.LoadFromFile(Filename);
      for i := 0 to Lines.Count - 1 do
        if not IsEmptyStr(Lines[i]) then
          FIgnoreUnits.Add(Lines[i]);
    end;

    Filename := IniDirectory + PathDelim + 'nointextreplace.ini';
    if FileExists(Filename) then
    begin
      Lines.LoadFromFile(Filename);
      for i := 0 to Lines.Count - 1 do
        if not IsEmptyStr(Lines[i]) then
          FLockedUsesUnits.Add(Lines[i]);
    end;
  finally
    Lines.Free;
  end;
end;

procedure TVCLConverter.TranslateUnit(var AName: string);
begin
  AName := UnitReplaceList.Find(AName);
end;

procedure TVCLConverter.TranslateInc(var AName: string);
begin
  // do nothing by default
end;

procedure TVCLConverter.TranslateResource(var AName: string);
begin
  if SameText(AName, '*.DFM') then
    AName := '*.xfm';
end;

procedure TVCLConverter.ParsePasFile(const Filename: string);
var
  Parser: TPascalParser;
  Lines: TStrings;
  FFilepath: string;
begin
  FFilename := Filename;
  FUsesUnits.Clear;
  FIncludeFiles.Clear;
  Lines := TStringList.Create;
  try
    Lines.LoadFromFile(Filename);
    Parser := TPascalParser.Create(Filename, Lines.Text);
    try
      Lines.Clear; // reduce memory usage

      Parse(Parser);
      Statistics.IncParsedFiles; {statistic}

      Lines.Text := Parser.Text;
      FFilepath := FOutDirectory + PathDelim + ChangeFileName(ExtractFileName(Filename));
      WriteFile(Lines, FFilePath,True);
    finally
      Parser.Free;
    end;
  finally
    Lines.Free;
  end;
end;

procedure TVCLConverter.WriteFile(Lines: TStrings; const Filename: string; AllowBeforeSave: Boolean);
var
  i: Integer;
  sb: IStringBuilder;
  lb, S, OldFileContent: string;
begin
  if AllowBeforeSave then
    BeforeSave(Filename, Lines);
  
  lb := GetLineBreak;
  sb := StringBuilder('');
  for i := 0 to Lines.Count - 1 do
  begin
    sb.Append(Lines[i]);
    sb.Append(lb);
  end;
  sb.GetValue(S);
  sb := nil;

  if not ForceOverwrite and FileExists(Filename) then
  begin
    ReadFileToString(Filename, OldFileContent);
    if OldFileContent = S then
      Exit; // file content is the same
  end;
  Statistics.IncWrittenFiles; {statistic}
  WriteFileFromString(Filename, S);
end;

function TVCLConverter.ChangeFileName(const Name: string): string;
begin
  if SameText(ExtractFileExt(Name), '.dfm') then
    Result := 'Q' + ChangeFileExt(Name, '.xfm')
  else
    Result := 'Q' + Name;
end;

function TVCLConverter.IsUnitIgnored(const AName: string): Boolean;
var
  Index, i: Integer;