paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-20 10:39:09 +02: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;

125
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,39 +152,11 @@ 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
): TModalResult;
var var
RemovedProcHeads: TStrings;
PropChanged: boolean;
function ExtractClassName: string;
var
ProcName: string;
p: LongInt;
i: Integer;
begin
Result:='';
if (RemovedProcHeads=nil) or (RemovedProcHeads.Count=0) then exit;
for i:=RemovedProcHeads.Count-1 downto 0 do begin
ProcName:=RemovedProcHeads[i];
p:=System.Pos('.',ProcName);
if p<1 then
RemovedProcHeads.Delete(i)
else begin
Result:=copy(ProcName,1,p-1);
RemovedProcHeads[i]:=copy(ProcName,p+1,length(ProcName));
//DebugLn(['ExtractClassName RemovedProcHeads[i]=',RemovedProcHeads[i]]);
end;
end;
end;
function GetInheritedMethod(AComponent: TComponent; PropInfo: PPropInfo): TMethod;
var
AncestorRoot, AncestorComponent: TComponent; AncestorRoot, AncestorComponent: TComponent;
AncestorMethod: TMethod; AncestorMethod: TMethod;
begin begin
FillByte(Result{%H-}, SizeOf(Result), 0); FillByte(Result{%H-}, SizeOf(Result), 0);
if csAncestor in AComponent.ComponentState then if csAncestor in AComponent.ComponentState then
begin begin
@ -199,10 +170,7 @@ var
AncestorComponent := nil; AncestorComponent := nil;
end end
else else
begin AncestorComponent := BaseFormEditor1.GetAncestorInstance(AComponent);
AncestorRoot := BaseFormEditor1.GetAncestorInstance(AComponent);
AncestorComponent := AncestorRoot;
end;
if Assigned(AncestorComponent) then if Assigned(AncestorComponent) then
begin begin
@ -211,12 +179,39 @@ var
Result := AncestorMethod Result := AncestorMethod
end; end;
end; end;
end;
function RemoveEmptyMethodsInUnit(Code: TCodeBuffer; AClassName: string;
X, Y: integer; Sections: TPascalClassSections): TModalResult;
var
RemovedProcHeads: TStrings;
PropChanged: boolean;
function ExtractClassName: string;
var
ProcName: string;
p: LongInt;
i: Integer;
begin
Result:='';
for i:=RemovedProcHeads.Count-1 downto 0 do
begin
ProcName:=RemovedProcHeads[i];
p:=System.Pos('.',ProcName);
if p<1 then
RemovedProcHeads.Delete(i)
else begin
Result:=copy(ProcName,1,p-1);
RemovedProcHeads[i]:=copy(ProcName,p+1,length(ProcName));
DebugLn(['ExtractClassName ClassName=',Result, ', RemovedProcHeads[i]=',RemovedProcHeads[i]]);
end;
end;
end; end;
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,29 +219,33 @@ 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);
//DebugLn(['CheckEvents: CurCount=', CurCount, ', ClassType=', TypeData^.ClassType]);
try try
// read properties // read properties
for ic:=0 to CurCount-1 do begin for ic:=0 to CurCount-1 do
begin
PropInfo:=PropList^[ic]; PropInfo:=PropList^[ic];
if (PropInfo^.PropType^.Kind=tkMethod) then begin if PropInfo^.PropType^.Kind=tkMethod then
begin
// event // event
AMethod:=GetMethodProp(AComponent,PropInfo); AMethod:=GetMethodProp(AComponent,PropInfo);
AMethodName:=GlobalDesignHook.GetMethodName(AMethod,nil); AMethodName:=GlobalDesignHook.GetMethodName(AMethod,nil);
//DebugLn(['CheckEvents ',PropInfo^.Name,' AMethodName=',AMethodName]); if AMethodName<>'' then
if AMethodName<>'' then begin begin
i:=RemovedProcHeads.Count-1; i:=RemovedProcHeads.Count-1;
while (i>=0) while (i>=0) and (CompareText(RemovedProcHeads[i],AMethodName)<>0) do
and (SysUtils.CompareText(RemovedProcHeads[i],AMethodName)<>0) do
dec(i); dec(i);
if i>=0 then begin if i>=0 then
DebugLn(['RemoveEmptyMethods Clearing Property=',PropInfo^.Name,' AMethodName=',AMethodName]); begin
//DebugLn([' CheckEvents Clearing Property=',PropInfo^.Name,' AMethodName=',AMethodName]);
AMethod := GetInheritedMethod(AComponent, PropInfo); AMethod := GetInheritedMethod(AComponent, PropInfo);
SetMethodProp(AComponent, PropInfo, AMethod); SetMethodProp(AComponent, PropInfo, AMethod);
PropChanged:=true; PropChanged:=true;
@ -257,8 +256,6 @@ var
finally finally
FreeMem(PropList); FreeMem(PropList);
end; end;
TypeInfo:=TypeData^.ParentInfo;
until TypeInfo=nil;
end; end;
var var
@ -269,32 +266,28 @@ 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
begin
// fix events of designer components // fix events of designer components
LookupRoot:=AnUnitInfo.Component; LookupRoot:=AnUnitInfo.Component;
if (LookupRoot<>nil) //DebugLn(['RemoveEmptyMethods: LookupRoot=', LookupRoot]);
and (SysUtils.CompareText(LookupRoot.ClassName,CurClassName)=0) then if (LookupRoot<>nil) and (CompareText(LookupRoot.ClassName,CurClassName)=0) then
begin begin
PropChanged:=false; PropChanged:=false;
CheckEvents(LookupRoot); CheckEvents(LookupRoot);
@ -307,7 +300,6 @@ begin
end; end;
end; end;
end; end;
end;
finally finally
RemovedProcHeads.Free; RemovedProcHeads.Free;
end; end;
@ -337,7 +329,8 @@ 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
and (RemoveEmptyMethodsInUnit(Code,'',Caret.X,Caret.Y,Sections)=mrOk) then
ModalResult:=mrOk; ModalResult:=mrOk;
end; end;

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;