mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-01 07:29:30 +01:00
IDE: codebrowser parses units
git-svn-id: trunk@10639 -
This commit is contained in:
mattias
parent
86fd4b58d6
commit
fee343a469
@ -275,7 +275,7 @@ type
|
||||
|
||||
// code exploring
|
||||
function Explore(Code: TCodeBuffer; out ACodeTool: TCodeTool;
|
||||
WithStatements: boolean): boolean;
|
||||
WithStatements: boolean; OnlyInterface: boolean = false): boolean;
|
||||
function CheckSyntax(Code: TCodeBuffer; out NewCode: TCodeBuffer;
|
||||
out NewX, NewY, NewTopLine: integer; out ErrorMsg: string): boolean;
|
||||
|
||||
@ -1339,14 +1339,15 @@ begin
|
||||
end;
|
||||
|
||||
function TCodeToolManager.Explore(Code: TCodeBuffer;
|
||||
out ACodeTool: TCodeTool; WithStatements: boolean): boolean;
|
||||
out ACodeTool: TCodeTool; WithStatements: boolean; OnlyInterface: boolean
|
||||
): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
ACodeTool:=nil;
|
||||
try
|
||||
if InitCurCodeTool(Code) then begin
|
||||
ACodeTool:=FCurCodeTool;
|
||||
FCurCodeTool.Explore(WithStatements);
|
||||
FCurCodeTool.Explore(WithStatements,OnlyInterface);
|
||||
Result:=true;
|
||||
end;
|
||||
except
|
||||
|
||||
@ -481,17 +481,23 @@ end;
|
||||
|
||||
function TCodeTreeNode.Next: TCodeTreeNode;
|
||||
begin
|
||||
Result:=Self;
|
||||
while (Result<>nil) and (Result.NextBrother=nil) do
|
||||
Result:=Result.Parent;
|
||||
if Result<>nil then Result:=Result.NextBrother;
|
||||
if FirstChild<>nil then begin
|
||||
Result:=FirstChild;
|
||||
end else begin
|
||||
Result:=Self;
|
||||
while (Result<>nil) and (Result.NextBrother=nil) do
|
||||
Result:=Result.Parent;
|
||||
if Result<>nil then Result:=Result.NextBrother;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeTreeNode.Prior: TCodeTreeNode;
|
||||
begin
|
||||
if PriorBrother<>nil then
|
||||
Result:=PriorBrother
|
||||
else
|
||||
if PriorBrother<>nil then begin
|
||||
Result:=PriorBrother;
|
||||
while Result.LastChild<>nil do
|
||||
Result:=Result.LastChild;
|
||||
end else
|
||||
Result:=Parent;
|
||||
end;
|
||||
|
||||
|
||||
@ -3864,8 +3864,8 @@ begin
|
||||
// <LazarusSrcDir>/ide
|
||||
DirTempl:=TDefineTemplate.Create('ide',ctsIDEDirectory,
|
||||
'','ide',da_Directory);
|
||||
DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
|
||||
Format(ctsAddsDirToSourcePath,['lcl, components']),
|
||||
DirTempl.AddChild(TDefineTemplate.Create('IDE path addition',
|
||||
Format(ctsAddsDirToSourcePath,['designer, debugger, synedit, ...']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
d('..;'
|
||||
+'../designer;'
|
||||
@ -3874,14 +3874,34 @@ begin
|
||||
+'../converter;'
|
||||
+'../packager;'
|
||||
+'../packager/registration;'
|
||||
+'../ideintf;'
|
||||
+'../lcl;'
|
||||
+'../lcl/interfaces/'+WidgetType+';'
|
||||
+'../components/synedit;'
|
||||
+'../components/codetools;'
|
||||
+'../components/custom;'
|
||||
+'../components/mpaslex;')
|
||||
,da_DefineRecurse));
|
||||
DirTempl.AddChild(TDefineTemplate.Create('IDEIntf path addition',
|
||||
Format(ctsAddsDirToSourcePath,['ideintf']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
d('../ideintf;'
|
||||
+SrcPath)
|
||||
,da_DefineRecurse));
|
||||
DirTempl.AddChild(TDefineTemplate.Create('SynEdit path addition',
|
||||
Format(ctsAddsDirToSourcePath,['synedit']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
d('../components/synedit;'
|
||||
+SrcPath)
|
||||
,da_DefineRecurse));
|
||||
DirTempl.AddChild(TDefineTemplate.Create('CodeTools path addition',
|
||||
Format(ctsAddsDirToSourcePath,['codetools']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
d('../components/codetools;'
|
||||
+SrcPath)
|
||||
,da_DefineRecurse));
|
||||
DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
|
||||
Format(ctsAddsDirToSourcePath,['lcl']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
d('../lcl;'
|
||||
+'../lcl/interfaces/'+WidgetType+';'
|
||||
+SrcPath)
|
||||
,da_DefineRecurse));
|
||||
// include path addition
|
||||
DirTempl.AddChild(TDefineTemplate.Create('includepath addition',
|
||||
Format(ctsSetsIncPathTo,['include, include/TargetOS, include/SrcOS']),
|
||||
|
||||
@ -225,6 +225,8 @@ const
|
||||
function ComparePointers(p1, p2: Pointer): integer;
|
||||
procedure MergeSort(List: PPointer; ListLength: PtrInt;
|
||||
Compare: TListSortCompare);
|
||||
function GetNextDelimitedItem(const List: string; Delimiter: char;
|
||||
var Position: integer): string;
|
||||
|
||||
// debugging
|
||||
procedure DebugLn(Args: array of const);
|
||||
@ -1840,6 +1842,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetNextDelimitedItem(const List: string; Delimiter: char;
|
||||
var Position: integer): string;
|
||||
var
|
||||
StartPos: LongInt;
|
||||
begin
|
||||
StartPos:=Position;
|
||||
while (Position<=length(List)) and (List[Position]<>Delimiter) do
|
||||
inc(Position);
|
||||
Result:=copy(List,StartPos,Position-StartPos);
|
||||
if Position<=length(List) then inc(Position); // skip Delimiter
|
||||
end;
|
||||
|
||||
procedure DebugLn(Args: array of const);
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
@ -71,7 +71,8 @@ type
|
||||
function ReadBackwardTilAnyBracketClose: boolean;
|
||||
public
|
||||
// explore the code
|
||||
function Explore(WithStatements: boolean): boolean;
|
||||
function Explore(WithStatements: boolean;
|
||||
OnlyInterface: boolean = false): boolean;
|
||||
|
||||
// source name e.g. 'unit UnitName;'
|
||||
function GetCachedSourceName: string;
|
||||
@ -3580,10 +3581,10 @@ begin
|
||||
// search all siblings in front
|
||||
ANode:=ANode.Parent;
|
||||
MoveCursorToCleanPos(ANode.Parent.StartPos);
|
||||
end else if ANode.Prior<>nil then begin
|
||||
end else if ANode.PriorBrother<>nil then begin
|
||||
// search between prior sibling and this node
|
||||
//DebugLn('TStandardCodeTool.FindCommentInFront ANode.Prior=',ANode.Prior.DescAsString);
|
||||
MoveCursorToLastNodeAtom(ANode.Prior);
|
||||
MoveCursorToLastNodeAtom(ANode.PriorBrother);
|
||||
end else if ANode.Parent<>nil then begin
|
||||
// search from start of parent node to this node
|
||||
//DebugLn('TStandardCodeTool.FindCommentInFront ANode.Parent=',ANode.Parent.DescAsString);
|
||||
@ -5081,28 +5082,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.Explore(WithStatements: boolean): boolean;
|
||||
|
||||
procedure ExploreNode(ANode: TCodeTreeNode);
|
||||
begin
|
||||
if ANode=nil then exit;
|
||||
case ANode.Desc of
|
||||
ctnClass,ctnClassInterface:
|
||||
BuildSubTreeForClass(ANode);
|
||||
ctnProcedure,ctnProcedureHead:
|
||||
BuildSubTreeForProcHead(ANode);
|
||||
ctnBeginBlock:
|
||||
if WithStatements then
|
||||
BuildSubTreeForBeginBlock(ANode);
|
||||
end;
|
||||
ExploreNode(ANode.FirstChild);
|
||||
ExploreNode(ANode.NextBrother);
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.Explore(WithStatements: boolean;
|
||||
OnlyInterface: boolean): boolean;
|
||||
var
|
||||
Node: TCodeTreeNode;
|
||||
begin
|
||||
Result:=true;
|
||||
BuildTree(false);
|
||||
ExploreNode(Tree.Root);
|
||||
BuildTree(OnlyInterface);
|
||||
Node:=Tree.Root;
|
||||
while Node<>nil do begin
|
||||
case Node.Desc of
|
||||
ctnClass,ctnClassInterface:
|
||||
BuildSubTreeForClass(Node);
|
||||
ctnProcedure,ctnProcedureHead:
|
||||
BuildSubTreeForProcHead(Node);
|
||||
ctnBeginBlock:
|
||||
if WithStatements then
|
||||
BuildSubTreeForBeginBlock(Node);
|
||||
ctnImplementation:
|
||||
if OnlyInterface then exit;
|
||||
end;
|
||||
Node:=Node.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -400,6 +400,7 @@ var
|
||||
AFilename: String;
|
||||
CurFile: TH2PasFile;
|
||||
begin
|
||||
if (Button=mbLeft) and (Shift=[]) then ;
|
||||
Node:=CHeaderFilesCheckTreeView.GetNodeAt(X,Y);
|
||||
if (Node=nil) or (Node.Parent<>nil) then exit;
|
||||
StateIconLeft:=Node.DisplayStateIconLeft;
|
||||
|
||||
@ -42,7 +42,8 @@ uses
|
||||
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
LCLIntf, AvgLvlTree, StdCtrls, ExtCtrls, ComCtrls, Buttons,
|
||||
// codetools
|
||||
CodeTree, CodeCache, CodeToolManager,
|
||||
BasicCodeTools, DefineTemplates, CodeTree, CodeCache, CodeToolManager,
|
||||
LinkScanner, FileProcs,
|
||||
// IDEIntf
|
||||
LazConfigStorage, Project,
|
||||
// IDE
|
||||
@ -79,19 +80,28 @@ type
|
||||
TCodeBrowserUnit = class
|
||||
private
|
||||
FChildNodes: TAvgLvlTree;
|
||||
FCodeBuffer: TCodeBuffer;
|
||||
FCodeTool: TCodeTool;
|
||||
FCodeTreeChangeStep: integer;
|
||||
FFilename: string;
|
||||
FScanned: boolean;
|
||||
FScannedBytes: integer;
|
||||
FScannedLines: integer;
|
||||
FUnitList: TCodeBrowserUnitList;
|
||||
procedure SetScanned(const AValue: boolean);
|
||||
public
|
||||
constructor Create(const TheFilename: string);
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
property Filename: string read FFilename;
|
||||
property CodeBuffer: TCodeBuffer read FCodeBuffer;
|
||||
property CodeTool: TCodeTool read FCodeTool;
|
||||
property CodeTreeChangeStep: integer read FCodeTreeChangeStep;
|
||||
property UnitList: TCodeBrowserUnitList read FUnitList;
|
||||
property ChildNodes: TAvgLvlTree read FChildNodes;
|
||||
property ScannedLines: integer read FScannedLines write FScannedLines;
|
||||
property ScannedBytes: integer read FScannedBytes write FScannedBytes;
|
||||
property Scanned: boolean read FScanned write SetScanned;
|
||||
end;
|
||||
|
||||
|
||||
@ -101,17 +111,29 @@ type
|
||||
private
|
||||
FOwner: string;
|
||||
FParentList: TCodeBrowserUnitList;
|
||||
FScannedUnits: integer;
|
||||
FUnitLists: TAvgLvlTree;
|
||||
FUnits: TAvgLvlTree;
|
||||
FUnitsValid: 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;
|
||||
procedure DeleteUnit(AnUnit: TCodeBrowserUnit);
|
||||
function AddUnit(const Filename: string): TCodeBrowserUnit;
|
||||
property Owner: string read FOwner write SetOwner;// IDE, project, package
|
||||
property ParentList: TCodeBrowserUnitList read FParentList;
|
||||
property Units: TAvgLvlTree read FUnits;
|
||||
property UnitLists: TAvgLvlTree read FUnitLists;
|
||||
property UnitsValid: boolean read FUnitsValid write FUnitsValid;
|
||||
property ScannedUnits: integer read FScannedUnits write FScannedUnits;
|
||||
end;
|
||||
|
||||
type
|
||||
@ -185,9 +207,10 @@ type
|
||||
cbwsGetOptions,
|
||||
cbwsGatherPackages,
|
||||
cbwsFreeUnusedPackages,
|
||||
cbwsAddNewPackages,
|
||||
cbwsGatherFiles,
|
||||
cbwsGatherOutdatedFiles,
|
||||
cbwsUpdateUnits,
|
||||
cbwsUpdateNodes,
|
||||
cbwsFinished
|
||||
);
|
||||
|
||||
@ -225,9 +248,15 @@ type
|
||||
FOptions: TCodeBrowserViewOptions;
|
||||
FProjectAlias: string;
|
||||
FRoot: TCodeBrowserUnitList;
|
||||
FScannedBytes: PtrInt;
|
||||
FScannedLines: PtrInt;
|
||||
FScannedPackages: integer;
|
||||
FScannedUnits: integer;
|
||||
FWorkingRoot: TCodeBrowserUnitList;
|
||||
fUpdateCount: integer;
|
||||
fStage: TCodeBrowserWorkStage;
|
||||
fOutdatedFiles: TAvgLvlTree;// tree of TCodeBrowserUnit
|
||||
fLastStatusBarUpdate: TDateTime;
|
||||
procedure LoadOptions;
|
||||
procedure LoadLevelsCheckGroup;
|
||||
procedure LoadSortListBoxes;
|
||||
@ -235,10 +264,22 @@ type
|
||||
procedure AddSortItem;
|
||||
procedure RemoveSortItem;
|
||||
procedure FillScopeComboBox;
|
||||
procedure SetScannedBytes(const AValue: PtrInt);
|
||||
procedure SetScannedLines(const AValue: PtrInt);
|
||||
procedure SetScannedPackages(const AValue: integer);
|
||||
procedure SetScannedUnits(const AValue: integer);
|
||||
procedure Work;
|
||||
procedure WorkGetOptions;
|
||||
procedure WorkGatherPackages;
|
||||
procedure WorkFreeUnusedPackages;
|
||||
procedure WorkAddNewUnitLists;
|
||||
procedure WorkGatherFileLists;
|
||||
procedure WorkUpdateFileList(List: TCodeBrowserUnitList);
|
||||
procedure WorkGatherOutdatedFiles;
|
||||
procedure WorkUpdateUnits;
|
||||
procedure WorkUpdateUnit(AnUnit: TCodeBrowserUnit);
|
||||
procedure FreeUnitList(List: TCodeBrowserUnitList);
|
||||
procedure UpdateStatusBar(Lazy: boolean);
|
||||
public
|
||||
procedure BeginUpdate;
|
||||
procedure EndUpdate;
|
||||
@ -247,15 +288,49 @@ type
|
||||
property Options: TCodeBrowserViewOptions read FOptions;
|
||||
property IDEAlias: string read FIDEAlias;
|
||||
property ProjectAlias: string read FProjectAlias;
|
||||
property ScannedPackages: integer read FScannedPackages write SetScannedPackages;
|
||||
property ScannedUnits: integer read FScannedUnits write SetScannedUnits;
|
||||
property ScannedLines: PtrInt read FScannedLines write SetScannedLines;
|
||||
property ScannedBytes: PtrInt read FScannedBytes write SetScannedBytes;
|
||||
end;
|
||||
|
||||
var
|
||||
CodeBrowserView: TCodeBrowserView = nil;
|
||||
|
||||
function CompareUnitListOwners(Data1, Data2: Pointer): integer;
|
||||
function ComparePAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer;
|
||||
function CompareUnitFilenames(Data1, Data2: Pointer): integer;
|
||||
function ComparePAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function CompareUnitListOwners(Data1, Data2: Pointer): integer;
|
||||
begin
|
||||
Result:=SysUtils.CompareText(TCodeBrowserUnitList(Data1).Owner,
|
||||
TCodeBrowserUnitList(Data2).Owner);
|
||||
end;
|
||||
|
||||
function ComparePAnsiStringWithUnitListOwner(Data1, Data2: Pointer): integer;
|
||||
begin
|
||||
Result:=SysUtils.CompareText(PAnsiString(Data1)^,
|
||||
TCodeBrowserUnitList(Data2).Owner);
|
||||
end;
|
||||
|
||||
function CompareUnitFilenames(Data1, Data2: Pointer): integer;
|
||||
begin
|
||||
Result:=CompareFilenames(TCodeBrowserUnit(Data1).Filename,
|
||||
TCodeBrowserUnit(Data2).Filename);
|
||||
end;
|
||||
|
||||
function ComparePAnsiStringWithUnitFilename(Data1, Data2: Pointer): integer;
|
||||
begin
|
||||
Result:=CompareFilenames(PAnsiString(Data1)^,
|
||||
TCodeBrowserUnit(Data2).Filename);
|
||||
end;
|
||||
|
||||
|
||||
{ TCodeBrowserView }
|
||||
|
||||
procedure TCodeBrowserView.FormCreate(Sender: TObject);
|
||||
@ -303,6 +378,7 @@ end;
|
||||
|
||||
procedure TCodeBrowserView.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(fOutdatedFiles);
|
||||
FreeAndNil(FRoot);
|
||||
FreeAndNil(FWorkingRoot);
|
||||
FreeAndNil(FOptions);
|
||||
@ -480,15 +556,50 @@ begin
|
||||
sl.Free;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.SetScannedBytes(const AValue: PtrInt);
|
||||
begin
|
||||
if FScannedBytes=AValue then exit;
|
||||
FScannedBytes:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.SetScannedLines(const AValue: PtrInt);
|
||||
begin
|
||||
if FScannedLines=AValue then exit;
|
||||
FScannedLines:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.SetScannedPackages(const AValue: integer);
|
||||
begin
|
||||
if FScannedPackages=AValue then exit;
|
||||
FScannedPackages:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.SetScannedUnits(const AValue: integer);
|
||||
begin
|
||||
if FScannedUnits=AValue then exit;
|
||||
FScannedUnits:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.Work;
|
||||
// do some work
|
||||
// This is called during OnIdle, so progress in small steps
|
||||
var
|
||||
OldStage: TCodeBrowserWorkStage;
|
||||
begin
|
||||
DebugLn(['TCodeBrowserView.Work START']);
|
||||
OldStage:=fStage;
|
||||
case fStage of
|
||||
cbwsGetOptions: WorkGetOptions;
|
||||
cbwsGatherPackages: WorkGatherPackages;
|
||||
cbwsFreeUnusedPackages: WorkFreeUnusedPackages;
|
||||
cbwsGetOptions: WorkGetOptions;
|
||||
cbwsGatherPackages: WorkGatherPackages;
|
||||
cbwsFreeUnusedPackages: WorkFreeUnusedPackages;
|
||||
cbwsAddNewPackages: WorkAddNewUnitLists;
|
||||
cbwsGatherFiles: WorkGatherFileLists;
|
||||
cbwsGatherOutdatedFiles: WorkGatherOutdatedFiles;
|
||||
cbwsUpdateUnits: WorkUpdateUnits;
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
if ord(OldStage)<ord(cbwsFinished) then begin
|
||||
UpdateStatusBar(cbwsFinished<fStage);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -557,10 +668,11 @@ begin
|
||||
|
||||
// find required packages
|
||||
if Options.WithRequiredPackages then begin
|
||||
if CompareText(FWorkingRoot.Owner,CodeBrowserIDEAlias)=0 then begin
|
||||
if SysUtils.CompareText(FWorkingRoot.Owner,CodeBrowserIDEAlias)=0 then begin
|
||||
for i:=0 to PackageGraph.Count-1 do
|
||||
AddPackage(PackageGraph[i]);
|
||||
end else if CompareText(FWorkingRoot.Owner,CodeBrowserProjectAlias)=0 then begin
|
||||
end else if SysUtils.CompareText(FWorkingRoot.Owner,CodeBrowserProjectAlias)=0
|
||||
then begin
|
||||
AddPackages(Project1.FirstRequiredDependency);
|
||||
end else if FWorkingRoot.Owner<>'' then begin
|
||||
APackage:=PackageGraph.FindAPackageWithName(FWorkingRoot.Owner,nil);
|
||||
@ -586,21 +698,27 @@ procedure TCodeBrowserView.WorkFreeUnusedPackages;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
UnusedPackage: TCodeBrowserUnitList;
|
||||
PackageName: String;
|
||||
begin
|
||||
// find an unused package
|
||||
// find an unused package (a package in Root but not in WorkingRoot)
|
||||
Result:=nil;
|
||||
if (FRoot<>nil) and (FRoot.UnitLists<>nil) then begin
|
||||
Node:=FRoot.UnitLists.FindLowest;
|
||||
while Node<>nil do begin
|
||||
UnusedPackage:=TCodeBrowserUnitList(Node.Data);
|
||||
if UnusedPackage<>nil then begin
|
||||
|
||||
end;
|
||||
Node:=FRoot.UnitLists.FindSuccessor(Node);
|
||||
if (FRoot=nil) or (FRoot.UnitLists=nil) then exit;
|
||||
Node:=FRoot.UnitLists.FindLowest;
|
||||
while Node<>nil do begin
|
||||
UnusedPackage:=TCodeBrowserUnitList(Node.Data);
|
||||
PackageName:=UnusedPackage.Owner;
|
||||
if (FWorkingRoot=nil)
|
||||
or (FWorkingRoot.UnitLists=nil)
|
||||
or (FWorkingRoot.UnitLists.FindKey(@PackageName,
|
||||
@ComparePAnsiStringWithUnitListOwner)=nil)
|
||||
then begin
|
||||
Result:=UnusedPackage;
|
||||
exit;
|
||||
end;
|
||||
Node:=FRoot.UnitLists.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
UnusedPackage: TCodeBrowserUnitList;
|
||||
begin
|
||||
@ -609,22 +727,505 @@ begin
|
||||
UnusedPackage:=FindUnusedUnitList;
|
||||
if UnusedPackage=nil then begin
|
||||
// this stage finished -> next stage
|
||||
fStage:=cbwsFreeUnusedPackages;
|
||||
fStage:=cbwsAddNewPackages;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// free this unused package
|
||||
// free the unused package
|
||||
FreeUnitList(UnusedPackage);
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.WorkAddNewUnitLists;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
List: TCodeBrowserUnitList;
|
||||
begin
|
||||
if (FWorkingRoot<>nil) and (FWorkingRoot.UnitLists<>nil)
|
||||
and (FRoot<>nil) then begin
|
||||
Node:=FWorkingRoot.UnitLists.FindLowest;
|
||||
while Node<>nil do begin
|
||||
List:=TCodeBrowserUnitList(Node.Data);
|
||||
if FRoot.FindUnitList(List.Owner)=nil then begin
|
||||
// new unit list
|
||||
TCodeBrowserUnitList.Create(List.Owner,FRoot);
|
||||
inc(FScannedPackages);
|
||||
end;
|
||||
Node:=FWorkingRoot.UnitLists.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
// this stage finished -> next stage
|
||||
fStage:=cbwsGatherFiles;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.WorkGatherFileLists;
|
||||
|
||||
function ListFilesAreValid(List: TCodeBrowserUnitList): boolean;
|
||||
begin
|
||||
Result:=List.UnitsValid;
|
||||
end;
|
||||
|
||||
function FindListWithInvalidFileList(StartList: TCodeBrowserUnitList
|
||||
): TCodeBrowserUnitList;
|
||||
var
|
||||
APackage: TCodeBrowserUnitList;
|
||||
Node: TAvgLvlTreeNode;
|
||||
begin
|
||||
Result:=nil;
|
||||
if StartList=nil then exit;
|
||||
if not ListFilesAreValid(StartList) then begin
|
||||
Result:=StartList;
|
||||
exit;
|
||||
end;
|
||||
if (StartList.UnitLists=nil) then exit;
|
||||
Node:=StartList.UnitLists.FindLowest;
|
||||
while Node<>nil do begin
|
||||
APackage:=TCodeBrowserUnitList(Node.Data);
|
||||
Result:=FindListWithInvalidFileList(APackage);
|
||||
if Result<>nil then exit;
|
||||
Node:=StartList.UnitLists.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
List: TCodeBrowserUnitList;
|
||||
begin
|
||||
DebugLn(['TCodeBrowserView.WorkGatherFiles START']);
|
||||
// find a unit list which needs update
|
||||
List:=FindListWithInvalidFileList(FRoot);
|
||||
if List=nil then begin
|
||||
// this stage finished -> next stage
|
||||
fStage:=cbwsGatherOutdatedFiles;
|
||||
exit;
|
||||
end;
|
||||
|
||||
WorkUpdateFileList(List);
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.WorkUpdateFileList(List: TCodeBrowserUnitList);
|
||||
var
|
||||
NewFileList: TAvgLvlTree;
|
||||
|
||||
procedure AddFile(const Filename: string);
|
||||
begin
|
||||
if Filename='' then exit;
|
||||
if System.Pos('$',Filename)>0 then begin
|
||||
DebugLn(['WARNING: TCodeBrowserView.WorkUpdateFiles Macros in filename ',Filename]);
|
||||
exit;
|
||||
end;
|
||||
if NewFileList.FindKey(@Filename,@ComparePAnsiStringWithUnitFilename)<>nil
|
||||
then exit;
|
||||
DebugLn(['TCodeBrowserView.WorkUpdateFiles AddFile ',Filename]);
|
||||
NewFileList.Add(TCodeBrowserUnit.Create(Filename));
|
||||
end;
|
||||
|
||||
procedure AddFilesOfProject(AProject: TProject);
|
||||
var
|
||||
AnUnitInfo: TUnitInfo;
|
||||
begin
|
||||
if AProject=nil then exit;
|
||||
AnUnitInfo:=AProject.FirstPartOfProject;
|
||||
while AnUnitInfo<>nil do begin
|
||||
if FilenameIsPascalUnit(AnUnitInfo.Filename) then
|
||||
AddFile(AnUnitInfo.Filename);
|
||||
AnUnitInfo:=AnUnitInfo.NextPartOfProject;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddFilesOfPackageFCL;
|
||||
var
|
||||
LazDir: String;
|
||||
UnitLinks: String;
|
||||
SpacePos: LongInt;
|
||||
Filename: String;
|
||||
StartPos: Integer;
|
||||
EndPos: LongInt;
|
||||
begin
|
||||
// use unitlinks of the lazarus source directory
|
||||
LazDir:=AppendPathDelim(EnvironmentOptions.LazarusDirectory);
|
||||
if (LazDir='') or (not FilenameIsAbsolute(LazDir)) then exit;
|
||||
UnitLinks:=CodeToolBoss.GetUnitLinksForDirectory(LazDir);
|
||||
StartPos:=1;
|
||||
while StartPos<=length(UnitLinks) do begin
|
||||
EndPos:=StartPos;
|
||||
while (EndPos<=length(UnitLinks))
|
||||
and (not (UnitLinks[EndPos] in [#10,#13])) do
|
||||
inc(EndPos);
|
||||
if EndPos>StartPos then begin
|
||||
SpacePos:=StartPos;
|
||||
while (SpacePos<=length(UnitLinks)) and (UnitLinks[SpacePos]<>' ') do
|
||||
inc(SpacePos);
|
||||
if (SpacePos>StartPos) and (SpacePos<EndPos) then begin
|
||||
Filename:=copy(UnitLinks,SpacePos+1,EndPos-SpacePos-1);
|
||||
AddFile(Filename);
|
||||
end;
|
||||
end;
|
||||
StartPos:=EndPos;
|
||||
while (StartPos<=length(UnitLinks))
|
||||
and (UnitLinks[StartPos] in [#10,#13]) do
|
||||
inc(StartPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddFilesOfPackage(APackage: TLazPackage);
|
||||
var
|
||||
i: Integer;
|
||||
PkgFile: TPkgFile;
|
||||
begin
|
||||
if APackage=nil then exit;
|
||||
for i:=0 to APackage.FileCount-1 do begin
|
||||
PkgFile:=APackage.Files[i];
|
||||
if (PkgFile.FileType in PkgFileUnitTypes) then
|
||||
AddFile(PkgFile.GetFullFilename);
|
||||
end;
|
||||
if APackage.Name='FCL' then begin
|
||||
AddFilesOfPackageFCL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddFilesOfDirectory(const Directory: string);
|
||||
// ! needs ending PathDelim !
|
||||
var
|
||||
FileInfo: TSearchRec;
|
||||
begin
|
||||
DebugLn(['AddFilesOfDirectory Directory="',Directory,'"']);
|
||||
if (not FilenameIsAbsolute(Directory))
|
||||
or (not DirectoryExists(Directory)) then begin
|
||||
DebugLn(['AddFilesOfDirectory WARNING: does not exist: "',Directory,'"']);
|
||||
exit;
|
||||
end;
|
||||
if SysUtils.FindFirst(Directory+FileMask,faAnyFile,FileInfo)=0 then begin
|
||||
repeat
|
||||
// check if special file
|
||||
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
|
||||
then
|
||||
continue;
|
||||
if FilenameIsPascalUnit(FileInfo.Name) then
|
||||
AddFile(Directory+FileInfo.Name);
|
||||
until SysUtils.FindNext(FileInfo)<>0;
|
||||
end;
|
||||
SysUtils.FindClose(FileInfo);
|
||||
end;
|
||||
|
||||
procedure AddFilesOfSearchPath(const SrcPath, BaseDir: string);
|
||||
var
|
||||
Dir: String;
|
||||
p: Integer;
|
||||
begin
|
||||
DebugLn(['AddFilesOfSearchPath SrcPath="',SrcPath,'" BaseDir="',BaseDir,'"']);
|
||||
p:=1;
|
||||
while (p<=length(SrcPath)) do begin
|
||||
Dir:=GetNextDelimitedItem(SrcPath,';',p);
|
||||
if Dir<>'' then begin
|
||||
if not FilenameIsAbsolute(Dir) then
|
||||
Dir:=BaseDir+PathDelim+Dir;
|
||||
Dir:=CleanAndExpandDirectory(Dir);
|
||||
AddFilesOfDirectory(Dir);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddFilesOfIDE;
|
||||
var
|
||||
LazDefines: TDefineTemplate;
|
||||
LazSrcDir: TDefineTemplate;
|
||||
LazIDEDir: TDefineTemplate;
|
||||
LazIDESrcPath: TDefineTemplate;
|
||||
SrcPath: String;
|
||||
LazDir: String;
|
||||
begin
|
||||
LazDir:=AppendPathDelim(EnvironmentOptions.LazarusDirectory);
|
||||
if not DirectoryExists(LazDir) then begin
|
||||
DebugLn(['AddFilesOfIDE WARNING: lazarus directory not found: "',LazDir,'"']);
|
||||
exit;
|
||||
end;
|
||||
// get the SrcPath template of the lazarus/ide directory
|
||||
LazDefines:=CodeToolBoss.DefineTree
|
||||
.FindDefineTemplateByName(StdDefTemplLazarusSources,true);
|
||||
if LazDefines=nil then begin
|
||||
DebugLn(['AddFilesOfIDE WARNING: codetools define templates for lazarus not found']);
|
||||
exit;
|
||||
end;
|
||||
LazSrcDir:=LazDefines.FindChildByName(StdDefTemplLazarusSrcDir);
|
||||
if LazSrcDir=nil then begin
|
||||
DebugLn(['AddFilesOfIDE WARNING: codetools define templates for lazarus directory not found']);
|
||||
exit;
|
||||
end;
|
||||
LazIDEDir:=LazSrcDir.FindChildByName('ide');
|
||||
if LazIDEDir=nil then begin
|
||||
DebugLn(['AddFilesOfIDE WARNING: codetools define templates for lazarus ide directory not found']);
|
||||
exit;
|
||||
end;
|
||||
LazIDESrcPath:=LazIDEDir.FindChildByName('IDE path addition');
|
||||
if LazIDESrcPath=nil then begin
|
||||
DebugLn(['AddFilesOfIDE WARNING: codetools define templates for src path of lazarus ide directory not found']);
|
||||
exit;
|
||||
end;
|
||||
SrcPath:=LazIDESrcPath.Value;
|
||||
AddFilesOfSearchPath(SrcPath,LazDir+'ide'+PathDelim);
|
||||
end;
|
||||
|
||||
procedure DeleteUnusedFiles;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
CurUnit: TCodeBrowserUnit;
|
||||
NextNode: TAvgLvlTreeNode;
|
||||
begin
|
||||
if List.Units=nil then exit;
|
||||
Node:=List.Units.FindLowest;
|
||||
while Node<>nil do begin
|
||||
NextNode:=List.Units.FindSuccessor(Node);
|
||||
CurUnit:=TCodeBrowserUnit(Node.Data);
|
||||
if NewFileList.FindKey(@CurUnit.Filename,
|
||||
@ComparePAnsiStringWithUnitFilename)=nil
|
||||
then begin
|
||||
// this unit is not part of List anymore -> delete
|
||||
List.DeleteUnit(CurUnit);
|
||||
end;
|
||||
Node:=NextNode;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddNewFiles;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
AnUnit: TCodeBrowserUnit;
|
||||
begin
|
||||
Node:=NewFileList.FindLowest;
|
||||
while Node<>nil do begin
|
||||
AnUnit:=TCodeBrowserUnit(Node.Data);
|
||||
if List.FindUnit(AnUnit.Filename)=nil then begin
|
||||
// this unit was not part of List -> add
|
||||
List.AddUnit(AnUnit.Filename);
|
||||
end;
|
||||
Node:=NewFileList.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
APackage: TLazPackage;
|
||||
begin
|
||||
DebugLn(['TCodeBrowserView.WorkUpdateFiles ',List.Owner]);
|
||||
NewFileList:=TAvgLvlTree.Create(@CompareUnitFilenames);
|
||||
try
|
||||
// get new list of files
|
||||
DebugLn(['TCodeBrowserView.WorkUpdateFiles "',List.Owner,'" "',ProjectAlias,'"']);
|
||||
if List.Owner=CodeBrowserIDEAlias then begin
|
||||
AddFilesOfIDE;
|
||||
end else if List.Owner=CodeBrowserProjectAlias then begin
|
||||
AddFilesOfProject(Project1);
|
||||
end else begin
|
||||
APackage:=PackageGraph.FindAPackageWithName(List.Owner,nil);
|
||||
AddFilesOfPackage(APackage);
|
||||
end;
|
||||
|
||||
// update file list
|
||||
DeleteUnusedFiles;
|
||||
AddNewFiles;
|
||||
|
||||
List.UnitsValid:=true;
|
||||
finally
|
||||
NewFileList.FreeAndClear;
|
||||
NewFileList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.WorkGatherOutdatedFiles;
|
||||
// add all files to fOutdatedFiles
|
||||
|
||||
procedure AddFile(AnUnit: TCodeBrowserUnit);
|
||||
begin
|
||||
if fOutdatedFiles=nil then
|
||||
fOutdatedFiles:=TAvgLvlTree.Create(@CompareUnitFilenames);
|
||||
if fOutdatedFiles.Find(AnUnit)<>nil then exit;
|
||||
fOutdatedFiles.Add(AnUnit);
|
||||
end;
|
||||
|
||||
procedure AddFiles(List: TCodeBrowserUnitList);
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
begin
|
||||
if List.Units<>nil then begin
|
||||
Node:=List.Units.FindLowest;
|
||||
while Node<>nil do begin
|
||||
AddFile(TCodeBrowserUnit(Node.Data));
|
||||
Node:=List.Units.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
if List.UnitLists<>nil then begin
|
||||
Node:=List.UnitLists.FindLowest;
|
||||
while Node<>nil do begin
|
||||
AddFiles(TCodeBrowserUnitList(Node.Data));
|
||||
Node:=List.UnitLists.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if fOutdatedFiles<>nil then
|
||||
fOutdatedFiles.FreeAndClear;
|
||||
AddFiles(Root);
|
||||
|
||||
// this stage finished -> next stage
|
||||
fStage:=cbwsUpdateUnits;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.WorkUpdateUnits;
|
||||
|
||||
function FindOutdatedUnit: TCodeBrowserUnit;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
begin
|
||||
Result:=nil;
|
||||
if fOutdatedFiles=nil then exit;
|
||||
Node:=fOutdatedFiles.FindLowest;
|
||||
if Node=nil then exit;
|
||||
Result:=TCodeBrowserUnit(Node.Data);
|
||||
end;
|
||||
|
||||
const
|
||||
SmallTimeStep = (1/86400)/5;
|
||||
var
|
||||
AnUnit: TCodeBrowserUnit;
|
||||
StartTime: TDateTime;
|
||||
begin
|
||||
//DebugLn(['TCodeBrowserView.WorkUpdateUnits START']);
|
||||
CodeToolBoss.ActivateWriteLock;
|
||||
try
|
||||
// parse units
|
||||
StartTime:=Now;
|
||||
repeat
|
||||
AnUnit:=FindOutdatedUnit;
|
||||
if AnUnit=nil then begin
|
||||
// this stage finished -> next stage
|
||||
fStage:=cbwsFinished;
|
||||
exit;
|
||||
end;
|
||||
|
||||
WorkUpdateUnit(AnUnit);
|
||||
until Abs(Now-StartTime)>SmallTimeStep;
|
||||
finally
|
||||
CodeToolBoss.DeactivateWriteLock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.WorkUpdateUnit(AnUnit: TCodeBrowserUnit);
|
||||
|
||||
procedure UpdateScannedCounters(Tool: TCodeTool);
|
||||
var
|
||||
LineCnt: Integer;
|
||||
ByteCnt: Integer;
|
||||
i: Integer;
|
||||
Link: TSourceLink;
|
||||
CodeBuf: TCodeBuffer;
|
||||
LastCode: TCodeBuffer;
|
||||
begin
|
||||
if (Tool=nil) or (Tool.Scanner=nil) then exit;
|
||||
LineCnt:=0;
|
||||
ByteCnt:=0;
|
||||
LastCode:=nil;
|
||||
for i:=0 to Tool.Scanner.LinkCount-1 do begin
|
||||
Link:=Tool.Scanner.Links[i];
|
||||
CodeBuf:=TCodeBuffer(Link.Code);
|
||||
if CodeBuf<>LastCode then begin
|
||||
inc(LineCnt,LineEndCount(CodeBuf.Source));
|
||||
inc(ByteCnt,length(CodeBuf.Source));
|
||||
LastCode:=CodeBuf;
|
||||
end;
|
||||
end;
|
||||
AnUnit.ScannedBytes:=ByteCnt;
|
||||
AnUnit.ScannedLines:=LineCnt;
|
||||
inc(FScannedBytes,ByteCnt);
|
||||
inc(FScannedLines,LineCnt);
|
||||
end;
|
||||
|
||||
var
|
||||
MainCodeBuf: TCodeBuffer;
|
||||
Tool: TCodeTool;
|
||||
begin
|
||||
//DebugLn(['TCodeBrowserView.WorkUpdateUnit START ',AnUnit.Filename]);
|
||||
// mark as updated
|
||||
fOutdatedFiles.Remove(AnUnit);
|
||||
// reset scanning counters
|
||||
if AnUnit.Scanned then begin
|
||||
dec(FScannedBytes,AnUnit.ScannedBytes);
|
||||
dec(FScannedLines,AnUnit.ScannedLines);
|
||||
AnUnit.ScannedBytes:=0;
|
||||
AnUnit.ScannedLines:=0;
|
||||
end;
|
||||
AnUnit.Scanned:=true;
|
||||
inc(FScannedUnits);
|
||||
// load the file
|
||||
AnUnit.FCodeBuffer:=CodeToolBoss.LoadFile(AnUnit.Filename,false,false);
|
||||
if AnUnit.CodeBuffer=nil then exit;
|
||||
// check if this is a unit
|
||||
MainCodeBuf:=CodeToolBoss.GetMainCode(AnUnit.CodeBuffer);
|
||||
if MainCodeBuf<>AnUnit.CodeBuffer then begin
|
||||
// this is not a unit, but an include file
|
||||
DebugLn(['TCodeBrowserView.WorkUpdateUnit HINT: this is not a unit: ',AnUnit.Filename]);
|
||||
exit;
|
||||
end;
|
||||
// scan
|
||||
CodeToolBoss.Explore(AnUnit.CodeBuffer,Tool,false,true);
|
||||
UpdateScannedCounters(Tool);
|
||||
//DebugLn(['TCodeBrowserView.WorkUpdateUnit END ',AnUnit.Filename]);
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.FreeUnitList(List: TCodeBrowserUnitList);
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
AnUnit: TCodeBrowserUnit;
|
||||
begin
|
||||
dec(FScannedPackages);
|
||||
if List.Units<>nil then begin
|
||||
Node:=List.Units.FindLowest;
|
||||
while Node<>nil do begin
|
||||
AnUnit:=TCodeBrowserUnit(Node.Data);
|
||||
if fOutdatedFiles<>nil then
|
||||
fOutdatedFiles.Remove(AnUnit);
|
||||
if AnUnit.Scanned then begin
|
||||
AnUnit.Scanned:=false;
|
||||
dec(FScannedUnits);
|
||||
dec(FScannedLines,AnUnit.ScannedLines);
|
||||
dec(FScannedBytes,AnUnit.ScannedBytes);
|
||||
end;
|
||||
Node:=List.Units.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
List.Free;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.UpdateStatusBar(Lazy: boolean);
|
||||
const
|
||||
SmallTimeStep = 1/86400;
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
if Lazy and (Abs(Now-fLastStatusBarUpdate)<SmallTimeStep) then begin
|
||||
// the last update is not long ago
|
||||
// => skip update
|
||||
exit;
|
||||
end;
|
||||
fLastStatusBarUpdate:=Now;
|
||||
s:='packages='+IntToStr(ScannedPackages)
|
||||
+' units='+IntToStr(ScannedUnits)
|
||||
+' lines='+IntToStr(ScannedLines)
|
||||
+' bytes='+IntToStr(ScannedBytes);
|
||||
if fStage<>cbwsFinished then
|
||||
s:=s+'. Scanning ...';
|
||||
StatusBar1.SimpleText:=s;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.BeginUpdate;
|
||||
begin
|
||||
inc(fUpdateCount);
|
||||
BrowseTreeView.BeginUpdate;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.EndUpdate;
|
||||
begin
|
||||
dec(fUpdateCount);
|
||||
BrowseTreeView.EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserView.FormClose(Sender: TObject;
|
||||
@ -658,6 +1259,20 @@ end;
|
||||
|
||||
{ TCodeBrowserUnit }
|
||||
|
||||
procedure TCodeBrowserUnit.SetScanned(const AValue: boolean);
|
||||
begin
|
||||
if FScanned=AValue then exit;
|
||||
FScanned:=AValue;
|
||||
FScannedBytes:=0;
|
||||
FScannedLines:=0;
|
||||
if UnitList<>nil then begin
|
||||
if FScanned then
|
||||
inc(UnitList.FScannedUnits)
|
||||
else
|
||||
dec(UnitList.FScannedUnits);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCodeBrowserUnit.Create(const TheFilename: string);
|
||||
begin
|
||||
FFilename:=TheFilename;
|
||||
@ -683,6 +1298,34 @@ begin
|
||||
if Owner=AValue then exit;
|
||||
if ParentList<>nil then RaiseGDBException('not allowed');
|
||||
FOwner:=AValue;
|
||||
FUnitsValid:=false;
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserUnitList.InternalAddUnitList(List: TCodeBrowserUnitList);
|
||||
begin
|
||||
if FUnitLists=nil then
|
||||
FUnitLists:=TAvgLvlTree.Create(@CompareUnitListOwners);
|
||||
FUnitLists.Add(List);
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserUnitList.InternalRemoveUnitList(List: TCodeBrowserUnitList
|
||||
);
|
||||
begin
|
||||
if FUnitLists<>nil then
|
||||
FUnitLists.Add(List);
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserUnitList.InternalAddUnit(AnUnit: TCodeBrowserUnit);
|
||||
begin
|
||||
if FUnits=nil then
|
||||
FUnits:=TAvgLvlTree.Create(@CompareUnitFilenames);
|
||||
FUnits.Add(AnUnit);
|
||||
end;
|
||||
|
||||
procedure TCodeBrowserUnitList.InternalRemoveUnit(AnUnit: TCodeBrowserUnit);
|
||||
begin
|
||||
if FUnits<>nil then
|
||||
FUnits.Add(AnUnit);
|
||||
end;
|
||||
|
||||
constructor TCodeBrowserUnitList.Create(TheOwner: string;
|
||||
@ -690,11 +1333,17 @@ constructor TCodeBrowserUnitList.Create(TheOwner: string;
|
||||
begin
|
||||
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;
|
||||
|
||||
@ -706,6 +1355,48 @@ begin
|
||||
if FUnitLists<>nil then
|
||||
FUnitLists.FreeAndClear;
|
||||
FreeAndNil(FUnitLists);
|
||||
FUnitsValid:=false;
|
||||
end;
|
||||
|
||||
function TCodeBrowserUnitList.FindUnit(const Filename: string
|
||||
): TCodeBrowserUnit;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
begin
|
||||
Result:=nil;
|
||||
if Filename='' then exit;
|
||||
if FUnits=nil then exit;
|
||||
Node:=FUnits.FindKey(@Filename,@ComparePAnsiStringWithUnitFilename);
|
||||
if Node=nil then exit;
|
||||
Result:=TCodeBrowserUnit(Node.Data);
|
||||
end;
|
||||
|
||||
function TCodeBrowserUnitList.FindUnitList(const OwnerName: string
|
||||
): TCodeBrowserUnitList;
|
||||
var
|
||||
Node: TAvgLvlTreeNode;
|
||||
begin
|
||||
Result:=nil;
|
||||
if FUnitLists=nil then exit;
|
||||
if OwnerName='' then exit;
|
||||
Node:=FUnitLists.FindKey(@OwnerName,@ComparePAnsiStringWithUnitListOwner);
|
||||
if Node=nil then exit;
|
||||
Result:=TCodeBrowserUnitList(Node.Data);
|
||||
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;
|
||||
|
||||
{ TCodeBrowserViewOptions }
|
||||
|
||||
@ -890,6 +890,7 @@ begin
|
||||
end;
|
||||
|
||||
function TAvgLvlTree.FindPointer(Data: Pointer): TAvgLvlTreeNode;
|
||||
// same as Find, but not comparing for key, but same Data too
|
||||
begin
|
||||
Result:=FindLeftMost(Data);
|
||||
while (Result<>nil) do begin
|
||||
|
||||
@ -1917,8 +1917,10 @@ begin
|
||||
//FillScreenFonts(Screen.Fonts);
|
||||
InitKeyboardTables;
|
||||
{ Compute pixels per inch variable }
|
||||
//writeln('TGtkWidgetSet.AppInit gdk_screen_width_mm=',gdk_screen_width_mm);
|
||||
ScreenInfo.PixelsPerInchX :=
|
||||
RoundToInt(gdk_screen_width / (gdk_screen_width_mm / 25.4));
|
||||
//writeln('TGtkWidgetSet.AppInit gdk_screen_height_mm=',gdk_screen_height_mm);
|
||||
ScreenInfo.PixelsPerInchY :=
|
||||
RoundToInt(gdk_screen_height / (gdk_screen_height_mm / 25.4));
|
||||
ScreenInfo.ColorDepth := gdk_visual_get_system^.depth;
|
||||
|
||||
@ -166,6 +166,8 @@ type
|
||||
FFilename: string;
|
||||
FFileType: TPkgFileType;
|
||||
FFlags: TPkgFileFlags;
|
||||
fFullFilename: string;
|
||||
fFullFilenameStamp: integer;
|
||||
FPackage: TLazPackage;
|
||||
FSourceDirectoryReferenced: boolean;
|
||||
FSourceDirNeedReference: boolean;
|
||||
@ -1319,6 +1321,11 @@ begin
|
||||
LazPackage.LongenFilename(NewFilename);
|
||||
if FFilename=NewFilename then exit;
|
||||
FFilename:=NewFilename;
|
||||
fFullFilenameStamp:=CompilerParseStamp;
|
||||
if fFullFilenameStamp=Low(fFullFilenameStamp) then
|
||||
fFullFilenameStamp:=High(fFullFilenameStamp)
|
||||
else
|
||||
dec(fFullFilenameStamp);
|
||||
OldDirectory:=FDirectory;
|
||||
FDirectory:=ExtractFilePath(fFilename);
|
||||
if OldDirectory<>FDirectory then begin
|
||||
@ -1439,7 +1446,18 @@ end;
|
||||
|
||||
function TPkgFile.GetFullFilename: string;
|
||||
begin
|
||||
Result:=Filename;
|
||||
if fFullFilenameStamp<>CompilerParseStamp then begin
|
||||
fFullFilename:=Filename;
|
||||
fFullFilenameStamp:=CompilerParseStamp;
|
||||
if LazPackage<>nil then begin
|
||||
// substitute locally
|
||||
LazPackage.SubstitutePkgMacro(fFullFilename,false);
|
||||
end;
|
||||
// substitute globally
|
||||
IDEMacros.SubstituteMacros(fFullFilename);
|
||||
fFullFilename:=CleanAndExpandFilename(fFullFilename);
|
||||
end;
|
||||
Result:=fFullFilename;
|
||||
end;
|
||||
|
||||
constructor TPkgFile.Create(ThePackage: TLazPackage);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user