{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: Functions and classes to list identifiers of groups of units. } unit CodeIndex; {$mode objfpc}{$H+} interface uses SysUtils, Laz_AVL_Tree, // LazUtils LazFileUtils, // Codetools CodeTree, CodeCache, StdCodeTools, CodeToolsStructs; type TCodeBrowserUnit = class; TCodeBrowserUnitList = class; { TCodeBrowserNode } TCodeBrowserNode = class private FCBUnit: TCodeBrowserUnit; FChildNodes: TAVLTree; FCodePos: TCodePosition; FDesc: TCodeTreeNodeDesc; FDescription: string; FIdentifier: string; FParentNode: TCodeBrowserNode; public constructor Create(TheUnit: TCodeBrowserUnit; TheParent: TCodeBrowserNode; const TheDescription, TheIdentifier: string); destructor Destroy; override; procedure Clear; function AddNode(const Description, Identifier: string): TCodeBrowserNode; function GetMemSize: SizeUInt; property CBUnit: TCodeBrowserUnit read FCBUnit; property Desc: TCodeTreeNodeDesc read FDesc write FDesc; property CodePos: TCodePosition read FCodePos write FCodePos; property ParentNode: TCodeBrowserNode read FParentNode; property ChildNodes: TAVLTree read FChildNodes; property Description: string read FDescription write FDescription; property Identifier: string read FIdentifier; end; { TCodeBrowserUnit } TCodeBrowserUnit = class private FChildNodes: TAVLTree; // tree of TCodeBrowserNode FCodeBuffer: TCodeBuffer; FCodeTool: TStandardCodeTool; FCodeTreeChangeStep: integer; FFilename: string; FScanned: boolean; FScannedBytes: integer; FScannedIdentifiers: integer; FScannedLines: integer; FUnitList: TCodeBrowserUnitList; procedure SetCodeBuffer(const AValue: TCodeBuffer); procedure SetCodeTool(const AValue: TStandardCodeTool); procedure SetScanned(const AValue: boolean); public constructor Create(const TheFilename: string); destructor Destroy; override; procedure Clear; function AddNode(const Description, Identifier: string): TCodeBrowserNode; function ChildNodeCount: integer; procedure DeleteNode(var Node: TCodeBrowserNode); property Filename: string read FFilename; property CodeBuffer: TCodeBuffer read FCodeBuffer write SetCodeBuffer; property CodeTool: TStandardCodeTool read FCodeTool write SetCodeTool; property CodeTreeChangeStep: integer read FCodeTreeChangeStep; property UnitList: TCodeBrowserUnitList read FUnitList; property ChildNodes: TAVLTree read FChildNodes; property ScannedLines: integer read FScannedLines write FScannedLines; property ScannedBytes: integer read FScannedBytes write FScannedBytes; property ScannedIdentifiers: integer read FScannedIdentifiers write FScannedIdentifiers; property Scanned: boolean read FScanned write SetScanned; end; { TCodeBrowserUnitList } TCodeBrowserUnitList = class private FOwner: string; FParentList: TCodeBrowserUnitList; FScannedUnits: integer; FUnitLists: TAVLTree; // tree of TCodeBrowserUnitList FUnits: TAVLTree; // tree of TCodeBrowserUnit FUnitsValid: boolean; fClearing: boolean; procedure SetOwner(const AValue: string); procedure InternalAddUnitList(List: TCodeBrowserUnitList); procedure InternalRemoveUnitList(List: TCodeBrowserUnitList); procedure InternalAddUnit(AnUnit: TCodeBrowserUnit); procedure InternalRemoveUnit(AnUnit: TCodeBrowserUnit); public constructor Create(TheOwner: string; TheParent: TCodeBrowserUnitList); destructor Destroy; override; procedure Clear; function FindUnit(const Filename: string): TCodeBrowserUnit; function FindUnitList(const OwnerName: string): TCodeBrowserUnitList; function UnitCount: integer; function UnitListCount: integer; function IsEmpty: boolean; procedure DeleteUnit(AnUnit: TCodeBrowserUnit); function AddUnit(const Filename: string): TCodeBrowserUnit; procedure AddUnit(AnUnit: TCodeBrowserUnit); property Owner: string read FOwner write SetOwner;// IDE, project, package property ParentList: TCodeBrowserUnitList read FParentList; property Units: TAVLTree read FUnits; property UnitLists: TAVLTree read FUnitLists; property UnitsValid: boolean read FUnitsValid write FUnitsValid; property ScannedUnits: integer read FScannedUnits write FScannedUnits; end; function CompareUnitListOwners(Data1, Data2: Pointer): integer; function CompareAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer; function CompareUnitFilenames(Data1, Data2: Pointer): integer; function CompareAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer; function CompareNodeIdentifiers(Data1, Data2: Pointer): integer; function CompareAnsiStringWithNodeIdentifier(Data1, Data2: Pointer): integer; implementation function CompareUnitListOwners(Data1, Data2: Pointer): integer; begin Result:=SysUtils.CompareText(TCodeBrowserUnitList(Data1).Owner, TCodeBrowserUnitList(Data2).Owner); end; function CompareAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer; begin Result:=SysUtils.CompareText(AnsiString(Data1), TCodeBrowserUnitList(Data2).Owner); end; function CompareUnitFilenames(Data1, Data2: Pointer): integer; begin Result:=CompareFilenames(TCodeBrowserUnit(Data1).Filename, TCodeBrowserUnit(Data2).Filename); end; function CompareAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer; begin Result:=CompareFilenames(AnsiString(Data1), TCodeBrowserUnit(Data2).Filename); end; function CompareNodeIdentifiers(Data1, Data2: Pointer): integer; begin Result:=SysUtils.CompareText(TCodeBrowserNode(Data1).Identifier, TCodeBrowserNode(Data2).Identifier); end; function CompareAnsiStringWithNodeIdentifier(Data1, Data2: Pointer): integer; begin Result:=SysUtils.CompareText(AnsiString(Data1), TCodeBrowserNode(Data2).Identifier); end; { TCodeBrowserNode } constructor TCodeBrowserNode.Create(TheUnit: TCodeBrowserUnit; TheParent: TCodeBrowserNode; const TheDescription, TheIdentifier: string); begin FCBUnit:=TheUnit; FParentNode:=TheParent; FDescription:=TheDescription; FIdentifier:=TheIdentifier; end; destructor TCodeBrowserNode.Destroy; begin Clear; inherited Destroy; end; procedure TCodeBrowserNode.Clear; begin if FChildNodes<>nil then FChildNodes.FreeAndClear; FreeAndNil(FChildNodes); end; function TCodeBrowserNode.AddNode(const Description, Identifier: string): TCodeBrowserNode; begin Result:=TCodeBrowserNode.Create(nil,Self,Description,Identifier); if FChildNodes=nil then FChildNodes:=TAVLTree.Create(@CompareNodeIdentifiers); FChildNodes.Add(Result); end; function TCodeBrowserNode.GetMemSize: SizeUInt; begin Result:=InstanceSize+length(FIdentifier)+length(FDescription); end; { TCodeBrowserUnit } procedure TCodeBrowserUnit.SetScanned(const AValue: boolean); begin if FScanned=AValue then exit; FScanned:=AValue; FScannedBytes:=0; FScannedLines:=0; FScannedIdentifiers:=0; if UnitList<>nil then begin if FScanned then inc(UnitList.FScannedUnits) else dec(UnitList.FScannedUnits); end; end; procedure TCodeBrowserUnit.SetCodeTool(const AValue: TStandardCodeTool); begin if FCodeTool=nil then exit; FCodeTool:=AValue; end; procedure TCodeBrowserUnit.SetCodeBuffer(const AValue: TCodeBuffer); begin if FCodeBuffer=AValue then exit; FCodeBuffer:=AValue; end; constructor TCodeBrowserUnit.Create(const TheFilename: string); begin FFilename:=TheFilename; end; destructor TCodeBrowserUnit.Destroy; begin Clear; inherited Destroy; end; procedure TCodeBrowserUnit.Clear; begin if FChildNodes<>nil then FChildNodes.FreeAndClear; FreeAndNil(FChildNodes); end; function TCodeBrowserUnit.AddNode(const Description, Identifier: string): TCodeBrowserNode; begin Result:=TCodeBrowserNode.Create(Self,nil,Description,Identifier); if FChildNodes=nil then FChildNodes:=TAVLTree.Create(@CompareNodeIdentifiers); FChildNodes.Add(Result); end; function TCodeBrowserUnit.ChildNodeCount: integer; begin if FChildNodes=nil then Result:=0 else Result:=FChildNodes.Count; end; procedure TCodeBrowserUnit.DeleteNode(var Node: TCodeBrowserNode); begin if Node=nil then exit; if ChildNodes<>nil then AVLRemovePointer(FChildNodes,Node); FreeAndNil(Node); end; { TCodeBrowserUnitList } procedure TCodeBrowserUnitList.SetOwner(const AValue: string); begin if Owner=AValue then exit; if ParentList<>nil then raise Exception.Create('not allowed'); FOwner:=AValue; FUnitsValid:=false; end; procedure TCodeBrowserUnitList.InternalAddUnitList(List: TCodeBrowserUnitList); begin if FUnitLists=nil then FUnitLists:=TAVLTree.Create(@CompareUnitListOwners); FUnitLists.Add(List); end; procedure TCodeBrowserUnitList.InternalRemoveUnitList(List: TCodeBrowserUnitList); begin if FUnitLists<>nil then FUnitLists.Remove(List); end; procedure TCodeBrowserUnitList.InternalAddUnit(AnUnit: TCodeBrowserUnit); begin if FUnits=nil then FUnits:=TAVLTree.Create(@CompareUnitFilenames); FUnits.Add(AnUnit); AnUnit.FUnitList:=Self; end; procedure TCodeBrowserUnitList.InternalRemoveUnit(AnUnit: TCodeBrowserUnit); begin if (not fClearing) and (FUnits<>nil) then FUnits.Remove(AnUnit); AnUnit.FUnitList:=nil; end; constructor TCodeBrowserUnitList.Create(TheOwner: string; TheParent: TCodeBrowserUnitList); begin //DebugLn(['TCodeBrowserUnitList.Create ',TheOwner]); //DumpStack; FOwner:=TheOwner; FParentList:=TheParent; if FParentList<>nil then FParentList.InternalAddUnitList(Self); end; destructor TCodeBrowserUnitList.Destroy; begin Clear; if FParentList<>nil then begin FParentList.InternalRemoveUnitList(Self); FParentList:=nil; end; inherited Destroy; end; procedure TCodeBrowserUnitList.Clear; procedure FreeTree(var Tree: TAVLTree); var TmpTree: TAVLTree; begin if Tree=nil then exit; TmpTree:=Tree; Tree:=nil; TmpTree.FreeAndClear; TmpTree.Free; end; begin fClearing:=true; try FreeTree(FUnits); FreeTree(FUnitLists); FUnitsValid:=false; finally fClearing:=false; end; end; function TCodeBrowserUnitList.FindUnit(const Filename: string ): TCodeBrowserUnit; var Node: TAVLTreeNode; begin Result:=nil; if Filename='' then exit; if FUnits=nil then exit; Node:=FUnits.FindKey(Pointer(Filename),@CompareAnsiStringWithUnitFilename); if Node=nil then exit; Result:=TCodeBrowserUnit(Node.Data); end; function TCodeBrowserUnitList.FindUnitList(const OwnerName: string ): TCodeBrowserUnitList; var Node: TAVLTreeNode; begin Result:=nil; if FUnitLists=nil then exit; if OwnerName='' then exit; Node:=FUnitLists.FindKey(Pointer(OwnerName),@CompareAnsiStringWithUnitListOwner); if Node=nil then exit; Result:=TCodeBrowserUnitList(Node.Data); end; function TCodeBrowserUnitList.UnitCount: integer; begin if FUnits=nil then Result:=0 else Result:=FUnits.Count; end; function TCodeBrowserUnitList.UnitListCount: integer; begin if FUnitLists=nil then Result:=0 else Result:=FUnitLists.Count; end; function TCodeBrowserUnitList.IsEmpty: boolean; begin Result:=(UnitCount=0) and (UnitListCount=0); end; procedure TCodeBrowserUnitList.DeleteUnit(AnUnit: TCodeBrowserUnit); begin if AnUnit=nil then exit; if FUnits=nil then exit; FUnits.Remove(AnUnit); AnUnit.Free; end; function TCodeBrowserUnitList.AddUnit(const Filename: string ): TCodeBrowserUnit; begin Result:=TCodeBrowserUnit.Create(Filename); InternalAddUnit(Result); end; procedure TCodeBrowserUnitList.AddUnit(AnUnit: TCodeBrowserUnit); begin if (AnUnit.UnitList=Self) then exit; if AnUnit.UnitList<>nil then AnUnit.UnitList.InternalRemoveUnit(AnUnit); InternalAddUnit(AnUnit); end; end.