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

IDE: Refactor RemoveEmptyMethods->RemoveEmptyMethodsInUnit. Remove repeat loop for parent types, props are already iterated. Prepare for issue #37163.

Browse Source 
git-svn-id: trunk@63780 -
This commit is contained in:
juha 2020-08-18 17:35:23 +00:00
parent 125e794a87
commit 5b1d9b4f7c
3 changed files with 95 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/ideintf/componenttreeview.pas
View File

@ -109,7 +109,7 @@ type
FLookupRoot: TComponent; FLookupRoot: TComponent;
FNode: TTreeNode; FNode: TTreeNode;
procedure AddCollection(AColl: TCollection; AParentNode: TTreeNode); procedure AddCollection(AColl: TCollection; AParentNode: TTreeNode);
procedure AddOwnedPersistent(APers: TPersistent; APropName: String; procedure AddOwnedPersistent(APers: TPersistent; const APropName: String;
AParentNode: TTreeNode); AParentNode: TTreeNode);
procedure GetOwnedPersistents(APers: TPersistent; AParentNode: TTreeNode); procedure GetOwnedPersistents(APers: TPersistent; AParentNode: TTreeNode);
function PersistentFoundInNode(APers: TPersistent): Boolean; function PersistentFoundInNode(APers: TPersistent): Boolean;
@ -173,7 +173,7 @@ begin
end; end;
procedure TComponentWalker.AddOwnedPersistent(APers: TPersistent; procedure TComponentWalker.AddOwnedPersistent(APers: TPersistent;
APropName: String; AParentNode: TTreeNode); const APropName: String; AParentNode: TTreeNode);
var var
TVNode: TTreeNode; TVNode: TTreeNode;
TheRoot: TPersistent; TheRoot: TPersistent;

189
ide/emptymethodsdlg.pas
View File

