mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 00:03:48 +02:00
876 lines
25 KiB
ObjectPascal
876 lines
25 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
unitdependencies.pas
|
|
--------------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* 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 <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Defines the TUnitDependenciesView form.
|
|
The Unit Dependencies shows the used units in a treeview.
|
|
|
|
}
|
|
unit UnitDependencies;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{$I ide.inc}
|
|
|
|
uses
|
|
{$IFDEF IDE_MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, Controls, Forms, Dialogs, Buttons, ComCtrls, StdCtrls,
|
|
Graphics, LCLType, FileUtil, LCLProc,
|
|
CodeToolManager, CodeCache,
|
|
IDECommands, IDEImagesIntf,
|
|
EnvironmentOpts, IDEOptionDefs, LazarusIDEStrConsts, InputHistory;
|
|
|
|
type
|
|
|
|
{ TUnitNode }
|
|
|
|
TUnitNodeFlag = (
|
|
unfImplementation, // this unit was used in an implementation uses section
|
|
unfCircle, // this unit is the parent of itself
|
|
unfForbiddenCircle,// forbidden circle
|
|
unfFileNotFound, // this unit file was not found
|
|
unfParseError // error parsing the source
|
|
);
|
|
TUnitNodeFlags = set of TUnitNodeFlag;
|
|
|
|
TUnitNodeSourceType = (
|
|
unstUnknown,
|
|
unstUnit,
|
|
unstProgram,
|
|
unstLibrary,
|
|
unstPackage
|
|
);
|
|
|
|
const
|
|
UnitNodeSourceTypeNames: array[TUnitNodeSourceType] of string = (
|
|
'?',
|
|
'Unit',
|
|
'Program',
|
|
'Library',
|
|
'Package'
|
|
);
|
|
|
|
type
|
|
TUnitDependenciesView = class;
|
|
|
|
|
|
{ TUnitNode }
|
|
|
|
TUnitNode = class
|
|
private
|
|
FChildCount: integer;
|
|
FCodeBuffer: TCodeBuffer;
|
|
FFilename: string;
|
|
FFirstChild: TUnitNode;
|
|
FFlags: TUnitNodeFlags;
|
|
FLastChild: TUnitNode;
|
|
FNextSibling: TUnitNode;
|
|
FParent: TUnitNode;
|
|
FPrevSibling: TUnitNode;
|
|
FShortFilename: string;
|
|
FSourceType: TUnitNodeSourceType;
|
|
FTreeNode: TTreeNode;
|
|
procedure SetCodeBuffer(const AValue: TCodeBuffer);
|
|
procedure SetFilename(const AValue: string);
|
|
procedure SetParent(const AValue: TUnitNode);
|
|
procedure SetShortFilename(const AValue: string);
|
|
procedure SetTreeNode(const AValue: TTreeNode);
|
|
procedure CreateShortFilename;
|
|
procedure UnbindFromParent;
|
|
procedure AddToParent;
|
|
procedure AddChild(const AFilename: string; ACodeBuffer: TCodeBuffer;
|
|
InImplementation: boolean);
|
|
procedure UpdateSourceType;
|
|
function ForbiddenCircle: boolean;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure ClearChildren;
|
|
procedure CreateChildren;
|
|
procedure ClearGrandChildren;
|
|
procedure CreateGrandChildren;
|
|
function FindParentWithCodeBuffer(ACodeBuffer: TCodeBuffer): TUnitNode;
|
|
function HasChildren: boolean;
|
|
function ImageIndex: integer;
|
|
function IsFirstImplementationNode: boolean;
|
|
function IsImplementationNode: boolean;
|
|
property ChildCount: integer read FChildCount;
|
|
property CodeBuffer: TCodeBuffer read FCodeBuffer write SetCodeBuffer;
|
|
property Filename: string read FFilename write SetFilename;
|
|
property FirstChild: TUnitNode read FFirstChild;
|
|
property Flags: TUnitNodeFlags read FFlags;
|
|
property LastChild: TUnitNode read FLastChild;
|
|
property NextSibling: TUnitNode read FNextSibling;
|
|
property PrevSibling: TUnitNode read FPrevSibling;
|
|
property Parent: TUnitNode read FParent write SetParent;
|
|
property ShortFilename: string read FShortFilename write SetShortFilename;
|
|
property SourceType: TUnitNodeSourceType read FSourceType;
|
|
property TreeNode: TTreeNode read FTreeNode write SetTreeNode;
|
|
end;
|
|
|
|
|
|
{ TUnitDependenciesView }
|
|
|
|
TOnGetProjectMainFilename = function(Sender: TObject): string of object;
|
|
TOnOpenFile = procedure(Sender: TObject; const Filename: string) of object;
|
|
|
|
TUnitDependenciesView = class(TForm)
|
|
CloseButton: TBitBtn;
|
|
ToolBar: TToolBar;
|
|
RefreshButton: TToolButton;
|
|
ShowProjectButton: TToolButton;
|
|
SelectUnitButton: TToolButton;
|
|
UnitHistoryList: TComboBox;
|
|
UnitTreeView: TTreeView;
|
|
procedure RefreshButtonClick(Sender: TObject);
|
|
procedure SelectUnitButtonClick(Sender: TObject);
|
|
procedure ShowProjectButtonClick(Sender: TObject);
|
|
procedure UnitHistoryListEditingDone(Sender: TObject);
|
|
procedure UnitTreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView;
|
|
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
|
|
var PaintImages, DefaultDraw: Boolean);
|
|
procedure UnitTreeViewCollapsing(Sender: TObject; Node: TTreeNode;
|
|
var AllowCollapse: Boolean);
|
|
procedure UnitTreeViewExpanding(Sender: TObject; Node: TTreeNode;
|
|
var AllowExpansion: Boolean);
|
|
procedure UnitTreeViewMouseDown(Sender: TOBject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
private
|
|
FCommitUnitHistoryListSelectionNeeded: boolean;
|
|
FOnAccessingSources: TNotifyEvent;
|
|
FOnGetProjectMainFilename: TOnGetProjectMainFilename;
|
|
FOnOpenFile: TOnOpenFile;
|
|
FRefreshNeeded: boolean;
|
|
FRebuildTreeNeeded: boolean;
|
|
FRefreshHistoryListNeeded: boolean;
|
|
FRootCodeBuffer: TCodeBuffer;
|
|
FRootFilename: string;
|
|
FRootNode: TUnitNode;
|
|
FRootShortFilename: string;
|
|
FRootValid: boolean;
|
|
FUpdateCount: integer;
|
|
procedure ClearTree;
|
|
procedure RebuildTree;
|
|
procedure SetRootFilename(const AValue: string);
|
|
procedure SetRootShortFilename(const AValue: string);
|
|
procedure CommitUnitHistoryListSelection;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
procedure Refresh;
|
|
procedure RefreshHistoryList;
|
|
function RootValid: boolean;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
property OnAccessingSources: TNotifyEvent
|
|
read FOnAccessingSources write FOnAccessingSources;
|
|
property OnGetProjectMainFilename: TOnGetProjectMainFilename
|
|
read FOnGetProjectMainFilename write FOnGetProjectMainFilename;
|
|
property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
|
|
property RootFilename: string read FRootFilename write SetRootFilename;
|
|
property RootShortFilename: string read FRootShortFilename write SetRootShortFilename;
|
|
property RefreshNeeded: boolean read FRefreshNeeded write FRefreshNeeded;
|
|
end;
|
|
|
|
var
|
|
UnitDependenciesView: TUnitDependenciesView = nil;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
type
|
|
{ TExpandedUnitNodeState
|
|
Used to save which TUnitNodes are expanded during a Refresh }
|
|
|
|
TExpandedUnitNodeState = class
|
|
private
|
|
FPaths: TStringList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Assign(ANode: TUnitNode);
|
|
procedure AssignTo(ANode: TUnitNode);
|
|
end;
|
|
|
|
{ TUnitDependenciesView }
|
|
|
|
procedure TUnitDependenciesView.RefreshButtonClick(Sender: TObject);
|
|
begin
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.SelectUnitButtonClick(Sender: TObject);
|
|
var
|
|
OpenDialog: TOpenDialog;
|
|
begin
|
|
OpenDialog:=TOpenDialog.Create(nil);
|
|
try
|
|
InputHistories.ApplyFileDialogSettings(OpenDialog);
|
|
OpenDialog.Title:=lisOpenFile;
|
|
OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist];
|
|
if OpenDialog.Execute then begin
|
|
RootFilename:=ExpandFileNameUTF8(OpenDialog.Filename);
|
|
end;
|
|
InputHistories.StoreFileDialogSettings(OpenDialog);
|
|
finally
|
|
OpenDialog.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.ShowProjectButtonClick(Sender: TObject);
|
|
var
|
|
NewFilename: string;
|
|
begin
|
|
if Assigned(OnGetProjectMainFilename) then begin
|
|
NewFilename:=OnGetProjectMainFilename(Self);
|
|
if NewFilename<>'' then
|
|
RootFilename:=NewFilename;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.UnitHistoryListEditingDone(Sender: TObject);
|
|
begin
|
|
//DebugLn('TUnitDependenciesView.UnitHistoryListEditingDone ',UnitHistoryList.Text,' ',dbgs(UnitHistoryList.Items.IndexOf(UnitHistoryList.Text)));
|
|
if UnitHistoryList.Items.IndexOf(UnitHistoryList.Text)<0 then exit;
|
|
CommitUnitHistoryListSelection;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.UnitTreeViewAdvancedCustomDrawItem(
|
|
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
|
|
Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
|
|
var
|
|
UnitNode: TUnitNode;
|
|
NodeRect: TRect;
|
|
begin
|
|
if Stage<>cdPostPaint then exit;
|
|
UnitNode:=TUnitNode(Node.Data);
|
|
if (UnitNode<>nil) and UnitNode.IsFirstImplementationNode then begin
|
|
NodeRect:=Node.DisplayRect(false);
|
|
NodeRect.Left:=Node.DisplayStateIconLeft;
|
|
with Node.TreeView.Canvas do begin
|
|
Pen.Color:=clRed;
|
|
MoveTo(NodeRect.Left,NodeRect.Top);
|
|
LineTo(NodeRect.Right,NodeRect.Top);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.UnitTreeViewCollapsing(Sender: TObject;
|
|
Node: TTreeNode; var AllowCollapse: Boolean);
|
|
var
|
|
UnitNode: TUnitNode;
|
|
begin
|
|
AllowCollapse:=true;
|
|
UnitNode:=TUnitNode(Node.Data);
|
|
UnitNode.ClearGrandChildren;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.UnitTreeViewExpanding(Sender: TObject;
|
|
Node: TTreeNode; var AllowExpansion: Boolean);
|
|
var
|
|
UnitNode: TUnitNode;
|
|
begin
|
|
UnitNode:=TUnitNode(Node.Data);
|
|
if UnitNode.HasChildren then begin
|
|
UnitTreeView.BeginUpdate;
|
|
try
|
|
AllowExpansion:=true;
|
|
UnitNode.CreateGrandChildren;
|
|
finally
|
|
UnitTreeView.EndUpdate;
|
|
end;
|
|
end else begin
|
|
AllowExpansion:=false;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.UnitTreeViewMouseDown(Sender: TOBject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
ATreeNode: TTreeNode;
|
|
CurNode: TUnitNode;
|
|
begin
|
|
if ssDouble in Shift then begin
|
|
ATreeNode:=UnitTreeView.GetNodeAt(X,Y);
|
|
if ATreeNode=nil then exit;
|
|
CurNode:=TUnitNode(ATreeNode.Data);
|
|
if Assigned(OnOpenFile) then OnOpenFile(Self,CurNode.Filename);;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.ClearTree;
|
|
begin
|
|
FreeThenNil(FRootNode);
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.RebuildTree;
|
|
var
|
|
ExpandState: TExpandedUnitNodeState;
|
|
begin
|
|
if FUpdateCount>0 then begin
|
|
FRebuildTreeNeeded:=true;
|
|
exit;
|
|
end;
|
|
FRebuildTreeNeeded:=false;
|
|
|
|
CodeToolBoss.ActivateWriteLock;
|
|
ExpandState:=TExpandedUnitNodeState.Create;
|
|
BeginUpdate;
|
|
try
|
|
ExpandState.Assign(FRootNode);
|
|
ClearTree;
|
|
if RootFilename='' then exit;
|
|
FRootNode:=TUnitNode.Create;
|
|
FRootNode.CodeBuffer:=FRootCodeBuffer;
|
|
FRootNode.Filename:=RootFilename;
|
|
//debugln('TUnitDependenciesView.RebuildTree RootFilename=',RootFilename);
|
|
FRootNode.ShortFilename:=FRootShortFilename;
|
|
UnitTreeView.Items.Clear;
|
|
FRootNode.TreeNode:=UnitTreeView.Items.Add(nil,'');
|
|
FRootNode.CreateChildren;
|
|
ExpandState.AssignTo(FRootNode);
|
|
finally
|
|
FRebuildTreeNeeded:=false;
|
|
EndUpdate;
|
|
ExpandState.Free;
|
|
CodeToolBoss.DeActivateWriteLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.SetRootFilename(const AValue: string);
|
|
begin
|
|
//DebugLn('TUnitDependenciesView.SetRootFilename Old=',FRootFilename,' New',AValue);
|
|
if FRootFilename=AValue then exit;
|
|
FRootFilename:=AValue;
|
|
FRootCodeBuffer:=CodeToolBoss.LoadFile(FRootFilename,false,false);
|
|
FRootShortFilename:=FRootFilename;
|
|
FRootValid:=FRootCodeBuffer<>nil;
|
|
RebuildTree;
|
|
RefreshHistoryList;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.SetRootShortFilename(const AValue: string);
|
|
begin
|
|
if FRootShortFilename=AValue then exit;
|
|
FRootShortFilename:=AValue;
|
|
if FRootNode<>nil then
|
|
FRootNode.ShortFilename:=AValue;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.CommitUnitHistoryListSelection;
|
|
begin
|
|
//DebugLn('TUnitDependenciesView.CommitUnitHistoryListSelection Old=',FRootFilename,' New=',UnitHistoryList.Text,' FUpdateCount=',dbgs(FUpdateCount));
|
|
if FUpdateCount>0 then begin
|
|
FCommitUnitHistoryListSelectionNeeded:=true;
|
|
exit;
|
|
end;
|
|
FCommitUnitHistoryListSelectionNeeded:=false;
|
|
if UnitHistoryList.Items.IndexOf(UnitHistoryList.Text)<0 then exit;
|
|
RootFilename:=ExpandFileNameUTF8(UnitHistoryList.Text);
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyUp(Key, Shift);
|
|
ExecuteIDEShortCut(Self,Key,Shift,nil);
|
|
end;
|
|
|
|
function TUnitDependenciesView.RootValid: boolean;
|
|
begin
|
|
Result:=FRootValid;
|
|
end;
|
|
|
|
constructor TUnitDependenciesView.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
|
|
Name:=NonModalIDEWindowNames[nmiwUnitDependenciesName];
|
|
Caption := dlgUnitDepCaption;
|
|
|
|
RefreshHistoryList;
|
|
|
|
SelectUnitButton.Caption:=dlgUnitDepBrowse;
|
|
RefreshButton.Caption:=dlgUnitDepRefresh;
|
|
ShowProjectButton.Caption:=dlgEnvProject;
|
|
CloseButton.Caption:=lisClose;
|
|
UnitTreeView.Images := IDEImages.Images_16;
|
|
ToolBar.Images := IDEImages.Images_16;
|
|
ShowProjectButton.ImageIndex := IDEImages.LoadImage(16, 'item_project');
|
|
SelectUnitButton.ImageIndex := IDEImages.LoadImage(16, 'laz_open');
|
|
RefreshButton.ImageIndex := IDEImages.LoadImage(16, 'laz_refresh');
|
|
end;
|
|
|
|
destructor TUnitDependenciesView.Destroy;
|
|
begin
|
|
ClearTree;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.BeginUpdate;
|
|
begin
|
|
inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.EndUpdate;
|
|
begin
|
|
if FUpdateCount<0 then RaiseGDBException('TUnitDependenciesView.EndUpdate');
|
|
dec(FUpdateCount);
|
|
if FUpdateCount=0 then begin
|
|
if FCommitUnitHistoryListSelectionNeeded then
|
|
CommitUnitHistoryListSelection;
|
|
if FRefreshNeeded then
|
|
Refresh;
|
|
if FRebuildTreeNeeded then
|
|
RebuildTree;
|
|
if FRefreshHistoryListNeeded then
|
|
RefreshHistoryList;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.Refresh;
|
|
begin
|
|
if FUpdateCount>0 then begin
|
|
FRefreshNeeded:=true;
|
|
exit;
|
|
end;
|
|
FRefreshNeeded:=false;
|
|
BeginUpdate;
|
|
try
|
|
if Assigned(OnAccessingSources) then OnAccessingSources(Self);
|
|
RebuildTree;
|
|
finally
|
|
FRefreshNeeded:=false;
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitDependenciesView.RefreshHistoryList;
|
|
begin
|
|
if FUpdateCount>0 then begin
|
|
FRefreshHistoryListNeeded:=true;
|
|
exit;
|
|
end;
|
|
FRefreshHistoryListNeeded:=false;
|
|
BeginUpdate;
|
|
try
|
|
if RootFilename<>'' then
|
|
if not InputHistories.AddToUnitDependenciesHistory(RootFilename) then
|
|
exit;
|
|
UnitHistoryList.Items.Assign(InputHistories.UnitDependenciesHistory);
|
|
if UnitHistoryList.Items.Count>0 then
|
|
UnitHistoryList.Text:=UnitHistoryList.Items[0]
|
|
else
|
|
UnitHistoryList.Text:=RootFilename;
|
|
finally
|
|
FRefreshHistoryListNeeded:=false;
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
{ TUnitNode }
|
|
|
|
procedure TUnitNode.SetCodeBuffer(const AValue: TCodeBuffer);
|
|
begin
|
|
if CodeBuffer=AValue then exit;
|
|
FCodeBuffer:=AValue;
|
|
if CodeBuffer<>nil then
|
|
Filename:=CodeBuffer.Filename;
|
|
end;
|
|
|
|
procedure TUnitNode.SetFilename(const AValue: string);
|
|
begin
|
|
if Filename=AValue then exit;
|
|
FFilename:=AValue;
|
|
FSourceType:=unstUnknown;
|
|
CreateShortFilename;
|
|
end;
|
|
|
|
procedure TUnitNode.SetParent(const AValue: TUnitNode);
|
|
begin
|
|
if Parent=AValue then exit;
|
|
UnbindFromParent;
|
|
FParent:=AValue;
|
|
if Parent<>nil then AddToParent;
|
|
end;
|
|
|
|
procedure TUnitNode.SetShortFilename(const AValue: string);
|
|
begin
|
|
if ShortFilename=AValue then exit;
|
|
FShortFilename:=AValue;
|
|
if TreeNode<>nil then
|
|
TreeNode.Text:=FShortFilename;
|
|
end;
|
|
|
|
procedure TUnitNode.SetTreeNode(const AValue: TTreeNode);
|
|
begin
|
|
if TreeNode=AValue then exit;
|
|
FTreeNode:=AValue;
|
|
if TreeNode<>nil then begin
|
|
TreeNode.Text:=ShortFilename;
|
|
TreeNode.Data:=Self;
|
|
TreeNode.HasChildren:=HasChildren;
|
|
TreeNode.ImageIndex:=ImageIndex;
|
|
TreeNode.SelectedIndex:=ImageIndex;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitNode.CreateShortFilename;
|
|
begin
|
|
ShortFilename:=Filename;
|
|
if (Parent<>nil) and (FilenameIsAbsolute(Parent.Filename))
|
|
and (FilenameIsAbsolute(Filename)) then begin
|
|
ShortFilename:=ExtractRelativePath(ExtractFilePath(Parent.Filename),
|
|
Filename);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitNode.UnbindFromParent;
|
|
begin
|
|
if TreeNode<>nil then begin
|
|
TreeNode.Free;
|
|
TreeNode:=nil;
|
|
end;
|
|
if Parent<>nil then begin
|
|
if Parent.FirstChild=Self then Parent.FFirstChild:=NextSibling;
|
|
if Parent.LastChild=Self then Parent.FLastChild:=PrevSibling;
|
|
Dec(Parent.FChildCount);
|
|
end;
|
|
if NextSibling<>nil then NextSibling.FPrevSibling:=PrevSibling;
|
|
if PrevSibling<>nil then PrevSibling.FNextSibling:=NextSibling;
|
|
FNextSibling:=nil;
|
|
FPrevSibling:=nil;
|
|
FParent:=nil;
|
|
end;
|
|
|
|
procedure TUnitNode.AddToParent;
|
|
begin
|
|
if Parent=nil then exit;
|
|
|
|
FPrevSibling:=Parent.LastChild;
|
|
FNextSibling:=nil;
|
|
Parent.FLastChild:=Self;
|
|
if Parent.FirstChild=nil then Parent.FFirstChild:=Self;
|
|
if PrevSibling<>nil then PrevSibling.FNextSibling:=Self;
|
|
Inc(Parent.FChildCount);
|
|
CreateShortFilename;
|
|
|
|
if FindParentWithCodeBuffer(CodeBuffer)<>nil then begin
|
|
Include(FFlags,unfCircle);
|
|
if ForbiddenCircle then
|
|
Include(FFlags,unfForbiddenCircle);
|
|
end;
|
|
|
|
if Parent.TreeNode<>nil then begin
|
|
Parent.TreeNode.HasChildren:=true;
|
|
TreeNode:=Parent.TreeNode.TreeNodes.AddChild(Parent.TreeNode,'');
|
|
if Parent.TreeNode.Expanded then begin
|
|
CreateChildren;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitNode.AddChild(const AFilename: string; ACodeBuffer: TCodeBuffer;
|
|
InImplementation: boolean);
|
|
var
|
|
NewNode: TUnitNode;
|
|
begin
|
|
NewNode:=TUnitNode.Create;
|
|
NewNode.CodeBuffer:=ACodeBuffer;
|
|
NewNode.Filename:=AFilename;
|
|
if InImplementation then
|
|
Include(NewNode.FFlags,unfImplementation);
|
|
if ACodeBuffer=nil then begin
|
|
Include(NewNode.FFlags,unfFileNotFound);
|
|
end;
|
|
NewNode.Parent:=Self;
|
|
end;
|
|
|
|
procedure TUnitNode.UpdateSourceType;
|
|
var
|
|
SourceKeyWord: string;
|
|
ASrcType: TUnitNodeSourceType;
|
|
begin
|
|
FSourceType:=unstUnknown;
|
|
if CodeBuffer=nil then exit;
|
|
SourceKeyWord:=CodeToolBoss.GetSourceType(CodeBuffer,false);
|
|
for ASrcType:=Low(TUnitNodeSourceType) to High(TUnitNodeSourceType) do
|
|
if CompareText(SourceKeyWord,UnitNodeSourceTypeNames[ASrcType])=0
|
|
then
|
|
FSourceType:=ASrcType;
|
|
if TreeNode<>nil then begin
|
|
TreeNode.ImageIndex:=ImageIndex;
|
|
TreeNode.SelectedIndex:=ImageIndex;
|
|
end;
|
|
end;
|
|
|
|
function TUnitNode.ForbiddenCircle: boolean;
|
|
var
|
|
ParentNode, CurNode: TUnitNode;
|
|
begin
|
|
Result:=false;
|
|
if CodeBuffer=nil then exit;
|
|
CurNode:=Self;
|
|
ParentNode:=Parent;
|
|
if (ParentNode<>nil) and (ParentNode.CodeBuffer=CodeBuffer) then begin
|
|
// unit includes itself -> forbidden
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
while ParentNode<>nil do begin
|
|
if (unfImplementation in CurNode.Flags) then begin
|
|
// pascal allows to use nearly anything in the implementation section
|
|
exit;
|
|
end;
|
|
if ParentNode.CodeBuffer=CodeBuffer then begin
|
|
// interface circle detected
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
CurNode:=ParentNode;
|
|
ParentNode:=ParentNode.Parent;
|
|
end;
|
|
end;
|
|
|
|
constructor TUnitNode.Create;
|
|
begin
|
|
inherited Create;
|
|
FSourceType:=unstUnknown;
|
|
end;
|
|
|
|
destructor TUnitNode.Destroy;
|
|
begin
|
|
ClearChildren;
|
|
Parent:=nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TUnitNode.ClearChildren;
|
|
begin
|
|
while LastChild<>nil do
|
|
LastChild.Free;
|
|
end;
|
|
|
|
procedure TUnitNode.CreateChildren;
|
|
var
|
|
UsedInterfaceFilenames, UsedImplementationFilenames: TStrings;
|
|
i: integer;
|
|
begin
|
|
ClearChildren;
|
|
UpdateSourceType;
|
|
if CodeBuffer=nil then exit;
|
|
if CodeToolBoss.FindUsedUnitFiles(CodeBuffer,
|
|
UsedInterfaceFilenames,
|
|
UsedImplementationFilenames) then
|
|
begin
|
|
Exclude(FFlags,unfParseError);
|
|
for i:=0 to UsedInterfaceFilenames.Count-1 do
|
|
AddChild(UsedInterfaceFilenames[i],
|
|
TCodeBuffer(UsedInterfaceFilenames.Objects[i]),false);
|
|
UsedInterfaceFilenames.Free;
|
|
for i:=0 to UsedImplementationFilenames.Count-1 do
|
|
AddChild(UsedImplementationFilenames[i],
|
|
TCodeBuffer(UsedImplementationFilenames.Objects[i]),true);
|
|
UsedImplementationFilenames.Free;
|
|
end else begin
|
|
Include(FFlags,unfParseError);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitNode.ClearGrandChildren;
|
|
var
|
|
AChildNode: TUnitNode;
|
|
begin
|
|
AChildNode:=FirstChild;
|
|
while AChildNode<>nil do begin
|
|
AChildNode.ClearChildren;
|
|
AChildNode:=AChildNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnitNode.CreateGrandChildren;
|
|
var
|
|
AChildNode: TUnitNode;
|
|
begin
|
|
AChildNode:=FirstChild;
|
|
while AChildNode<>nil do begin
|
|
AChildNode.CreateChildren;
|
|
AChildNode:=AChildNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
function TUnitNode.FindParentWithCodeBuffer(ACodeBuffer: TCodeBuffer): TUnitNode;
|
|
begin
|
|
Result:=Parent;
|
|
while (Result<>nil) and (Result.CodeBuffer<>ACodeBuffer) do begin
|
|
Result:=Result.Parent;
|
|
end;
|
|
end;
|
|
|
|
function TUnitNode.HasChildren: boolean;
|
|
begin
|
|
Result:=FChildCount>0;
|
|
end;
|
|
|
|
function TUnitNode.ImageIndex: integer;
|
|
begin
|
|
if not (unfCircle in FFlags) then
|
|
begin
|
|
case SourceType of
|
|
unstUnit: Result := IDEImages.LoadImage(16, 'item_unit');
|
|
unstProgram: Result := IDEImages.LoadImage(16, 'item_project');
|
|
unstLibrary: Result := IDEImages.LoadImage(16, 'item_library');
|
|
unstPackage: Result := IDEImages.LoadImage(16, 'item_package');
|
|
else
|
|
begin
|
|
if unfFileNotFound in Flags then
|
|
Result := IDEImages.LoadImage(16, 'state_not_found')
|
|
else if unfParseError in Flags then
|
|
Result := IDEImages.LoadImage(16, 'state_error')
|
|
else
|
|
Result := IDEImages.LoadImage(16, 'state_unknown');
|
|
end;
|
|
end;
|
|
end else
|
|
begin
|
|
if unfForbiddenCircle in Flags then
|
|
Result := IDEImages.LoadImage(16, 'state_circular_reference')
|
|
else
|
|
Result := IDEImages.LoadImage(16, 'state_unit_circular_reference');
|
|
end;
|
|
end;
|
|
|
|
function TUnitNode.IsFirstImplementationNode: boolean;
|
|
begin
|
|
Result:=IsImplementationNode
|
|
and ((PrevSibling=nil) or (not PrevSibling.IsImplementationNode));
|
|
end;
|
|
|
|
function TUnitNode.IsImplementationNode: boolean;
|
|
begin
|
|
Result:=unfImplementation in FFlags;
|
|
end;
|
|
|
|
//-----------------------------------------------------------------------------
|
|
|
|
{ TExpandedUnitNodeState }
|
|
|
|
constructor TExpandedUnitNodeState.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TExpandedUnitNodeState.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TExpandedUnitNodeState.Clear;
|
|
|
|
procedure ClearPathTree(StringListNode: TStringList);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if StringListNode=nil then exit;
|
|
for i:=0 to StringListNode.Count-1 do
|
|
ClearPathTree(TStringList(StringListNode.Objects[i]));
|
|
FreeAndNil(StringListNode);
|
|
end;
|
|
|
|
begin
|
|
ClearPathTree(FPaths);
|
|
end;
|
|
|
|
procedure TExpandedUnitNodeState.Assign(ANode: TUnitNode);
|
|
|
|
procedure AssignRecursive(var CurPathList: TStringList; CurNode: TUnitNode);
|
|
var
|
|
ChildNode: TUnitNode;
|
|
CurChildList: TStringList;
|
|
begin
|
|
if (CurNode=nil) or (not CurNode.HasChildren) or (CurNode.TreeNode=nil) then
|
|
exit;
|
|
if not CurNode.TreeNode.Expanded then exit;
|
|
if CurPathList=nil then
|
|
CurPathList:=TStringList.Create;
|
|
|
|
CurPathList.Add(CurNode.Filename);
|
|
CurChildList:=nil;
|
|
ChildNode:=CurNode.FirstChild;
|
|
while ChildNode<>nil do begin
|
|
AssignRecursive(CurChildList,ChildNode);
|
|
ChildNode:=ChildNode.NextSibling;
|
|
end;
|
|
CurPathList.Objects[CurPathList.Count-1]:=CurChildList;
|
|
end;
|
|
|
|
begin
|
|
Clear;
|
|
AssignRecursive(FPaths,ANode);
|
|
end;
|
|
|
|
procedure TExpandedUnitNodeState.AssignTo(ANode: TUnitNode);
|
|
|
|
procedure AssignToRecursive(CurPathList: TStringList; CurNode: TUnitNode);
|
|
var
|
|
ChildNode: TUnitNode;
|
|
CurChildList: TStringList;
|
|
i: integer;
|
|
begin
|
|
if (CurNode=nil) or (not CurNode.HasChildren) or (CurNode.TreeNode=nil) then
|
|
exit;
|
|
if CurPathList=nil then exit;
|
|
i:=CurPathList.IndexOf(CurNode.Filename);
|
|
if i<0 then exit;
|
|
|
|
CurNode.TreeNode.Expand(false);
|
|
CurChildList:=TStringList(CurPathList.Objects[i]);
|
|
if CurChildList=nil then exit;
|
|
|
|
ChildNode:=CurNode.FirstChild;
|
|
while ChildNode<>nil do begin
|
|
AssignToRecursive(CurChildList,ChildNode);
|
|
ChildNode:=ChildNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
AssignToRecursive(FPaths,ANode);
|
|
end;
|
|
|
|
end.
|
|
|