paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-01 11:12:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

Converter: Extend fields for replacement functions and their UI. Refactoring.

Browse Source 
git-svn-id: trunk@26665 -
This commit is contained in:
juha 2010-07-15 15:22:35 +00:00
parent 34c4400419
commit 3dc1fa1a34
5 changed files with 179 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
converter/convcodetool.pas
View File

@ -16,7 +16,7 @@ uses
CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner,
CodeCache, SourceChanger, CustomCodeTool, CodeToolsStructs, EventCodeTool, CodeCache, SourceChanger, CustomCodeTool, CodeToolsStructs, EventCodeTool,
// Converter // Converter
ConverterTypes, ConvertSettings, ReplaceNamesUnit; ConverterTypes, ConvertSettings, ReplaceNamesUnit, ReplaceFuncsUnit;
type type
@ -44,8 +44,8 @@ type
fUnitsToComment: TStringList; fUnitsToComment: TStringList;
// Delphi Function names to replace with FCL/LCL functions. // Delphi Function names to replace with FCL/LCL functions.
fDefinedProcNames: TStringList; fDefinedProcNames: TStringList;
fReplaceFuncs: TStringToStringTree; fReplaceFuncs: TStringList;
fFuncsToReplace: TObjectList; // List of TCalledFuncInfo. fFuncsToReplace: TObjectList; // List of TFuncReplacement.
function AddDelphiAndLCLSections: boolean; function AddDelphiAndLCLSections: boolean;
function AddModeDelphiDirective: boolean; function AddModeDelphiDirective: boolean;
function RenameResourceDirectives: boolean; function RenameResourceDirectives: boolean;
@ -72,7 +72,7 @@ type
property UnitsToRemove: TStringList read fUnitsToRemove write fUnitsToRemove; property UnitsToRemove: TStringList read fUnitsToRemove write fUnitsToRemove;
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename; property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment; property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
property ReplaceFuncs: TStringToStringTree read fReplaceFuncs write fReplaceFuncs; property ReplaceFuncs: TStringList read fReplaceFuncs write fReplaceFuncs;
end; end;
@ -576,7 +576,7 @@ var
end; end;
var var
FuncInfo: TCalledFuncInfo; FuncInfo: TFuncReplacement;
PossibleCommPos: Integer; // Start looking for comments here. PossibleCommPos: Integer; // Start looking for comments here.
i: Integer; i: Integer;
s, NewFunc, NewParamStr, Comment: String; s, NewFunc, NewParamStr, Comment: String;
@ -586,24 +586,24 @@ begin
try try
// Replace from bottom to top. // Replace from bottom to top.
for i:=fFuncsToReplace.Count-1 downto 0 do begin for i:=fFuncsToReplace.Count-1 downto 0 do begin
FuncInfo:=TCalledFuncInfo(fFuncsToReplace[i]); FuncInfo:=TFuncReplacement(fFuncsToReplace[i]);
BodyEnd:=-1; BodyEnd:=-1;
PossibleCommPos:=ParseReplacementParams(FuncInfo.fReplFunc); PossibleCommPos:=ParseReplacementParams(FuncInfo.ReplFunc);
NewParamStr:=CollectParams(FuncInfo.fParams); NewParamStr:=CollectParams(FuncInfo.Params);
Comment:=GetComment(FuncInfo.fReplFunc, PossibleCommPos); Comment:=GetComment(FuncInfo.ReplFunc, PossibleCommPos);
// Separate function body // Separate function body
if BodyEnd=-1 then if BodyEnd=-1 then
BodyEnd:=Length(FuncInfo.fReplFunc); BodyEnd:=Length(FuncInfo.ReplFunc);
NewFunc:=Trim(Copy(FuncInfo.fReplFunc, 1, BodyEnd)); NewFunc:=Trim(Copy(FuncInfo.ReplFunc, 1, BodyEnd));
NewFunc:=Format('%s(%s)%s { *Converted from %s* %s }', 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. // 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]); s:=StringReplace(s, sLineBreak, '', [rfReplaceAll]);
// Now replace it. // Now replace it.
fSrcCache.MainScanner:=fCodeTool.Scanner; fSrcCache.MainScanner:=fCodeTool.Scanner;
if not fSrcCache.Replace(gtNone, gtNone, 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('Replaced call '+s, '', -1);
IDEMessagesWindow.AddMsg(' with '+NewFunc, '', -1); IDEMessagesWindow.AddMsg(' with '+NewFunc, '', -1);
end; end;
@ -635,26 +635,25 @@ function TConvDelphiCodeTool.ReplaceFuncCalls: boolean;
// Search for calls to functions / procedures given in a list in current unit's // Search for calls to functions / procedures given in a list in current unit's
// implementation section. Add their positions to another list for replacement. // implementation section. Add their positions to another list for replacement.
var var
FuncNames: TStringList; xStart: Integer;
StartPos: Integer;
procedure CheckSemiColon(FuncInfo: TCalledFuncInfo); procedure CheckSemiColon(FuncInfo: TFuncReplacement);
begin begin
with fCodeTool do with fCodeTool do
if AtomIsChar(';') then begin if AtomIsChar(';') then begin
FuncInfo.fEndPos:=CurPos.EndPos; FuncInfo.EndPos:=CurPos.EndPos;
FuncInfo.fInclSemiColon:=';'; FuncInfo.InclSemiColon:=';';
end; end;
end; end;
procedure ReadParams(FuncInfo: TCalledFuncInfo); procedure ReadParams(FuncInfo: TFuncReplacement);
var var
ExprStartPos, ExprEndPos: integer; ExprStartPos, ExprEndPos: integer;
begin begin
FuncInfo.fInclSemiColon:=''; FuncInfo.InclSemiColon:='';
FuncInfo.fStartPos:=StartPos; FuncInfo.StartPos:=xStart;
with fCodeTool do begin with fCodeTool do begin
MoveCursorToCleanPos(StartPos); MoveCursorToCleanPos(xStart);
ReadNextAtom; // Read func name. ReadNextAtom; // Read func name.
ReadNextAtom; // Read first atom after proc name. ReadNextAtom; // Read first atom after proc name.
if AtomIsChar('(') then begin if AtomIsChar('(') then begin
@ -673,11 +672,11 @@ var
until false; until false;
ExprEndPos:=CurPos.StartPos; ExprEndPos:=CurPos.StartPos;
// Add parameter to list // Add parameter to list
FuncInfo.fParams.Add(copy(Src,ExprStartPos,ExprEndPos-ExprStartPos)); FuncInfo.Params.Add(copy(Src,ExprStartPos,ExprEndPos-ExprStartPos));
MoveCursorToCleanPos(ExprEndPos); MoveCursorToCleanPos(ExprEndPos);
ReadNextAtom; ReadNextAtom;
if AtomIsChar(')') then begin if AtomIsChar(')') then begin
FuncInfo.fEndPos:=CurPos.EndPos; FuncInfo.EndPos:=CurPos.EndPos;
ReadNextAtom; ReadNextAtom;
CheckSemiColon(FuncInfo); CheckSemiColon(FuncInfo);
break; break;
@ -696,29 +695,30 @@ var
procedure ReadFuncCall(MaxPos: Integer); procedure ReadFuncCall(MaxPos: Integer);
var var
FuncInfo: TCalledFuncInfo; FuncInfo: TFuncReplacement;
FuncName: string; FuncName: string;
i, x, IdentEndPos: Integer; i, x, IdentEndPos: Integer;
begin begin
IdentEndPos:=StartPos; IdentEndPos:=xStart;
with fCodeTool do begin with fCodeTool do begin
while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do
inc(IdentEndPos); inc(IdentEndPos);
for i:=0 to FuncNames.Count-1 do begin for i:=0 to fReplaceFuncs.Count-1 do begin
FuncName:=FuncNames[i]; FuncName:=fReplaceFuncs[i];
if (IdentEndPos-StartPos=length(FuncName)) if (IdentEndPos-xStart=length(FuncName))
and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[StartPos])=0) and (CompareIdentifiers(PChar(Pointer(FuncName)),@Src[xStart])=0)
and not fDefinedProcNames.Find(FuncName, x) and not fDefinedProcNames.Find(FuncName, x)
then begin 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); 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); fFuncsToReplace.Add(FuncInfo);
Break; Break;
end; end;
end; end;
end; end;
StartPos:=IdentEndPos; xStart:=IdentEndPos;
end; end;
function SearchFuncCalls(aNode: TCodeTreeNode): TCodeTreeNode; function SearchFuncCalls(aNode: TCodeTreeNode): TCodeTreeNode;
@ -726,18 +726,18 @@ var
CommentLvl: Integer; CommentLvl: Integer;
InStrConst: Boolean; InStrConst: Boolean;
begin begin
StartPos:=aNode.StartPos; xStart:=aNode.StartPos;
with fCodeTool do with fCodeTool do
while StartPos<=aNode.EndPos do begin while xStart<=aNode.EndPos do begin
case Src[StartPos] of case Src[xStart] of
'{': // pascal comment '{': // pascal comment
begin begin
inc(StartPos); inc(xStart);
CommentLvl:=1; CommentLvl:=1;
InStrConst:=false; InStrConst:=false;
while StartPos<=aNode.EndPos do begin while xStart<=aNode.EndPos do begin
case Src[StartPos] of case Src[xStart] of
'{': if Scanner.NestedComments then inc(CommentLvl); '{': if Scanner.NestedComments then inc(CommentLvl);
'}': '}':
begin begin
@ -747,48 +747,48 @@ var
'''': '''':
InStrConst:=not InStrConst; InStrConst:=not InStrConst;
end; end;
inc(StartPos); inc(xStart);
end; end;
inc(StartPos); inc(xStart);
end; end;
'/': // Delphi comment '/': // Delphi comment
if (Src[StartPos+1]<>'/') then begin if (Src[xStart+1]<>'/') then begin
inc(StartPos); inc(xStart);
end else begin end else begin
inc(StartPos,2); inc(xStart,2);
InStrConst:=false; InStrConst:=false;
while (StartPos<=aNode.EndPos) do begin while (xStart<=aNode.EndPos) do begin
case Src[StartPos] of case Src[xStart] of
#10,#13: #10,#13:
break; break;
'''': '''':
InStrConst:=not InStrConst; InStrConst:=not InStrConst;
end; end;
inc(StartPos); inc(xStart);
end; end;
inc(StartPos); inc(xStart);
if (StartPos<=aNode.EndPos) and (Src[StartPos] in [#10,#13]) if (xStart<=aNode.EndPos) and (Src[xStart] in [#10,#13])
and (Src[StartPos-1]<>Src[StartPos]) then and (Src[xStart-1]<>Src[xStart]) then
inc(StartPos); inc(xStart);
end; end;
'(': // turbo pascal comment '(': // turbo pascal comment
if (Src[StartPos+1]<>'*') then begin if (Src[xStart+1]<>'*') then begin
inc(StartPos); inc(xStart);
end else begin end else begin
inc(StartPos,3); inc(xStart,3);
InStrConst:=false; InStrConst:=false;
while (StartPos<=aNode.EndPos) do begin while (xStart<=aNode.EndPos) do begin
case Src[StartPos] of case Src[xStart] of
')': ')':
if Src[StartPos-1]='*' then break; if Src[xStart-1]='*' then break;
'''': '''':
InStrConst:=not InStrConst; InStrConst:=not InStrConst;
end; end;
inc(StartPos); inc(xStart);
end; end;
inc(StartPos); inc(xStart);
end; end;
'a'..'z','A'..'Z','_': 'a'..'z','A'..'Z','_':
@ -796,19 +796,19 @@ var
'''': '''':
begin // skip string constant begin // skip string constant
inc(StartPos); inc(xStart);
while (StartPos<=aNode.EndPos) do begin while (xStart<=aNode.EndPos) do begin
if (not (Src[StartPos] in ['''',#10,#13])) then if (not (Src[xStart] in ['''',#10,#13])) then
inc(StartPos) inc(xStart)
else begin else begin
inc(StartPos); inc(xStart);
break; break;
end; end;
end; end;
end; end;
else else
inc(StartPos); inc(xStart);
end; end;
end; end;
Result:=aNode.NextSkipChilds; Result:=aNode.NextSkipChilds;
@ -820,13 +820,11 @@ begin
Result:=false; Result:=false;
with fCodeTool do begin with fCodeTool do begin
fFuncsToReplace:=TObjectList.Create; fFuncsToReplace:=TObjectList.Create;
FuncNames:=TStringList.Create;
fDefinedProcNames:=TStringList.Create; fDefinedProcNames:=TStringList.Create;
fDefinedProcNames.Sorted:=True; fDefinedProcNames.Sorted:=True;
fDefinedProcNames.Duplicates:=dupIgnore; fDefinedProcNames.Duplicates:=dupIgnore;
ActivateGlobalWriteLock; ActivateGlobalWriteLock;
try try
fReplaceFuncs.GetNames(FuncNames);
BuildTree(false); BuildTree(false);
// Only convert identifiers in ctnBeginBlock nodes // Only convert identifiers in ctnBeginBlock nodes
Node:=fCodeTool.Tree.Root; Node:=fCodeTool.Tree.Root;
@ -842,7 +840,6 @@ begin
finally finally
DeactivateGlobalWriteLock; DeactivateGlobalWriteLock;
fDefinedProcNames.Free; fDefinedProcNames.Free;
FuncNames.Free;
fFuncsToReplace.Free; fFuncsToReplace.Free;
end; end;
end; end;

106
converter/convertsettings.pas
View File

@ -33,7 +33,7 @@ uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, IDEProcs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, IDEProcs,
StdCtrls, EditBtn, Buttons, ExtCtrls, DialogProcs, LazarusIDEStrConsts, StdCtrls, EditBtn, Buttons, ExtCtrls, DialogProcs, LazarusIDEStrConsts,
CodeToolsStructs, AVL_Tree, BaseIDEIntf, LazConfigStorage, CodeToolsStructs, AVL_Tree, BaseIDEIntf, LazConfigStorage,
ButtonPanel, ReplaceNamesUnit; ButtonPanel, ReplaceNamesUnit, ReplaceFuncsUnit;
type type
@ -60,7 +60,7 @@ type
// Delphi types mapped to Lazarus types, will be replaced. // Delphi types mapped to Lazarus types, will be replaced.
fReplaceTypes: TStringToStringTree; fReplaceTypes: TStringToStringTree;
// Delphi global function names mapped to FCL/LCL functions. // Delphi global function names mapped to FCL/LCL functions.
fReplaceFuncs: TStringToStringTree; fReplaceFuncs: TStringList; // Objects property is used for data items.
// Getter / setter: // Getter / setter:
function GetBackupPath: String; function GetBackupPath: String;
procedure SetMainFilename(const AValue: String); procedure SetMainFilename(const AValue: String);
@ -96,7 +96,7 @@ type
property AutoRemoveProperties: boolean read fAutoRemoveProperties; property AutoRemoveProperties: boolean read fAutoRemoveProperties;
property ReplaceUnits: TStringToStringTree read fReplaceUnits; property ReplaceUnits: TStringToStringTree read fReplaceUnits;
property ReplaceTypes: TStringToStringTree read fReplaceTypes; property ReplaceTypes: TStringToStringTree read fReplaceTypes;
property ReplaceFuncs: TStringToStringTree read fReplaceFuncs; property ReplaceFuncs: TStringList read fReplaceFuncs;
end; end;
@ -136,7 +136,7 @@ implementation
{$R *.lfm} {$R *.lfm}
{ TConvertSettings } // Load and store configuration in StringToStringTree :
procedure LoadStringToStringTree(Config: TConfigStorage; const Path: string; procedure LoadStringToStringTree(Config: TConfigStorage; const Path: string;
Tree: TStringToStringTree); Tree: TStringToStringTree);
@ -148,7 +148,7 @@ var
i: Integer; i: Integer;
begin begin
Tree.Clear; Tree.Clear;
Cnt:=Config.GetValue(Path+'Count',0); Cnt:=Config.GetValue(Path+'Count', 0);
for i:=0 to Cnt-1 do begin for i:=0 to Cnt-1 do begin
SubPath:=Path+'Item'+IntToStr(i)+'/'; SubPath:=Path+'Item'+IntToStr(i)+'/';
CurName:=Config.GetValue(SubPath+'Name',''); CurName:=Config.GetValue(SubPath+'Name','');
@ -165,7 +165,7 @@ var
i, j: Integer; i, j: Integer;
SubPath: String; SubPath: String;
begin begin
Config.SetDeleteValue(Path+'Count',Tree.Tree.Count,0); Config.SetDeleteValue(Path+'Count', Tree.Tree.Count, 0);
Node:=Tree.Tree.FindLowest; Node:=Tree.Tree.FindLowest;
i:=0; i:=0;
while Node<>nil do begin while Node<>nil do begin
@ -183,6 +183,62 @@ begin
end; end;
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); constructor TConvertSettings.Create(const ATitle: string);
var var
TheMap: TStringToStringTree; TheMap: TStringToStringTree;
@ -199,7 +255,9 @@ begin
fMainPath:=''; fMainPath:='';
fReplaceUnits:=TStringToStringTree.Create(false); fReplaceUnits:=TStringToStringTree.Create(false);
fReplaceTypes:=TStringToStringTree.Create(false); fReplaceTypes:=TStringToStringTree.Create(false);
fReplaceFuncs:=TStringToStringTree.Create(false); fReplaceFuncs:=TStringList.Create;
fReplaceFuncs.Sorted:=True;
fReplaceFuncs.CaseSensitive:=False;
// Load settings from ConfigStorage. // Load settings from ConfigStorage.
fConfigStorage:=GetIDEConfigStorage('delphiconverter.xml', true); fConfigStorage:=GetIDEConfigStorage('delphiconverter.xml', true);
fBackupFiles :=fConfigStorage.GetValue('BackupFiles', true); fBackupFiles :=fConfigStorage.GetValue('BackupFiles', true);
@ -207,9 +265,9 @@ begin
fSameDFMFile :=fConfigStorage.GetValue('SameDFMFile', false); fSameDFMFile :=fConfigStorage.GetValue('SameDFMFile', false);
fAutoReplaceUnits :=fConfigStorage.GetValue('AutoReplaceUnits', true); fAutoReplaceUnits :=fConfigStorage.GetValue('AutoReplaceUnits', true);
fAutoRemoveProperties :=fConfigStorage.GetValue('AutoRemoveProperties', true); fAutoRemoveProperties :=fConfigStorage.GetValue('AutoRemoveProperties', true);
LoadStringToStringTree(fConfigStorage, 'ReplaceUnits/', fReplaceUnits); LoadStringToStringTree(fConfigStorage, 'UnitReplacements/', fReplaceUnits);
LoadStringToStringTree(fConfigStorage, 'ReplaceTypes/', fReplaceTypes); LoadStringToStringTree(fConfigStorage, 'TypeReplacements/', fReplaceTypes);
LoadStringToStringTree(fConfigStorage, 'ReplaceFuncs/', fReplaceFuncs); LoadFuncReplacements (fConfigStorage, 'FuncReplacements/', fReplaceFuncs);
// Add default values for string maps if ConfigStorage doesn't have them. // Add default values for string maps if ConfigStorage doesn't have them.
// Map Delphi units to Lazarus units. // Map Delphi units to Lazarus units.
@ -252,18 +310,20 @@ begin
MapReplacement('^TTnt(.+[^L][^X])$','T$1'); MapReplacement('^TTnt(.+[^L][^X])$','T$1');
// Map Delphi function names to FCL/LCL functions. // Map Delphi function names to FCL/LCL functions.
TheMap:=fReplaceFuncs; AddReplaceFunc(fReplaceFuncs, 'Other', 'ShellExecute',
MapReplacement('ShellExecute', 'if $3 match ":/" then OpenURL($3); OpenDocument($3)'); 'if $3 match ":/" then OpenURL($3); OpenDocument($3)', '', '');
// File name encoding. ToDo: add other similar funcs with UTF8 counterparts. // 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. // File functions using a handle.
MapReplacement('CreateFile', 'FileCreate($1)'); // in SysUtils AddReplaceFunc(fReplaceFuncs, 'Other', 'CreateFile', 'FileCreate($1)', '', 'SysUtils');
MapReplacement('GetFileSize', 'FileSize($1)'); // in SysUtils AddReplaceFunc(fReplaceFuncs, 'Other', 'GetFileSize', 'FileSize($1)' , '', 'SysUtils');
MapReplacement('ReadFile', 'FileRead($1)'); // in SysUtils AddReplaceFunc(fReplaceFuncs, 'Other', 'ReadFile', 'FileRead($1)' , '', 'SysUtils');
MapReplacement('CloseHandle', 'FileClose($1)'); // in SysUtils AddReplaceFunc(fReplaceFuncs, 'Other', 'CloseHandle', 'FileClose($1)' , '', 'SysUtils');
end; end;
destructor TConvertSettings.Destroy; destructor TConvertSettings.Destroy;
var
i: Integer;
begin begin
// Save possibly modified settings to ConfigStorage. // Save possibly modified settings to ConfigStorage.
fConfigStorage.SetDeleteValue('BackupFiles', fBackupFiles, true); fConfigStorage.SetDeleteValue('BackupFiles', fBackupFiles, true);
@ -271,11 +331,15 @@ begin
fConfigStorage.SetDeleteValue('SameDFMFile', fSameDFMFile, false); fConfigStorage.SetDeleteValue('SameDFMFile', fSameDFMFile, false);
fConfigStorage.SetDeleteValue('AutoReplaceUnits', fAutoReplaceUnits, false); fConfigStorage.SetDeleteValue('AutoReplaceUnits', fAutoReplaceUnits, false);
fConfigStorage.SetDeleteValue('AutoRemoveProperties', fAutoRemoveProperties, false); fConfigStorage.SetDeleteValue('AutoRemoveProperties', fAutoRemoveProperties, false);
SaveStringToStringTree(fConfigStorage, 'ReplaceUnits/', fReplaceUnits); SaveStringToStringTree(fConfigStorage, 'UnitReplacements/', fReplaceUnits);
SaveStringToStringTree(fConfigStorage, 'ReplaceTypes/', fReplaceTypes); SaveStringToStringTree(fConfigStorage, 'TypeReplacements/', fReplaceTypes);
SaveStringToStringTree(fConfigStorage, 'ReplaceFuncs/', fReplaceFuncs); SaveFuncReplacements (fConfigStorage, 'FuncReplacements/', fReplaceFuncs);
// Free stuff // Free stuff
fConfigStorage.Free; fConfigStorage.Free;
for i:=0 to fReplaceFuncs.Count-1 do begin
fReplaceFuncs.Objects[i].Free;
fReplaceFuncs.Objects[i]:=nil;
end;
fReplaceFuncs.Free; fReplaceFuncs.Free;
fReplaceTypes.Free; fReplaceTypes.Free;
fReplaceUnits.Free; fReplaceUnits.Free;
@ -471,7 +535,7 @@ end;
procedure TConvertSettingsForm.FuncReplacementsButtonClick(Sender: TObject); procedure TConvertSettingsForm.FuncReplacementsButtonClick(Sender: TObject);
begin begin
EditMap(fSettings.ReplaceFuncs, lisConvFuncsToReplace); EditFuncReplacements(fSettings.ReplaceFuncs, lisConvFuncsToReplace);
end; end;

94
converter/replacenamesunit.lfm
View File

@ -2,29 +2,29 @@ object ReplaceNamesForm: TReplaceNamesForm
Left = 314 Left = 314
Height = 472 Height = 472
Top = 438 Top = 438
Width = 343 Width = 433
Caption = 'Properties and Types to replace' Caption = 'Properties and Types to replace'
ClientHeight = 472 ClientHeight = 472
ClientWidth = 343 ClientWidth = 433
OnCreate = FormCreate OnCreate = FormCreate
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '0.9.29' LCLVersion = '0.9.29'
object Grid: TStringGrid object Grid: TStringGrid
Left = 0 Left = 0
Height = 434 Height = 421
Top = 0 Top = 0
Width = 343 Width = 433
Align = alClient Align = alClient
AutoFillColumns = True AutoFillColumns = True
ColCount = 2 ColCount = 2
Columns = < Columns = <
item item
Title.Caption = 'Delphi name' Title.Caption = 'Delphi name'
Width = 169 Width = 214
end end
item item
Title.Caption = 'New name' Title.Caption = 'New name'
Width = 170 Width = 215
end> end>
FixedCols = 0 FixedCols = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goEditing, goSmoothScroll] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goEditing, goSmoothScroll]
@ -34,73 +34,27 @@ object ReplaceNamesForm: TReplaceNamesForm
OnEditingDone = GridEditingDone OnEditingDone = GridEditingDone
OnSetEditText = GridSetEditText OnSetEditText = GridSetEditText
ColWidths = ( ColWidths = (
169 214
170 215
) )
end end
object BtnPanel: TPanel object ButtonPanel: TButtonPanel
Left = 0 Left = 6
Height = 38 Height = 39
Top = 434 Top = 427
Width = 343 Width = 421
Align = alBottom OKButton.Name = 'OKButton'
AutoSize = True OKButton.Caption = '&OK'
BevelOuter = bvNone OKButton.OnClick = btnOKClick
ClientHeight = 38 HelpButton.Name = 'HelpButton'
ClientWidth = 343 HelpButton.Caption = '&Help'
CloseButton.Name = 'CloseButton'
CloseButton.Caption = '&Close'
CloseButton.Enabled = False
CancelButton.Name = 'CancelButton'
CancelButton.Caption = 'Cancel'
TabOrder = 1 TabOrder = 1
object HelpButton: TBitBtn ShowButtons = [pbOK, pbCancel, pbHelp]
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
end end
object PopupMenu1: TPopupMenu object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup OnPopup = PopupMenu1Popup

170
converter/replacenamesunit.pas
View File

@ -6,31 +6,11 @@ interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Grids, Buttons, ExtCtrls, Menus, CodeToolsStructs, SynRegExpr, Grids, Buttons, ExtCtrls, Menus, ButtonPanel, CodeToolsStructs, SynRegExpr,
LazarusIDEStrConsts, ConverterTypes; LazarusIDEStrConsts, ConverterTypes;
type 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 }
TStringMapUpdater = class TStringMapUpdater = class
@ -59,22 +39,19 @@ type
{ TReplaceNamesForm } { TReplaceNamesForm }
TReplaceNamesForm = class(TForm) TReplaceNamesForm = class(TForm)
btnCancel: TBitBtn; ButtonPanel: TButtonPanel;
btnOK: TBitBtn;
BtnPanel: TPanel;
HelpButton: TBitBtn;
InsertRow1: TMenuItem; InsertRow1: TMenuItem;
DeleteRow1: TMenuItem; DeleteRow1: TMenuItem;
Grid: TStringGrid; Grid: TStringGrid;
PopupMenu1: TPopupMenu; PopupMenu1: TPopupMenu;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure InsertRow1Click(Sender: TObject); procedure InsertRow1Click(Sender: TObject);
procedure DeleteRow1Click(Sender: TObject); procedure DeleteRow1Click(Sender: TObject);
procedure GridEditingDone(Sender: TObject); procedure GridEditingDone(Sender: TObject);
procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer; procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string); const Value: string);
procedure btnOKClick(Sender: TObject); procedure btnOKClick(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
private private
IsLasRow: Boolean; IsLasRow: Boolean;
public public
@ -156,144 +133,6 @@ begin
end; 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 } { TStringMapUpdater }
constructor TStringMapUpdater.Create(AStringsMap: TStringToStringTree); constructor TStringMapUpdater.Create(AStringsMap: TStringToStringTree);
@ -383,9 +222,6 @@ end;
procedure TReplaceNamesForm.FormCreate(Sender: TObject); procedure TReplaceNamesForm.FormCreate(Sender: TObject);
begin begin
Caption:=lisReplacements; Caption:=lisReplacements;
btnOK.Caption:=lisOk;
HelpButton.Caption:=lisMenuHelp;
btnCancel.Caption:=dlgCancel;
IsLasRow:=false; IsLasRow:=false;
end; end;

1
ide/lazarusidestrconsts.pas
View File

@ -483,6 +483,7 @@ resourcestring
lisProperties = 'Properties (replace or delete)'; lisProperties = 'Properties (replace or delete)';
lisTypes = 'Types (not removed if no replacement)'; lisTypes = 'Types (not removed if no replacement)';
lisReplaceRemoveUnknown = 'Fix unknown properties and types'; lisReplaceRemoveUnknown = 'Fix unknown properties and types';
lisReplacementFuncs = 'Replacement functions';
lisUnableToLoadOldResourceFileTheResourceFileIs = 'Unable to load old ' lisUnableToLoadOldResourceFileTheResourceFileIs = 'Unable to load old '
+'resource file.%sThe resource file is the first include file in the%' +'resource file.%sThe resource file is the first include file in the%'