paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 05:09:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

Converter: Regexp syntax for used unit replacements. Refactoring code for it.

Browse Source 
git-svn-id: trunk@24576 -
This commit is contained in:
juha 2010-04-11 11:39:54 +00:00
parent ad2406418f
commit b81f0445eb
5 changed files with 196 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
converter/convcodetool.pas
View File

@ -41,20 +41,18 @@ type
fUnitsToRename: TStringToStringTree;
// List of units to be commented.
fUnitsToComment: TStringList;
// Map of class member object types to be renamed in ReplaceMemberTypes.
fMemberTypesToRename: TStringToStringTree;
function AddDelphiAndLCLSections: boolean;
function AddModeDelphiDirective: boolean;
function RenameResourceDirectives: boolean;
function RemoveUnits: boolean;
function RenameUnits: boolean;
function CommentOutUnits: boolean;
function HandleCodetoolError: TModalResult;
public
constructor Create(Code: TCodeBuffer);
destructor Destroy; override;
function Convert: TModalResult;
function ReplaceMemberTypes(AClassName: string): boolean;
function RemoveUnits: boolean;
function RenameUnits: boolean;
function UsesSectionsToUnitnames: TStringList;
public
property Ask: Boolean read fAsk write fAsk;
property UseBothDfmAndLfm: boolean read fUseBothDfmAndLfm write fUseBothDfmAndLfm;
@ -64,8 +62,6 @@ type
property UnitsToRemove: TStringList read fUnitsToRemove write fUnitsToRemove;
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
property MemberTypesToRename: TStringToStringTree read fMemberTypesToRename
write fMemberTypesToRename;
end;
implementation
@ -83,7 +79,6 @@ begin
fUnitsToRemove:=nil; // These are set from outside.
fUnitsToComment:=nil;
fUnitsToRename:=nil;
fMemberTypesToRename:=nil;
// Initialize codetools. (Copied from TCodeToolManager.)
if not CodeToolBoss.InitCurCodeTool(fCode) then exit;
try
@ -376,12 +371,20 @@ begin
Result:=true;
end;
function TConvDelphiCodeTool.ReplaceMemberTypes(AClassName: string): boolean;
// Replace types of class object members.
function TConvDelphiCodeTool.UsesSectionsToUnitnames: TStringList;
// Collect all unit names from uses sections to a StringList.
var
UsesNode: TCodeTreeNode;
ImplList: TStrings;
begin
// CodeToolBoss.RetypeClassVariables();
Result:=fCodeTool.RetypeClassVariables(AClassName, fMemberTypesToRename,
false, fSrcCache);
fCodeTool.BuildTree(true);
fSrcCache.MainScanner:=fCodeTool.Scanner;
UsesNode:=fCodeTool.FindMainUsesSection;
Result:=TStringList(fCodeTool.UsesSectionToUnitnames(UsesNode));
UsesNode:=fCodeTool.FindImplementationUsesSection;
ImplList:=fCodeTool.UsesSectionToUnitnames(UsesNode);
Result.AddStrings(ImplList);
ImplList.Free;
end;

47
converter/convertdelphi.pas
View File

