mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-04 07:42:59 +02:00
Replace class member object types also to pascal source buffer.
git-svn-id: trunk@24223 -
This commit is contained in:
parent
afdba5afae
commit
ca0b3c395b
@ -43,6 +43,8 @@ type
|
|||||||
fUnitsToAdd: TStringList;
|
fUnitsToAdd: TStringList;
|
||||||
// List of units to be commented.
|
// List of units to be commented.
|
||||||
fUnitsToComment: TStringList;
|
fUnitsToComment: TStringList;
|
||||||
|
// Map of class member object types to be renamed in ReplaceMemberTypes.
|
||||||
|
fMemberTypesToRename: TStringList; // TStringToStringTree;
|
||||||
function AddDelphiAndLCLSections: boolean;
|
function AddDelphiAndLCLSections: boolean;
|
||||||
function AddModeDelphiDirective: boolean;
|
function AddModeDelphiDirective: boolean;
|
||||||
function RenameResourceDirectives: boolean;
|
function RenameResourceDirectives: boolean;
|
||||||
@ -55,6 +57,7 @@ type
|
|||||||
constructor Create(Code: TCodeBuffer);
|
constructor Create(Code: TCodeBuffer);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
function Convert: TModalResult;
|
function Convert: TModalResult;
|
||||||
|
function ReplaceMemberTypes(AClassName: string): boolean;
|
||||||
public
|
public
|
||||||
property Ask: Boolean read fAsk write fAsk;
|
property Ask: Boolean read fAsk write fAsk;
|
||||||
property UseBothDfmAndLfm: boolean read fUseBothDfmAndLfm write fUseBothDfmAndLfm;
|
property UseBothDfmAndLfm: boolean read fUseBothDfmAndLfm write fUseBothDfmAndLfm;
|
||||||
@ -65,6 +68,8 @@ type
|
|||||||
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
|
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
|
||||||
property UnitsToAdd: TStringList read fUnitsToAdd write fUnitsToAdd;
|
property UnitsToAdd: TStringList read fUnitsToAdd write fUnitsToAdd;
|
||||||
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
|
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
|
||||||
|
property MemberTypesToRename: TStringList read fMemberTypesToRename
|
||||||
|
write fMemberTypesToRename;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -81,6 +86,7 @@ begin
|
|||||||
fTarget:=ctLazarus;
|
fTarget:=ctLazarus;
|
||||||
fUnitsToComment:=nil;
|
fUnitsToComment:=nil;
|
||||||
fUnitsToRename:=nil;
|
fUnitsToRename:=nil;
|
||||||
|
fMemberTypesToRename:=nil;
|
||||||
// Initialize codetools. (Copied from TCodeToolManager.)
|
// Initialize codetools. (Copied from TCodeToolManager.)
|
||||||
if not CodeToolBoss.InitCurCodeTool(fCode) then exit;
|
if not CodeToolBoss.InitCurCodeTool(fCode) then exit;
|
||||||
try
|
try
|
||||||
@ -134,7 +140,6 @@ begin
|
|||||||
finally
|
finally
|
||||||
fSrcCache.EndUpdate;
|
fSrcCache.EndUpdate;
|
||||||
end;
|
end;
|
||||||
// This adds units to add, remove and rename if Delphi compat is not required.
|
|
||||||
if not AddDelphiAndLCLSections then exit;
|
if not AddDelphiAndLCLSections then exit;
|
||||||
if not RemoveUnits then exit;
|
if not RemoveUnits then exit;
|
||||||
if not RenameUnits then exit;
|
if not RenameUnits then exit;
|
||||||
@ -390,6 +395,14 @@ begin
|
|||||||
Result:=true;
|
Result:=true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TConvDelphiCodeTool.ReplaceMemberTypes(AClassName: string): boolean;
|
||||||
|
// Replace types of class object members.
|
||||||
|
begin
|
||||||
|
// CodeToolBoss.RetypeClassVariables();
|
||||||
|
Result:=fCodeTool.RetypeClassVariables(AClassName, fMemberTypesToRename,
|
||||||
|
false, fSrcCache);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -34,7 +34,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
// FCL+LCL
|
// FCL+LCL
|
||||||
Classes, SysUtils, Math, LCLProc, Forms, Controls,
|
Classes, SysUtils, Math, LCLProc, Forms, Controls,
|
||||||
Graphics, Dialogs, Buttons, StdCtrls, contnrs, IniFiles,
|
Graphics, Dialogs, Buttons, StdCtrls, contnrs,
|
||||||
// components
|
// components
|
||||||
SynHighlighterLFM, SynEdit, SynEditMiscClasses, LFMTrees,
|
SynHighlighterLFM, SynEdit, SynEditMiscClasses, LFMTrees,
|
||||||
// codetools
|
// codetools
|
||||||
@ -42,7 +42,7 @@ uses
|
|||||||
// IDE
|
// IDE
|
||||||
IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
|
IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
|
||||||
CustomFormEditor, LazarusIDEStrConsts, IDEProcs, OutputFilter,
|
CustomFormEditor, LazarusIDEStrConsts, IDEProcs, OutputFilter,
|
||||||
EditorOptions, ExtCtrls, Grids, ConvertSettings, CheckLFMDlg;
|
EditorOptions, ExtCtrls, Grids, ConvertSettings, ConvCodeTool, CheckLFMDlg;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -117,10 +117,13 @@ end;
|
|||||||
|
|
||||||
function TLFMFixer.ReplaceAndRemoveAll: TModalResult;
|
function TLFMFixer.ReplaceAndRemoveAll: TModalResult;
|
||||||
var
|
var
|
||||||
|
ConvTool: TConvDelphiCodeTool;
|
||||||
CurError: TLFMError;
|
CurError: TLFMError;
|
||||||
TheNode: TLFMTreeNode;
|
TheNode: TLFMTreeNode;
|
||||||
|
ObjNode: TLFMObjectNode;
|
||||||
// Property name --> replacement name.
|
// Property name --> replacement name.
|
||||||
PropNameRepl: THashedStringList;
|
PropNameRepl: TStringToStringTree;
|
||||||
|
MemberTypes: TStringList;
|
||||||
// List of TLFMChangeEntry objects.
|
// List of TLFMChangeEntry objects.
|
||||||
ChgEntryRepl: TObjectList;
|
ChgEntryRepl: TObjectList;
|
||||||
OldIdent, NewIdent: string;
|
OldIdent, NewIdent: string;
|
||||||
@ -129,33 +132,40 @@ var
|
|||||||
begin
|
begin
|
||||||
Result:=mrNone;
|
Result:=mrNone;
|
||||||
ChgEntryRepl:=TObjectList.Create;
|
ChgEntryRepl:=TObjectList.Create;
|
||||||
PropNameRepl:=THashedStringList.Create;
|
PropNameRepl:=TStringToStringTree.Create(false);
|
||||||
|
MemberTypes:=TStringList.Create;
|
||||||
try
|
try
|
||||||
// Collect (maybe edited) properties from StringGrid to PropNameRepl.
|
// Collect (maybe edited) properties from StringGrid to PropNameRepl.
|
||||||
for i:=1 to fPropReplaceGrid.RowCount-1 do begin // Skip the fixed row.
|
for i:=1 to fPropReplaceGrid.RowCount-1 do begin // Skip the fixed row.
|
||||||
OldIdent:=fPropReplaceGrid.Cells[0,i];
|
OldIdent:=fPropReplaceGrid.Cells[0,i];
|
||||||
NewIdent:=fPropReplaceGrid.Cells[1,i];
|
NewIdent:=fPropReplaceGrid.Cells[1,i];
|
||||||
PropNameRepl.Values[OldIdent]:=NewIdent;
|
if NewIdent<>'' then
|
||||||
|
PropNameRepl[OldIdent]:=NewIdent;
|
||||||
end;
|
end;
|
||||||
// Replace each missing property or delete it if there is no replacement.
|
// Replace each missing property / type or delete it if no replacement.
|
||||||
CurError:=fLFMTree.LastError;
|
CurError:=fLFMTree.LastError;
|
||||||
while CurError<>nil do begin
|
while CurError<>nil do begin
|
||||||
TheNode:=CurError.FindContextNode;
|
TheNode:=CurError.FindContextNode;
|
||||||
if (TheNode<>nil) and (TheNode.Parent<>nil) then begin
|
if (TheNode<>nil) and (TheNode.Parent<>nil) then begin
|
||||||
if CurError.IsMissingObjectType then begin
|
if CurError.IsMissingObjectType then begin
|
||||||
OldIdent:=(CurError.Node as TLFMObjectNode).TypeName;
|
// Object type
|
||||||
StartPos:=(CurError.Node as TLFMObjectNode).TypeNamePosition;
|
ObjNode:=CurError.Node as TLFMObjectNode;
|
||||||
|
OldIdent:=ObjNode.TypeName;
|
||||||
|
StartPos:=ObjNode.TypeNamePosition;
|
||||||
EndPos:=StartPos+Length(OldIdent);
|
EndPos:=StartPos+Length(OldIdent);
|
||||||
NewIdent:=PropNameRepl.Values[OldIdent];
|
NewIdent:=PropNameRepl[OldIdent];
|
||||||
// Keep the old class name if no replacement.
|
// Keep the old class name if no replacement.
|
||||||
if NewIdent<>'' then
|
if NewIdent<>'' then begin
|
||||||
AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
|
AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
|
||||||
|
MemberTypes.Values[OldIdent]:=NewIdent;
|
||||||
|
end;
|
||||||
end
|
end
|
||||||
else begin
|
else begin
|
||||||
|
// Property
|
||||||
TheNode.FindIdentifier(StartPos,EndPos);
|
TheNode.FindIdentifier(StartPos,EndPos);
|
||||||
if StartPos>0 then begin
|
if StartPos>0 then begin
|
||||||
OldIdent:=copy(fLFMBuffer.Source,StartPos,EndPos-StartPos);
|
OldIdent:=copy(fLFMBuffer.Source,StartPos,EndPos-StartPos);
|
||||||
NewIdent:=PropNameRepl.Values[OldIdent];
|
NewIdent:=PropNameRepl[OldIdent];
|
||||||
// Delete the whole property line if no replacement.
|
// Delete the whole property line if no replacement.
|
||||||
if NewIdent='' then
|
if NewIdent='' then
|
||||||
FindNiceNodeBounds(TheNode,StartPos,EndPos);
|
FindNiceNodeBounds(TheNode,StartPos,EndPos);
|
||||||
@ -165,9 +175,22 @@ begin
|
|||||||
end;
|
end;
|
||||||
CurError:=CurError.PrevError;
|
CurError:=CurError.PrevError;
|
||||||
end;
|
end;
|
||||||
if ApplyReplacements(ChgEntryRepl) then
|
// Apply replacements to LFM.
|
||||||
|
if ApplyReplacements(ChgEntryRepl) then begin
|
||||||
|
if MemberTypes.Count>0 then begin
|
||||||
|
// Replace the object member types also to pascal source.
|
||||||
|
ConvTool:=TConvDelphiCodeTool.Create(fPascalBuffer);
|
||||||
|
try
|
||||||
|
ConvTool.MemberTypesToRename:=MemberTypes;
|
||||||
|
ConvTool.ReplaceMemberTypes(TLFMObjectNode(fLFMTree.Root).TypeName);
|
||||||
|
finally
|
||||||
|
ConvTool.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
Result:=mrOk;
|
Result:=mrOk;
|
||||||
|
end;
|
||||||
finally
|
finally
|
||||||
|
MemberTypes.Free;
|
||||||
PropNameRepl.Free;
|
PropNameRepl.Free;
|
||||||
ChgEntryRepl.Free;
|
ChgEntryRepl.Free;
|
||||||
end;
|
end;
|
||||||
@ -187,12 +210,10 @@ begin
|
|||||||
i:=1;
|
i:=1;
|
||||||
CurError:=fLFMTree.FirstError;
|
CurError:=fLFMTree.FirstError;
|
||||||
while CurError<>nil do begin
|
while CurError<>nil do begin
|
||||||
if CurError.IsMissingObjectType then begin
|
if CurError.IsMissingObjectType then
|
||||||
OldIdent:=(CurError.Node as TLFMObjectNode).TypeName;
|
OldIdent:=(CurError.Node as TLFMObjectNode).TypeName
|
||||||
end
|
else
|
||||||
else begin
|
|
||||||
OldIdent:=CurError.Node.GetIdentifier;
|
OldIdent:=CurError.Node.GetIdentifier;
|
||||||
end;
|
|
||||||
// Add only one instance of each property name.
|
// Add only one instance of each property name.
|
||||||
if SeenPropName.IndexOf(OldIdent)<0 then begin
|
if SeenPropName.IndexOf(OldIdent)<0 then begin
|
||||||
SeenPropName.Append(OldIdent);
|
SeenPropName.Append(OldIdent);
|
||||||
|
Loading…
Reference in New Issue
Block a user