diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 7310c0262f..d3cb7e89e2 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -672,7 +672,8 @@ type const AClassName: string; RootComponent: TComponent; ExceptionOnClassNotFound, SearchInAncestors: boolean; - out ListOfPInstancePropInfo: TFPList): boolean; + out ListOfPInstancePropInfo: TFPList; + const OverrideGetMethodName: TOnGetMethodname = nil): boolean; // functions for events in the object inspector function GetCompatiblePublishedMethods(Code: TCodeBuffer; @@ -4691,9 +4692,9 @@ end; function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer; const AClassName: string; RootComponent: TComponent; - ExceptionOnClassNotFound, SearchInAncestors: boolean; - out ListOfPInstancePropInfo: TFPList - ): boolean; + ExceptionOnClassNotFound, SearchInAncestors: boolean; out + ListOfPInstancePropInfo: TFPList; + const OverrideGetMethodName: TOnGetMethodname): boolean; begin Result:=false; {$IFDEF CTDEBUG} @@ -4704,7 +4705,7 @@ begin try Result:=FCurCodeTool.FindDanglingComponentEvents(AClassName,RootComponent, ExceptionOnClassNotFound,SearchInAncestors, - ListOfPInstancePropInfo); + ListOfPInstancePropInfo,OverrideGetMethodName); except on e: Exception do Result:=HandleException(e); end; diff --git a/components/codetools/codetoolsstructs.pas b/components/codetools/codetoolsstructs.pas index e25e994f24..55c6f1bbb8 100644 --- a/components/codetools/codetoolsstructs.pas +++ b/components/codetools/codetoolsstructs.pas @@ -157,6 +157,24 @@ type procedure ReplaceString(var s: string); function CalcMemSize: PtrUInt; end; + +type + TCTComponentAccess = class(TComponent); + + { TComponentChildCollector } + + TComponentChildCollector = class + private + FChilds: TFPList; + FRoot: TComponent; + procedure AddChildComponent(Child: TComponent); + public + constructor Create; + destructor Destroy; override; + function GetComponents(RootComponent: TComponent; AddRoot: boolean = true): TFPList; + property Childs: TFPList read FChilds; + property Root: TComponent read FRoot; + end; function CompareStringToStringItems(Data1, Data2: Pointer): integer; function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer; @@ -674,5 +692,45 @@ begin end; end; +{ TComponentChildCollector } + +procedure TComponentChildCollector.AddChildComponent(Child: TComponent); +var + OldRoot: TComponent; +begin + //debugln(['TComponentChildCollector.AddChildComponent ',DbgSName(Child)]); + Childs.Add(Child); + OldRoot := Root; + try + if csInline in Child.ComponentState then + FRoot := Child; + TCTComponentAccess(Child).GetChildren(@AddChildComponent,Root); + finally + FRoot := OldRoot; + end; +end; + +constructor TComponentChildCollector.Create; +begin + FChilds:=TFPList.Create; +end; + +destructor TComponentChildCollector.Destroy; +begin + FreeAndNil(FChilds); + inherited Destroy; +end; + +function TComponentChildCollector.GetComponents(RootComponent: TComponent; + AddRoot: boolean): TFPList; +begin + Childs.Clear; + if AddRoot then + Childs.Add(RootComponent); + FRoot:=RootComponent; + TCTComponentAccess(RootComponent).GetChildren(@AddChildComponent,FRoot); + Result:=Childs; +end; + end. diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 735562d0e0..1c8788682c 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -4274,6 +4274,7 @@ begin AVLNode:=PosTree.FindHighest; while AVLNode<>nil do begin StartPos:=PChar(AVLNode.Data)-PChar(Pointer(Src))+1; + // ToDo: if an include file is included twice a code position could be duplicated if CleanPosToCaret(StartPos,ReferencePos) then AddCodePosition(ListOfPCodeXYPosition,ReferencePos); AVLNode:=PosTree.FindPrecessor(AVLNode); diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 4a4cf57228..db57f2c143 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -192,7 +192,8 @@ type function FindDanglingComponentEvents(const TheClassName: string; RootComponent: TComponent; ExceptionOnClassNotFound, SearchInAncestors: boolean; - out ListOfPInstancePropInfo: TFPList): boolean; + out ListOfPInstancePropInfo: TFPList; + const OverrideGetMethodName: TOnGetMethodname = nil): boolean; // variables, constants, types function RemoveIdentifierDefinition(const CursorPos: TCodeXYPosition; @@ -4968,8 +4969,9 @@ end; function TStandardCodeTool.FindDanglingComponentEvents( const TheClassName: string; RootComponent: TComponent; - ExceptionOnClassNotFound, SearchInAncestors: boolean; - out ListOfPInstancePropInfo: TFPList): boolean; + ExceptionOnClassNotFound, SearchInAncestors: boolean; out + ListOfPInstancePropInfo: TFPList; + const OverrideGetMethodName: TOnGetMethodname): boolean; var PublishedMethods: TAVLTree; @@ -4987,7 +4989,7 @@ var {$ENDIF} end; - procedure CheckMethodsInComponent(AComponent: TComponent); + procedure CheckMethodsInPersistent(APersistent: TPersistent); var TypeInfo: PTypeInfo; TypeData: PTypeData; @@ -4997,13 +4999,14 @@ var NodeExt: TCodeTreeNodeExtension; CurMethod: TMethod; CurMethodName: String; + ObjValue: TObject; begin - if AComponent=nil then exit; + if APersistent=nil then exit; {$IFDEF VerboseDanglingComponentEvents} - debugln('TStandardCodeTool.FindDanglingComponentEvents Checking ',DbgSName(AComponent)); + debugln('TStandardCodeTool.FindDanglingComponentEvents.CheckMethodsInPersistent Checking ',DbgSName(APersistent)); {$ENDIF} // read all properties and remove doubles - TypeInfo:=AComponent.ClassInfo; + TypeInfo:=APersistent.ClassInfo; repeat // read all property infos of current class TypeData:=GetTypeData(TypeInfo); @@ -5023,22 +5026,41 @@ var debugln(' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name); {$ENDIF} PropType:=PropInfo^.PropType; - if PropType^.Kind=tkMethod then begin + + if (PropType^.Kind=tkMethod) then begin // RTTI property is method // -> search method in source - CurMethod:=GetMethodProp(AComponent,PropInfo); - CurMethodName:=OnGetMethodName(CurMethod,RootComponent); - {$IFDEF VerboseDanglingComponentEvents} - if (CurMethod.Data<>nil) or (CurMethod.COde<>nil) then - debugln(' Component ',DbgSName(AComponent),' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' CurMethodName="',CurMethodName,'"'); - {$ENDIF} - if CurMethodName<>'' then begin - NodeExt:=FindCodeTreeNodeExt(PublishedMethods,CurMethodName); - if NodeExt=nil then begin - // method not found -> dangling event - AddDanglingEvent(AComponent,PropInfo); + CurMethod:=GetMethodProp(APersistent,PropInfo); + if (CurMethod.Data<>nil) or (CurMethod.Code<>nil) then begin + if Assigned(OverrideGetMethodName) then + CurMethodName:=OverrideGetMethodName(CurMethod,RootComponent) + else + CurMethodName:=OnGetMethodName(CurMethod,RootComponent); + {$IFDEF VerboseDanglingComponentEvents} + debugln(' Persistent ',DbgSName(APersistent),' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' CurMethodName="',CurMethodName,'"'); + {$ENDIF} + if CurMethodName<>'' then begin + NodeExt:=FindCodeTreeNodeExt(PublishedMethods,CurMethodName); + if NodeExt=nil then begin + // method not found -> dangling event + AddDanglingEvent(APersistent,PropInfo); + end; end; end; + end else if (PropType^.Kind=tkClass) then begin + // RTTI property is class instance + ObjValue := TObject(GetObjectProp(APersistent, PropInfo)); + if ObjValue is TCollection then begin + // collection + + end else if (ObjValue is TPersistent) + and (not (ObjValue is TComponent) + or (csSubComponent in TComponent(ObjValue).ComponentStyle)) + then begin + // sub persistent (e.g. Canvas.Font) + //debugln(['CheckMethodsInPersistent sub persistent: ',DbgSName(ObjValue)]); + CheckMethodsInPersistent(TPersistent(ObjValue)); + end; end; PropInfo:=PPropInfo(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1); dec(CurCount); @@ -5049,9 +5071,13 @@ var var i: Integer; + Collector: TComponentChildCollector; + AllComponents: TFPList; begin PublishedMethods:=nil; ListOfPInstancePropInfo:=nil; + Collector:=nil; + AllComponents:=nil; try // search all available published methods {$IFDEF VerboseDanglingComponentEvents} @@ -5062,10 +5088,12 @@ begin PublishedMethods); if not Result then exit; // go through all components - CheckMethodsInComponent(RootComponent); - for i:=0 to RootComponent.ComponentCount-1 do - CheckMethodsInComponent(RootComponent.Components[i]); + Collector:=TComponentChildCollector.Create; + AllComponents:=Collector.GetComponents(RootComponent,true); + for i:=0 to AllComponents.Count-1 do + CheckMethodsInPersistent(TComponent(AllComponents[i])); finally + Collector.Free; NodeExtMemManager.DisposeAVLTree(PublishedMethods); end; end; diff --git a/ide/checklfmdlg.pas b/ide/checklfmdlg.pas index c18bab7717..d74259418d 100644 --- a/ide/checklfmdlg.pas +++ b/ide/checklfmdlg.pas @@ -301,7 +301,8 @@ begin // find all dangling events //debugln('RemoveDanglingEvents A ',PascalBuffer.Filename,' ',DbgSName(RootComponent)); if not CodeToolBoss.FindDanglingComponentEvents(PascalBuffer, - RootComponent.ClassName,RootComponent,false,true,ListOfPInstancePropInfo) + RootComponent.ClassName,RootComponent,false,true,ListOfPInstancePropInfo, + @BaseFormEditor1.OnGetDanglingMethodName) then begin //debugln('RemoveDanglingEvents Errors in code'); if OkOnCodeErrors then diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index e6b36af1b3..065fda95e4 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -155,6 +155,8 @@ type var Handled: boolean); function SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo; var BinCompStream: TExtMemoryStream): TModalResult; + function OnGetDanglingMethodName(const AMethod: TMethod; + aRootComponent: TObject): string; // ancestors function GetAncestorLookupRoot(AComponent: TComponent): TComponent; override; @@ -973,6 +975,20 @@ begin end; end; +function TCustomFormEditor.OnGetDanglingMethodName(const AMethod: TMethod; + aRootComponent: TObject): string; +// check if event is a JITMethod of aRootComponent +var + JITMethod: TJITMethod; +begin + Result:=''; + if IsJITMethod(aMethod) then begin + JITMethod:=TJITMethod(aMethod.Data); + if aRootComponent.ClassType=JITMethod.TheClass then + Result:=JITMethod.TheMethodName; + end; +end; + function TCustomFormEditor.DesignerCount: integer; begin Result:=JITFormList.Count+JITNonFormList.Count;