Converter: Improved syntax of replacement functions. Can test param values. Refactoring.

git-svn-id: trunk@26640 -
This commit is contained in:
juha 2010-07-14 11:10:55 +00:00
parent 9a46922fa4
commit f0c3b8b26b
4 changed files with 179 additions and 52 deletions

View File

@ -23,21 +23,6 @@ type
// For future, when .dfm form file can be used for both Delphi and Lazarus.
{ TFormFileAction = (faUseDfm, faRenameToLfm, faUseBothDfmAndLfm); }
{ TFuncCallPosition }
TCalledFuncInfo = class
private
fFuncName: string;
fReplacement: string;
fStartPos: Integer;
fEndPos: Integer;
fInclSemiColon: string;
fParams: TStringList;
public
constructor Create(aFuncName, aReplacement: string);
destructor Destroy; override;
end;
{ TConvDelphiCodeTool }
TConvDelphiCodeTool = class
@ -93,22 +78,6 @@ type
implementation
{ TCalledFuncInfo }
constructor TCalledFuncInfo.Create(aFuncName, aReplacement: string);
begin
fFuncName:=aFuncName;
fReplacement:=aReplacement;
fParams:=TStringList.Create;
end;
destructor TCalledFuncInfo.Destroy;
begin
fParams.Free;
inherited Destroy;
end;
{ TConvDelphiCodeTool }
constructor TConvDelphiCodeTool.Create(Code: TCodeBuffer);
@ -505,7 +474,7 @@ procedure SplitParam(const aStr: string; aDelimiter: Char; ResultList: TStringLi
Dec(Len);
end
else
raise EConverterError.Create('Replacement function parameter should start with "$".');
raise EDelphiConverterError.Create('Replacement function parameter should start with "$".');
ResultList.Add(Copy(aStr, Start, Len));
end;
@ -543,7 +512,7 @@ var
// Parse replacement params. They show which original params are copied where.
// Returns the first position where comments can be searched from.
var
ParamBeg, ParamEnd: Integer; // Start and end of parameters.
ParamBeg, ParamEnd: Integer; // Start and end of parameters.
s: String;
begin
Result:=1;
@ -551,9 +520,9 @@ var
if ParamBeg>0 then begin
ParamEnd:=Pos(')', aStr);
if ParamEnd=0 then
raise EConverterError.Create('")" is missing from replacement function.');
raise EDelphiConverterError.Create('")" is missing from replacement function.');
s:=Copy(aStr, ParamBeg+1, ParamEnd-ParamBeg-1);
SplitParam(s, ',', ParamList); // The actual parameter list.
SplitParam(s, ',', ParamList); // The actual parameter list.
BodyEnd:=ParamBeg-1;
Result:=ParamEnd+1;
end;
@ -570,9 +539,9 @@ var
for i:=0 to ParamList.Count-1 do begin
ParamPos:=StrToInt(ParamList[i]);
if ParamPos < 1 then
raise EConverterError.Create('Replacement function parameter number should be >= 1.');
Param:='nil'; // Default value if not found from original code.
if ParamPos <= aParams.Count then
raise EDelphiConverterError.Create('Replacement function parameter number should be >= 1.');
Param:='nil'; // Default value if not found from original code.
if ParamPos<=aParams.Count then
Param:=aParams[ParamPos-1];
if Result<>'' then
Result:=Result+', ';
@ -619,13 +588,13 @@ begin
for i:=fFuncsToReplace.Count-1 downto 0 do begin
FuncInfo:=TCalledFuncInfo(fFuncsToReplace[i]);
BodyEnd:=-1;
PossibleCommPos:=ParseReplacementParams(FuncInfo.fReplacement);
PossibleCommPos:=ParseReplacementParams(FuncInfo.fReplFunc);
NewParamStr:=CollectParams(FuncInfo.fParams);
Comment:=GetComment(FuncInfo.fReplacement, PossibleCommPos);
Comment:=GetComment(FuncInfo.fReplFunc, PossibleCommPos);
// Separate function body
if BodyEnd=-1 then
BodyEnd:=Length(FuncInfo.fReplacement);
NewFunc:=Trim(Copy(FuncInfo.fReplacement, 1, BodyEnd));
BodyEnd:=Length(FuncInfo.fReplFunc);
NewFunc:=Trim(Copy(FuncInfo.fReplFunc, 1, BodyEnd));
NewFunc:=Format('%s(%s)%s { *Converted from %s* %s }',
[NewFunc, NewParamStr, FuncInfo.fInclSemiColon, FuncInfo.fFuncName, Comment]);
// Old function call with params for IDE message output.
@ -714,7 +683,7 @@ var
break;
end;
if not AtomIsChar(',') then
raise EConverterError.Create('Bracket not found');
raise EDelphiConverterError.Create('Bracket not found');
ReadNextAtom;
end;
end;
@ -722,6 +691,7 @@ var
else
CheckSemiColon(FuncInfo);
end;
FuncInfo.UpdateReplacement;
end;
procedure ReadFuncCall(MaxPos: Integer);
@ -761,7 +731,7 @@ var
while StartPos<=aNode.EndPos do begin
case Src[StartPos] of
'{': // pascal comment
'{': // pascal comment
begin
inc(StartPos);
CommentLvl:=1;
@ -782,7 +752,7 @@ var
inc(StartPos);
end;
'/': // Delphi comment
'/': // Delphi comment
if (Src[StartPos+1]<>'/') then begin
inc(StartPos);
end else begin
@ -803,7 +773,7 @@ var
inc(StartPos);
end;
'(': // turbo pascal comment
'(': // turbo pascal comment
if (Src[StartPos+1]<>'*') then begin
inc(StartPos);
end else begin
@ -825,8 +795,7 @@ var
ReadFuncCall(aNode.EndPos);
'''':
begin
// skip string constant
begin // skip string constant
inc(StartPos);
while (StartPos<=aNode.EndPos) do begin
if (not (Src[StartPos] in ['''',#10,#13])) then

View File

@ -13,7 +13,7 @@ type
{ EConverterError }
EConverterError = class(Exception)
EDelphiConverterError = class(Exception)
constructor Create(const AMessage: string);
end;
@ -22,7 +22,7 @@ implementation
{ EConverterError }
constructor EConverterError.Create(const AMessage: string);
constructor EDelphiConverterError.Create(const AMessage: string);
begin
inherited Create('Converter: '+AMessage);
end;

View File

@ -253,7 +253,7 @@ begin
// Map Delphi function names to FCL/LCL functions.
TheMap:=fReplaceFuncs;
MapReplacement('ShellExecute', 'OpenURL($3) // Can be also OpenDocument depending on parameter.');
MapReplacement('ShellExecute', 'if $3 match ":/" then OpenURL($3); OpenDocument($3)');
// File name encoding. ToDo: add other similar funcs with UTF8 counterparts.
MapReplacement('FileExists', 'FileExistsUTF8($1)');
// File functions using a handle.

View File

@ -7,10 +7,30 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Grids, Buttons, ExtCtrls, Menus, CodeToolsStructs, SynRegExpr,
LazarusIDEStrConsts;
LazarusIDEStrConsts, ConverterTypes;
type
{ TCalledFuncInfo }
TCalledFuncInfo = class
// Used for function replacements.
private
function ParseIf(var StartPos: integer): boolean;
public
fFuncName: string;
fReplClause: string;
fReplFunc: string;
fStartPos: Integer;
fEndPos: Integer;
fInclSemiColon: string;
fParams: TStringList;
constructor Create(aFuncName, aReplacement: string);
destructor Destroy; override;
procedure UpdateReplacement;
end;
{ TStringMapUpdater }
TStringMapUpdater = class
@ -136,6 +156,144 @@ begin
end;
{ TCalledFuncInfo }
constructor TCalledFuncInfo.Create(aFuncName, aReplacement: string);
begin
fFuncName:=aFuncName;
fReplClause:=aReplacement;
fParams:=TStringList.Create;
end;
destructor TCalledFuncInfo.Destroy;
begin
fParams.Free;
inherited Destroy;
end;
function TCalledFuncInfo.ParseIf(var StartPos: integer): boolean;
// Parse a clause starting with "if" and set fReplFunc if the condition matches.
// Example: 'if $3 match ":/" then OpenURL($3); OpenDocument($3)'
// Return true if the condition matched.
var
RE: TRegExpr;
ParamPos: integer;
Str, Param: String;
Repl: String;
procedure ReadWhiteSpace(NewStartPos: integer);
begin
StartPos:=NewStartPos;
while (StartPos<=Length(fReplClause)) and (fReplClause[StartPos]=' ') do
inc(StartPos);
end;
function ParseParamNum: integer;
var
EndPos: Integer;
s: String;
begin
if fReplClause[StartPos]<>'$' then
raise EDelphiConverterError.Create(Format('$ expected, %s found.', [fReplClause[StartPos]]));
Inc(StartPos); // Skip $
EndPos:=StartPos;
while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos] in ['0'..'9']) do
Inc(EndPos);
s:=Copy(fReplClause, StartPos, EndPos-StartPos);
Result:=StrToInt(s);
ReadWhiteSpace(EndPos);
end;
procedure ParseString(aStr: string);
var
EndPos: Integer;
s: String;
begin
EndPos:=StartPos;
while (EndPos<=Length(fReplClause)) and
(fReplClause[EndPos] in ['a'..'z','A'..'Z','_']) do
Inc(EndPos);
s:=Copy(fReplClause, StartPos, EndPos-StartPos);
if s<>aStr then
raise EDelphiConverterError.Create(Format('%s expected, %s found.', [aStr, s]));
ReadWhiteSpace(EndPos);
end;
function ParseDoubleQuoted: string;
var
EndPos: Integer;
begin
if fReplClause[StartPos]<>'"' then
raise EDelphiConverterError.Create(Format('" expected, %s found.', [fReplClause[StartPos]]));
Inc(StartPos); // Skip "
EndPos:=StartPos;
while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos]<>'"') do
inc(EndPos);
Result:=Copy(fReplClause, StartPos, EndPos-StartPos);
ReadWhiteSpace(EndPos+1);
end;
function GetReplacement: string;
var
EndPos: Integer;
begin
EndPos:=StartPos;
while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos]<>';') do
inc(EndPos);
Result:=Copy(fReplClause, StartPos, EndPos-StartPos);
StartPos:=EndPos+1; // Skip ';'
end;
begin
// "if " is already skipped when coming here.
ReadWhiteSpace(StartPos); // Possible space in the beginning.
ParamPos:=ParseParamNum;
ParseString('match');
Str:=ParseDoubleQuoted;
ParseString('then');
Repl:=GetReplacement;
Result:=False;
if ParamPos<=fParams.Count then begin
Param:=fParams[ParamPos-1];
RE:=TRegExpr.Create;
try
RE.Expression:=Str;
if RE.Exec(Param) then begin
fReplFunc:=Repl;
Result:=True;
end;
finally
RE.Free;
end;
end;
end;
procedure TCalledFuncInfo.UpdateReplacement;
// Parse fReplClause and set fReplFunc, maybe conditionally based on parameters.
var
StartPos, EndPos: Integer;
begin
StartPos:=1;
while true do begin // StartPos<=Length(fReplClause)
// "If" condition can match or not. Continue if it didn't match.
if Copy(fReplClause, StartPos, 3) = 'if ' then begin
Inc(StartPos, 3);
if ParseIf(StartPos) then
Break;
end
else begin
// Replacement without conditions. Copy it and stop.
EndPos:=StartPos;
while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos]<>';') do
inc(EndPos);
fReplFunc:=Copy(fReplClause, StartPos, EndPos-StartPos);
Break;
end;
end;
end;
{ TStringMapUpdater }
constructor TStringMapUpdater.Create(AStringsMap: TStringToStringTree);