mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-28 06:23:56 +02:00
IDE: implemented using Ancestor component when saving inherited root component, codetools: added flag to search in ancestors for dangling events
git-svn-id: trunk@10046 -
This commit is contained in:
mattias
parent
b6f164d0aa
commit
c038401b5b
@ -540,7 +540,8 @@ type
|
||||
VarType: shortstring; ErrorOnClassNotFound: boolean): boolean;
|
||||
function FindDanglingComponentEvents(Code: TCodeBuffer;
|
||||
const AClassName: string;
|
||||
RootComponent: TComponent; ExceptionOnClassNotFound: boolean;
|
||||
RootComponent: TComponent; ExceptionOnClassNotFound,
|
||||
SearchInAncestors: boolean;
|
||||
out ListOfPInstancePropInfo: TFPList): boolean;
|
||||
|
||||
// functions for events in the object inspector
|
||||
@ -3571,7 +3572,8 @@ end;
|
||||
|
||||
function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer;
|
||||
const AClassName: string; RootComponent: TComponent;
|
||||
ExceptionOnClassNotFound: boolean; out ListOfPInstancePropInfo: TFPList
|
||||
ExceptionOnClassNotFound, SearchInAncestors: boolean;
|
||||
out ListOfPInstancePropInfo: TFPList
|
||||
): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
@ -3582,7 +3584,8 @@ begin
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
try
|
||||
Result:=FCurCodeTool.FindDanglingComponentEvents(AClassName,RootComponent,
|
||||
ExceptionOnClassNotFound,ListOfPInstancePropInfo);
|
||||
ExceptionOnClassNotFound,SearchInAncestors,
|
||||
ListOfPInstancePropInfo);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
|
||||
@ -185,10 +185,11 @@ type
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function GatherPublishedClassElements(const TheClassName: string;
|
||||
ExceptionOnClassNotFound, WithVariables, WithMethods,
|
||||
WithProperties: boolean;
|
||||
WithProperties, WithAncestors: boolean;
|
||||
out TreeOfCodeTreeNodeExtension: TAVLTree): boolean;
|
||||
function FindDanglingComponentEvents(const TheClassName: string;
|
||||
RootComponent: TComponent; ExceptionOnClassNotFound: boolean;
|
||||
RootComponent: TComponent; ExceptionOnClassNotFound,
|
||||
SearchInAncestors: boolean;
|
||||
out ListOfPInstancePropInfo: TFPList): boolean;
|
||||
|
||||
// blocks (e.g. begin..end)
|
||||
@ -4026,15 +4027,71 @@ end;
|
||||
|
||||
function TStandardCodeTool.GatherPublishedClassElements(
|
||||
const TheClassName: string;
|
||||
ExceptionOnClassNotFound, WithVariables, WithMethods, WithProperties: boolean;
|
||||
ExceptionOnClassNotFound, WithVariables, WithMethods, WithProperties,
|
||||
WithAncestors: boolean;
|
||||
out TreeOfCodeTreeNodeExtension: TAVLTree): boolean;
|
||||
|
||||
function Add(AFindContext: PFindContext): boolean;
|
||||
var
|
||||
ClassNode: TCodeTreeNode;
|
||||
CurTool: TFindDeclarationTool;
|
||||
SectionNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
CurProcName: String;
|
||||
NewNodeExt: TCodeTreeNodeExtension;
|
||||
CurPropName: String;
|
||||
CurVarName: String;
|
||||
begin
|
||||
Result:=false;
|
||||
ClassNode:=AFindContext^.Node;
|
||||
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) then exit;
|
||||
CurTool:=AFindContext^.Tool;
|
||||
CurTool.BuildSubTreeForClass(ClassNode);
|
||||
SectionNode:=ClassNode.FirstChild;
|
||||
while (SectionNode<>nil) do begin
|
||||
if SectionNode.Desc=ctnClassPublished then begin
|
||||
ANode:=SectionNode.FirstChild;
|
||||
while ANode<>nil do begin
|
||||
if (ANode.Desc=ctnProcedure) and WithMethods then begin
|
||||
CurProcName:=CurTool.ExtractProcName(ANode,[]);
|
||||
//debugln('TStandardCodeTool.GatherPublishedClassElements CurProcName="',CurProcName,'"');
|
||||
NewNodeExt:=NodeExtMemManager.NewNode;
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurProcName;
|
||||
end;
|
||||
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
||||
end
|
||||
else if (ANode.Desc=ctnVarDefinition) and WithVariables then begin
|
||||
CurVarName:=CurTool.ExtractDefinitionName(ANode);
|
||||
NewNodeExt:=NodeExtMemManager.NewNode;
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurVarName;
|
||||
end;
|
||||
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
||||
end
|
||||
else if (ANode.Desc=ctnProperty) and WithProperties then begin
|
||||
CurPropName:=CurTool.ExtractPropName(ANode,false);
|
||||
NewNodeExt:=NodeExtMemManager.NewNode;
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurPropName;
|
||||
end;
|
||||
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
||||
end;
|
||||
ANode:=ANode.NextBrother;
|
||||
end;
|
||||
end;
|
||||
SectionNode:=SectionNode.NextBrother;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
var
|
||||
ClassNode, SectionNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
CurProcName: String;
|
||||
NewNodeExt: TCodeTreeNodeExtension;
|
||||
CurVarName: String;
|
||||
CurPropName: String;
|
||||
ClassNode: TCodeTreeNode;
|
||||
AncestorList: TFPList;// of PFindContext
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
TreeOfCodeTreeNodeExtension:=nil;
|
||||
@ -4044,52 +4101,26 @@ begin
|
||||
ClassNode:=FindClassNodeInInterface(TheClassName,true,false,
|
||||
ExceptionOnClassNotFound);
|
||||
if ClassNode=nil then exit;
|
||||
TreeOfCodeTreeNodeExtension:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
BuildSubTreeForClass(ClassNode);
|
||||
SectionNode:=ClassNode.FirstChild;
|
||||
while (SectionNode<>nil) do begin
|
||||
if SectionNode.Desc=ctnClassPublished then begin
|
||||
ANode:=SectionNode.FirstChild;
|
||||
while ANode<>nil do begin
|
||||
if (ANode.Desc=ctnProcedure) and WithMethods then begin
|
||||
CurProcName:=ExtractProcName(ANode,[]);
|
||||
//debugln('TStandardCodeTool.GatherPublishedClassElements CurProcName="',CurProcName,'"');
|
||||
NewNodeExt:=NodeExtMemManager.NewNode;
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurProcName;
|
||||
end;
|
||||
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
||||
end
|
||||
else if (ANode.Desc=ctnVarDefinition) and WithVariables then begin
|
||||
CurVarName:=ExtractDefinitionName(ANode);
|
||||
NewNodeExt:=NodeExtMemManager.NewNode;
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurVarName;
|
||||
end;
|
||||
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
||||
end
|
||||
else if (ANode.Desc=ctnProperty) and WithProperties then begin
|
||||
CurPropName:=ExtractPropName(ANode,false);
|
||||
NewNodeExt:=NodeExtMemManager.NewNode;
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurPropName;
|
||||
end;
|
||||
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
|
||||
end;
|
||||
ANode:=ANode.NextBrother;
|
||||
end;
|
||||
AncestorList:=nil;
|
||||
try
|
||||
if WithAncestors then begin
|
||||
if not FindClassAndAncestors(ClassNode,AncestorList) then exit;
|
||||
end else begin
|
||||
AddFindContext(AncestorList,CreateFindContext(Self,ClassNode));
|
||||
end;
|
||||
SectionNode:=SectionNode.NextBrother;
|
||||
TreeOfCodeTreeNodeExtension:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
for i:=0 to AncestorList.Count-1 do begin
|
||||
if not Add(PFindContext(AncestorList[i])) then exit;
|
||||
end;
|
||||
finally
|
||||
FreeListOfPFindContext(AncestorList);
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.FindDanglingComponentEvents(
|
||||
const TheClassName: string; RootComponent: TComponent;
|
||||
ExceptionOnClassNotFound: boolean;
|
||||
ExceptionOnClassNotFound, SearchInAncestors: boolean;
|
||||
out ListOfPInstancePropInfo: TFPList): boolean;
|
||||
var
|
||||
PublishedMethods: TAVLTree;
|
||||
@ -4165,7 +4196,8 @@ begin
|
||||
// search all available published methods
|
||||
//debugln('TStandardCodeTool.FindDanglingComponentEvents A ',MainFilename,' ',DbgSName(RootComponent));
|
||||
Result:=GatherPublishedClassElements(TheClassName,ExceptionOnClassNotFound,
|
||||
false,true,false,PublishedMethods);
|
||||
false,true,false,SearchInAncestors,
|
||||
PublishedMethods);
|
||||
if not Result then exit;
|
||||
// go through all components
|
||||
CheckMethodsInComponent(RootComponent);
|
||||
|
||||
@ -246,7 +246,7 @@ begin
|
||||
// find all dangling events
|
||||
//debugln('RemoveDanglingEvents A ',PascalBuffer.Filename,' ',DbgSName(RootComponent));
|
||||
if not CodeToolBoss.FindDanglingComponentEvents(PascalBuffer,
|
||||
RootComponent.ClassName,RootComponent,false,ListOfPInstancePropInfo)
|
||||
RootComponent.ClassName,RootComponent,false,true,ListOfPInstancePropInfo)
|
||||
then begin
|
||||
//debugln('RemoveDanglingEvents Errors in code');
|
||||
if OkOnCodeErrors then
|
||||
|
||||
@ -881,7 +881,7 @@ Begin
|
||||
DebugLn(['WARNING: TCustomFormEditor.DeleteComponent freeing orphaned component ',DbgSName(AComponent)]);
|
||||
TryFreeComponent(AComponent);
|
||||
end;
|
||||
// if not free, then free the handle to hide it
|
||||
// if not free, then hide it
|
||||
if (not FreeComponent) and (AComponent is TWinControl) then begin
|
||||
AWinControl:=TWinControl(AComponent);
|
||||
if AWinControl.HandleAllocated and (AWinControl.Parent=nil) then begin
|
||||
|
||||
33
ide/main.pp
33
ide/main.pp
@ -554,9 +554,9 @@ type
|
||||
// methods for 'save unit'
|
||||
function DoShowSaveFileAsDialog(AnUnitInfo: TUnitInfo;
|
||||
var ResourceCode: TCodeBuffer): TModalResult;
|
||||
function DoSaveFileResources(AnUnitInfo: TUnitInfo;
|
||||
function DoSaveUnitComponent(AnUnitInfo: TUnitInfo;
|
||||
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
|
||||
function DoSaveFileResourceToBinStream(AnUnitInfo: TUnitInfo;
|
||||
function DoSaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
|
||||
var BinCompStream: TExtMemoryStream): TModalResult;
|
||||
function DoRemoveDanglingEvents(AnUnitInfo: TUnitInfo;
|
||||
OkOnCodeErrors: boolean): TModalResult;
|
||||
@ -592,6 +592,7 @@ type
|
||||
Flags: TCloseFlags): TModalResult;
|
||||
function UnitComponentIsUsed(AnUnitInfo: TUnitInfo;
|
||||
CheckHasDesigner: boolean): boolean;
|
||||
function GetAncestorUnit(AnUnitInfo: TUnitInfo): TUnitInfo;
|
||||
|
||||
// methods for creating a project
|
||||
function CreateProjectObject(ProjectDesc,
|
||||
@ -4027,7 +4028,7 @@ begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TMainIDE.DoSaveFileResources(AnUnitInfo: TUnitInfo;
|
||||
function TMainIDE.DoSaveUnitComponent(AnUnitInfo: TUnitInfo;
|
||||
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
|
||||
var
|
||||
ComponentSavingOk: boolean;
|
||||
@ -4038,6 +4039,8 @@ var
|
||||
CompResourceCode, LFMFilename, TestFilename, ResTestFilename: string;
|
||||
UnitSaveFilename: String;
|
||||
ADesigner: TDesigner;
|
||||
AncestorUnit: TUnitInfo;
|
||||
AncestorInstance: TComponent;
|
||||
{$IFDEF TRANSLATESTRING}Grubber:TLRTGrubber;{$ENDIF}
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
@ -4086,7 +4089,13 @@ begin
|
||||
Grubber:=TLRTGrubber.Create;
|
||||
Writer.OnWriteStringProperty:=@Grubber.Grub;
|
||||
{$ENDIF}
|
||||
Writer.WriteDescendent(AnUnitInfo.Component,nil);
|
||||
AncestorUnit:=GetAncestorUnit(AnUnitInfo);
|
||||
if AncestorUnit<>nil then
|
||||
AncestorInstance:=AncestorUnit.Component
|
||||
else
|
||||
AncestorInstance:=nil;
|
||||
DebugLn(['TMainIDE.DoSaveUnitComponent AncestorInstance=',dbgsName(AncestorInstance)]);
|
||||
Writer.WriteDescendent(AnUnitInfo.Component,AncestorInstance);
|
||||
if DestroyDriver then Writer.Driver.Free;
|
||||
FreeAndNil(Writer);
|
||||
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
|
||||
@ -4294,7 +4303,7 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TMainIDE.DoSaveFileResourceToBinStream(AnUnitInfo: TUnitInfo;
|
||||
function TMainIDE.DoSaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
|
||||
var BinCompStream: TExtMemoryStream): TModalResult;
|
||||
var
|
||||
Writer: TWriter;
|
||||
@ -4868,7 +4877,7 @@ begin
|
||||
OpenFlags,AncestorType,AncestorUnitInfo);
|
||||
if Result=mrAbort then exit;
|
||||
if Result=mrOk then begin
|
||||
Result:=DoSaveFileResourceToBinStream(AncestorUnitInfo,
|
||||
Result:=DoSaveUnitComponentToBinStream(AncestorUnitInfo,
|
||||
AncestorBinStream);
|
||||
if Result<>mrOk then exit;
|
||||
AncestorBinStream.Position:=0;
|
||||
@ -4923,6 +4932,8 @@ begin
|
||||
NewComponent:=FormEditor1.CreateRawComponentFromStream(BinStream,
|
||||
AncestorType,AncestorBinStream,copy(NewUnitName,1,255),true);
|
||||
AnUnitInfo.Component:=NewComponent;
|
||||
if (AncestorUnitInfo<>nil) then
|
||||
AnUnitInfo.AddRequiresComponentDependency(AncestorUnitInfo);
|
||||
if NewComponent=nil then begin
|
||||
// error streaming component -> examine lfm file
|
||||
DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
|
||||
@ -5266,6 +5277,14 @@ begin
|
||||
exit(true);
|
||||
end;
|
||||
|
||||
function TMainIDE.GetAncestorUnit(AnUnitInfo: TUnitInfo): TUnitInfo;
|
||||
begin
|
||||
if (AnUnitInfo=nil) or (AnUnitInfo.Component=nil) then
|
||||
Result:=nil
|
||||
else
|
||||
Result:=AnUnitInfo.FindAncestorUnit;
|
||||
end;
|
||||
|
||||
function TMainIDE.CreateProjectObject(ProjectDesc,
|
||||
FallbackProjectDesc: TProjectDescriptor): TProject;
|
||||
begin
|
||||
@ -6019,7 +6038,7 @@ begin
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.DoSaveEditorFile B');{$ENDIF}
|
||||
// save resource file and lfm file
|
||||
if (ResourceCode<>nil) or (ActiveUnitInfo.Component<>nil) then begin
|
||||
Result:=DoSaveFileResources(ActiveUnitInfo,ResourceCode,LFMCode,Flags);
|
||||
Result:=DoSaveUnitComponent(ActiveUnitInfo,ResourceCode,LFMCode,Flags);
|
||||
if Result in [mrIgnore, mrOk] then
|
||||
Result:=mrCancel
|
||||
else
|
||||
|
||||
171
ide/project.pp
171
ide/project.pp
@ -79,6 +79,37 @@ type
|
||||
uilLoaded,
|
||||
uilAutoRevertLocked
|
||||
);
|
||||
|
||||
TUnitCompDependencyList = (
|
||||
ucdlRequires,
|
||||
ucdlUsedBy
|
||||
);
|
||||
|
||||
{ TUnitComponentDependency }
|
||||
|
||||
TUnitComponentDependency = class
|
||||
private
|
||||
FRequiresUnit: TUnitInfo;
|
||||
FUsedByUnit: TUnitInfo;
|
||||
procedure SetRequiresUnit(const AValue: TUnitInfo);
|
||||
procedure SetUsedByUnit(const AValue: TUnitInfo);
|
||||
public
|
||||
NextDependency, PrevDependency:
|
||||
array[TUnitCompDependencyList] of TUnitComponentDependency;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function NextUsedByDependency: TUnitComponentDependency;
|
||||
function PrevUsedByDependency: TUnitComponentDependency;
|
||||
function NextRequiresDependency: TUnitComponentDependency;
|
||||
function PrevRequiresDependency: TUnitComponentDependency;
|
||||
procedure AddToList(var FirstDependency: TUnitComponentDependency;
|
||||
ListType: TUnitCompDependencyList);
|
||||
procedure RemoveFromList(var FirstDependency: TUnitComponentDependency;
|
||||
ListType: TUnitCompDependencyList);
|
||||
property RequiresUnit: TUnitInfo read FRequiresUnit write SetRequiresUnit;
|
||||
property UsedByUnit: TUnitInfo read FUsedByUnit write SetUsedByUnit;
|
||||
end;
|
||||
|
||||
//---------------------------------------------------------------------------
|
||||
|
||||
@ -105,6 +136,8 @@ type
|
||||
fEditorIndex: integer;
|
||||
fFileName: string;
|
||||
fFileReadOnly: Boolean;
|
||||
FFirstRequiredComponent: TUnitComponentDependency;
|
||||
FFirstUsedByComponent: TUnitComponentDependency;
|
||||
fHasResources: boolean; // source has resource file
|
||||
FIgnoreFileDateOnDiskValid: boolean;
|
||||
FIgnoreFileDateOnDisk: longint;
|
||||
@ -175,6 +208,7 @@ type
|
||||
function WriteUnitSourceToFile(const AFileName: string): TModalResult;
|
||||
procedure Clear;
|
||||
procedure ClearModifieds;
|
||||
procedure ClearComponentDependencies;
|
||||
procedure CreateStartCode(Descriptor: TProjectFileDescriptor;
|
||||
const NewUnitName: string);
|
||||
procedure DecreaseAutoRevertLock;
|
||||
@ -193,6 +227,11 @@ type
|
||||
|
||||
procedure SetSourceText(const SourceText: string); override;
|
||||
function GetSourceText: string; override;
|
||||
|
||||
// component dependencies
|
||||
procedure AddRequiresComponentDependency(RequiredUnit: TUnitInfo);
|
||||
procedure RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo);
|
||||
function FindAncestorUnit: TUnitInfo;
|
||||
public
|
||||
{ Properties }
|
||||
// Unit lists
|
||||
@ -225,6 +264,10 @@ type
|
||||
read fCustomHighlighter write fCustomHighlighter;
|
||||
property EditorIndex: integer read fEditorIndex write SetEditorIndex;
|
||||
property FileReadOnly: Boolean read fFileReadOnly write SetFileReadOnly;
|
||||
property FirstRequiredComponent: TUnitComponentDependency
|
||||
read FFirstRequiredComponent;
|
||||
property FirstUsedByComponent: TUnitComponentDependency
|
||||
read FFirstUsedByComponent;
|
||||
property HasResources: boolean read GetHasResources write fHasResources;
|
||||
property Loaded: Boolean read fLoaded write SetLoaded;
|
||||
property LoadingComponent: boolean read FLoadingComponent write FLoadingComponent;
|
||||
@ -755,6 +798,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
destructor TUnitInfo.Destroy;
|
||||
begin
|
||||
Component:=nil;
|
||||
Source:=nil;
|
||||
FreeAndNil(FBookmarks);
|
||||
Project:=nil;
|
||||
@ -919,6 +963,7 @@ begin
|
||||
fUserReadOnly := false;
|
||||
if fSource<>nil then fSource.Clear;
|
||||
Loaded := false;
|
||||
ClearComponentDependencies;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.ClearModifieds;
|
||||
@ -927,6 +972,12 @@ begin
|
||||
SessionModified:=false;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.ClearComponentDependencies;
|
||||
begin
|
||||
while FFirstRequiredComponent<>nil do FFirstRequiredComponent.Free;
|
||||
while FFirstUsedByComponent<>nil do FFirstUsedByComponent.Free;
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUnitInfo SaveToXMLConfig
|
||||
@ -1229,6 +1280,38 @@ begin
|
||||
Result:=Source.Source;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.AddRequiresComponentDependency(RequiredUnit: TUnitInfo);
|
||||
var
|
||||
ADependency: TUnitComponentDependency;
|
||||
begin
|
||||
if RequiredUnit=nil then RaiseGDBException('inconsistency');
|
||||
ADependency:=TUnitComponentDependency.Create;
|
||||
ADependency.RequiresUnit:=RequiredUnit;
|
||||
ADependency.UsedByUnit:=Self;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo);
|
||||
begin
|
||||
RequiredUnit.Free;
|
||||
end;
|
||||
|
||||
function TUnitInfo.FindAncestorUnit: TUnitInfo;
|
||||
var
|
||||
Dependency: TUnitComponentDependency;
|
||||
begin
|
||||
if Component<>nil then begin
|
||||
Dependency:=FirstRequiredComponent;
|
||||
while Dependency<>nil do begin
|
||||
Result:=Dependency.RequiresUnit;
|
||||
if (Result.Component<>nil)
|
||||
and (Component.ClassParent=Result.Component.ClassType) then
|
||||
exit;
|
||||
Dependency:=Dependency.NextRequiresDependency;
|
||||
end;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TUnitInfo.ReadOnly: boolean;
|
||||
begin
|
||||
Result:=UserReadOnly or FileReadOnly;
|
||||
@ -1367,6 +1450,7 @@ begin
|
||||
if fComponent=AValue then exit;
|
||||
fComponent:=AValue;
|
||||
UpdateList(uilWithComponent,fComponent<>nil);
|
||||
if fComponent=nil then ClearComponentDependencies;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.SetIsPartOfProject(const AValue: boolean);
|
||||
@ -4504,5 +4588,92 @@ begin
|
||||
[ofProjectLoading,ofRegularFile]);
|
||||
end;
|
||||
|
||||
{ TUnitComponentDependency }
|
||||
|
||||
procedure TUnitComponentDependency.SetRequiresUnit(const AValue: TUnitInfo);
|
||||
begin
|
||||
if FRequiresUnit=AValue then exit;
|
||||
if FRequiresUnit<>nil then
|
||||
RemoveFromList(FRequiresUnit.FFirstUsedByComponent,ucdlUsedBy);
|
||||
FRequiresUnit:=AValue;
|
||||
if FRequiresUnit<>nil then
|
||||
AddToList(FRequiresUnit.FFirstUsedByComponent,ucdlUsedBy);
|
||||
end;
|
||||
|
||||
procedure TUnitComponentDependency.SetUsedByUnit(const AValue: TUnitInfo);
|
||||
begin
|
||||
if FUsedByUnit=AValue then exit;
|
||||
if FUsedByUnit<>nil then
|
||||
RemoveFromList(FUsedByUnit.FFirstRequiredComponent,ucdlRequires);
|
||||
FUsedByUnit:=AValue;
|
||||
if FUsedByUnit<>nil then
|
||||
AddToList(FUsedByUnit.FFirstRequiredComponent,ucdlRequires);
|
||||
end;
|
||||
|
||||
constructor TUnitComponentDependency.Create;
|
||||
begin
|
||||
Clear;
|
||||
end;
|
||||
|
||||
destructor TUnitComponentDependency.Destroy;
|
||||
begin
|
||||
RequiresUnit:=nil;
|
||||
UsedByUnit:=nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TUnitComponentDependency.Clear;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TUnitComponentDependency.NextUsedByDependency
|
||||
: TUnitComponentDependency;
|
||||
begin
|
||||
Result:=NextDependency[ucdlUsedBy];
|
||||
end;
|
||||
|
||||
function TUnitComponentDependency.PrevUsedByDependency
|
||||
: TUnitComponentDependency;
|
||||
begin
|
||||
Result:=PrevDependency[ucdlUsedBy];
|
||||
end;
|
||||
|
||||
function TUnitComponentDependency.NextRequiresDependency
|
||||
: TUnitComponentDependency;
|
||||
begin
|
||||
Result:=NextDependency[ucdlRequires];
|
||||
end;
|
||||
|
||||
function TUnitComponentDependency.PrevRequiresDependency
|
||||
: TUnitComponentDependency;
|
||||
begin
|
||||
Result:=PrevDependency[ucdlRequires];
|
||||
end;
|
||||
|
||||
procedure TUnitComponentDependency.AddToList(
|
||||
var FirstDependency: TUnitComponentDependency;
|
||||
ListType: TUnitCompDependencyList);
|
||||
begin
|
||||
NextDependency[ListType]:=FirstDependency;
|
||||
FirstDependency:=Self;
|
||||
PrevDependency[ListType]:=nil;
|
||||
if NextDependency[ListType]<>nil then
|
||||
NextDependency[ListType].PrevDependency[ListType]:=Self;
|
||||
end;
|
||||
|
||||
procedure TUnitComponentDependency.RemoveFromList(
|
||||
var FirstDependency: TUnitComponentDependency;
|
||||
ListType: TUnitCompDependencyList);
|
||||
begin
|
||||
if FirstDependency=Self then FirstDependency:=NextDependency[ListType];
|
||||
if NextDependency[ListType]<>nil then
|
||||
NextDependency[ListType].PrevDependency[ListType]:=PrevDependency[ListType];
|
||||
if PrevDependency[ListType]<>nil then
|
||||
PrevDependency[ListType].NextDependency[ListType]:=NextDependency[ListType];
|
||||
NextDependency[ListType]:=nil;
|
||||
PrevDependency[ListType]:=nil;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user