@ -43,7 +43,7 @@ uses
// IDE
IDEProcs, Project, DialogProcs,
EditorOptions, CompilerOptions, PackageDefs, PackageSystem,
PackageEditor, BasePkgManager, LazarusIDEStrConsts,
PackageEditor, BasePkgManager, LazarusIDEStrConsts, ReplaceNamesUnit,
ConvertSettings, ConvCodeTool, MissingUnits, MissingPropertiesDlg;
const
@ -590,7 +590,9 @@ begin
finally
LfmFixer.Free;
end;
// save LFM file
// save source and LFM files
Result:=SaveCodeBufferToFile(fPascalBuffer,fPascalBuffer.Filename);
if Result<>mrOk then exit;
Result:=SaveCodeBufferToFile(fLFMBuffer,fLFMBuffer.Filename);
if Result<>mrOk then exit;
end;
@ -715,18 +717,28 @@ end;
function TConvertDelphiUnit.FixMissingUnits: TModalResult;
var
UnitUpdater: TStringMapUpdater;
ConvTool: TConvDelphiCodeTool;
UnitNames: TStringList;
CTResult: Boolean;
i: Integer;
UnitN, s: string;
i, d: Integer;
UnitN, FN, s: string;
begin
Result:=mrOk;
UnitUpdater:=TStringMapUpdater.Create(fSettings.ReplaceUnits);
ConvTool:=TConvDelphiCodeTool.Create(fPascalBuffer);
UnitNames:=nil; // Will be created in ConvTool.UsesSectionsToUnitnames.
fMissingUnits:=nil; // Will be created in CodeToolBoss.FindMissingUnits.
try
// Collect all unit names from uses sections.
UnitNames:=ConvTool.UsesSectionsToUnitnames;
UnitNames.Sorted:=true;
s:=UnitNames.Text;
// find missing units
CTResult:=CodeToolBoss.FindMissingUnits(fPascalBuffer,fMissingUnits,true);
if not CTResult then begin
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
Application.ProcessMessages;
Result:=mrCancel;
exit;
end;
// no missing units -> good
@ -735,9 +747,8 @@ begin
// Remove or replace units defined in settings.
for i:=fMissingUnits.Count-1 downto 0 do begin
UnitN:=fMissingUnits[i];
if fSettings.ReplaceUnits.Contains(UnitN) then begin
s:=fSettings.ReplaceUnits[UnitN];
if s<>'' then begin
if UnitUpdater.FindReplacement(UnitN, s) then begin
if (s<>'') and not UnitNames.Find(s, d) then begin
fUnitsToRename[UnitN]:=s;
IDEMessagesWindow.AddMsg(Format(
'Replaced unit "%s" with "%s" in uses section.',[UnitN, s]),'',-1);
@ -747,9 +758,23 @@ begin
IDEMessagesWindow.AddMsg(Format(
'Removed used unit "%s" in uses section.',[UnitN]),'',-1);
end;
fMissingUnits.Delete(i);
end;
end;
// Remove and rename missing units. More of them may be added later.
ConvTool.UnitsToRename:=fUnitsToRename;
ConvTool.UnitsToRemove:=fUnitsToRemove;
ConvTool.RenameUnits;
ConvTool.RemoveUnits;
fUnitsToRename.Clear;
fUnitsToRemove.Clear;
// Find missing units again. Some replacements may not be valid.
fMissingUnits.Clear;
CTResult:=CodeToolBoss.FindMissingUnits(fPascalBuffer,fMissingUnits,true);
if not CTResult then begin
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
Result:=mrCancel;
exit;
end;
if fMissingUnits.Count=0 then exit;
if Assigned(fOwnerConverter) then begin
@ -769,6 +794,9 @@ begin
Application.ProcessMessages;
finally
fMissingUnits.Free;
UnitNames.Free;
ConvTool.Free;
UnitUpdater.Free;
end;
end;
@ -854,6 +882,7 @@ begin
// load required packages
AddPackageDependency('LCL');// Nearly all Delphi projects require it
AddPackageDependency('virtualtreeview_package'); //!!!
if fProjPack is TProject then
PkgBoss.AddDefaultDependencies(fProjPack as TProject);
CustomDefinesChanged;

45
converter/convertsettings.pas
View File

