/components/codetools/codeindex.pas

http://github.com/graemeg/lazarus · Pascal · 452 lines · 360 code · 58 blank · 34 comment · 33 complexity · d2dc66e34734058d661700f9bafbff1a MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. Author: Mattias Gaertner
  21. Abstract:
  22. Functions and classes to list identifiers of groups of units.
  23. }
  24. unit CodeIndex;
  25. {$mode objfpc}{$H+}
  26. interface
  27. uses
  28. SysUtils, AVL_Tree, CodeTree, CodeCache,
  29. LazFileUtils, StdCodeTools, CodeToolsStructs;
  30. type
  31. TCodeBrowserUnit = class;
  32. TCodeBrowserUnitList = class;
  33. { TCodeBrowserNode }
  34. TCodeBrowserNode = class
  35. private
  36. FCBUnit: TCodeBrowserUnit;
  37. FChildNodes: TAVLTree;
  38. FCodePos: TCodePosition;
  39. FDesc: TCodeTreeNodeDesc;
  40. FDescription: string;
  41. FIdentifier: string;
  42. FParentNode: TCodeBrowserNode;
  43. public
  44. constructor Create(TheUnit: TCodeBrowserUnit;
  45. TheParent: TCodeBrowserNode;
  46. const TheDescription, TheIdentifier: string);
  47. destructor Destroy; override;
  48. procedure Clear;
  49. function AddNode(const Description, Identifier: string): TCodeBrowserNode;
  50. function GetMemSize: SizeUInt;
  51. property CBUnit: TCodeBrowserUnit read FCBUnit;
  52. property Desc: TCodeTreeNodeDesc read FDesc write FDesc;
  53. property CodePos: TCodePosition read FCodePos write FCodePos;
  54. property ParentNode: TCodeBrowserNode read FParentNode;
  55. property ChildNodes: TAVLTree read FChildNodes;
  56. property Description: string read FDescription write FDescription;
  57. property Identifier: string read FIdentifier;
  58. end;
  59. { TCodeBrowserUnit }
  60. TCodeBrowserUnit = class
  61. private
  62. FChildNodes: TAVLTree; // tree of TCodeBrowserNode
  63. FCodeBuffer: TCodeBuffer;
  64. FCodeTool: TStandardCodeTool;
  65. FCodeTreeChangeStep: integer;
  66. FFilename: string;
  67. FScanned: boolean;
  68. FScannedBytes: integer;
  69. FScannedIdentifiers: integer;
  70. FScannedLines: integer;
  71. FUnitList: TCodeBrowserUnitList;
  72. procedure SetCodeBuffer(const AValue: TCodeBuffer);
  73. procedure SetCodeTool(const AValue: TStandardCodeTool);
  74. procedure SetScanned(const AValue: boolean);
  75. public
  76. constructor Create(const TheFilename: string);
  77. destructor Destroy; override;
  78. procedure Clear;
  79. function AddNode(const Description, Identifier: string): TCodeBrowserNode;
  80. function ChildNodeCount: integer;
  81. procedure DeleteNode(var Node: TCodeBrowserNode);
  82. property Filename: string read FFilename;
  83. property CodeBuffer: TCodeBuffer read FCodeBuffer write SetCodeBuffer;
  84. property CodeTool: TStandardCodeTool read FCodeTool write SetCodeTool;
  85. property CodeTreeChangeStep: integer read FCodeTreeChangeStep;
  86. property UnitList: TCodeBrowserUnitList read FUnitList;
  87. property ChildNodes: TAVLTree read FChildNodes;
  88. property ScannedLines: integer read FScannedLines write FScannedLines;
  89. property ScannedBytes: integer read FScannedBytes write FScannedBytes;
  90. property ScannedIdentifiers: integer read FScannedIdentifiers write FScannedIdentifiers;
  91. property Scanned: boolean read FScanned write SetScanned;
  92. end;
  93. { TCodeBrowserUnitList }
  94. TCodeBrowserUnitList = class
  95. private
  96. FOwner: string;
  97. FParentList: TCodeBrowserUnitList;
  98. FScannedUnits: integer;
  99. FUnitLists: TAVLTree; // tree of TCodeBrowserUnitList
  100. FUnits: TAVLTree; // tree of TCodeBrowserUnit
  101. FUnitsValid: boolean;
  102. fClearing: boolean;
  103. procedure SetOwner(const AValue: string);
  104. procedure InternalAddUnitList(List: TCodeBrowserUnitList);
  105. procedure InternalRemoveUnitList(List: TCodeBrowserUnitList);
  106. procedure InternalAddUnit(AnUnit: TCodeBrowserUnit);
  107. procedure InternalRemoveUnit(AnUnit: TCodeBrowserUnit);
  108. public
  109. constructor Create(TheOwner: string; TheParent: TCodeBrowserUnitList);
  110. destructor Destroy; override;
  111. procedure Clear;
  112. function FindUnit(const Filename: string): TCodeBrowserUnit;
  113. function FindUnitList(const OwnerName: string): TCodeBrowserUnitList;
  114. function UnitCount: integer;
  115. function UnitListCount: integer;
  116. function IsEmpty: boolean;
  117. procedure DeleteUnit(AnUnit: TCodeBrowserUnit);
  118. function AddUnit(const Filename: string): TCodeBrowserUnit;
  119. procedure AddUnit(AnUnit: TCodeBrowserUnit);
  120. property Owner: string read FOwner write SetOwner;// IDE, project, package
  121. property ParentList: TCodeBrowserUnitList read FParentList;
  122. property Units: TAVLTree read FUnits;
  123. property UnitLists: TAVLTree read FUnitLists;
  124. property UnitsValid: boolean read FUnitsValid write FUnitsValid;
  125. property ScannedUnits: integer read FScannedUnits write FScannedUnits;
  126. end;
  127. function CompareUnitListOwners(Data1, Data2: Pointer): integer;
  128. function CompareAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer;
  129. function CompareUnitFilenames(Data1, Data2: Pointer): integer;
  130. function CompareAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer;
  131. function CompareNodeIdentifiers(Data1, Data2: Pointer): integer;
  132. function CompareAnsiStringWithNodeIdentifier(Data1, Data2: Pointer): integer;
  133. implementation
  134. function CompareUnitListOwners(Data1, Data2: Pointer): integer;
  135. begin
  136. Result:=SysUtils.CompareText(TCodeBrowserUnitList(Data1).Owner,
  137. TCodeBrowserUnitList(Data2).Owner);
  138. end;
  139. function CompareAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer;
  140. begin
  141. Result:=SysUtils.CompareText(AnsiString(Data1),
  142. TCodeBrowserUnitList(Data2).Owner);
  143. end;
  144. function CompareUnitFilenames(Data1, Data2: Pointer): integer;
  145. begin
  146. Result:=CompareFilenames(TCodeBrowserUnit(Data1).Filename,
  147. TCodeBrowserUnit(Data2).Filename);
  148. end;
  149. function CompareAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer;
  150. begin
  151. Result:=CompareFilenames(AnsiString(Data1),
  152. TCodeBrowserUnit(Data2).Filename);
  153. end;
  154. function CompareNodeIdentifiers(Data1, Data2: Pointer): integer;
  155. begin
  156. Result:=SysUtils.CompareText(TCodeBrowserNode(Data1).Identifier,
  157. TCodeBrowserNode(Data2).Identifier);
  158. end;
  159. function CompareAnsiStringWithNodeIdentifier(Data1, Data2: Pointer): integer;
  160. begin
  161. Result:=SysUtils.CompareText(AnsiString(Data1),
  162. TCodeBrowserNode(Data2).Identifier);
  163. end;
  164. { TCodeBrowserNode }
  165. constructor TCodeBrowserNode.Create(TheUnit: TCodeBrowserUnit;
  166. TheParent: TCodeBrowserNode; const TheDescription, TheIdentifier: string);
  167. begin
  168. FCBUnit:=TheUnit;
  169. FParentNode:=TheParent;
  170. FDescription:=TheDescription;
  171. FIdentifier:=TheIdentifier;
  172. end;
  173. destructor TCodeBrowserNode.Destroy;
  174. begin
  175. Clear;
  176. inherited Destroy;
  177. end;
  178. procedure TCodeBrowserNode.Clear;
  179. begin
  180. if FChildNodes<>nil then
  181. FChildNodes.FreeAndClear;
  182. FreeAndNil(FChildNodes);
  183. end;
  184. function TCodeBrowserNode.AddNode(const Description,
  185. Identifier: string): TCodeBrowserNode;
  186. begin
  187. Result:=TCodeBrowserNode.Create(nil,Self,Description,Identifier);
  188. if FChildNodes=nil then
  189. FChildNodes:=TAVLTree.Create(@CompareNodeIdentifiers);
  190. FChildNodes.Add(Result);
  191. end;
  192. function TCodeBrowserNode.GetMemSize: SizeUInt;
  193. begin
  194. Result:=InstanceSize+length(FIdentifier)+length(FDescription);
  195. end;
  196. { TCodeBrowserUnit }
  197. procedure TCodeBrowserUnit.SetScanned(const AValue: boolean);
  198. begin
  199. if FScanned=AValue then exit;
  200. FScanned:=AValue;
  201. FScannedBytes:=0;
  202. FScannedLines:=0;
  203. FScannedIdentifiers:=0;
  204. if UnitList<>nil then begin
  205. if FScanned then
  206. inc(UnitList.FScannedUnits)
  207. else
  208. dec(UnitList.FScannedUnits);
  209. end;
  210. end;
  211. procedure TCodeBrowserUnit.SetCodeTool(const AValue: TStandardCodeTool);
  212. begin
  213. if FCodeTool=nil then exit;
  214. FCodeTool:=AValue;
  215. end;
  216. procedure TCodeBrowserUnit.SetCodeBuffer(const AValue: TCodeBuffer);
  217. begin
  218. if FCodeBuffer=AValue then exit;
  219. FCodeBuffer:=AValue;
  220. end;
  221. constructor TCodeBrowserUnit.Create(const TheFilename: string);
  222. begin
  223. FFilename:=TheFilename;
  224. end;
  225. destructor TCodeBrowserUnit.Destroy;
  226. begin
  227. Clear;
  228. inherited Destroy;
  229. end;
  230. procedure TCodeBrowserUnit.Clear;
  231. begin
  232. if FChildNodes<>nil then
  233. FChildNodes.FreeAndClear;
  234. FreeAndNil(FChildNodes);
  235. end;
  236. function TCodeBrowserUnit.AddNode(const Description,
  237. Identifier: string): TCodeBrowserNode;
  238. begin
  239. Result:=TCodeBrowserNode.Create(Self,nil,Description,Identifier);
  240. if FChildNodes=nil then
  241. FChildNodes:=TAVLTree.Create(@CompareNodeIdentifiers);
  242. FChildNodes.Add(Result);
  243. end;
  244. function TCodeBrowserUnit.ChildNodeCount: integer;
  245. begin
  246. if FChildNodes=nil then
  247. Result:=0
  248. else
  249. Result:=FChildNodes.Count;
  250. end;
  251. procedure TCodeBrowserUnit.DeleteNode(var Node: TCodeBrowserNode);
  252. begin
  253. if Node=nil then exit;
  254. if ChildNodes<>nil then
  255. AVLRemovePointer(FChildNodes,Node);
  256. FreeAndNil(Node);
  257. end;
  258. { TCodeBrowserUnitList }
  259. procedure TCodeBrowserUnitList.SetOwner(const AValue: string);
  260. begin
  261. if Owner=AValue then exit;
  262. if ParentList<>nil then raise Exception.Create('not allowed');
  263. FOwner:=AValue;
  264. FUnitsValid:=false;
  265. end;
  266. procedure TCodeBrowserUnitList.InternalAddUnitList(List: TCodeBrowserUnitList);
  267. begin
  268. if FUnitLists=nil then
  269. FUnitLists:=TAVLTree.Create(@CompareUnitListOwners);
  270. FUnitLists.Add(List);
  271. end;
  272. procedure TCodeBrowserUnitList.InternalRemoveUnitList(List: TCodeBrowserUnitList);
  273. begin
  274. if FUnitLists<>nil then
  275. FUnitLists.Remove(List);
  276. end;
  277. procedure TCodeBrowserUnitList.InternalAddUnit(AnUnit: TCodeBrowserUnit);
  278. begin
  279. if FUnits=nil then
  280. FUnits:=TAVLTree.Create(@CompareUnitFilenames);
  281. FUnits.Add(AnUnit);
  282. AnUnit.FUnitList:=Self;
  283. end;
  284. procedure TCodeBrowserUnitList.InternalRemoveUnit(AnUnit: TCodeBrowserUnit);
  285. begin
  286. if (not fClearing) and (FUnits<>nil) then
  287. FUnits.Remove(AnUnit);
  288. AnUnit.FUnitList:=nil;
  289. end;
  290. constructor TCodeBrowserUnitList.Create(TheOwner: string;
  291. TheParent: TCodeBrowserUnitList);
  292. begin
  293. //DebugLn(['TCodeBrowserUnitList.Create ',TheOwner]);
  294. //DumpStack;
  295. FOwner:=TheOwner;
  296. FParentList:=TheParent;
  297. if FParentList<>nil then
  298. FParentList.InternalAddUnitList(Self);
  299. end;
  300. destructor TCodeBrowserUnitList.Destroy;
  301. begin
  302. Clear;
  303. if FParentList<>nil then begin
  304. FParentList.InternalRemoveUnitList(Self);
  305. FParentList:=nil;
  306. end;
  307. inherited Destroy;
  308. end;
  309. procedure TCodeBrowserUnitList.Clear;
  310. procedure FreeTree(var Tree: TAVLTree);
  311. var
  312. TmpTree: TAVLTree;
  313. begin
  314. if Tree=nil then exit;
  315. TmpTree:=Tree;
  316. Tree:=nil;
  317. TmpTree.FreeAndClear;
  318. TmpTree.Free;
  319. end;
  320. begin
  321. fClearing:=true;
  322. try
  323. FreeTree(FUnits);
  324. FreeTree(FUnitLists);
  325. FUnitsValid:=false;
  326. finally
  327. fClearing:=false;
  328. end;
  329. end;
  330. function TCodeBrowserUnitList.FindUnit(const Filename: string
  331. ): TCodeBrowserUnit;
  332. var
  333. Node: TAVLTreeNode;
  334. begin
  335. Result:=nil;
  336. if Filename='' then exit;
  337. if FUnits=nil then exit;
  338. Node:=FUnits.FindKey(Pointer(Filename),@CompareAnsiStringWithUnitFilename);
  339. if Node=nil then exit;
  340. Result:=TCodeBrowserUnit(Node.Data);
  341. end;
  342. function TCodeBrowserUnitList.FindUnitList(const OwnerName: string
  343. ): TCodeBrowserUnitList;
  344. var
  345. Node: TAVLTreeNode;
  346. begin
  347. Result:=nil;
  348. if FUnitLists=nil then exit;
  349. if OwnerName='' then exit;
  350. Node:=FUnitLists.FindKey(Pointer(OwnerName),@CompareAnsiStringWithUnitListOwner);
  351. if Node=nil then exit;
  352. Result:=TCodeBrowserUnitList(Node.Data);
  353. end;
  354. function TCodeBrowserUnitList.UnitCount: integer;
  355. begin
  356. if FUnits=nil then
  357. Result:=0
  358. else
  359. Result:=FUnits.Count;
  360. end;
  361. function TCodeBrowserUnitList.UnitListCount: integer;
  362. begin
  363. if FUnitLists=nil then
  364. Result:=0
  365. else
  366. Result:=FUnitLists.Count;
  367. end;
  368. function TCodeBrowserUnitList.IsEmpty: boolean;
  369. begin
  370. Result:=(UnitCount=0) and (UnitListCount=0);
  371. end;
  372. procedure TCodeBrowserUnitList.DeleteUnit(AnUnit: TCodeBrowserUnit);
  373. begin
  374. if AnUnit=nil then exit;
  375. if FUnits=nil then exit;
  376. FUnits.Remove(AnUnit);
  377. AnUnit.Free;
  378. end;
  379. function TCodeBrowserUnitList.AddUnit(const Filename: string
  380. ): TCodeBrowserUnit;
  381. begin
  382. Result:=TCodeBrowserUnit.Create(Filename);
  383. InternalAddUnit(Result);
  384. end;
  385. procedure TCodeBrowserUnitList.AddUnit(AnUnit: TCodeBrowserUnit);
  386. begin
  387. if (AnUnit.UnitList=Self) then exit;
  388. if AnUnit.UnitList<>nil then
  389. AnUnit.UnitList.InternalRemoveUnit(AnUnit);
  390. InternalAddUnit(AnUnit);
  391. end;
  392. end.