paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-02-19 18:36:42 +01:00
Code Issues Packages Projects Releases Wiki Activity

Converter: Convert dotted unit names. Optimization. Issue #40979.

Browse Source
This commit is contained in:
Juha 2026-02-18 08:33:26 +02:00
parent 92283f0312
commit aa15430072
4 changed files with 96 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
converter/convcodetool.pas
View File

@ -390,7 +390,7 @@ function TConvDelphiCodeTool.FixMainClassAncestor(const AClassName: string;
// Replace the ancestor type of main form with a fall-back type if needed.
var
ANode, InheritanceNode: TCodeTreeNode;
TypeUpdater: TStringMapUpdater;
TypeUpdater: TNameUpdater;
OldType, NewType: String;
begin
Result:=false;
@ -410,7 +410,7 @@ begin
ReadNextAtom;
OldType:=GetAtom;
end;
TypeUpdater:=TStringMapUpdater.Create(AReplaceTypes);
TypeUpdater:=TNameUpdater.Create(AReplaceTypes);
try
// Find replacement for ancestor type maybe using regexp syntax.
if TypeUpdater.FindReplacement(OldType, NewType) then begin

5
converter/convertsettings.pas
View File

@ -497,6 +497,11 @@ begin
TheMap:=fReplaceUnits;
LoadStringToStringTree('UnitReplacements/', TheMap);
// Add default values for configuration if ConfigStorage doesn't have them
// Remove the first part of dotted unit names.
MapReplacement('^Winapi\.(.+)', '$1'); // Windows units.
MapReplacement('^System\.(.+)', '$1');
MapReplacement('^Vcl\.(.+)', '$1');
// Windows specifig types need special treatment.
MapReplacement('Windows', 'LCLIntf, LCLType, LMessages');
MapReplacement('WinTypes', 'LCLIntf, LCLType, LMessages');
MapReplacement('WinProcs', 'LCLIntf, LCLType, LMessages');

121
converter/replacenamesunit.pas
View File

@ -5,7 +5,7 @@ unit ReplaceNamesUnit;
interface
uses
Classes, SysUtils, RegExpr,
Classes, SysUtils, StrUtils, RegExpr, AVL_Tree,
// LCL
Forms, Controls, Dialogs, Grids, Menus, ButtonPanel,
// LazUtils
@ -20,19 +20,29 @@ type
TStringMapUpdater = class
private
fStringToStringMap: TStringToStringTree;
fSeenNames: TStringMap;
fMapNames: TStringList; // Names (keys) in fStringToStringMap.
fNoReplacementNames: TStringMap;
public
constructor Create(AStringToStringMap: TStringToStringTree);
destructor Destroy; override;
function FindReplacement(AIdent: string; out AReplacement: string): boolean;
end;
{ TNameUpdater }
TNameUpdater = class(TStringMapUpdater)
public
//constructor Create(AStringToStringMap: TStringToStringTree);
//destructor Destroy; override;
end;
{ TGridUpdater }
TGridUpdater = class(TStringMapUpdater)
private
fGrid: TStringGrid;
GridEndInd: Integer;
fSeenNames: TStringMap;
fGridEndInd: Integer;
public
constructor Create(AStringToStringMap: TStringToStringTree; AGrid: TStringGrid);
destructor Destroy; override;
@ -198,18 +208,36 @@ begin
end;
end;
procedure GetMapNames(Map: TStringToStringTree; List: TStrings);
var
Node: TAvlTreeNode;
Item: PStringMapItem;
begin
Node:=Map.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringMapItem(Node.Data);
if EndsStr('\.(.+)', Item^.Name) then
List.Insert(0, Item^.Name) // Put RegExp for dotted unit names first.
else
List.Add(Item^.Name);
Node:=Node.Successor;
end;
end;
{ TStringMapUpdater }
constructor TStringMapUpdater.Create(AStringToStringMap: TStringToStringTree);
begin
fStringToStringMap:=AStringToStringMap;
fSeenNames:=TStringMap.Create(False);
fMapNames:=TStringList.Create;
GetMapNames(fStringToStringMap, fMapNames);
fNoReplacementNames:=TStringMap.Create(False);
end;
destructor TStringMapUpdater.Destroy;
begin
fSeenNames.Free;
fNoReplacementNames.Free;
fMapNames.Free;
inherited Destroy;
end;
@ -218,53 +246,72 @@ function TStringMapUpdater.FindReplacement(AIdent: string;
// Try to find a matching replacement using regular expression.
var
RE: TRegExpr;
MapNames: TStringList; // Names (keys) in fStringToStringMap.
i: Integer;
Key: string;
IsDotted: Boolean;
begin
if fStringToStringMap.Contains(AIdent) then begin
AReplacement:=fStringToStringMap[AIdent];
Result:=true;
end
else begin // Not found by name, try regexp.
Result:=false;
AReplacement:='';
RE:=TRegExpr.Create;
MapNames:=TStringList.Create;
try
RE.ModifierI:=True;
fStringToStringMap.GetNames(MapNames);
for i:=0 to MapNames.Count-1 do begin
Key:=MapNames[i]; // fMapNames has names extracted from fStringToStringMap.
// If key contains special chars, assume it is a regexp.
if (Pos('(',Key)>0) or (Pos('*',Key)>0) or (Pos('+',Key)>0) then begin
RE.Expression:=Key;
if RE.Exec(AIdent) then begin // Match with regexp.
AReplacement:=RE.Substitute(fStringToStringMap[Key]);
Result:=true;
Break;
Result:=false;
AReplacement:='';
if fNoReplacementNames.Contains(AIdent) then // Already tried, no replacement.
exit;
repeat
IsDotted:=False;
if fStringToStringMap.Contains(AIdent) then begin
AReplacement:=fStringToStringMap[AIdent];
Result:=true;
end
else begin // Not found by name, try RegExp.
RE:=TRegExpr.Create;
try
RE.ModifierI:=True;
for i:=0 to fMapNames.Count-1 do begin
Key:=fMapNames[i]; // fMapNames has names extracted from fStringToStringMap.
// If key contains special chars, assume it is a RegExp.
if (Pos('(',Key)>0) or (Pos('*',Key)>0) or (Pos('+',Key)>0) then begin
RE.Expression:=Key;
if RE.Exec(AIdent) then begin // Match with RegExp.
Result:=true;
AReplacement:=RE.Substitute(fStringToStringMap[Key]);
AIdent:=AReplacement; // Continue with the replacement if first part
IsDotted:=EndsStr('\.(.+)', Key); // of dotted name was stripped.
Break;
end;
end;
end;
finally
RE.Free;
end;
finally
MapNames.Free;
RE.Free;
end;
end;
until not IsDotted;
if not Result then
fNoReplacementNames.Add(AIdent); // Means AOldIdent had no replacement.
end;
{ TNameUpdater }
{
constructor TNameUpdater.Create(AStringToStringMap: TStringToStringTree);
begin
inherited;
end;
destructor TNameUpdater.Destroy;
begin
inherited Destroy;
end;
}
{ TGridUpdater }
constructor TGridUpdater.Create(AStringToStringMap: TStringToStringTree; AGrid: TStringGrid);
begin
inherited Create(AStringToStringMap);
fGrid:=AGrid;
GridEndInd:=1;
fSeenNames:=TStringMap.Create(False);
fGridEndInd:=1;
end;
destructor TGridUpdater.Destroy;
begin
fSeenNames.Free;
inherited Destroy;
end;
@ -276,11 +323,11 @@ begin
// Add only one instance of each name.
fSeenNames.Add(AOldIdent);
FindReplacement(AOldIdent, Result);
if fGrid.RowCount<GridEndInd+1 then
fGrid.RowCount:=GridEndInd+1;
fGrid.Cells[0,GridEndInd]:=AOldIdent;
fGrid.Cells[1,GridEndInd]:=Result;
Inc(GridEndInd);
if fGrid.RowCount<fGridEndInd+1 then
fGrid.RowCount:=fGridEndInd+1;
fGrid.Cells[0,fGridEndInd]:=AOldIdent;
fGrid.Cells[1,fGridEndInd]:=Result;
Inc(fGridEndInd);
end
else
Result:='';

9
converter/usedunits.pas
View File

@ -67,7 +67,7 @@ type
fMissingUnits: TStringList; // Units not found in search path.
function FindMissingUnits: boolean;
procedure ToBeRenamedOrRemoved(AOldName, ANewName: string);
procedure FindReplacement(AUnitUpdater: TStringMapUpdater;
procedure FindReplacement(AUnitUpdater: TNameUpdater;
AMapToEdit: TStringToStringTree);
function AddDelphiAndLCLSections: Boolean;
function RemoveUnits: boolean;
@ -337,7 +337,7 @@ begin
end;
end;
procedure TUsedUnits.FindReplacement(AUnitUpdater: TStringMapUpdater;
procedure TUsedUnits.FindReplacement(AUnitUpdater: TNameUpdater;
AMapToEdit: TStringToStringTree);
var
i: integer;
@ -586,7 +586,7 @@ function TUsedUnitsTool.Prepare: TModalResult;
// Find missing units and mark some of them to be replaced later.
// More units can be marked for add, remove, rename and comment during conversion.
var
UnitUpdater: TStringMapUpdater;
UnitUpdater: TNameUpdater;
MapToEdit: TStringToStringTree;
Node: TAVLTreeNode;
Item: PStringToStringItem;
@ -597,12 +597,13 @@ begin
// Add unit 'Interfaces' if project uses 'Forms' and doesn't have 'Interfaces' yet.
if fIsMainFile then begin
if ( fMainUsedUnits.fExistingUnits.Find('forms', i)
or fMainUsedUnits.fExistingUnits.Find('Vcl.Forms', i)
or fImplUsedUnits.fExistingUnits.Find('forms', i) )
and (not fMainUsedUnits.fExistingUnits.Find('interfaces', i) )
and (not fImplUsedUnits.fExistingUnits.Find('interfaces', i) ) then
fMainUsedUnits.fUnitsToAddForLCL.Add('Interfaces');
end;
UnitUpdater:=TStringMapUpdater.Create(fCTLink.Settings.ReplaceUnits);
UnitUpdater:=TNameUpdater.Create(fCTLink.Settings.ReplaceUnits);
try
MapToEdit:=Nil;
if fCTLink.Settings.UnitsReplaceMode=rlInteractive then