/components/codetools/codeindex.pas

  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
 21  Author: Mattias Gaertner
 22
 23  Abstract:
 24    Functions and classes to list identifiers of groups of units.
 25}
 26unit CodeIndex;
 27
 28{$mode objfpc}{$H+}
 29
 30interface
 31
 32uses
 33  SysUtils, AVL_Tree, CodeTree, CodeCache,
 34  LazFileUtils, StdCodeTools, CodeToolsStructs;
 35
 36type
 37  TCodeBrowserUnit = class;
 38  TCodeBrowserUnitList = class;
 39
 40
 41  { TCodeBrowserNode }
 42
 43  TCodeBrowserNode = class
 44  private
 45    FCBUnit: TCodeBrowserUnit;
 46    FChildNodes: TAVLTree;
 47    FCodePos: TCodePosition;
 48    FDesc: TCodeTreeNodeDesc;
 49    FDescription: string;
 50    FIdentifier: string;
 51    FParentNode: TCodeBrowserNode;
 52  public
 53    constructor Create(TheUnit: TCodeBrowserUnit;
 54                       TheParent: TCodeBrowserNode;
 55                       const TheDescription, TheIdentifier: string);
 56    destructor Destroy; override;
 57    procedure Clear;
 58    function AddNode(const Description, Identifier: string): TCodeBrowserNode;
 59    function GetMemSize: SizeUInt;
 60    property CBUnit: TCodeBrowserUnit read FCBUnit;
 61    property Desc: TCodeTreeNodeDesc read FDesc write FDesc;
 62    property CodePos: TCodePosition read FCodePos write FCodePos;
 63    property ParentNode: TCodeBrowserNode read FParentNode;
 64    property ChildNodes: TAVLTree read FChildNodes;
 65    property Description: string read FDescription write FDescription;
 66    property Identifier: string read FIdentifier;
 67  end;
 68
 69
 70  { TCodeBrowserUnit }
 71
 72  TCodeBrowserUnit = class
 73  private
 74    FChildNodes: TAVLTree; // tree of TCodeBrowserNode
 75    FCodeBuffer: TCodeBuffer;
 76    FCodeTool: TStandardCodeTool;
 77    FCodeTreeChangeStep: integer;
 78    FFilename: string;
 79    FScanned: boolean;
 80    FScannedBytes: integer;
 81    FScannedIdentifiers: integer;
 82    FScannedLines: integer;
 83    FUnitList: TCodeBrowserUnitList;
 84    procedure SetCodeBuffer(const AValue: TCodeBuffer);
 85    procedure SetCodeTool(const AValue: TStandardCodeTool);
 86    procedure SetScanned(const AValue: boolean);
 87  public
 88    constructor Create(const TheFilename: string);
 89    destructor Destroy; override;
 90    procedure Clear;
 91    function AddNode(const Description, Identifier: string): TCodeBrowserNode;
 92    function ChildNodeCount: integer;
 93    procedure DeleteNode(var Node: TCodeBrowserNode);
 94    property Filename: string read FFilename;
 95    property CodeBuffer: TCodeBuffer read FCodeBuffer write SetCodeBuffer;
 96    property CodeTool: TStandardCodeTool read FCodeTool write SetCodeTool;
 97    property CodeTreeChangeStep: integer read FCodeTreeChangeStep;
 98    property UnitList: TCodeBrowserUnitList read FUnitList;
 99    property ChildNodes: TAVLTree read FChildNodes;