@ -81,9 +81,8 @@ type
function ShowEmptyMethodsDialog: TModalResult; function ShowEmptyMethodsDialog: TModalResult;
function RemoveEmptyMethods(Code: TCodeBuffer; AClassName: string; function RemoveEmptyMethodsInUnit(Code: TCodeBuffer; AClassName: string;
X, Y: integer; CommitSrcEditor: boolean; Sections: TPascalClassSections X, Y: integer; Sections: TPascalClassSections): TModalResult;
): TModalResult;
implementation implementation
@ -153,9 +152,37 @@ begin
end; end;
end; end;
function RemoveEmptyMethods(Code: TCodeBuffer; AClassName: string; function GetInheritedMethod(AComponent: TComponent; PropInfo: PPropInfo): TMethod;
X, Y: integer; CommitSrcEditor: boolean; Sections: TPascalClassSections var
): TModalResult; AncestorRoot, AncestorComponent: TComponent;
AncestorMethod: TMethod;
begin
FillByte(Result{%H-}, SizeOf(Result), 0);
if csAncestor in AComponent.ComponentState then
begin
// search for ancestor component
if Assigned(AComponent.Owner) then
begin
AncestorRoot := BaseFormEditor1.GetAncestorLookupRoot(AComponent);
if Assigned(AncestorRoot) then
AncestorComponent := AncestorRoot.FindComponent(AComponent.Name)
else
AncestorComponent := nil;
end
else
AncestorComponent := BaseFormEditor1.GetAncestorInstance(AComponent);
if Assigned(AncestorComponent) then
begin
AncestorMethod := GetMethodProp(AncestorComponent, PropInfo);
if IsJITMethod(AncestorMethod) then
Result := AncestorMethod
end;
end;
end;
function RemoveEmptyMethodsInUnit(Code: TCodeBuffer; AClassName: string;
X, Y: integer; Sections: TPascalClassSections): TModalResult;
var var
RemovedProcHeads: TStrings; RemovedProcHeads: TStrings;
PropChanged: boolean; PropChanged: boolean;
@ -167,8 +194,8 @@ var
i: Integer; i: Integer;
begin begin
Result:=''; Result:='';
if (RemovedProcHeads=nil) or (RemovedProcHeads.Count=0) then exit; for i:=RemovedProcHeads.Count-1 downto 0 do
for i:=RemovedProcHeads.Count-1 downto 0 do begin begin
ProcName:=RemovedProcHeads[i]; ProcName:=RemovedProcHeads[i];
p:=System.Pos('.',ProcName); p:=System.Pos('.',ProcName);
if p<1 then if p<1 then
@ -176,39 +203,7 @@ var
else begin else begin
Result:=copy(ProcName,1,p-1); Result:=copy(ProcName,1,p-1);
RemovedProcHeads[i]:=copy(ProcName,p+1,length(ProcName)); RemovedProcHeads[i]:=copy(ProcName,p+1,length(ProcName));
//DebugLn(['ExtractClassName RemovedProcHeads[i]=',RemovedProcHeads[i]]); DebugLn(['ExtractClassName ClassName=',Result, ', RemovedProcHeads[i]=',RemovedProcHeads[i]]);
end;
end;
end;
function GetInheritedMethod(AComponent: TComponent; PropInfo: PPropInfo): TMethod;
var
AncestorRoot, AncestorComponent: TComponent;
AncestorMethod: TMethod;
begin
FillByte(Result{%H-}, SizeOf(Result), 0);
if csAncestor in AComponent.ComponentState then
begin
// search for ancestor component
if Assigned(AComponent.Owner) then
begin
AncestorRoot := BaseFormEditor1.GetAncestorLookupRoot(AComponent);
if Assigned(AncestorRoot) then
AncestorComponent := AncestorRoot.FindComponent(AComponent.Name)
else
AncestorComponent := nil;
end
else
begin
AncestorRoot := BaseFormEditor1.GetAncestorInstance(AComponent);
AncestorComponent := AncestorRoot;
end;
if Assigned(AncestorComponent) then
begin
AncestorMethod := GetMethodProp(AncestorComponent, PropInfo);
if IsJITMethod(AncestorMethod) then
Result := AncestorMethod
end; end;
end; end;
end; end;
@ -216,7 +211,7 @@ var
procedure CheckEvents(AComponent: TComponent); procedure CheckEvents(AComponent: TComponent);
var var
TypeInfo: PTypeInfo; TypeInfo: PTypeInfo;
TypeData: PTypeData; //TypeData: PTypeData;
PropInfo: PPropInfo; PropInfo: PPropInfo;
PropList: PPropList; PropList: PPropList;
CurCount,ic: integer; CurCount,ic: integer;
@ -224,41 +219,43 @@ var
AMethodName: String; AMethodName: String;
i: Integer; i: Integer;
begin begin
//DebugLn('');
// read all properties and remove doubles // read all properties and remove doubles
TypeInfo:=PTypeInfo(AComponent.ClassInfo); TypeInfo:=PTypeInfo(AComponent.ClassInfo);
repeat //DebugLn(['CheckEvents: AComponent=',AComponent, ', TypeInfo^.Name=',TypeInfo^.Name]);
// read all property infos of current class // read all property infos of current class
TypeData:=GetTypeData(TypeInfo); //TypeData:=GetTypeData(TypeInfo);
// read property count // read property count
CurCount:=GetPropList(TypeInfo,PropList);; CurCount:=GetPropList(TypeInfo,PropList);
try //DebugLn(['CheckEvents: CurCount=', CurCount, ', ClassType=', TypeData^.ClassType]);
// read properties try
for ic:=0 to CurCount-1 do begin // read properties
PropInfo:=PropList^[ic]; for ic:=0 to CurCount-1 do
if (PropInfo^.PropType^.Kind=tkMethod) then begin begin
// event PropInfo:=PropList^[ic];
AMethod:=GetMethodProp(AComponent,PropInfo); if PropInfo^.PropType^.Kind=tkMethod then
AMethodName:=GlobalDesignHook.GetMethodName(AMethod,nil); begin
//DebugLn(['CheckEvents ',PropInfo^.Name,' AMethodName=',AMethodName]); // event
if AMethodName<>'' then begin AMethod:=GetMethodProp(AComponent,PropInfo);
i:=RemovedProcHeads.Count-1; AMethodName:=GlobalDesignHook.GetMethodName(AMethod,nil);
while (i>=0) if AMethodName<>'' then
and (SysUtils.CompareText(RemovedProcHeads[i],AMethodName)<>0) do begin
dec(i); i:=RemovedProcHeads.Count-1;
if i>=0 then begin while (i>=0) and (CompareText(RemovedProcHeads[i],AMethodName)<>0) do
DebugLn(['RemoveEmptyMethods Clearing Property=',PropInfo^.Name,' AMethodName=',AMethodName]); dec(i);
AMethod := GetInheritedMethod(AComponent, PropInfo); if i>=0 then
SetMethodProp(AComponent, PropInfo, AMethod); begin
PropChanged:=true; //DebugLn([' CheckEvents Clearing Property=',PropInfo^.Name,' AMethodName=',AMethodName]);
end; AMethod := GetInheritedMethod(AComponent, PropInfo);
SetMethodProp(AComponent, PropInfo, AMethod);
PropChanged:=true;
end; end;
end; end;
end; end;
finally
FreeMem(PropList);
end; end;
TypeInfo:=TypeData^.ParentInfo; finally
until TypeInfo=nil; FreeMem(PropList);
end;
end; end;
var var
@ -269,41 +266,36 @@ var
CurClassName: String; CurClassName: String;
begin begin
Result:=mrCancel; Result:=mrCancel;
if CommitSrcEditor and (not LazarusIDE.BeginCodeTools) then exit;
//DebugLn(['TEmptyMethodsDialog.OKButtonClick ']);
RemovedProcHeads:=nil; RemovedProcHeads:=nil;
try try
if (not CodeToolBoss.RemoveEmptyMethods(Code,AClassName,X,Y, if not CodeToolBoss.RemoveEmptyMethods(Code,AClassName,X,Y,Sections,AllEmpty,
Sections,AllEmpty,
[phpAddClassName,phpDoNotAddSemicolon,phpWithoutParamList, [phpAddClassName,phpDoNotAddSemicolon,phpWithoutParamList,
phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon], phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon],
RemovedProcHeads)) RemovedProcHeads)
then begin then begin
DebugLn(['RemoveEmptyMethods failed']); DebugLn(['RemoveEmptyMethods failed']);
exit; exit;
end; end;
if (RemovedProcHeads<>nil) and (RemovedProcHeads.Count>0) then begin if (RemovedProcHeads<>nil) and (RemovedProcHeads.Count>0) then begin
// RemovedProcHeads contains a list of classname.procname // RemovedProcHeads contains a list of classname.procname, remove classname from the list
// remove the classname from the list
CurClassName:=ExtractClassName; CurClassName:=ExtractClassName;
if CurClassName<>'' then begin if (CurClassName<>'') and (Project1<>nil) then
if (Project1<>nil) then begin begin
AnUnitInfo:=Project1.UnitInfoWithFilename(Code.Filename); AnUnitInfo:=Project1.UnitInfoWithFilename(Code.Filename);
if AnUnitInfo<>nil then begin if AnUnitInfo<>nil then
// fix events of designer components begin
LookupRoot:=AnUnitInfo.Component; // fix events of designer components
if (LookupRoot<>nil) LookupRoot:=AnUnitInfo.Component;
and (SysUtils.CompareText(LookupRoot.ClassName,CurClassName)=0) then //DebugLn(['RemoveEmptyMethods: LookupRoot=', LookupRoot]);
begin if (LookupRoot<>nil) and (CompareText(LookupRoot.ClassName,CurClassName)=0) then
PropChanged:=false; begin
CheckEvents(LookupRoot); PropChanged:=false;
for i:=0 to LookupRoot.ComponentCount-1 do CheckEvents(LookupRoot);
CheckEvents(LookupRoot.Components[i]); for i:=0 to LookupRoot.ComponentCount-1 do
// update objectinspector CheckEvents(LookupRoot.Components[i]);
if PropChanged and (GlobalDesignHook.LookupRoot=LookupRoot) then // update objectinspector
GlobalDesignHook.RefreshPropertyValues; if PropChanged and (GlobalDesignHook.LookupRoot=LookupRoot) then
end; GlobalDesignHook.RefreshPropertyValues;
end; end;
end; end;
end; end;
@ -337,8 +329,9 @@ end;
procedure TEmptyMethodsDialog.OKButtonClick(Sender: TObject); procedure TEmptyMethodsDialog.OKButtonClick(Sender: TObject);
begin begin
if RemoveEmptyMethods(Code,'',Caret.X,Caret.Y,true,Sections)<>mrOk then exit; if LazarusIDE.BeginCodeTools
ModalResult:=mrOk; and (RemoveEmptyMethodsInUnit(Code,'',Caret.X,Caret.Y,Sections)=mrOk) then
ModalResult:=mrOk;
end; end;
procedure TEmptyMethodsDialog.PrivateCheckBoxChange(Sender: TObject); procedure TEmptyMethodsDialog.PrivateCheckBoxChange(Sender: TObject);

4
ide/sourcefilemanager.pas
View File

@ -2498,8 +2498,8 @@ begin
// Note: When removing published methods, the source, the lfm, the lrs // Note: When removing published methods, the source, the lfm, the lrs
// and the form must be changed. At the moment editing the lfm without // and the form must be changed. At the moment editing the lfm without
// the component is not yet implemented. // the component is not yet implemented.
Result:=RemoveEmptyMethods(AnUnitInfo.Source, Result:=RemoveEmptyMethodsInUnit(AnUnitInfo.Source, AnUnitInfo.Component.ClassName,
AnUnitInfo.Component.ClassName,0,0,false,[pcsPublished]); 0,0,[pcsPublished]);
if Result=mrAbort then exit; if Result=mrAbort then exit;
end; end;