mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 05:58:06 +02:00
Converter: Improved syntax of replacement functions. Can test param values. Refactoring.
git-svn-id: trunk@26640 -
This commit is contained in:
parent
9a46922fa4
commit
f0c3b8b26b
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user