resref.inc 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448
  1. type
  2. // Quadruple representing an unresolved component property.
  3. { TUnresolvedReference }
  4. TUnresolvedReference = class(TlinkedListItem)
  5. Private
  6. FRoot: TComponent; // Root component when streaming
  7. FPropInfo: PPropInfo; // Property to set.
  8. FGlobal, // Global component.
  9. FRelative : string; // Path relative to global component.
  10. Function Resolve(Instance : TPersistent) : Boolean; // Resolve this reference
  11. Function RootMatches(ARoot : TComponent) : Boolean; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE} // True if Froot matches or ARoot is nil.
  12. Function NextRef : TUnresolvedReference; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
  13. end;
  14. TLocalUnResolvedReference = class(TUnresolvedReference)
  15. Finstance : TPersistent;
  16. end;
  17. // Linked list of TPersistent items that have unresolved properties.
  18. { TUnResolvedInstance }
  19. TUnResolvedInstance = Class(TLinkedListItem)
  20. Instance : TPersistent; // Instance we're handling unresolveds for
  21. FUnresolved : TLinkedList; // The list
  22. Destructor Destroy; override;
  23. Function AddReference(ARoot : TComponent; APropInfo : PPropInfo; AGlobal,ARelative : String) : TUnresolvedReference;
  24. Function RootUnresolved : TUnresolvedReference; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE} // Return root element in list.
  25. Function ResolveReferences : Boolean; // Return true if all unresolveds were resolved.
  26. end;
  27. // Builds a list of TUnResolvedInstances, removes them from global list on free.
  28. TBuildListVisitor = Class(TLinkedListVisitor)
  29. List : TFPList;
  30. Procedure Add(Item : TlinkedListItem); // Add TUnResolvedInstance item to list. Create list if needed
  31. Destructor Destroy; override; // All elements in list (if any) are removed from the global list.
  32. end;
  33. // Visitor used to try and resolve instances in the global list
  34. TResolveReferenceVisitor = Class(TBuildListVisitor)
  35. Function Visit(Item : TLinkedListItem) : Boolean; override;
  36. end;
  37. // Visitor used to remove all references to a certain component.
  38. TRemoveReferenceVisitor = Class(TBuildListVisitor)
  39. FRef : String;
  40. FRoot : TComponent;
  41. Constructor Create(ARoot : TComponent;Const ARef : String);
  42. Function Visit(Item : TLinkedListItem) : Boolean; override;
  43. end;
  44. // Visitor used to collect reference names.
  45. TReferenceNamesVisitor = Class(TLinkedListVisitor)
  46. FList : TStrings;
  47. FRoot : TComponent;
  48. Function Visit(Item : TLinkedListItem) : Boolean; override;
  49. Constructor Create(ARoot : TComponent;AList : TStrings);
  50. end;
  51. // Visitor used to collect instance names.
  52. TReferenceInstancesVisitor = Class(TLinkedListVisitor)
  53. FList : TStrings;
  54. FRef : String;
  55. FRoot : TComponent;
  56. Function Visit(Item : TLinkedListItem) : Boolean; override;
  57. Constructor Create(ARoot : TComponent;Const ARef : String; AList : TStrings);
  58. end;
  59. // Visitor used to redirect links to another root component.
  60. TRedirectReferenceVisitor = Class(TLinkedListVisitor)
  61. FOld,
  62. FNew : String;
  63. FRoot : TComponent;
  64. Function Visit(Item : TLinkedListItem) : Boolean; override;
  65. Constructor Create(ARoot : TComponent;Const AOld,ANew : String);
  66. end;
  67. var
  68. NeedResolving : TLinkedList;
  69. ResolveSection : TRTLCriticalSection;
  70. // Add an instance to the global list of instances which need resolving.
  71. Function FindUnresolvedInstance(AInstance: TPersistent) : TUnResolvedInstance;
  72. begin
  73. Result:=Nil;
  74. EnterCriticalSection(ResolveSection);
  75. Try
  76. If Assigned(NeedResolving) then
  77. begin
  78. Result:=TUnResolvedInstance(NeedResolving.Root);
  79. While (Result<>Nil) and (Result.Instance<>AInstance) do
  80. Result:=TUnResolvedInstance(Result.Next);
  81. end;
  82. finally
  83. LeaveCriticalSection(ResolveSection);
  84. end;
  85. end;
  86. Function AddtoResolveList(AInstance: TPersistent) : TUnResolvedInstance;
  87. begin
  88. Result:=FindUnresolvedInstance(AInstance);
  89. If (Result=Nil) then
  90. begin
  91. EnterCriticalSection(ResolveSection);
  92. Try
  93. If not Assigned(NeedResolving) then
  94. NeedResolving:=TLinkedList.Create(TUnResolvedInstance);
  95. Result:=NeedResolving.Add as TUnResolvedInstance;
  96. Result.Instance:=AInstance;
  97. finally
  98. LeaveCriticalSection(ResolveSection);
  99. end;
  100. end;
  101. end;
  102. // Walk through the global list of instances to be resolved.
  103. Procedure VisitResolveList(V : TLinkedListVisitor);
  104. begin
  105. EnterCriticalSection(ResolveSection);
  106. Try
  107. try
  108. NeedResolving.Foreach(V);
  109. Finally
  110. FreeAndNil(V);
  111. end;
  112. Finally
  113. LeaveCriticalSection(ResolveSection);
  114. end;
  115. end;
  116. procedure GlobalFixupReferences;
  117. begin
  118. If (NeedResolving=Nil) then
  119. Exit;
  120. GlobalNameSpace.BeginWrite;
  121. try
  122. VisitResolveList(TResolveReferenceVisitor.Create);
  123. finally
  124. GlobalNameSpace.EndWrite;
  125. end;
  126. end;
  127. procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
  128. begin
  129. If (NeedResolving=Nil) then
  130. Exit;
  131. VisitResolveList(TReferenceNamesVisitor.Create(Root,Names));
  132. end;
  133. procedure GetFixupInstanceNames(Root: TComponent; const ReferenceRootName: string; Names: TStrings);
  134. begin
  135. If (NeedResolving=Nil) then
  136. Exit;
  137. VisitResolveList(TReferenceInstancesVisitor.Create(Root,ReferenceRootName,Names));
  138. end;
  139. procedure RedirectFixupReferences(Root: TComponent; const OldRootName, NewRootName: string);
  140. begin
  141. If (NeedResolving=Nil) then
  142. Exit;
  143. VisitResolveList(TRedirectReferenceVisitor.Create(Root,OldRootName,NewRootName));
  144. end;
  145. procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
  146. begin
  147. If (NeedResolving=Nil) then
  148. Exit;
  149. VisitResolveList(TRemoveReferenceVisitor.Create(Root,RootName));
  150. end;
  151. procedure RemoveFixups(Instance: TPersistent);
  152. begin
  153. // This needs work.
  154. {
  155. if not Assigned(GlobalFixupList) then
  156. exit;
  157. with GlobalFixupList.LockList do
  158. try
  159. for i := Count - 1 downto 0 do
  160. begin
  161. CurFixup := TPropFixup(Items[i]);
  162. if (CurFixup.FInstance = Instance) then
  163. begin
  164. Delete(i);
  165. CurFixup.Free;
  166. end;
  167. end;
  168. finally
  169. GlobalFixupList.UnlockList;
  170. end;
  171. }
  172. end;
  173. { TUnresolvedReference }
  174. Function TUnresolvedReference.Resolve(Instance : TPersistent) : Boolean;
  175. Var
  176. C : TComponent;
  177. begin
  178. C:=FindGlobalComponent(FGlobal);
  179. Result:=(C<>Nil);
  180. If Result then
  181. begin
  182. C:=FindNestedComponent(C,FRelative);
  183. Result:=C<>Nil;
  184. If Result then
  185. SetObjectProp(Instance, FPropInfo,C);
  186. end;
  187. end;
  188. Function TUnresolvedReference.RootMatches(ARoot : TComponent) : Boolean; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
  189. begin
  190. Result:=(ARoot=Nil) or (ARoot=FRoot);
  191. end;
  192. Function TUnResolvedReference.NextRef : TUnresolvedReference;
  193. begin
  194. Result:=TUnresolvedReference(Next);
  195. end;
  196. { TUnResolvedInstance }
  197. destructor TUnResolvedInstance.Destroy;
  198. begin
  199. FUnresolved.Free;
  200. inherited Destroy;
  201. end;
  202. function TUnResolvedInstance.AddReference(ARoot: TComponent;
  203. APropInfo: PPropInfo; AGlobal, ARelative: String): TUnresolvedReference;
  204. begin
  205. If (FUnResolved=Nil) then
  206. FUnResolved:=TLinkedList.Create(TUnresolvedReference);
  207. Result:=FUnResolved.Add as TUnresolvedReference;
  208. Result.FGlobal:=AGLobal;
  209. Result.FRelative:=ARelative;
  210. Result.FPropInfo:=APropInfo;
  211. Result.FRoot:=ARoot;
  212. end;
  213. Function TUnResolvedInstance.RootUnresolved : TUnresolvedReference;
  214. begin
  215. Result:=Nil;
  216. If Assigned(FUnResolved) then
  217. Result:=TUnresolvedReference(FUnResolved.Root);
  218. end;
  219. Function TUnResolvedInstance.ResolveReferences:Boolean;
  220. Var
  221. R,RN : TUnresolvedReference;
  222. begin
  223. R:=RootUnResolved;
  224. While (R<>Nil) do
  225. begin
  226. RN:=R.NextRef;
  227. If R.Resolve(Self.Instance) then
  228. FUnresolved.RemoveItem(R,True);
  229. R:=RN;
  230. end;
  231. Result:=RootUnResolved=Nil;
  232. end;
  233. { TReferenceNamesVisitor }
  234. Constructor TReferenceNamesVisitor.Create(ARoot : TComponent;AList : TStrings);
  235. begin
  236. FRoot:=ARoot;
  237. FList:=AList;
  238. end;
  239. Function TReferenceNamesVisitor.Visit(Item : TLinkedListItem) : Boolean;
  240. Var
  241. R : TUnresolvedReference;
  242. begin
  243. R:=TUnResolvedInstance(Item).RootUnresolved;
  244. While (R<>Nil) do
  245. begin
  246. If R.RootMatches(FRoot) then
  247. If (FList.IndexOf(R.FGlobal)=-1) then
  248. FList.Add(R.FGlobal);
  249. R:=R.NextRef;
  250. end;
  251. Result:=True;
  252. end;
  253. { TReferenceInstancesVisitor }
  254. Constructor TReferenceInstancesVisitor.Create(ARoot : TComponent; Const ARef : String;AList : TStrings);
  255. begin
  256. FRoot:=ARoot;
  257. FRef:=UpperCase(ARef);
  258. FList:=AList;
  259. end;
  260. Function TReferenceInstancesVisitor.Visit(Item : TLinkedListItem) : Boolean;
  261. Var
  262. R : TUnresolvedReference;
  263. begin
  264. R:=TUnResolvedInstance(Item).RootUnresolved;
  265. While (R<>Nil) do
  266. begin
  267. If (FRoot=R.FRoot) and (FRef=UpperCase(R.FGLobal)) Then
  268. If Flist.IndexOf(R.FRelative)=-1 then
  269. Flist.Add(R.FRelative);
  270. R:=R.NextRef;
  271. end;
  272. Result:=True;
  273. end;
  274. { TRedirectReferenceVisitor }
  275. Constructor TRedirectReferenceVisitor.Create(ARoot : TComponent; Const AOld,ANew : String);
  276. begin
  277. FRoot:=ARoot;
  278. FOld:=UpperCase(AOld);
  279. FNew:=ANew;
  280. end;
  281. Function TRedirectReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
  282. Var
  283. R : TUnresolvedReference;
  284. begin
  285. R:=TUnResolvedInstance(Item).RootUnresolved;
  286. While (R<>Nil) do
  287. begin
  288. If R.RootMatches(FRoot) and (FOld=UpperCase(R.FGLobal)) Then
  289. R.FGlobal:=FNew;
  290. R:=R.NextRef;
  291. end;
  292. Result:=True;
  293. end;
  294. { TRemoveReferenceVisitor }
  295. Constructor TRemoveReferenceVisitor.Create(ARoot : TComponent; Const ARef : String);
  296. begin
  297. FRoot:=ARoot;
  298. FRef:=UpperCase(ARef);
  299. end;
  300. Function TRemoveReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
  301. Var
  302. I : Integer;
  303. UI : TUnResolvedInstance;
  304. R : TUnresolvedReference;
  305. L : TFPList;
  306. begin
  307. UI:=TUnResolvedInstance(Item);
  308. R:=UI.RootUnresolved;
  309. L:=Nil;
  310. Try
  311. // Collect all matches.
  312. While (R<>Nil) do
  313. begin
  314. If R.RootMatches(FRoot) and ((FRef = '') or (FRef=UpperCase(R.FGLobal))) Then
  315. begin
  316. If Not Assigned(L) then
  317. L:=TFPList.Create;
  318. L.Add(R);
  319. end;
  320. R:=R.NextRef;
  321. end;
  322. // Remove all matches.
  323. IF Assigned(L) then
  324. begin
  325. For I:=0 to L.Count-1 do
  326. UI.FUnresolved.RemoveItem(TLinkedListitem(L[i]),True);
  327. end;
  328. // If any references are left, leave them.
  329. If UI.FUnResolved.Root=Nil then
  330. begin
  331. If List=Nil then
  332. List:=TFPList.Create;
  333. List.Add(UI);
  334. end;
  335. Finally
  336. L.Free;
  337. end;
  338. Result:=True;
  339. end;
  340. { TBuildListVisitor }
  341. Procedure TBuildListVisitor.Add(Item : TlinkedListItem);
  342. begin
  343. If (List=Nil) then
  344. List:=TFPList.Create;
  345. List.Add(Item);
  346. end;
  347. Destructor TBuildListVisitor.Destroy;
  348. Var
  349. I : Integer;
  350. begin
  351. If Assigned(List) then
  352. For I:=0 to List.Count-1 do
  353. NeedResolving.RemoveItem(TLinkedListItem(List[I]),True);
  354. FreeAndNil(List);
  355. Inherited;
  356. end;
  357. { TResolveReferenceVisitor }
  358. Function TResolveReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
  359. begin
  360. If TUnResolvedInstance(Item).ResolveReferences then
  361. Add(Item);
  362. Result:=True;
  363. end;