1157 lines
37 KiB
ObjectPascal
1157 lines
37 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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 11089 2006-12-16 22:32:51Z ahuser $
|
|
|
|
unit VclClxCvt;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
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;
|
|
begin
|
|
Result := FIgnoreUnits.Find(AName, Index);
|
|
if not Result then
|
|
begin
|
|
for i := FIncludeFiles.Count - 1 downto 0 do
|
|
begin
|
|
Result := FIgnoreUnits.Find(FIncludeFiles[i] + '::' + AName, Index);
|
|
if Result then
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TVCLConverter.IsUsesUnit(const AName: string): Boolean;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Result := FUsesUnits.Find(AName, Index);
|
|
if Result then
|
|
Result := FLockedUsesUnits.IndexOf(AName) < 0;
|
|
end;
|
|
|
|
procedure TVCLConverter.ReplaceUnitName(Token: PTokenInfo);
|
|
var
|
|
UnitName: string;
|
|
begin
|
|
UnitName := Token.Value;
|
|
TranslateUnit(UnitName);
|
|
if UnitName <> Token.Value then
|
|
begin
|
|
FStatistics.IncUnitReplacements;
|
|
Token.Parser.ReplaceParseNext(Token, Token, UnitName);
|
|
end;
|
|
end;
|
|
|
|
function TVCLConverter.CheckFullQualifiedUnitIdentifier(Token: PTokenInfo;
|
|
var Context: TParseContext): Boolean;
|
|
var
|
|
ParserIndex: Integer;
|
|
Parser: TPascalParser;
|
|
Tk: TTokenInfo;
|
|
begin
|
|
Result := False;
|
|
with Context do
|
|
begin
|
|
if (((Context.LastToken.Kind = tkSymbol) and (Context.LastToken.Value <> '.')) or
|
|
(Context.LastToken.Kind <> tkSymbol)) and
|
|
not IsProtectedByConditions and IsUsesUnit(Token.Value) then
|
|
begin
|
|
// "UnitName.xxx" but not ".Unitname.xxx"
|
|
Tk := Token^;
|
|
Parser := Token.Parser;
|
|
ParserIndex := Parser.Index;
|
|
if GetNextToken(Parser, Token, Context) and (Token.Kind = tkSymbol) and (Token.Value = '.') then
|
|
begin
|
|
if not IsUnitIgnored(Tk.Value) then
|
|
ReplaceUnitName(@Tk);
|
|
Result := True;
|
|
end
|
|
else
|
|
Parser.Index := ParserIndex;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TVCLConverter.CaseParseContext(Token: PTokenInfo; var Context: TParseContext): Boolean;
|
|
var
|
|
S: string;
|
|
begin
|
|
Result := False;
|
|
with Context do
|
|
begin
|
|
case Token.Kind of
|
|
tkIdent:
|
|
begin
|
|
S := Token.Value;
|
|
if InImplementation and
|
|
(SameText(S, 'procedure') or
|
|
SameText(S, 'function') or
|
|
SameText(S, 'constructor') or
|
|
SameText(S, 'destructor')) then
|
|
begin
|
|
CheckFunction(Token, Context);
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := CheckFullQualifiedUnitIdentifier(Token, Context);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.Parse(Parser: TPascalParser);
|
|
var
|
|
Token: PTokenInfo;
|
|
Context: TParseContext;
|
|
S: string;
|
|
begin
|
|
FConditionStack := nil;
|
|
FDefines := nil;
|
|
try
|
|
FConditionStack := TConditionStack.Create;
|
|
FDefines := TStringList.Create;
|
|
FDefines.Sorted := True;
|
|
FDefines.Duplicates := dupIgnore;
|
|
|
|
with Context do
|
|
begin
|
|
FillChar(Context, SizeOf(Context), 0);
|
|
InImplementation := False;
|
|
InInterfaceSection := False;
|
|
while GetNextToken(Parser, Token, Context) do
|
|
begin
|
|
case Token.Kind of
|
|
tkIdent:
|
|
begin
|
|
if not CaseParseContext(Token, Context) then
|
|
begin
|
|
S := Token.Value;
|
|
if SameText(S, 'uses') then
|
|
CheckUses(Token, Context)
|
|
else
|
|
if (not InInterfaceSection) and (not InImplementation) and
|
|
SameText(S, 'interface') then
|
|
InInterfaceSection := True
|
|
else
|
|
if (not InImplementation) and
|
|
(SameText(S, 'unit') or
|
|
SameText(S, 'program') or
|
|
SameText(S, 'package') or
|
|
SameText(S, 'library')) then
|
|
begin
|
|
CheckFileHead(Token, Context);
|
|
end
|
|
else
|
|
if SameText(S, 'implementation') then
|
|
begin
|
|
InImplementation := True;
|
|
InInterfaceSection := False;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
CaseParseContext(Token, Context);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(FConditionStack);
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckOption(Token: PTokenInfo);
|
|
// handles the compiler directives
|
|
var
|
|
Condition, S: string;
|
|
IncFilename, OrgIncFilename: string;
|
|
ResourceName, OrgResource: string;
|
|
Index: Integer;
|
|
begin
|
|
S := RemoveCommentChars(Token.Value);
|
|
if AnsiStartsText('$I ', S) or AnsiStartsText('$INCLUDE ', S) then
|
|
begin
|
|
if AnsiStartsText('$I ', S) then
|
|
IncFilename := TrimCopy(S, 4, MaxInt)
|
|
else
|
|
IncFilename := TrimCopy(S, 9, MaxInt);
|
|
FIncludeFiles.Add(IncFilename);
|
|
OrgIncFilename := IncFilename;
|
|
TranslateInc(IncFilename);
|
|
if IncFilename <> OrgIncFilename then
|
|
begin
|
|
S := StringReplace(Token.Value, OrgIncFilename, IncFilename, []);
|
|
Token.Parser.ReplaceParseNext(Token, Token, S);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if AnsiStartsText('$DEFINE ', S) then
|
|
FDefines.Add(TrimCopy(S, 9, MaxInt))
|
|
else
|
|
if AnsiStartsText('$UNDEF ', S) then
|
|
begin
|
|
if FDefines.Find(TrimCopy(S, 8, MaxInt), Index) then
|
|
FDefines.Delete(Index);
|
|
end
|
|
else
|
|
if AnsiStartsText('$IFDEF ', S) then
|
|
begin
|
|
Condition := TrimCopy(S, 8, MaxInt);
|
|
FConditionStack.Enter(Condition, Token.StartIndex, Token.EndIndex, Token.StartLine);
|
|
end
|
|
else
|
|
if AnsiStartsText('$IFNDEF ', S) then
|
|
begin
|
|
Condition := TrimCopy(S, 9, MaxInt);
|
|
FConditionStack.EnterNot(Condition, Token.StartIndex, Token.EndIndex, Token.StartLine);
|
|
end
|
|
else
|
|
if AnsiStartsText('$ELSE', S) then // $ELSEIF ???
|
|
begin
|
|
FConditionStack.GoElse(Token.StartIndex, Token.EndIndex, Token.StartLine);
|
|
end
|
|
else
|
|
if AnsiStartsText('$ENDIF', S) then
|
|
begin
|
|
CheckCondition(Token.Parser, Token); // accesses FConditionStack.Current
|
|
FConditionStack.Leave;
|
|
end
|
|
else
|
|
if AnsiStartsText('$R ', S) or AnsiStartsText('$RESOURCE ', S) then
|
|
begin
|
|
if ((FConditionStack.IsIn('LINUX') = 0) and
|
|
(FConditionStack.IsIn('MSWINDOWS') = 0))
|
|
or
|
|
(SameText(S, '$R *.DFM')) then
|
|
begin
|
|
if SameText(S, '$R *.DFM') then
|
|
begin
|
|
if IsProtectedByConditions then
|
|
Exit; // forced by condition block
|
|
end;
|
|
|
|
if AnsiStartsText('$R ', S) then
|
|
ResourceName := TrimCopy(S, 4, MaxInt)
|
|
else
|
|
ResourceName := TrimCopy(S, 11, MaxInt);
|
|
OrgResource := ResourceName;
|
|
TranslateResource(ResourceName);
|
|
if ResourceName <> OrgResource then
|
|
begin
|
|
S := StringReplace(Token.Value, OrgResource, ResourceName, []);
|
|
Token.Parser.ReplaceParseNext(Token, Token, S);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckCondition(Parser: TPascalParser; EndifToken: PTokenInfo);
|
|
var
|
|
Cond: TConditionStackItem;
|
|
|
|
function LineClean(Index: Integer): Integer; // after LineClean the tokens are invalidt
|
|
var
|
|
StartIndex: Integer;
|
|
begin
|
|
Result := 0;
|
|
StartIndex := Index;
|
|
while Index > 0 do
|
|
begin
|
|
case Parser.Text[Index] of
|
|
#0..#9: ;
|
|
#10: // we read backward
|
|
begin
|
|
if Parser.Text[Index - 1] = #13 then
|
|
Dec(Index);
|
|
Break;
|
|
end;
|
|
#11, #12: ;
|
|
#13:
|
|
Break;
|
|
#14..#32: ;
|
|
else
|
|
Exit;
|
|
end;
|
|
Dec(Index);
|
|
end;
|
|
Result := StartIndex - Index;
|
|
Parser.Delete(Index, Result);
|
|
Parser.Index := Index;
|
|
end;
|
|
|
|
procedure Remove(RemoveContent: Boolean);
|
|
var
|
|
S: string;
|
|
ParserIndex: Integer;
|
|
begin
|
|
ParserIndex := Parser.Index;
|
|
if not Cond.HasElse then
|
|
begin
|
|
if not RemoveContent then
|
|
begin
|
|
// remove $ENDIF before $IFDEF
|
|
Dec(ParserIndex, EndifToken.EndIndex - EndifToken.StartIndex + 1);
|
|
Parser.Replace(EndifToken, EndifToken, '');
|
|
if not KeepLines then
|
|
Dec(ParserIndex, LineClean(EndifToken.StartIndex - 1));
|
|
Dec(ParserIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1);
|
|
Parser.ReplaceParseNext(Cond.OpenStartIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1, '');
|
|
end
|
|
else
|
|
begin
|
|
if KeepLines then
|
|
S := RepeatStr(GetLineBreak, EndifToken.EndLine - Cond.OpenLine)
|
|
else
|
|
S := '';
|
|
Dec(ParserIndex, EndifToken.EndIndex - Cond.OpenStartIndex + 1);
|
|
Parser.ReplaceParseNext(Cond.OpenStartIndex, EndifToken.EndIndex - Cond.OpenStartIndex + 1, S);
|
|
Inc(ParserIndex, Length(S));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if not RemoveContent then
|
|
begin
|
|
// remove $ENDIF before $IFDEF
|
|
if KeepLines then
|
|
S := RepeatStr(GetLineBreak, EndifToken.EndLine - Cond.ElseLine)
|
|
else
|
|
S := '';
|
|
Dec(ParserIndex, EndifToken.EndIndex - Cond.ElseStartIndex + 1);
|
|
Parser.ReplaceParseNext(Cond.ElseStartIndex, EndifToken.EndIndex - Cond.ElseStartIndex + 1, S);
|
|
Inc(ParserIndex, Length(S));
|
|
if not KeepLines then
|
|
Dec(ParserIndex, LineClean(Cond.ElseStartIndex - 1));
|
|
|
|
Dec(ParserIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1);
|
|
Parser.ReplaceParseNext(Cond.OpenStartIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1, '');
|
|
end
|
|
else
|
|
begin
|
|
// remove $ENDIF before $IFDEF
|
|
if KeepLines then
|
|
S := RepeatStr(GetLineBreak, Cond.ElseLine - Cond.OpenLine)
|
|
else
|
|
S := '';
|
|
Dec(ParserIndex, EndifToken.EndIndex - EndifToken.StartIndex + 1);
|
|
Parser.Replace(EndifToken, EndifToken, '');
|
|
if not KeepLines then
|
|
Dec(ParserIndex, LineClean(EndifToken.StartIndex - 1));
|
|
|
|
Dec(ParserIndex, Cond.ElseEndIndex - Cond.OpenStartIndex + 1);
|
|
Parser.ReplaceParseNext(Cond.OpenStartIndex, Cond.ElseEndIndex - Cond.OpenStartIndex + 1, S);
|
|
Inc(ParserIndex, Length(S));
|
|
end;
|
|
end;
|
|
|
|
if not KeepLines then
|
|
Dec(ParserIndex, LineClean(Parser.Index - 1));
|
|
|
|
// restore next token start index
|
|
Parser.Index := ParserIndex;
|
|
end;
|
|
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
if not ReduceConditions then
|
|
Exit; // do nothing here
|
|
|
|
Cond := FConditionStack.Current;
|
|
if Cond = nil then
|
|
begin
|
|
FStatistics.AddError('No IFDEF/IFNDEF open.');
|
|
Exit;
|
|
end;
|
|
|
|
if FRemoveConditions.Find(Cond.Condition, Index) then // "Condition"
|
|
Remove(not Cond.Negative)
|
|
else
|
|
if FRemoveConditions.Find('!' + Cond.Condition, Index) then // "!Condition"
|
|
Remove(Cond.Negative);
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckUses(Token: PTokenInfo; var Context: TParseContext);
|
|
var
|
|
Parser: TPascalParser;
|
|
StartConditionStackCount: Integer;
|
|
// InsertTypesUnitStartIndex: Integer;
|
|
i: Integer;
|
|
Changed: Boolean;
|
|
begin
|
|
// InsertTypesUnitStartIndex := -1;
|
|
StartConditionStackCount := FConditionStack.OpenCount;
|
|
Parser := Token.Parser;
|
|
while GetNextToken(Parser, Token, Context) do
|
|
begin
|
|
case Token.Kind of
|
|
tkSymbol:
|
|
if (Token.Value = ';') and (StartConditionStackCount <= FConditionStack.OpenCount) then
|
|
Break; // finished
|
|
tkIdent:
|
|
begin
|
|
if SameText(Token.Value, 'in') and UnixPathDelim then // uses unitname in 'filename.pas';
|
|
begin
|
|
if GetNextToken(Parser, Token, Context) then
|
|
begin
|
|
{ Replace '\' by '/' in the filename }
|
|
if Token.Kind = tkString then
|
|
begin
|
|
Changed := False;
|
|
for i := 1 to Length(Token.Value) do
|
|
if Token.Value[i] = '\' then
|
|
begin
|
|
Token.Value[i] := '/';
|
|
Changed := True;
|
|
end;
|
|
if Changed then
|
|
Parser.ReplaceParseNext(Token, Token, Token.Value);
|
|
end;
|
|
end;
|
|
Continue;
|
|
end;
|
|
if SameText(Token.Value, 'type') or SameText(Token.Value, 'const') or
|
|
SameText(Token.Value, 'resourcestring') or SameText(Token.Value, 'var') or
|
|
SameText(Token.Value, 'function') or SameText(Token.Value, 'procedure') or
|
|
SameText(Token.Value, 'implementation') or SameText(Token.Value, 'begin') then
|
|
begin
|
|
FStatistics.AddError('Wrong condition blocks in ' + Token.Parser.Filename);
|
|
Parser.Index := Token.StartIndex; // reparse this token
|
|
Break; // there is something wrong with the Condition-Blocks.
|
|
end;
|
|
|
|
FUsesUnits.Add(Token.Value);
|
|
if not IsProtectedByConditions then
|
|
begin
|
|
// replace unit names, because we are outside a VCL/VisualCLX condition
|
|
if not IsUnitIgnored(Token.Value) then
|
|
begin
|
|
{ asn: not required anymore.
|
|
if SameText(Token.Value, 'Windows') then
|
|
InsertTypesUnitStartIndex := Token.StartIndex;
|
|
if (InsertTypesUnitStartIndex = -1) and SameText(Token.Value, 'Graphics') then
|
|
InsertTypesUnitStartIndex := Token.StartIndex;
|
|
}
|
|
ReplaceUnitName(Token);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{
|
|
if (InsertTypesUnitStartIndex > 0) and Context.InInterfaceSection and
|
|
(FUsesUnits.IndexOf('Types') = -1) then
|
|
begin
|
|
Parser.Insert(InsertTypesUnitStartIndex, 'Types, ');
|
|
Parser.IndexNoClear := Parser.Index + 7;
|
|
end;
|
|
}
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckFileHead(Token: PTokenInfo; var Context: TParseContext);
|
|
var
|
|
Parser: TPascalParser;
|
|
NewFilename, Filename, Ext: string;
|
|
begin
|
|
if SameText(Token.Value, 'unit') then
|
|
Ext := '.pas'
|
|
else if SameText(Token.Value, 'package') then
|
|
Ext := '.dpk'
|
|
else
|
|
Ext := '.dpr';
|
|
|
|
Filename := '';
|
|
Parser := Token.Parser;
|
|
while GetNextToken(Parser, Token, Context) do
|
|
begin
|
|
if Token.Kind = tkIdent then
|
|
begin
|
|
// unit/program/library/package name
|
|
if Filename = '' then // only the first identifier is the unit name, others are syntax errors
|
|
begin
|
|
FUsesUnits.Add(Token.Value);
|
|
Filename := Token.Value + Ext;
|
|
NewFilename := ChangeFileName(Filename);
|
|
if NewFilename <> Filename then
|
|
begin
|
|
Filename := ChangeFileExt(ExtractFileName(NewFilename), '');
|
|
Parser.ReplaceParseNext(Token, Token, Filename);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if (Token.Kind = tkSymbol) and (Token.Value = ';') then
|
|
Break; // finished
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckFunction(Token: PTokenInfo; var Context: TParseContext);
|
|
var
|
|
Parser: TPascalParser;
|
|
LockedUnitStartCount: Integer;
|
|
BeginBlockCount: Integer;
|
|
InParams: Boolean;
|
|
LastTokenValue: string;
|
|
begin
|
|
Parser := Token.Parser;
|
|
LockedUnitStartCount := FLockedUsesUnits.Count;
|
|
try
|
|
// procedure/function header
|
|
InParams := False;
|
|
while GetNextToken(Parser, Token, Context) do
|
|
begin
|
|
if not InParams then
|
|
begin
|
|
if Token.Kind = tkSymbol then
|
|
begin
|
|
if Token.Value = ';' then
|
|
InParams := True; // no parameters
|
|
if Token.Value = '(' then
|
|
InParams := True;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case Token.Kind of
|
|
tkIdent:
|
|
begin
|
|
if (LastTokenValue <> ':') and IsUsesUnit(Token.Value) then
|
|
FLockedUsesUnits.Add(Token.Value) // this unit name is redeclared as parameter
|
|
else
|
|
begin
|
|
CaseParseContext(Token, Context);
|
|
if SameText(Token.Value, 'external') or
|
|
SameText(Token.Value, 'forward') then
|
|
Exit; // this is only a procedure head
|
|
if SameText(Token.Value, 'begin') or
|
|
SameText(Token.Value, 'var') or
|
|
SameText(Token.Value, 'const') or
|
|
SameText(Token.Value, 'type') or
|
|
SameText(Token.Value, 'resourcestring') then
|
|
Break;
|
|
if SameText(Token.Value, 'end') then
|
|
begin
|
|
FStatistics.AddError('"end" found but "begin", "var", "const", "type" or "resourcestring" expected.');
|
|
Exit; // something very strange happend
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
CaseParseContext(Token, Context);
|
|
end;
|
|
end;
|
|
LastTokenValue := Token.Value;
|
|
end;
|
|
|
|
if Token = nil then
|
|
Exit;
|
|
|
|
if not SameText(Token.Value, 'begin') then
|
|
CheckFunctionVarDecls(Token, Context);
|
|
|
|
BeginBlockCount := 1;
|
|
while GetNextToken(Parser, Token, Context) do
|
|
begin
|
|
if Token.Kind = tkIdent then
|
|
begin
|
|
if SameText(Token.Value, 'begin') then
|
|
Inc(BeginBlockCount)
|
|
else
|
|
if SameText(Token.Value, 'end') then
|
|
begin
|
|
Dec(BeginBlockCount);
|
|
if BeginBlockCount = 0 then
|
|
Break; // function end
|
|
end;
|
|
end;
|
|
CaseParseContext(Token, Context);
|
|
end;
|
|
finally
|
|
// we leave the function so remove the locked local "unit name" variables
|
|
while FLockedUsesUnits.Count > LockedUnitStartCount do
|
|
FLockedUsesUnits.Delete(FLockedUsesUnits.Count - 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckFunctionVarDecls(Token: PTokenInfo;
|
|
var Context: TParseContext);
|
|
var
|
|
Parser: TPascalParser;
|
|
LastTokenValue: string;
|
|
begin
|
|
Parser := Token.Parser;
|
|
while GetNextToken(Parser, Token, Context) do
|
|
begin
|
|
case Token.Kind of
|
|
tkIdent:
|
|
begin
|
|
if (LastTokenValue <> ':') and IsUsesUnit(Token.Value) then
|
|
FLockedUsesUnits.Add(Token.Value) // this unit name is redeclared as variable/const/resstring
|
|
else
|
|
begin
|
|
if not CaseParseContext(Token, Context) then // meight find records, ...
|
|
begin
|
|
if SameText(Token.Value, 'begin') then
|
|
Break;
|
|
if SameText(Token.Value, 'end') then
|
|
begin
|
|
FStatistics.AddError('"end" found but "begin", "var", "const", "type" or "resourcestring" expected.');
|
|
Exit; // something very strange happend
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
CaseParseContext(Token, Context);
|
|
end;
|
|
LastTokenValue := Token.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.BeforeSave(const Filename: string; Lines: TStrings);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
{
|
|
Calls CheckDfmLine with parameter Control=
|
|
* ClassName e.g. 'TListView'
|
|
* ClassName.Property for Collections e.g: 'TListView.Columns'
|
|
* ClassName.Property:item for Collection items: e.g. 'TListView.Columns:item'
|
|
}
|
|
procedure TVCLConverter.ParseDfmFile(const Filename: string);
|
|
var
|
|
Lines: TStrings;
|
|
i, ps: Integer;
|
|
S, TrimS: string;
|
|
Controls: TStringList;
|
|
begin
|
|
Controls := TStringList.Create;
|
|
Lines := TStringList.Create;
|
|
try
|
|
Lines.LoadFromFile(Filename);
|
|
if Lines.Count > 0 then
|
|
begin
|
|
if (Lines[0] <> '') and (Lines[0][1] < #32) or (Lines[0][2] < #32) then
|
|
begin
|
|
FStatistics.AddError(ExtractFileName(Filename) + ' is binary. Converting to text.');
|
|
ConvertBinDfmToText(Filename);
|
|
Lines.LoadFromFile(Filename);
|
|
end;
|
|
|
|
i := 0;
|
|
while i < Lines.Count do
|
|
begin
|
|
S := Lines[i];
|
|
TrimS := Trim(S);
|
|
if TrimS <> '' then
|
|
begin
|
|
if TrimS = 'DesignSize = (' then
|
|
begin
|
|
Lines.Delete(i);
|
|
Lines.Delete(i);
|
|
Lines.Delete(i);
|
|
Continue;
|
|
end
|
|
else
|
|
begin
|
|
if AnsiStartsText('object ', TrimS) then
|
|
begin
|
|
ps := Pos(':', TrimS);
|
|
if ps > 0 then
|
|
Controls.Add(Trim(Copy(TrimS, ps + 1, MaxInt)));
|
|
end
|
|
else
|
|
if SameText(TrimS, 'end') and (Controls.Count > 0) then
|
|
Controls.Delete(Controls.Count - 1)
|
|
else
|
|
if Controls.Count > 0 then
|
|
begin
|
|
if AnsiEndsText('= <', TrimS) then
|
|
begin
|
|
// collection
|
|
Controls.Add(Controls[Controls.Count - 1] + '.' + Trim(Copy(TrimS, 1, Pos('=', TrimS) - 1)));
|
|
end
|
|
else
|
|
if SameText(TrimS, 'end>') then
|
|
begin
|
|
Controls.Delete(Controls.Count - 1);
|
|
Controls.Delete(Controls.Count - 1);
|
|
end
|
|
else if SameText(TrimS, 'item') then
|
|
Controls.Add(Controls[Controls.Count - 1] + ':item')
|
|
else
|
|
CheckDfmLine(S, Controls[Controls.Count - 1], Controls);
|
|
Lines[i] := S;
|
|
end;
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
|
|
WriteFile(Lines,
|
|
FOutDirectory + PathDelim + ChangeFileName(ExtractFileName(Filename)),
|
|
False);
|
|
end
|
|
else
|
|
FStatistics.AddError(ExtractFileName(Filename) + ' is empty.');
|
|
finally
|
|
Lines.Free;
|
|
Controls.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.CheckDfmLine(var Line: string; const Control: string; Controls: TStrings);
|
|
var
|
|
S, OrgS: string;
|
|
begin
|
|
Line := TrimRight(Line);
|
|
if Line <> '' then
|
|
begin
|
|
S := TrimLeft(Line);
|
|
OrgS := S;
|
|
ChangeDfmLine(S, Control, Controls);
|
|
if S <> OrgS then
|
|
Line := StringReplace(Line, OrgS, S, []);
|
|
end;
|
|
end;
|
|
|
|
procedure TVCLConverter.ChangeDfmLine(var Line: string; const Control: string; Controls: TStrings);
|
|
begin
|
|
if (Controls.Count = 1) and AnsiStartsText('BorderStyle = ', Line) then
|
|
Line := StringReplace(Line, ' bs', ' fbs', [rfIgnoreCase]);
|
|
if AnsiStartsText('Ctl3D = ', Line) or
|
|
AnsiStartsText('ParentCtl3D = ', Line) then
|
|
Line := '';
|
|
if AnsiStartsText('IsControl = True', Line) or
|
|
AnsiStartsText('PageSize = 0', Line) or
|
|
AnsiStartsText('DefaultMonitor = ', Line) or
|
|
AnsiStartsText('RightClickSelect = True', Line) then
|
|
Line := '';
|
|
if (Control = 'TProgressBar') and AnsiStartsText('TabOrder = ', Line) then
|
|
Line := '';
|
|
if (Control = 'TComboBox') and (AnsiStartsText('AutoDropDown = ', Line) or
|
|
AnsiStartsText('AutoCloseUp = ', Line)) then
|
|
Line := '';
|
|
if (Control = 'TListView') then
|
|
begin
|
|
if AnsiStartsText('SmallImages = ', Line) then
|
|
Line := StringReplace(Line, 'SmallImages = ', 'Images = ', [rfIgnoreCase])
|
|
else if AnsiStartsText('OnCompare = ', Line) then
|
|
Line := ''
|
|
else if AnsiStartsText('SortType = ', Line) then
|
|
begin
|
|
if Pos('= stNone', Line) = 0 then
|
|
Line := 'Sorted = True'
|
|
else
|
|
Line := ''
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TVCLConverter.IsProtectedByConditions: Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
for i := 0 to ConvertProtected.Count - 1 do
|
|
if FConditionStack.IsIn(ConvertProtected[i]) <> 0 then
|
|
Exit;
|
|
Result := False;
|
|
end;
|
|
|
|
function TVCLConverter.GetNextToken(Parser: TPascalParser;
|
|
var Token: PTokenInfo; var Context: TParseContext): Boolean;
|
|
begin
|
|
Context.LastToken := Context.CurToken;
|
|
while Parser.GetToken(Token) and (Token.Kind = tkComment) do
|
|
begin
|
|
if Token.ExKind = tekOption then
|
|
CheckOption(Token);
|
|
end;
|
|
Result := Token <> nil;
|
|
if Result then
|
|
Context.CurToken := Token^;
|
|
end;
|
|
|
|
end.
|
|
|