100    property ScannedLines: integer read FScannedLines write FScannedLines;
101    property ScannedBytes: integer read FScannedBytes write FScannedBytes;
102    property ScannedIdentifiers: integer read FScannedIdentifiers write FScannedIdentifiers;
103    property Scanned: boolean read FScanned write SetScanned;
104  end;
105
106
107  { TCodeBrowserUnitList }
108
109  TCodeBrowserUnitList = class
110  private
111    FOwner: string;
112    FParentList: TCodeBrowserUnitList;
113    FScannedUnits: integer;
114    FUnitLists: TAVLTree; // tree of TCodeBrowserUnitList
115    FUnits: TAVLTree; // tree of TCodeBrowserUnit
116    FUnitsValid: boolean;
117    fClearing: boolean;
118    procedure SetOwner(const AValue: string);
119    procedure InternalAddUnitList(List: TCodeBrowserUnitList);
120    procedure InternalRemoveUnitList(List: TCodeBrowserUnitList);
121    procedure InternalAddUnit(AnUnit: TCodeBrowserUnit);
122    procedure InternalRemoveUnit(AnUnit: TCodeBrowserUnit);
123  public
124    constructor Create(TheOwner: string; TheParent: TCodeBrowserUnitList);
125    destructor Destroy; override;
126    procedure Clear;
127    function FindUnit(const Filename: string): TCodeBrowserUnit;
128    function FindUnitList(const OwnerName: string): TCodeBrowserUnitList;
129    function UnitCount: integer;
130    function UnitListCount: integer;
131    function IsEmpty: boolean;
132    procedure DeleteUnit(AnUnit: TCodeBrowserUnit);
133    function AddUnit(const Filename: string): TCodeBrowserUnit;
134    procedure AddUnit(AnUnit: TCodeBrowserUnit);
135    property Owner: string read FOwner write SetOwner;// IDE, project, package
136    property ParentList: TCodeBrowserUnitList read FParentList;
137    property Units: TAVLTree read FUnits;
138    property UnitLists: TAVLTree read FUnitLists;
139    property UnitsValid: boolean read FUnitsValid write FUnitsValid;
140    property ScannedUnits: integer read FScannedUnits write FScannedUnits;
141  end;
142
143function CompareUnitListOwners(Data1, Data2: Pointer): integer;
144function CompareAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer;
145function CompareUnitFilenames(Data1, Data2: Pointer): integer;
146function CompareAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer;
147function CompareNodeIdentifiers(Data1, Data2: Pointer): integer;
148function CompareAnsiStringWithNodeIdentifier(Data1, Data2: Pointer): integer;
149
150implementation
151
152function CompareUnitListOwners(Data1, Data2: Pointer): integer;
153begin
154  Result:=SysUtils.CompareText(TCodeBrowserUnitList(Data1).Owner,
155                               TCodeBrowserUnitList(Data2).Owner);
156end;
157
158function CompareAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer;
159begin
160  Result:=SysUtils.CompareText(AnsiString(Data1),
161                               TCodeBrowserUnitList(Data2).Owner);
162end;
163
164function CompareUnitFilenames(Data1, Data2: Pointer): integer;
165begin
166  Result:=CompareFilenames(TCodeBrowserUnit(Data1).Filename,
167                           TCodeBrowserUnit(Data2).Filename);
168end;
169
170function CompareAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer;
171begin
172  Result:=CompareFilenames(AnsiString(Data1),
173                           TCodeBrowserUnit(Data2).Filename);
174end;
175
176function CompareNodeIdentifiers(Data1, Data2: Pointer): integer;
177begin
178  Result:=SysUtils.CompareText(TCodeBrowserNode(Data1).Identifier,
179                               TCodeBrowserNode(Data2).Identifier);
180end;
181
182function CompareAnsiStringWithNodeIdentifier(Data1, Data2: Pointer): integer;
183begin
184  Result:=SysUtils.CompareText(AnsiString(Data1),
185                               TCodeBrowserNode(Data2).Identifier);
186end;
187
188{ TCodeBrowserNode }
189
190constructor TCodeBrowserNode.Create(TheUnit: TCodeBrowserUnit;
191  TheParent: TCodeBrowserNode; const TheDescription, TheIdentifier: string);
192begin
193  FCBUnit:=TheUnit;
194  FParentNode:=TheParent;
195  FDescription:=TheDescription;
196  FIdentifier:=TheIdentifier;
197end;
198
199destructor TCodeBrowserNode.Destroy;
200begin
201  Clear;
202  inherited Destroy;
203end;
204
205procedure TCodeBrowserNode.Clear;
206begin
207  if FChildNodes<>nil then
208    FChildNodes.FreeAndClear;
209  FreeAndNil(FChildNodes);
210end;
211
212function TCodeBrowserNode.AddNode(const Description,
213  Identifier: string): TCodeBrowserNode;
214begin
215  Result:=TCodeBrowserNode.Create(nil,Self,Description,Identifier);
216  if FChildNodes=nil then
217    FChildNodes:=TAVLTree.Create(@CompareNodeIdentifiers);
218  FChildNodes.Add(Result);
219end;
220
221function TCodeBrowserNode.GetMemSize: SizeUInt;
222begin
223  Result:=InstanceSize+length(FIdentifier)+length(FDescription);
224end;
225
226{ TCodeBrowserUnit }
227
228procedure TCodeBrowserUnit.SetScanned(const AValue: boolean);
229begin
230  if FScanned=AValue then exit;
231  FScanned:=AValue;
232  FScannedBytes:=0;
233  FScannedLines:=0;
234  FScannedIdentifiers:=0;
235  if UnitList<>nil then begin
236    if FScanned then
237      inc(UnitList.FScannedUnits)
238    else
239      dec(UnitList.FScannedUnits);
240  end;
241end;
242
243procedure TCodeBrowserUnit.SetCodeTool(const AValue: TStandardCodeTool);
244begin
245  if FCodeTool=nil then exit;
246  FCodeTool:=AValue;
247end;
248
249procedure TCodeBrowserUnit.SetCodeBuffer(const AValue: TCodeBuffer);
250begin
251  if FCodeBuffer=AValue then exit;
252  FCodeBuffer:=AValue;
253end;
254
255constructor TCodeBrowserUnit.Create(const TheFilename: string);
256begin
257  FFilename:=TheFilename;
258end;
259
260destructor TCodeBrowserUnit.Destroy;
261begin
262  Clear;
263  inherited Destroy;
264end;
265
266procedure TCodeBrowserUnit.Clear;
267begin
268  if FChildNodes<>nil then
269    FChildNodes.FreeAndClear;
270  FreeAndNil(FChildNodes);
271end;
272
273function TCodeBrowserUnit.AddNode(const Description,
274  Identifier: string): TCodeBrowserNode;
275begin
276  Result:=TCodeBrowserNode.Create(Self,nil,Description,Identifier);
277  if FChildNodes=nil then
278    FChildNodes:=TAVLTree.Create(@CompareNodeIdentifiers);
279  FChildNodes.Add(Result);
280end;
281
282function TCodeBrowserUnit.ChildNodeCount: integer;
283begin
284  if FChildNodes=nil then
285    Result:=0
286  else
287    Result:=FChildNodes.Count;
288end;
289
290procedure TCodeBrowserUnit.DeleteNode(var Node: TCodeBrowserNode);
291begin
292  if Node=nil then exit;
293  if ChildNodes<>nil then
294    AVLRemovePointer(FChildNodes,Node);
295  FreeAndNil(Node);
296end;
297
298{ TCodeBrowserUnitList }
299
300procedure TCodeBrowserUnitList.SetOwner(const AValue: string);
301begin
302  if Owner=AValue then exit;
303  if ParentList<>nil then raise Exception.Create('not allowed');
304  FOwner:=AValue;
305  FUnitsValid:=false;
306end;
307
308procedure TCodeBrowserUnitList.InternalAddUnitList(List: TCodeBrowserUnitList);
309begin
310  if FUnitLists=nil then
311    FUnitLists:=TAVLTree.Create(@CompareUnitListOwners);
312  FUnitLists.Add(List);
313end;
314
315procedure TCodeBrowserUnitList.InternalRemoveUnitList(List: TCodeBrowserUnitList);
316begin
317  if FUnitLists<>nil then
318    FUnitLists.Remove(List);
319end;
320
321procedure TCodeBrowserUnitList.InternalAddUnit(AnUnit: TCodeBrowserUnit);
322begin
323  if FUnits=nil then
324    FUnits:=TAVLTree.Create(@CompareUnitFilenames);
325  FUnits.Add(AnUnit);
326  AnUnit.FUnitList:=Self;
327end;
328
329procedure TCodeBrowserUnitList.InternalRemoveUnit(AnUnit: TCodeBrowserUnit);
330begin
331  if (not fClearing) and (FUnits<>nil) then
332    FUnits.Remove(AnUnit);
333  AnUnit.FUnitList:=nil;
334end;
335
336constructor TCodeBrowserUnitList.Create(TheOwner: string;
337  TheParent: TCodeBrowserUnitList);
338begin
339  //DebugLn(['TCodeBrowserUnitList.Create ',TheOwner]);
340  //DumpStack;
341  FOwner:=TheOwner;
342  FParentList:=TheParent;
343  if FParentList<>nil then
344    FParentList.InternalAddUnitList(Self);
345end;
346
347destructor TCodeBrowserUnitList.Destroy;
348begin
349  Clear;
350  if FParentList<>nil then begin
351    FParentList.InternalRemoveUnitList(Self);
352    FParentList:=nil;
353  end;
354  inherited Destroy;
355end;
356
357procedure TCodeBrowserUnitList.Clear;
358
359  procedure FreeTree(var Tree: TAVLTree);
360  var
361    TmpTree: TAVLTree;
362  begin
363    if Tree=nil then exit;
364    TmpTree:=Tree;
365    Tree:=nil;
366    TmpTree.FreeAndClear;
367    TmpTree.Free;
368  end;
369
370begin
371  fClearing:=true;
372  try
373    FreeTree(FUnits);
374    FreeTree(FUnitLists);
375    FUnitsValid:=false;
376  finally
377    fClearing:=false;
378  end;
379end;
380
381function TCodeBrowserUnitList.FindUnit(const Filename: string
382  ): TCodeBrowserUnit;
383var
384  Node: TAVLTreeNode;
385begin
386  Result:=nil;
387  if Filename='' then exit;
388  if FUnits=nil then exit;
389  Node:=FUnits.FindKey(Pointer(Filename),@CompareAnsiStringWithUnitFilename);
390  if Node=nil then exit;
391  Result:=TCodeBrowserUnit(Node.Data);
392end;
393
394function TCodeBrowserUnitList.FindUnitList(const OwnerName: string
395  ): TCodeBrowserUnitList;
396var
397  Node: TAVLTreeNode;
398begin
399  Result:=nil;
400  if FUnitLists=nil then exit;
401  if OwnerName='' then exit;
402  Node:=FUnitLists.FindKey(Pointer(OwnerName),@CompareAnsiStringWithUnitListOwner);
403  if Node=nil then exit;
404  Result:=TCodeBrowserUnitList(Node.Data);
405end;
406
407function TCodeBrowserUnitList.UnitCount: integer;
408begin
409  if FUnits=nil then
410    Result:=0
411  else
412    Result:=FUnits.Count;
413end;
414
415function TCodeBrowserUnitList.UnitListCount: integer;
416begin
417  if FUnitLists=nil then
418    Result:=0
419  else
420    Result:=FUnitLists.Count;
421end;
422
423function TCodeBrowserUnitList.IsEmpty: boolean;
424begin
425  Result:=(UnitCount=0) and (UnitListCount=0);
426end;
427
428procedure TCodeBrowserUnitList.DeleteUnit(AnUnit: TCodeBrowserUnit);
429begin
430  if AnUnit=nil then exit;
431  if FUnits=nil then exit;
432  FUnits.Remove(AnUnit);
433  AnUnit.Free;
434end;
435
436function TCodeBrowserUnitList.AddUnit(const Filename: string
437  ): TCodeBrowserUnit;
438begin
439  Result:=TCodeBrowserUnit.Create(Filename);
440  InternalAddUnit(Result);
441end;
442
443procedure TCodeBrowserUnitList.AddUnit(AnUnit: TCodeBrowserUnit);
444begin
445  if (AnUnit.UnitList=Self) then exit;
446  if AnUnit.UnitList<>nil then
447    AnUnit.UnitList.InternalRemoveUnit(AnUnit);
448  InternalAddUnit(AnUnit);
449end;
450
451end.
452