@ -147,17 +147,10 @@ begin
fReplaceUnits['Windows']:='LCLIntf, LCLType, LMessages';
fReplaceUnits['Variants']:='';
fReplaceUnits['ShellApi']:='';
fReplaceUnits['TntActnList']:='ActnList';
fReplaceUnits['TntMenus']:='Menus';
fReplaceUnits['TntClasses']:='Classes';
fReplaceUnits['TntForms']:='Forms';
fReplaceUnits['TntComCtrls']:='ComCtrls';
fReplaceUnits['TntStdCtrls']:='StdCtrls';
fReplaceUnits['TntExtCtrls']:='ExtCtrls';
fReplaceUnits['TntSysUtils']:='SysUtils';
fReplaceUnits['pngImage']:='';
fReplaceUnits['Jpeg']:='';
fReplaceUnits['gifimage']:='';
fReplaceUnits['^Tnt(.+)']:='$1';
// Map Delphi types to LCL types.
fReplaceTypes:=TStringToStringTree.Create(false);
@ -171,7 +164,7 @@ begin
fReplaceTypes['TDBRichEdit']:='TDBMemo';
fReplaceTypes['TApplicationEvents']:='TApplicationProperties';
fReplaceTypes['TPNGObject']:='TPortableNetworkGraphic';
fReplaceTypes['TTnt(.+)']:='T$1';
fReplaceTypes['^TTnt(.+)']:='T$1';
end;
@ -354,31 +347,37 @@ end;
procedure TConvertSettingsForm.UnitReplacementsButtonClick(Sender: TObject);
var
ReplaceNamesForm: TReplaceNamesForm;
RNForm: TReplaceNamesForm;
GridUpdater: TGridUpdater;
begin
ReplaceNamesForm:=TReplaceNamesForm.Create(nil);
RNForm:=TReplaceNamesForm.Create(nil);
GridUpdater:=TGridUpdater.Create(fSettings.ReplaceUnits, RNForm.NamePairGrid);
try
ReplaceNamesForm.Caption:=lisConvUnitsToReplace;
CopyFromMapToGrid(ReplaceNamesForm.NamePairGrid, fSettings.ReplaceUnits);
if ReplaceNamesForm.ShowModal=mrOK then
CopyFromGridToMap(ReplaceNamesForm.NamePairGrid, fSettings.ReplaceUnits);
RNForm.Caption:=lisConvUnitsToReplace;
GridUpdater.MapToGrid;
if RNForm.ShowModal=mrOK then
GridUpdater.GridToMap;
finally
ReplaceNamesForm.Free;
GridUpdater.Free;
RNForm.Free;
end;
end;
procedure TConvertSettingsForm.TypeReplacementsButtonClick(Sender: TObject);
var
ReplaceNamesForm: TReplaceNamesForm;
RNForm: TReplaceNamesForm;
GridUpdater: TGridUpdater;
begin
ReplaceNamesForm:=TReplaceNamesForm.Create(nil);
RNForm:=TReplaceNamesForm.Create(nil);
GridUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, RNForm.NamePairGrid);
try
ReplaceNamesForm.Caption:=lisConvTypesToReplace;
CopyFromMapToGrid(ReplaceNamesForm.NamePairGrid, fSettings.ReplaceTypes);
if ReplaceNamesForm.ShowModal=mrOK then
CopyFromGridToMap(ReplaceNamesForm.NamePairGrid, fSettings.ReplaceTypes);
RNForm.Caption:=lisConvTypesToReplace;
GridUpdater.MapToGrid;
if RNForm.ShowModal=mrOK then
GridUpdater.GridToMap;
finally
ReplaceNamesForm.Free;
GridUpdater.Free;
RNForm.Free;
end;
end;

34
converter/missingpropertiesdlg.pas
View File

@ -40,9 +40,9 @@ uses
// codetools
BasicCodeTools, CodeCache, CodeToolManager, CodeToolsStructs,
// IDE
IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf, DialogProcs,
CustomFormEditor, LazarusIDEStrConsts, IDEProcs, OutputFilter,
EditorOptions, ConvertSettings, ConvCodeTool, ReplaceNamesUnit, CheckLFMDlg;
EditorOptions, ConvertSettings, ReplaceNamesUnit, CheckLFMDlg;
type
@ -225,7 +225,6 @@ end;
function TLFMFixer.ReplaceAndRemoveAll: TModalResult;
var
ConvTool: TConvDelphiCodeTool;
CurError: TLFMError;
TheNode: TLFMTreeNode;
ObjNode: TLFMObjectNode;
@ -233,15 +232,17 @@ var
NameReplacements: TStringToStringTree;
// List of TLFMChangeEntry objects.
ChgEntryRepl: TObjectList;
GridUpdater: TGridUpdater;
OldIdent, NewIdent: string;
StartPos, EndPos: integer;
begin
Result:=mrNone;
Result:=mrOK;
ChgEntryRepl:=TObjectList.Create;
NameReplacements:=TStringToStringTree.Create(false);
GridUpdater:=TGridUpdater.Create(NameReplacements, fPropReplaceGrid);
try
// Collect (maybe edited) properties from StringGrid to NameReplacements.
CopyFromGridToMap(fPropReplaceGrid, NameReplacements);
GridUpdater.GridToMap;
// Replace each missing property / type or delete it if no replacement.
CurError:=fLFMTree.LastError;
while CurError<>nil do begin
@ -274,19 +275,18 @@ begin
end;
CurError:=CurError.PrevError;
end;
// Apply replacements to LFM.
if ApplyReplacements(ChgEntryRepl) then begin
// Replace the object member types also to pascal source.
ConvTool:=TConvDelphiCodeTool.Create(fPascalBuffer);
try
ConvTool.MemberTypesToRename:=NameReplacements;
ConvTool.ReplaceMemberTypes(TLFMObjectNode(fLFMTree.Root).TypeName);
finally
ConvTool.Free;
end;
Result:=mrOk;
// Apply replacement types also to pascal source.
if not CodeToolBoss.RetypeClassVariables(fPascalBuffer,
TLFMObjectNode(fLFMTree.Root).TypeName, NameReplacements, false)
then begin
Result:=mrCancel;
exit;
end;
// Apply replacements to LFM.
if not ApplyReplacements(ChgEntryRepl) then
Result:=mrCancel;
finally
GridUpdater.Free;
NameReplacements.Free;
ChgEntryRepl.Free;
end;
@ -299,7 +299,7 @@ var
OldIdent: string;
begin
fHasMissingObjectTypes:=false;
GridUpdater:=TGridUpdater.Create(fPropReplaceGrid, fSettings.ReplaceTypes);
GridUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, fPropReplaceGrid);
try
if fLFMTree<>nil then begin
CurError:=fLFMTree.FirstError;

