mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-30 03:22:48 +02:00
Converter: Extend fields for replacement functions and their UI. Refactoring.
git-svn-id: trunk@26665 -
This commit is contained in:
juha
parent
34c4400419
commit
3dc1fa1a34
@ -16,7 +16,7 @@ uses
|
||||
CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner,
|
||||
CodeCache, SourceChanger, CustomCodeTool, CodeToolsStructs, EventCodeTool,
|
||||
// Converter
|
||||
ConverterTypes, ConvertSettings, ReplaceNamesUnit;
|
||||
ConverterTypes, ConvertSettings, ReplaceNamesUnit, ReplaceFuncsUnit;
|
||||
|
||||
type
|
||||
|
||||
@ -44,8 +44,8 @@ type
|
||||
fUnitsToComment: TStringList;
|
||||
// Delphi Function names to replace with FCL/LCL functions.
|
||||
fDefinedProcNames: TStringList;
|
||||
fReplaceFuncs: TStringToStringTree;
|
||||
fFuncsToReplace: TObjectList; // List of TCalledFuncInfo.
|
||||
fReplaceFuncs: TStringList;
|
||||
fFuncsToReplace: TObjectList; // List of TFuncReplacement.
|
||||
function AddDelphiAndLCLSections: boolean;
|
||||
function AddModeDelphiDirective: boolean;
|
||||
function RenameResourceDirectives: boolean;
|
||||
@ -72,7 +72,7 @@ type
|
||||
property UnitsToRemove: TStringList read fUnitsToRemove write fUnitsToRemove;
|
||||
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
|
||||
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
|
||||
property ReplaceFuncs: TStringToStringTree read fReplaceFuncs write fReplaceFuncs;
|
||||
property ReplaceFuncs: TStringList read fReplaceFuncs write fReplaceFuncs;
|
||||
end;
|
||||
|
||||
|
||||
@ -576,7 +576,7 @@ var
|
||||
end;
|
||||
|
||||
var
|
||||
FuncInfo: TCalledFuncInfo;
|
||||
FuncInfo: TFuncReplacement;
|
||||
PossibleCommPos: Integer; // Start looking for comments here.
|
||||
i: Integer;
|
||||
s, NewFunc, NewParamStr, Comment: String;
|
||||
@ -586,24 +586,24 @@ begin
|
||||
try
|
||||
// Replace from bottom to top.
|
||||
for i:=fFuncsToReplace.Count-1 downto 0 do begin
|
||||
FuncInfo:=TCalledFuncInfo(fFuncsToReplace[i]);
|
||||
FuncInfo:=TFuncReplacement(fFuncsToReplace[i]);
|
||||
BodyEnd:=-1;
|
||||
PossibleCommPos:=ParseReplacementParams(FuncInfo.fReplFunc);
|
||||
NewParamStr:=CollectParams(FuncInfo.fParams);
|
||||
Comment:=GetComment(FuncInfo.fReplFunc, PossibleCommPos);
|
||||
PossibleCommPos:=ParseReplacementParams(FuncInfo.ReplFunc);
|
||||
NewParamStr:=CollectParams(FuncInfo.Params);
|
||||
Comment:=GetComment(FuncInfo.ReplFunc, PossibleCommPos);
|
||||
// Separate function body
|
||||
if BodyEnd=-1 then
|
||||
BodyEnd:=Length(FuncInfo.fReplFunc);
|
||||
NewFunc:=Trim(Copy(FuncInfo.fReplFunc, 1, BodyEnd));
|
||||
BodyEnd:=Length(FuncInfo.ReplFunc);
|
||||
NewFunc:=Trim(Copy(FuncInfo.ReplFunc, 1, BodyEnd));
|
||||
NewFunc:=Format('%s(%s)%s { *Converted from %s* %s }',
|
||||
[NewFunc, NewParamStr, FuncInfo.fInclSemiColon, FuncInfo.fFuncName, Comment]);
|
||||
[NewFunc, NewParamStr, FuncInfo.InclSemiColon, FuncInfo.FuncName, Comment]);
|
||||
// Old function call with params for IDE message output.
|
||||
s:=copy(fCodeTool.Src, FuncInfo.fStartPos, FuncInfo.fEndPos-FuncInfo.fStartPos);
|
||||
s:=copy(fCodeTool.Src, FuncInfo.StartPos, FuncInfo.EndPos-FuncInfo.StartPos);
|
||||
s:=StringReplace(s, sLineBreak, '', [rfReplaceAll]);
|
||||
// Now replace it.
|
||||
fSrcCache.MainScanner:=fCodeTool.Scanner;
|
||||
if not fSrcCache.Replace(gtNone, gtNone,
|
||||
FuncInfo.fStartPos, FuncInfo.fEndPos, NewFunc) then exit;
|
||||
FuncInfo.StartPos, FuncInfo.EndPos, NewFunc) then exit;
|
||||
IDEMessagesWindow.AddMsg('Replaced call '+s, '', -1);
|
||||
IDEMessagesWindow.AddMsg(' with '+NewFunc, '', -1);
|
||||
end;
|
||||
@ -635,26 +635,25 @@ function TConvDelphiCodeTool.ReplaceFuncCalls: boolean;
|
||||
// Search for calls to functions / procedures given in a list in current unit's
|
||||
// implementation section. Add their positions to another list for replacement.
|
||||
var
|
||||
FuncNames: TStringList;
|
||||
StartPos: Integer;
|
||||
xStart: Integer;
|
||||
|
||||
procedure CheckSemiColon(FuncInfo: TCalledFuncInfo);
|
||||
procedure CheckSemiColon(FuncInfo: TFuncReplacement);
|
||||
begin
|
||||
with fCodeTool do
|
||||
if AtomIsChar(';') then begin
|
||||
FuncInfo.fEndPos:=CurPos.EndPos;
|
||||
FuncInfo.fInclSemiColon:=';';
|
||||
FuncInfo.EndPos:=CurPos.EndPos;
|
||||
FuncInfo.InclSemiColon:=';';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ReadParams(FuncInfo: TCalledFuncInfo);
|
||||
procedure ReadParams(FuncInfo: TFuncReplacement);
|
||||
var
|
||||
ExprStartPos, ExprEndPos: integer;
|
||||
begin
|
||||
FuncInfo.fInclSemiColon:='';
|
||||
FuncInfo.fStartPos:=StartPos;
|
||||
FuncInfo.InclSemiColon:='';
|
||||
FuncInfo.StartPos:=xStart;
|
||||
with fCodeTool do begin
|
||||
MoveCursorToCleanPos(StartPos);
|
||||
MoveCursorToCleanPos(xStart);
|
||||
ReadNextAtom; // Read func name.
|
||||
ReadNextAtom; // Read first atom after proc name.
|
||||
if AtomIsChar('(') then begin
|
||||
@ -673,11 +672,11 @@ var
|
||||
until false;
|
||||
ExprEndPos:=CurPos.StartPos;
|
||||
// Add parameter to list
|
||||
FuncInfo.fParams.Add(copy(Src,ExprStartPos,ExprEndPos-ExprStartPos));
|
||||
FuncInfo.Params.Add(copy(Src,ExprStartPos,ExprEndPos-ExprStartPos));
|
||||
MoveCursorToCleanPos(ExprEndPos);
|
||||
ReadNextAtom;
|
||||
if AtomIsChar(')') then begin
|
||||
FuncInfo.fEndPos:=CurPos.EndPos;
|
||||
FuncInfo.EndPos:=CurPos.EndPos;
|
||||
ReadNextAtom;
|
||||
CheckSemiColon(FuncInfo);
|
||||
break;
|
||||
@ -696,29 +695,30 @@ var
|
||||
|
||||
procedure ReadFuncCall(MaxPos: Integer);
|
||||
var
|
||||
FuncInfo: TCalledFuncInfo;
|
||||
FuncInfo: TFuncReplacement;
|
||||
FuncName: string;
|
||||
i, x, IdentEndPos: Integer;
|
||||
begin
|
||||
IdentEndPos:=StartPos;
|
||||
IdentEndPos:=xStart;
|
||||
with fCodeTool do begin
|
||||
while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do
|
||||
inc(IdentEndPos);
|
||||
for i:=0 to FuncNames.Count-1 do begin
|
||||
FuncName:=FuncNames[i];
|
||||
if (IdentEndPos-StartPos=length(FuncName))
|
||||
and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[StartPos])=0)
|
||||
for i:=0 to fReplaceFuncs.Count-1 do begin
|
||||
FuncName:=fReplaceFuncs[i];
|
||||
if (IdentEndPos-xStart=length(FuncName))
|
||||
and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[xStart])=0)
|
||||
and not fDefinedProcNames.Find(FuncName, x)
|
||||
then begin
|
||||
FuncInfo:=TCalledFuncInfo.Create(FuncName, fReplaceFuncs[FuncName]);
|
||||
// Create a new replacement object for params, position and other info.
|
||||
FuncInfo:=TFuncReplacement.Create(TFuncReplacement(fReplaceFuncs.Objects[i]));
|
||||
ReadParams(FuncInfo);
|
||||
IdentEndPos:=FuncInfo.fEndPos; // Skip the params, too, for next search.
|
||||
IdentEndPos:=FuncInfo.EndPos; // Skip the params, too, for next search.
|
||||
fFuncsToReplace.Add(FuncInfo);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
StartPos:=IdentEndPos;
|
||||
xStart:=IdentEndPos;
|
||||
end;
|
||||
|
||||
function SearchFuncCalls(aNode: TCodeTreeNode): TCodeTreeNode;
|
||||
@ -726,18 +726,18 @@ var
|
||||
CommentLvl: Integer;
|
||||
InStrConst: Boolean;
|
||||
begin
|
||||
StartPos:=aNode.StartPos;
|
||||
xStart:=aNode.StartPos;
|
||||
with fCodeTool do
|
||||
while StartPos<=aNode.EndPos do begin
|
||||
case Src[StartPos] of
|
||||
while xStart<=aNode.EndPos do begin
|
||||
case Src[xStart] of
|
||||
|
||||
'{': // pascal comment
|
||||
begin
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
CommentLvl:=1;
|
||||
InStrConst:=false;
|
||||
while StartPos<=aNode.EndPos do begin
|
||||
case Src[StartPos] of
|
||||
while xStart<=aNode.EndPos do begin
|
||||
case Src[xStart] of
|
||||
'{': if Scanner.NestedComments then inc(CommentLvl);
|
||||
'}':
|
||||
begin
|
||||
@ -747,48 +747,48 @@ var
|
||||
'''':
|
||||
InStrConst:=not InStrConst;
|
||||
end;
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
end;
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
end;
|
||||
|
||||
'/': // Delphi comment
|
||||
if (Src[StartPos+1]<>'/') then begin
|
||||
inc(StartPos);
|
||||
if (Src[xStart+1]<>'/') then begin
|
||||
inc(xStart);
|
||||
end else begin
|
||||
inc(StartPos,2);
|
||||
inc(xStart,2);
|
||||
InStrConst:=false;
|
||||
while (StartPos<=aNode.EndPos) do begin
|
||||
case Src[StartPos] of
|
||||
while (xStart<=aNode.EndPos) do begin
|
||||
case Src[xStart] of
|
||||
#10,#13:
|
||||
break;
|
||||
'''':
|
||||
InStrConst:=not InStrConst;
|
||||
end;
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
end;
|
||||
inc(StartPos);
|
||||
if (StartPos<=aNode.EndPos) and (Src[StartPos] in [#10,#13])
|
||||
and (Src[StartPos-1]<>Src[StartPos]) then
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
if (xStart<=aNode.EndPos) and (Src[xStart] in [#10,#13])
|
||||
and (Src[xStart-1]<>Src[xStart]) then
|
||||
inc(xStart);
|
||||
end;
|
||||
|
||||
'(': // turbo pascal comment
|
||||
if (Src[StartPos+1]<>'*') then begin
|
||||
inc(StartPos);
|
||||
if (Src[xStart+1]<>'*') then begin
|
||||
inc(xStart);
|
||||
end else begin
|
||||
inc(StartPos,3);
|
||||
inc(xStart,3);
|
||||
InStrConst:=false;
|
||||
while (StartPos<=aNode.EndPos) do begin
|
||||
case Src[StartPos] of
|
||||
while (xStart<=aNode.EndPos) do begin
|
||||
case Src[xStart] of
|
||||
')':
|
||||
if Src[StartPos-1]='*' then break;
|
||||
if Src[xStart-1]='*' then break;
|
||||
'''':
|
||||
InStrConst:=not InStrConst;
|
||||
end;
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
end;
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
end;
|
||||
|
||||
'a'..'z','A'..'Z','_':
|
||||
@ -796,19 +796,19 @@ var
|
||||
|
||||
'''':
|
||||
begin // skip string constant
|
||||
inc(StartPos);
|
||||
while (StartPos<=aNode.EndPos) do begin
|
||||
if (not (Src[StartPos] in ['''',#10,#13])) then
|
||||
inc(StartPos)
|
||||
inc(xStart);
|
||||
while (xStart<=aNode.EndPos) do begin
|
||||
if (not (Src[xStart] in ['''',#10,#13])) then
|
||||
inc(xStart)
|
||||
else begin
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
else
|
||||
inc(StartPos);
|
||||
inc(xStart);
|
||||
end;
|
||||
end;
|
||||
Result:=aNode.NextSkipChilds;
|
||||
@ -820,13 +820,11 @@ begin
|
||||
Result:=false;
|
||||
with fCodeTool do begin
|
||||
fFuncsToReplace:=TObjectList.Create;
|
||||
FuncNames:=TStringList.Create;
|
||||
fDefinedProcNames:=TStringList.Create;
|
||||
fDefinedProcNames.Sorted:=True;
|
||||
fDefinedProcNames.Duplicates:=dupIgnore;
|
||||
ActivateGlobalWriteLock;
|
||||
try
|
||||
fReplaceFuncs.GetNames(FuncNames);
|
||||
BuildTree(false);
|
||||
// Only convert identifiers in ctnBeginBlock nodes
|
||||
Node:=fCodeTool.Tree.Root;
|
||||
@ -842,7 +840,6 @@ begin
|
||||
finally
|
||||
DeactivateGlobalWriteLock;
|
||||
fDefinedProcNames.Free;
|
||||
FuncNames.Free;
|
||||
fFuncsToReplace.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -33,7 +33,7 @@ uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, IDEProcs,
|
||||
StdCtrls, EditBtn, Buttons, ExtCtrls, DialogProcs, LazarusIDEStrConsts,
|
||||
CodeToolsStructs, AVL_Tree, BaseIDEIntf, LazConfigStorage,
|
||||
ButtonPanel, ReplaceNamesUnit;
|
||||
ButtonPanel, ReplaceNamesUnit, ReplaceFuncsUnit;
|
||||
|
||||
type
|
||||
|
||||
@ -60,7 +60,7 @@ type
|
||||
// Delphi types mapped to Lazarus types, will be replaced.
|
||||
fReplaceTypes: TStringToStringTree;
|
||||
// Delphi global function names mapped to FCL/LCL functions.
|
||||
fReplaceFuncs: TStringToStringTree;
|
||||
fReplaceFuncs: TStringList; // Objects property is used for data items.
|
||||
// Getter / setter:
|
||||
function GetBackupPath: String;
|
||||
procedure SetMainFilename(const AValue: String);
|
||||
@ -96,7 +96,7 @@ type
|
||||
property AutoRemoveProperties: boolean read fAutoRemoveProperties;
|
||||
property ReplaceUnits: TStringToStringTree read fReplaceUnits;
|
||||
property ReplaceTypes: TStringToStringTree read fReplaceTypes;
|
||||
property ReplaceFuncs: TStringToStringTree read fReplaceFuncs;
|
||||
property ReplaceFuncs: TStringList read fReplaceFuncs;
|
||||
end;
|
||||
|
||||
|
||||
@ -136,7 +136,7 @@ implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TConvertSettings }
|
||||
// Load and store configuration in StringToStringTree :
|
||||
|
||||
procedure LoadStringToStringTree(Config: TConfigStorage; const Path: string;
|
||||
Tree: TStringToStringTree);
|
||||
@ -148,7 +148,7 @@ var
|
||||
i: Integer;
|
||||
begin
|
||||
Tree.Clear;
|
||||
Cnt:=Config.GetValue(Path+'Count',0);
|
||||
Cnt:=Config.GetValue(Path+'Count', 0);
|
||||
for i:=0 to Cnt-1 do begin
|
||||
SubPath:=Path+'Item'+IntToStr(i)+'/';
|
||||
CurName:=Config.GetValue(SubPath+'Name','');
|
||||
@ -165,7 +165,7 @@ var
|
||||
i, j: Integer;
|
||||
SubPath: String;
|
||||
begin
|
||||
Config.SetDeleteValue(Path+'Count',Tree.Tree.Count,0);
|
||||
Config.SetDeleteValue(Path+'Count', Tree.Tree.Count, 0);
|
||||
Node:=Tree.Tree.FindLowest;
|
||||
i:=0;
|
||||
while Node<>nil do begin
|
||||
@ -183,6 +183,62 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// Load and store configuration in TStringList + TFuncReplacement :
|
||||
|
||||
procedure LoadFuncReplacements(Config: TConfigStorage; const Path: string;
|
||||
aFuncs: TStringList);
|
||||
var
|
||||
Cnt: LongInt;
|
||||
SubPath: String;
|
||||
FuncRepl: TFuncReplacement;
|
||||
xCategory, xDelphiFunc, xReplacement, xPackage, xUnitName: String;
|
||||
i: Integer;
|
||||
begin
|
||||
aFuncs.Clear;
|
||||
Cnt:=Config.GetValue(Path+'Count', 0);
|
||||
for i:=0 to Cnt-1 do begin
|
||||
SubPath:=Path+'Item'+IntToStr(i)+'/';
|
||||
xCategory :=Config.GetValue(SubPath+'Category','');
|
||||
xDelphiFunc :=Config.GetValue(SubPath+'DelphiFunction','');
|
||||
xReplacement:=Config.GetValue(SubPath+'Replacement','');
|
||||
xPackage :=Config.GetValue(SubPath+'Package','');
|
||||
xUnitName :=Config.GetValue(SubPath+'UnitName','');
|
||||
if xDelphiFunc<>'' then begin
|
||||
FuncRepl:=TFuncReplacement.Create(xCategory,
|
||||
xDelphiFunc, xReplacement, xPackage, xUnitName);
|
||||
aFuncs.AddObject(xDelphiFunc, FuncRepl);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SaveFuncReplacements(Config: TConfigStorage; const Path: string;
|
||||
aFuncs: TStringList);
|
||||
var
|
||||
SubPath: String;
|
||||
FuncRepl: TFuncReplacement;
|
||||
i, j: Integer;
|
||||
begin
|
||||
Config.SetDeleteValue(Path+'Count', aFuncs.Count, 0);
|
||||
for i:=0 to aFuncs.Count-1 do
|
||||
if (aFuncs[i]<>'') and (aFuncs.Objects[i]<>nil) then begin
|
||||
FuncRepl:=TFuncReplacement(aFuncs.Objects[i]);
|
||||
SubPath:=Path+'Item'+IntToStr(i)+'/';
|
||||
Config.SetDeleteValue(SubPath+'Category' ,FuncRepl.Category,'');
|
||||
Config.SetDeleteValue(SubPath+'DelphiFunction',aFuncs[i],'');
|
||||
Config.SetDeleteValue(SubPath+'Replacement' ,FuncRepl.ReplClause,'');
|
||||
Config.SetDeleteValue(SubPath+'Package' ,FuncRepl.PackageName,'');
|
||||
Config.SetDeleteValue(SubPath+'UnitName' ,FuncRepl.UnitName,'');
|
||||
end;
|
||||
// Remove leftover items in case the list has become shorter.
|
||||
for j:=i to i+10 do begin
|
||||
SubPath:=Path+'Item'+IntToStr(j)+'/';
|
||||
Config.DeletePath(SubPath);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TConvertSettings }
|
||||
|
||||
constructor TConvertSettings.Create(const ATitle: string);
|
||||
var
|
||||
TheMap: TStringToStringTree;
|
||||
@ -199,7 +255,9 @@ begin
|
||||
fMainPath:='';
|
||||
fReplaceUnits:=TStringToStringTree.Create(false);
|
||||
fReplaceTypes:=TStringToStringTree.Create(false);
|
||||
fReplaceFuncs:=TStringToStringTree.Create(false);
|
||||
fReplaceFuncs:=TStringList.Create;
|
||||
fReplaceFuncs.Sorted:=True;
|
||||
fReplaceFuncs.CaseSensitive:=False;
|
||||
// Load settings from ConfigStorage.
|
||||
fConfigStorage:=GetIDEConfigStorage('delphiconverter.xml', true);
|
||||
fBackupFiles :=fConfigStorage.GetValue('BackupFiles', true);
|
||||
@ -207,9 +265,9 @@ begin
|
||||
fSameDFMFile :=fConfigStorage.GetValue('SameDFMFile', false);
|
||||
fAutoReplaceUnits :=fConfigStorage.GetValue('AutoReplaceUnits', true);
|
||||
fAutoRemoveProperties :=fConfigStorage.GetValue('AutoRemoveProperties', true);
|
||||
LoadStringToStringTree(fConfigStorage, 'ReplaceUnits/', fReplaceUnits);
|
||||
LoadStringToStringTree(fConfigStorage, 'ReplaceTypes/', fReplaceTypes);
|
||||
LoadStringToStringTree(fConfigStorage, 'ReplaceFuncs/', fReplaceFuncs);
|
||||
LoadStringToStringTree(fConfigStorage, 'UnitReplacements/', fReplaceUnits);
|
||||
LoadStringToStringTree(fConfigStorage, 'TypeReplacements/', fReplaceTypes);
|
||||
LoadFuncReplacements (fConfigStorage, 'FuncReplacements/', fReplaceFuncs);
|
||||
|
||||
// Add default values for string maps if ConfigStorage doesn't have them.
|
||||
// Map Delphi units to Lazarus units.
|
||||
@ -252,18 +310,20 @@ begin
|
||||
MapReplacement('^TTnt(.+[^L][^X])$','T$1');
|
||||
|
||||
// Map Delphi function names to FCL/LCL functions.
|
||||
TheMap:=fReplaceFuncs;
|
||||
MapReplacement('ShellExecute', 'if $3 match ":/" then OpenURL($3); OpenDocument($3)');
|
||||
AddReplaceFunc(fReplaceFuncs, 'Other', 'ShellExecute',
|
||||
'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', '');
|
||||
// File name encoding. ToDo: add other similar funcs with UTF8 counterparts.
|
||||
MapReplacement('FileExists', 'FileExistsUTF8($1)');
|
||||
AddReplaceFunc(fReplaceFuncs, 'UTF8Names', 'FileExists', 'FileExistsUTF8($1)', '', '');
|
||||
// File functions using a handle.
|
||||
MapReplacement('CreateFile', 'FileCreate($1)'); // in SysUtils
|
||||
MapReplacement('GetFileSize', 'FileSize($1)'); // in SysUtils
|
||||
MapReplacement('ReadFile', 'FileRead($1)'); // in SysUtils
|
||||
MapReplacement('CloseHandle', 'FileClose($1)'); // in SysUtils
|
||||
AddReplaceFunc(fReplaceFuncs, 'Other', 'CreateFile', 'FileCreate($1)', '', 'SysUtils');
|
||||
AddReplaceFunc(fReplaceFuncs, 'Other', 'GetFileSize', 'FileSize($1)' , '', 'SysUtils');
|
||||
AddReplaceFunc(fReplaceFuncs, 'Other', 'ReadFile', 'FileRead($1)' , '', 'SysUtils');
|
||||
AddReplaceFunc(fReplaceFuncs, 'Other', 'CloseHandle', 'FileClose($1)' , '', 'SysUtils');
|
||||
end;
|
||||
|
||||
destructor TConvertSettings.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// Save possibly modified settings to ConfigStorage.
|
||||
fConfigStorage.SetDeleteValue('BackupFiles', fBackupFiles, true);
|
||||
@ -271,11 +331,15 @@ begin
|
||||
fConfigStorage.SetDeleteValue('SameDFMFile', fSameDFMFile, false);
|
||||
fConfigStorage.SetDeleteValue('AutoReplaceUnits', fAutoReplaceUnits, false);
|
||||
fConfigStorage.SetDeleteValue('AutoRemoveProperties', fAutoRemoveProperties, false);
|
||||
SaveStringToStringTree(fConfigStorage, 'ReplaceUnits/', fReplaceUnits);
|
||||
SaveStringToStringTree(fConfigStorage, 'ReplaceTypes/', fReplaceTypes);
|
||||
SaveStringToStringTree(fConfigStorage, 'ReplaceFuncs/', fReplaceFuncs);
|
||||
SaveStringToStringTree(fConfigStorage, 'UnitReplacements/', fReplaceUnits);
|
||||
SaveStringToStringTree(fConfigStorage, 'TypeReplacements/', fReplaceTypes);
|
||||
SaveFuncReplacements (fConfigStorage, 'FuncReplacements/', fReplaceFuncs);
|
||||
// Free stuff
|
||||
fConfigStorage.Free;
|
||||
for i:=0 to fReplaceFuncs.Count-1 do begin
|
||||
fReplaceFuncs.Objects[i].Free;
|
||||
fReplaceFuncs.Objects[i]:=nil;
|
||||
end;
|
||||
fReplaceFuncs.Free;
|
||||
fReplaceTypes.Free;
|
||||
fReplaceUnits.Free;
|
||||
@ -471,7 +535,7 @@ end;
|
||||
|
||||
procedure TConvertSettingsForm.FuncReplacementsButtonClick(Sender: TObject);
|
||||
begin
|
||||
EditMap(fSettings.ReplaceFuncs, lisConvFuncsToReplace);
|
||||
EditFuncReplacements(fSettings.ReplaceFuncs, lisConvFuncsToReplace);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -2,29 +2,29 @@ object ReplaceNamesForm: TReplaceNamesForm
|
||||
Left = 314
|
||||
Height = 472
|
||||
Top = 438
|
||||
Width = 343
|
||||
Width = 433
|
||||
Caption = 'Properties and Types to replace'
|
||||
ClientHeight = 472
|
||||
ClientWidth = 343
|
||||
ClientWidth = 433
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object Grid: TStringGrid
|
||||
Left = 0
|
||||
Height = 434
|
||||
Height = 421
|
||||
Top = 0
|
||||
Width = 343
|
||||
Width = 433
|
||||
Align = alClient
|
||||
AutoFillColumns = True
|
||||
ColCount = 2
|
||||
Columns = <
|
||||
item
|
||||
Title.Caption = 'Delphi name'
|
||||
Width = 169
|
||||
Width = 214
|
||||
end
|
||||
item
|
||||
Title.Caption = 'New name'
|
||||
Width = 170
|
||||
Width = 215
|
||||
end>
|
||||
FixedCols = 0
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goEditing, goSmoothScroll]
|
||||
@ -34,73 +34,27 @@ object ReplaceNamesForm: TReplaceNamesForm
|
||||
OnEditingDone = GridEditingDone
|
||||
OnSetEditText = GridSetEditText
|
||||
ColWidths = (
|
||||
169
|
||||
170
|
||||
214
|
||||
215
|
||||
)
|
||||
end
|
||||
object BtnPanel: TPanel
|
||||
Left = 0
|
||||
Height = 38
|
||||
Top = 434
|
||||
Width = 343
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 38
|
||||
ClientWidth = 343
|
||||
object ButtonPanel: TButtonPanel
|
||||
Left = 6
|
||||
Height = 39
|
||||
Top = 427
|
||||
Width = 421
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.Caption = '&OK'
|
||||
OKButton.OnClick = btnOKClick
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.Caption = '&Help'
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.Caption = '&Close'
|
||||
CloseButton.Enabled = False
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.Caption = 'Cancel'
|
||||
TabOrder = 1
|
||||
object HelpButton: TBitBtn
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 6
|
||||
Width = 75
|
||||
Align = alLeft
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&Help'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkHelp
|
||||
NumGlyphs = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnOK: TBitBtn
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 179
|
||||
Height = 26
|
||||
Top = 6
|
||||
Width = 75
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&OK'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkOK
|
||||
NumGlyphs = 0
|
||||
OnClick = btnOKClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object btnCancel: TBitBtn
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 260
|
||||
Height = 26
|
||||
Top = 6
|
||||
Width = 77
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkCancel
|
||||
ModalResult = 2
|
||||
NumGlyphs = 0
|
||||
TabOrder = 2
|
||||
end
|
||||
ShowButtons = [pbOK, pbCancel, pbHelp]
|
||||
end
|
||||
object PopupMenu1: TPopupMenu
|
||||
OnPopup = PopupMenu1Popup
|
||||
|
||||
@ -6,31 +6,11 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
Grids, Buttons, ExtCtrls, Menus, CodeToolsStructs, SynRegExpr,
|
||||
Grids, Buttons, ExtCtrls, Menus, ButtonPanel, CodeToolsStructs, SynRegExpr,
|
||||
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
|
||||
@ -59,22 +39,19 @@ type
|
||||
{ TReplaceNamesForm }
|
||||
|
||||
TReplaceNamesForm = class(TForm)
|
||||
btnCancel: TBitBtn;
|
||||
btnOK: TBitBtn;
|
||||
BtnPanel: TPanel;
|
||||
HelpButton: TBitBtn;
|
||||
ButtonPanel: TButtonPanel;
|
||||
InsertRow1: TMenuItem;
|
||||
DeleteRow1: TMenuItem;
|
||||
Grid: TStringGrid;
|
||||
PopupMenu1: TPopupMenu;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure PopupMenu1Popup(Sender: TObject);
|
||||
procedure InsertRow1Click(Sender: TObject);
|
||||
procedure DeleteRow1Click(Sender: TObject);
|
||||
procedure GridEditingDone(Sender: TObject);
|
||||
procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer;
|
||||
const Value: string);
|
||||
procedure btnOKClick(Sender: TObject);
|
||||
procedure PopupMenu1Popup(Sender: TObject);
|
||||
private
|
||||
IsLasRow: Boolean;
|
||||
public
|
||||
@ -156,144 +133,6 @@ 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);
|
||||
@ -383,9 +222,6 @@ end;
|
||||
procedure TReplaceNamesForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption:=lisReplacements;
|
||||
btnOK.Caption:=lisOk;
|
||||
HelpButton.Caption:=lisMenuHelp;
|
||||
btnCancel.Caption:=dlgCancel;
|
||||
IsLasRow:=false;
|
||||
end;
|
||||
|
||||
|
||||
@ -483,6 +483,7 @@ resourcestring
|
||||
lisProperties = 'Properties (replace or delete)';
|
||||
lisTypes = 'Types (not removed if no replacement)';
|
||||
lisReplaceRemoveUnknown = 'Fix unknown properties and types';
|
||||
lisReplacementFuncs = 'Replacement functions';
|
||||
|
||||
lisUnableToLoadOldResourceFileTheResourceFileIs = 'Unable to load old '
|
||||
+'resource file.%sThe resource file is the first include file in the%'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user