{ /*************************************************************************** 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 . 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, CodeToolManager, CodeCache, EnvironmentOpts, LResources, IDEOptionDefs, LazarusIDEStrConsts, InputHistory, IDEProcs, Graphics, LCLType; 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 ClearChilds; procedure CreateChilds; 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; { 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 } TOnGetProjectMainFilename = function(Sender: TObject): string of object; TOnOpenFile = procedure(Sender: TObject; const Filename: string) of object; TUnitDependenciesView = class(TForm) SrcTypeImageList: TImageList; UnitHistoryList: TComboBox; SelectUnitButton: TBitBtn; UnitTreeView: TTreeView; RefreshButton: TBitBtn; ShowProjectButton: TBitBtn; procedure RefreshButtonClick(Sender: TObject); procedure SelectUnitButtonClick(Sender: TObject); procedure ShowProjectButtonClick(Sender: TObject); procedure UnitDependenciesViewResize(Sender: TObject); procedure UnitHistoryListChange(Sender: TObject); procedure UnitHistoryListKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 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 FOnAccessingSources: TNotifyEvent; FOnGetProjectMainFilename: TOnGetProjectMainFilename; FOnOpenFile: TOnOpenFile; FRootCodeBuffer: TCodeBuffer; FRootFilename: string; FRootNode: TUnitNode; FRootShortFilename: string; FRootValid: boolean; FUpdateCount: integer; procedure DoResize; procedure ClearTree; procedure RebuildTree; procedure SetRootFilename(const AValue: string); procedure SetRootShortFilename(const AValue: string); public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure EndUpdate; procedure Refresh; procedure RefreshHistoryList; function RootValid: boolean; 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; end; var UnitDependenciesView: TUnitDependenciesView; implementation { TUnitDependenciesView } procedure TUnitDependenciesView.RefreshButtonClick(Sender: TObject); begin Refresh; end; procedure TUnitDependenciesView.SelectUnitButtonClick(Sender: TObject); var OpenDialog: TOpenDialog; begin OpenDialog:=TOpenDialog.Create(Application); try InputHistories.ApplyFileDialogSettings(OpenDialog); OpenDialog.Title:=lisOpenFile; OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist]; if OpenDialog.Execute then begin RootFilename:=ExpandFilename(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.UnitDependenciesViewResize(Sender: TObject); begin DoResize; end; procedure TUnitDependenciesView.UnitHistoryListChange(Sender: TObject); begin if UnitHistoryList.Items.IndexOf(UnitHistoryList.Text)<0 then exit; //RootFilename:=ExpandFilename(UnitHistoryList.Text); end; procedure TUnitDependenciesView.UnitHistoryListKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var NewFilename: string; begin if (Key=VK_RETURN) and (Shift=[]) then begin NewFilename:=ExpandFilename(UnitHistoryList.Text); RootFilename:=NewFilename; end; 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.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 AllowExpansion:=true; UnitNode.CreateGrandChildren; 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.DoResize; begin with UnitHistoryList do begin SetBounds(0,0,Parent.ClientWidth-Left,Height); end; with SelectUnitButton do begin SetBounds(0,UnitHistoryList.Top+UnitHistoryList.Height+2,70,Height); end; with RefreshButton do begin SetBounds(SelectUnitButton.Left+SelectUnitButton.Width+5, SelectUnitButton.Top,70,SelectUnitButton.Height); end; with ShowProjectButton do begin SetBounds(RefreshButton.Left+RefreshButton.Width+5, RefreshButton.Top,70,RefreshButton.Height); end; with UnitTreeView do begin SetBounds(0,SelectUnitButton.Top+SelectUnitButton.Height+2, Parent.ClientWidth,Parent.ClientHeight-Top); end; end; procedure TUnitDependenciesView.ClearTree; begin FRootNode.Free; FRootNode:=nil; end; procedure TUnitDependenciesView.RebuildTree; begin CodeToolBoss.ActivateWriteLock; BeginUpdate; ClearTree; if RootFilename='' then exit; FRootNode:=TUnitNode.Create; FRootNode.CodeBuffer:=FRootCodeBuffer; FRootNode.Filename:=RootFilename; FRootNode.ShortFilename:=FRootShortFilename; UnitTreeView.Items.Clear; FRootNode.TreeNode:=UnitTreeView.Items.Add(nil,''); FRootNode.CreateChilds; EndUpdate; CodeToolBoss.DeActivateWriteLock; end; procedure TUnitDependenciesView.SetRootFilename(const AValue: string); begin 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; function TUnitDependenciesView.RootValid: boolean; begin Result:=FRootValid; end; constructor TUnitDependenciesView.Create(TheOwner: TComponent); procedure AddResImg(ImgList: TImageList; const ResName: string); var Pixmap: TPixmap; begin Pixmap:=TPixmap.Create; if LazarusResources.Find(ResName)=nil then writeln('TUnitDependenciesView.Create: ', ' WARNING: icon not found: "',ResName,'"'); Pixmap.LoadFromLazarusResource(ResName); ImgList.Add(Pixmap,nil) end; var ALayout: TIDEWindowLayout; begin inherited Create(TheOwner); if LazarusResources.Find(ClassName)=nil then begin Name:=DefaultUnitDependenciesName; Caption := 'Unit Dependencies'; ALayout:=EnvironmentOptions.IDEWindowLayoutList.ItemByFormID(Name); ALayout.Form:=TForm(Self); ALayout.Apply; SrcTypeImageList:=TImageList.Create(Self); with SrcTypeImageList do begin Name:='SrcTypeImageList'; Width:=22; Height:=22; AddResImg(SrcTypeImageList,'srctype_unknown_22x22'); // 0 AddResImg(SrcTypeImageList,'srctype_unit_22x22'); // 1 AddResImg(SrcTypeImageList,'srctype_program_22x22'); // 2 AddResImg(SrcTypeImageList,'srctype_library_22x22'); // 3 AddResImg(SrcTypeImageList,'srctype_package_22x22'); // 4 AddResImg(SrcTypeImageList,'srctype_filenotfound_22x22'); // 5 AddResImg(SrcTypeImageList,'srctype_parseerror_22x22'); // 6 AddResImg(SrcTypeImageList,'srctype_forbiddencircle_22x22'); // 7 AddResImg(SrcTypeImageList,'srctype_circle_22x22'); // 8 end; UnitHistoryList:=TComboBox.Create(Self); with UnitHistoryList do begin Name:='UnitHistoryList'; Parent:=Self; Left:=0; Top:=0; Width:=Parent.ClientWidth-Left; RefreshHistoryList; OnKeyUp:=@UnitHistoryListKeyUp; OnChange:=@UnitHistoryListChange; Visible:=true; end; SelectUnitButton:=TBitBtn.Create(Self); with SelectUnitButton do begin Name:='SelectUnitButton'; Parent:=Self; Left:=0; Top:=UnitHistoryList.Top+UnitHistoryList.Height+2; Width:=70; Caption:='Browse'; OnClick:=@SelectUnitButtonClick; Visible:=true; end; RefreshButton:=TBitBtn.Create(Self); with RefreshButton do begin Name:='RefreshButton'; Parent:=Self; Left:=SelectUnitButton.Left+SelectUnitButton.Width+5; Top:=SelectUnitButton.Top; Width:=70; Height:=SelectUnitButton.Height; Caption:='Refresh'; OnClick:=@RefreshButtonClick; Visible:=true; end; ShowProjectButton:=TBitBtn.Create(Self); with ShowProjectButton do begin Name:='ShowProjectButton'; Parent:=Self; Left:=RefreshButton.Left+RefreshButton.Width+5; Top:=RefreshButton.Top; Width:=70; Height:=RefreshButton.Height; Caption:='Project'; OnClick:=@ShowProjectButtonClick; Visible:=true; end; UnitTreeView:=TTreeView.Create(Self); with UnitTreeView do begin Name:='UnitTreeView'; Parent:=Self; Left:=0; Top:=SelectUnitButton.Top+SelectUnitButton.Height+2; Width:=Parent.ClientWidth; Height:=Parent.ClientHeight-Top; OnExpanding:=@UnitTreeViewExpanding; OnCollapsing:=@UnitTreeViewCollapsing; Images:=SrcTypeImageList; //StateImages:=SrcTypeImageList; OnAdvancedCustomDrawItem:=@UnitTreeViewAdvancedCustomDrawItem; OnMouseDown:=@UnitTreeViewMouseDown; Visible:=true; end; OnResize:=@UnitDependenciesViewResize; end; end; destructor TUnitDependenciesView.Destroy; begin ClearTree; inherited Destroy; end; procedure TUnitDependenciesView.BeginUpdate; begin inc(FUpdateCount); end; procedure TUnitDependenciesView.EndUpdate; begin dec(FUpdateCount); end; procedure TUnitDependenciesView.Refresh; var ExpandState: TExpandedUnitNodeState; begin if FUpdateCount>0 then exit; BeginUpdate; if Assigned(OnAccessingSources) then OnAccessingSources(Self); // save old expanded nodes ExpandState:=TExpandedUnitNodeState.Create; ExpandState.Assign(FRootNode); // clear all child nodes RebuildTree; // restore expanded state ExpandState.AssignTo(FRootNode); ExpandState.Free; EndUpdate; end; procedure TUnitDependenciesView.RefreshHistoryList; begin 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; 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 CreateChilds; 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 AnsiCompareText(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 ClearChilds; Parent:=nil; inherited Destroy; end; procedure TUnitNode.ClearChilds; begin while LastChild<>nil do LastChild.Free; end; procedure TUnitNode.CreateChilds; var UsedInterfaceFilenames, UsedImplementationFilenames: TStrings; i: integer; begin ClearChilds; UpdateSourceType; if CodeBuffer=nil then exit; if CodeToolBoss.FindUsedUnits(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.ClearChilds; AChildNode:=AChildNode.NextSibling; end; end; procedure TUnitNode.CreateGrandChildren; var AChildNode: TUnitNode; begin AChildNode:=FirstChild; while AChildNode<>nil do begin AChildNode.CreateChilds; 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:=1; unstProgram: Result:=2; unstLibrary: Result:=3; unstPackage: Result:=4; else begin if unfFileNotFound in Flags then Result:=5 else if unfParseError in Flags then Result:=6 else Result:=0; end; end; end else begin if unfForbiddenCircle in Flags then begin Result:=7; end else begin Result:=8; end; 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; sl: TStringList; begin if StringListNode=nil then exit; for i:=0 to StringListNode.Count-1 do begin sl:=TStringList(StringListNode.Objects[i]); if sl<>nil then begin ClearPathTree(sl); sl.Free; end; end; StringListNode.Clear; end; begin if FPaths=nil then exit; ClearPathTree(FPaths); FreeAndNil(FPaths); end; procedure TExpandedUnitNodeState.Assign(ANode: TUnitNode); procedure AssignRecursive(var CurPathList: TStringList; CurNode: TUnitNode); var ChildNode: TUnitNode; CurChildList: TStringList; begin if CurNode=nil then exit; if CurNode.HasChildren and (CurNode.TreeNode<>nil) and (CurNode.TreeNode.Expanded) then begin 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; if CurChildList<>nil then CurPathList.Objects[CurPathList.Count-1]:=CurChildList; end; 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 (CurPathList=nil) or (CurNode=nil) or (not CurNode.HasChildren) or (CurNode.TreeNode=nil) then exit; i:=CurPathList.IndexOf(CurNode.Filename); if i>=0 then begin CurNode.TreeNode.Expand(false); CurChildList:=TStringList(CurPathList.Objects[i]); if CurChildList<>nil then begin ChildNode:=CurNode.FirstChild; while ChildNode<>nil do begin AssignToRecursive(CurChildList,ChildNode); ChildNode:=ChildNode.NextSibling; end; end; end; end; begin AssignToRecursive(FPaths,ANode); end; initialization UnitDependenciesView:=nil; {$I unitdependencies.lrs} end.