176
converter/replacenamesunit.pas
View File

@ -10,20 +10,31 @@ uses
type
{ TStringMapUpdater }
TStringMapUpdater = class
private
fStringMap: TStringToStringTree;
fMapNames: TStringList; // Names (keys) in fStringMap.
fSeenName: TStringList;
public
constructor Create(AStringMap: TStringToStringTree);
destructor Destroy; override;
function FindReplacement(AIdent: string; out AReplacement: string): boolean;
end;
{ TGridUpdater }
TGridUpdater = class
TGridUpdater = class(TStringMapUpdater)
private
fGrid: TStringGrid;
fReplaceMap: TStringToStringTree;
fNameList: TStringList; // Names (keys) in fReplaceMap.
fSeenName: TStringList;
GridEndInd: Integer;
function FindReplacement(AIdent: string): string;
public
constructor Create(AGrid: TStringGrid; AReplaceMap: TStringToStringTree);
constructor Create(AStringMap: TStringToStringTree; AGrid: TStringGrid);
destructor Destroy; override;
procedure AddUnique(AOldIdent: string);
procedure MapToGrid;
procedure GridToMap;
end;
{ TReplaceNamesForm }
@ -45,15 +56,81 @@ type
var
ReplaceNamesForm: TReplaceNamesForm;
procedure CopyFromMapToGrid(AGrid: TStringGrid; AMap: TStringToStringTree);
procedure CopyFromGridToMap(AGrid: TStringGrid; AMap: TStringToStringTree);
implementation
{$R *.lfm}
procedure CopyFromMapToGrid(AGrid: TStringGrid; AMap: TStringToStringTree);
{ TStringMapUpdater }
constructor TStringMapUpdater.Create(AStringMap: TStringToStringTree);
begin
fStringMap:=AStringMap;
fMapNames:=TStringList.Create;
fStringMap.GetNames(fMapNames);
fSeenName:=TStringList.Create;
end;
destructor TStringMapUpdater.Destroy;
begin
fSeenName.Free;
fMapNames.Free;
inherited Destroy;
end;
function TStringMapUpdater.FindReplacement(AIdent: string;
out AReplacement: string): boolean;
// Try to find a matching replacement using regular expression.
var
RE: TRegExpr;
i: Integer;
Key: string;
begin
if fStringMap.Contains(AIdent) then begin
AReplacement:=fStringMap[AIdent];
Result:=true;
end
else begin // Not found by name, try regexp.
Result:=false;
AReplacement:='';
RE:=TRegExpr.Create;
try
for i:=0 to fMapNames.Count-1 do begin
Key:=fMapNames[i]; // fMapNames has extracted keys from fStringMap.
// If key contains '(' assume it is a regexp.
if Pos('(', Key)>0 then begin
RE.Expression:=Key;
if RE.Exec(AIdent) then begin // Match with regexp.
AReplacement:=RE.Substitute(fStringMap[Key]);
Result:=true;
Break;
end;
end;
end;
finally
RE.Free;
end;
end;
end;
{ TGridUpdater }
constructor TGridUpdater.Create(AStringMap: TStringToStringTree; AGrid: TStringGrid);
begin
inherited Create(AStringMap);
fGrid:=AGrid;
GridEndInd:=1;
fGrid.BeginUpdate;
end;
destructor TGridUpdater.Destroy;
begin
fGrid.EndUpdate;
inherited Destroy;
end;
procedure TGridUpdater.MapToGrid;
var
OldIdent, NewIdent: string;
List: TStringList;
@ -62,80 +139,33 @@ begin
// Collect (maybe edited) properties from StringGrid to NameReplacements.
List:=TStringList.Create;
try
AGrid.BeginUpdate;
AMap.GetNames(List);
fGrid.BeginUpdate;
fStringMap.GetNames(List);
for i:=0 to List.Count-1 do begin
OldIdent:=List[i];
NewIdent:=AMap[OldIdent];
if AGrid.RowCount<i+1 then
AGrid.RowCount:=i+1;
AGrid.Cells[0,i]:=OldIdent;
AGrid.Cells[1,i]:=NewIdent;
NewIdent:=fStringMap[OldIdent];
if fGrid.RowCount<i+1 then
fGrid.RowCount:=i+1;
fGrid.Cells[0,i]:=OldIdent;
fGrid.Cells[1,i]:=NewIdent;
end;
AGrid.EndUpdate;
fGrid.EndUpdate;
finally
List.Free;
end;
end;
procedure CopyFromGridToMap(AGrid: TStringGrid; AMap: TStringToStringTree);
procedure TGridUpdater.GridToMap;
var
OldIdent, NewIdent: string;
i: Integer;
begin
// Collect (maybe edited) properties from StringGrid to NameReplacements.
for i:=1 to AGrid.RowCount-1 do begin // Skip the fixed row.
OldIdent:=AGrid.Cells[0,i];
NewIdent:=AGrid.Cells[1,i];
for i:=1 to fGrid.RowCount-1 do begin // Skip the fixed row.
OldIdent:=fGrid.Cells[0,i];
NewIdent:=fGrid.Cells[1,i];
if NewIdent<>'' then
AMap[OldIdent]:=NewIdent;
end;
end;
{ TGridUpdater }
constructor TGridUpdater.Create(AGrid: TStringGrid; AReplaceMap: TStringToStringTree);
begin
fGrid:=AGrid;
fReplaceMap:=AReplaceMap;
fNameList:=TStringList.Create;
fReplaceMap.GetNames(fNameList);
fSeenName:=TStringList.Create;
GridEndInd:=1;
fGrid.BeginUpdate;
end;
destructor TGridUpdater.Destroy;
begin
fGrid.EndUpdate;
fSeenName.Free;
fNameList.Free;
inherited Destroy;
end;
function TGridUpdater.FindReplacement(AIdent: string): string;
// Try to find a matching replacement using regular expression.
var
RE: TRegExpr;
i: Integer;
s: string;
begin
Result:='';
RE:=TRegExpr.Create;
try
for i:=0 to fNameList.Count-1 do begin
s:=fNameList[i]; // NameList has extracted keys from fReplaceMap.
// If key contains '(' assume it is a regexp.
if Pos('(', s)>0 then begin
RE.Expression:=s;
if RE.Exec(AIdent) then begin // Match with regexp.
Result:=RE.Substitute(fReplaceMap[s]);
Break;
end;
end;
end;
finally
RE.Free;
fStringMap[OldIdent]:=NewIdent;
end;
end;
@ -147,9 +177,7 @@ begin
// Add only one instance of each property name.
if fSeenName.IndexOf(AOldIdent)<0 then begin
fSeenName.Append(AOldIdent);
NewIdent:=fReplaceMap[AOldIdent];
if NewIdent='' then // Not found by name, try regexp.
NewIdent:=FindReplacement(AOldIdent);
FindReplacement(AOldIdent, NewIdent);
if fGrid.RowCount<GridEndInd+1 then
fGrid.RowCount:=GridEndInd+1;
fGrid.Cells[0,GridEndInd]:=AOldIdent;
@ -158,6 +186,7 @@ begin
end;
end;
{ TReplaceNamesForm }
procedure TReplaceNamesForm.FormCreate(Sender: TObject);
@ -170,5 +199,6 @@ begin
ModalResult:=mrOK;
end;
end.