123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448 |
- type
- // Quadruple representing an unresolved component property.
- { TUnresolvedReference }
- TUnresolvedReference = class(TlinkedListItem)
- Private
- FRoot: TComponent; // Root component when streaming
- FPropInfo: PPropInfo; // Property to set.
- FGlobal, // Global component.
- FRelative : string; // Path relative to global component.
- Function Resolve(Instance : TPersistent) : Boolean; // Resolve this reference
- Function RootMatches(ARoot : TComponent) : Boolean; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE} // True if Froot matches or ARoot is nil.
- Function NextRef : TUnresolvedReference; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
- end;
-
- TLocalUnResolvedReference = class(TUnresolvedReference)
- Finstance : TPersistent;
- end;
- // Linked list of TPersistent items that have unresolved properties.
- { TUnResolvedInstance }
- TUnResolvedInstance = Class(TLinkedListItem)
- Instance : TPersistent; // Instance we're handling unresolveds for
- FUnresolved : TLinkedList; // The list
- Destructor Destroy; override;
- Function AddReference(ARoot : TComponent; APropInfo : PPropInfo; AGlobal,ARelative : String) : TUnresolvedReference;
- Function RootUnresolved : TUnresolvedReference; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE} // Return root element in list.
- Function ResolveReferences : Boolean; // Return true if all unresolveds were resolved.
- end;
- // Builds a list of TUnResolvedInstances, removes them from global list on free.
- TBuildListVisitor = Class(TLinkedListVisitor)
- List : TFPList;
- Procedure Add(Item : TlinkedListItem); // Add TUnResolvedInstance item to list. Create list if needed
- Destructor Destroy; override; // All elements in list (if any) are removed from the global list.
- end;
-
- // Visitor used to try and resolve instances in the global list
- TResolveReferenceVisitor = Class(TBuildListVisitor)
- Function Visit(Item : TLinkedListItem) : Boolean; override;
- end;
-
- // Visitor used to remove all references to a certain component.
- TRemoveReferenceVisitor = Class(TBuildListVisitor)
- FRef : String;
- FRoot : TComponent;
- Constructor Create(ARoot : TComponent;Const ARef : String);
- Function Visit(Item : TLinkedListItem) : Boolean; override;
- end;
- // Visitor used to collect reference names.
- TReferenceNamesVisitor = Class(TLinkedListVisitor)
- FList : TStrings;
- FRoot : TComponent;
- Function Visit(Item : TLinkedListItem) : Boolean; override;
- Constructor Create(ARoot : TComponent;AList : TStrings);
- end;
- // Visitor used to collect instance names.
- TReferenceInstancesVisitor = Class(TLinkedListVisitor)
- FList : TStrings;
- FRef : String;
- FRoot : TComponent;
- Function Visit(Item : TLinkedListItem) : Boolean; override;
- Constructor Create(ARoot : TComponent;Const ARef : String; AList : TStrings);
- end;
-
- // Visitor used to redirect links to another root component.
- TRedirectReferenceVisitor = Class(TLinkedListVisitor)
- FOld,
- FNew : String;
- FRoot : TComponent;
- Function Visit(Item : TLinkedListItem) : Boolean; override;
- Constructor Create(ARoot : TComponent;Const AOld,ANew : String);
- end;
-
- var
- NeedResolving : TLinkedList;
- ResolveSection : TRTLCriticalSection;
- // Add an instance to the global list of instances which need resolving.
- Function FindUnresolvedInstance(AInstance: TPersistent) : TUnResolvedInstance;
- begin
- Result:=Nil;
- EnterCriticalSection(ResolveSection);
- Try
- If Assigned(NeedResolving) then
- begin
- Result:=TUnResolvedInstance(NeedResolving.Root);
- While (Result<>Nil) and (Result.Instance<>AInstance) do
- Result:=TUnResolvedInstance(Result.Next);
- end;
- finally
- LeaveCriticalSection(ResolveSection);
- end;
- end;
- Function AddtoResolveList(AInstance: TPersistent) : TUnResolvedInstance;
- begin
- Result:=FindUnresolvedInstance(AInstance);
- If (Result=Nil) then
- begin
- EnterCriticalSection(ResolveSection);
- Try
- If not Assigned(NeedResolving) then
- NeedResolving:=TLinkedList.Create(TUnResolvedInstance);
- Result:=NeedResolving.Add as TUnResolvedInstance;
- Result.Instance:=AInstance;
- finally
- LeaveCriticalSection(ResolveSection);
- end;
- end;
- end;
- // Walk through the global list of instances to be resolved.
- Procedure VisitResolveList(V : TLinkedListVisitor);
- begin
- EnterCriticalSection(ResolveSection);
- Try
- try
- NeedResolving.Foreach(V);
- Finally
- FreeAndNil(V);
- end;
- Finally
- LeaveCriticalSection(ResolveSection);
- end;
- end;
- procedure GlobalFixupReferences;
- begin
- If (NeedResolving=Nil) then
- Exit;
- GlobalNameSpace.BeginWrite;
- try
- VisitResolveList(TResolveReferenceVisitor.Create);
- finally
- GlobalNameSpace.EndWrite;
- end;
- end;
- procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
- begin
- If (NeedResolving=Nil) then
- Exit;
- VisitResolveList(TReferenceNamesVisitor.Create(Root,Names));
- end;
- procedure GetFixupInstanceNames(Root: TComponent; const ReferenceRootName: string; Names: TStrings);
- begin
- If (NeedResolving=Nil) then
- Exit;
- VisitResolveList(TReferenceInstancesVisitor.Create(Root,ReferenceRootName,Names));
- end;
- procedure RedirectFixupReferences(Root: TComponent; const OldRootName, NewRootName: string);
- begin
- If (NeedResolving=Nil) then
- Exit;
- VisitResolveList(TRedirectReferenceVisitor.Create(Root,OldRootName,NewRootName));
- end;
- procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
- begin
- If (NeedResolving=Nil) then
- Exit;
- VisitResolveList(TRemoveReferenceVisitor.Create(Root,RootName));
- end;
- procedure RemoveFixups(Instance: TPersistent);
- begin
- // This needs work.
- {
- if not Assigned(GlobalFixupList) then
- exit;
- with GlobalFixupList.LockList do
- try
- for i := Count - 1 downto 0 do
- begin
- CurFixup := TPropFixup(Items[i]);
- if (CurFixup.FInstance = Instance) then
- begin
- Delete(i);
- CurFixup.Free;
- end;
- end;
- finally
- GlobalFixupList.UnlockList;
- end;
- }
- end;
- { TUnresolvedReference }
- Function TUnresolvedReference.Resolve(Instance : TPersistent) : Boolean;
- Var
- C : TComponent;
- begin
- C:=FindGlobalComponent(FGlobal);
- Result:=(C<>Nil);
- If Result then
- begin
- C:=FindNestedComponent(C,FRelative);
- Result:=C<>Nil;
- If Result then
- SetObjectProp(Instance, FPropInfo,C);
- end;
- end;
- Function TUnresolvedReference.RootMatches(ARoot : TComponent) : Boolean; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
- begin
- Result:=(ARoot=Nil) or (ARoot=FRoot);
- end;
- Function TUnResolvedReference.NextRef : TUnresolvedReference;
- begin
- Result:=TUnresolvedReference(Next);
- end;
- { TUnResolvedInstance }
- destructor TUnResolvedInstance.Destroy;
- begin
- FUnresolved.Free;
- inherited Destroy;
- end;
- function TUnResolvedInstance.AddReference(ARoot: TComponent;
- APropInfo: PPropInfo; AGlobal, ARelative: String): TUnresolvedReference;
- begin
- If (FUnResolved=Nil) then
- FUnResolved:=TLinkedList.Create(TUnresolvedReference);
- Result:=FUnResolved.Add as TUnresolvedReference;
- Result.FGlobal:=AGLobal;
- Result.FRelative:=ARelative;
- Result.FPropInfo:=APropInfo;
- Result.FRoot:=ARoot;
- end;
- Function TUnResolvedInstance.RootUnresolved : TUnresolvedReference;
- begin
- Result:=Nil;
- If Assigned(FUnResolved) then
- Result:=TUnresolvedReference(FUnResolved.Root);
- end;
- Function TUnResolvedInstance.ResolveReferences:Boolean;
- Var
- R,RN : TUnresolvedReference;
- begin
- R:=RootUnResolved;
- While (R<>Nil) do
- begin
- RN:=R.NextRef;
- If R.Resolve(Self.Instance) then
- FUnresolved.RemoveItem(R,True);
- R:=RN;
- end;
- Result:=RootUnResolved=Nil;
- end;
- { TReferenceNamesVisitor }
- Constructor TReferenceNamesVisitor.Create(ARoot : TComponent;AList : TStrings);
- begin
- FRoot:=ARoot;
- FList:=AList;
- end;
- Function TReferenceNamesVisitor.Visit(Item : TLinkedListItem) : Boolean;
- Var
- R : TUnresolvedReference;
- begin
- R:=TUnResolvedInstance(Item).RootUnresolved;
- While (R<>Nil) do
- begin
- If R.RootMatches(FRoot) then
- If (FList.IndexOf(R.FGlobal)=-1) then
- FList.Add(R.FGlobal);
- R:=R.NextRef;
- end;
- Result:=True;
- end;
- { TReferenceInstancesVisitor }
- Constructor TReferenceInstancesVisitor.Create(ARoot : TComponent; Const ARef : String;AList : TStrings);
- begin
- FRoot:=ARoot;
- FRef:=UpperCase(ARef);
- FList:=AList;
- end;
- Function TReferenceInstancesVisitor.Visit(Item : TLinkedListItem) : Boolean;
- Var
- R : TUnresolvedReference;
- begin
- R:=TUnResolvedInstance(Item).RootUnresolved;
- While (R<>Nil) do
- begin
- If (FRoot=R.FRoot) and (FRef=UpperCase(R.FGLobal)) Then
- If Flist.IndexOf(R.FRelative)=-1 then
- Flist.Add(R.FRelative);
- R:=R.NextRef;
- end;
- Result:=True;
- end;
- { TRedirectReferenceVisitor }
- Constructor TRedirectReferenceVisitor.Create(ARoot : TComponent; Const AOld,ANew : String);
- begin
- FRoot:=ARoot;
- FOld:=UpperCase(AOld);
- FNew:=ANew;
- end;
- Function TRedirectReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
- Var
- R : TUnresolvedReference;
- begin
- R:=TUnResolvedInstance(Item).RootUnresolved;
- While (R<>Nil) do
- begin
- If R.RootMatches(FRoot) and (FOld=UpperCase(R.FGLobal)) Then
- R.FGlobal:=FNew;
- R:=R.NextRef;
- end;
- Result:=True;
- end;
- { TRemoveReferenceVisitor }
- Constructor TRemoveReferenceVisitor.Create(ARoot : TComponent; Const ARef : String);
- begin
- FRoot:=ARoot;
- FRef:=UpperCase(ARef);
- end;
- Function TRemoveReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
- Var
- I : Integer;
- UI : TUnResolvedInstance;
- R : TUnresolvedReference;
- L : TFPList;
-
- begin
- UI:=TUnResolvedInstance(Item);
- R:=UI.RootUnresolved;
- L:=Nil;
- Try
- // Collect all matches.
- While (R<>Nil) do
- begin
- If R.RootMatches(FRoot) and ((FRef = '') or (FRef=UpperCase(R.FGLobal))) Then
- begin
- If Not Assigned(L) then
- L:=TFPList.Create;
- L.Add(R);
- end;
- R:=R.NextRef;
- end;
- // Remove all matches.
- IF Assigned(L) then
- begin
- For I:=0 to L.Count-1 do
- UI.FUnresolved.RemoveItem(TLinkedListitem(L[i]),True);
- end;
- // If any references are left, leave them.
- If UI.FUnResolved.Root=Nil then
- begin
- If List=Nil then
- List:=TFPList.Create;
- List.Add(UI);
- end;
- Finally
- L.Free;
- end;
- Result:=True;
- end;
- { TBuildListVisitor }
- Procedure TBuildListVisitor.Add(Item : TlinkedListItem);
- begin
- If (List=Nil) then
- List:=TFPList.Create;
- List.Add(Item);
- end;
- Destructor TBuildListVisitor.Destroy;
- Var
- I : Integer;
- begin
- If Assigned(List) then
- For I:=0 to List.Count-1 do
- NeedResolving.RemoveItem(TLinkedListItem(List[I]),True);
- FreeAndNil(List);
- Inherited;
- end;
- { TResolveReferenceVisitor }
- Function TResolveReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
- begin
- If TUnResolvedInstance(Item).ResolveReferences then
- Add(Item);
- Result:=True;
- end;
|