lazarus/ide/unitdependencies.pas

{
/***************************************************************************
                             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, LResources, LCLProc,
  CodeToolManager, CodeCache,
  IDECommands,
  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 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 UnitDependenciesViewClose(Sender: TObject;
      var CloseAction: TCloseAction);
    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);
  protected
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  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(nil);
  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.UnitDependenciesViewClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  EnvironmentOptions.IDEWindowLayoutList.ItemByForm(Self).GetCurrentPosition;
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;

procedure TUnitDependenciesView.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
  ExecuteIDECommand(Self,Key,Shift,caMenuOnly);
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
      DebugLn('TUnitDependenciesView.Create: ',
        ' WARNING: icon not found: "',ResName,'"');
    Pixmap.LoadFromLazarusResource(ResName);
    ImgList.Add(Pixmap,nil)
  end;
  
var
  W: Integer;
begin
  inherited Create(TheOwner);

  Name:=NonModalIDEWindowNames[nmiwUnitDependenciesName];
  Caption := dlgUnitDepCaption;
  EnvironmentOptions.IDEWindowLayoutList.Apply(Self,Name);
  KeyPreview:=true;

  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;
  
  W:=90; //Used foro simplified the update
  SelectUnitButton:=TBitBtn.Create(Self);
  with SelectUnitButton do
  begin
    Name:='SelectUnitButton';
    Parent:=Self;
    Left:=0;
    Top:=UnitHistoryList.Top+UnitHistoryList.Height+2;
    Width:=W;
    Caption:=dlgUnitDepBrowse;
    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:=W;
    Height:=SelectUnitButton.Height;
    Caption:=dlgUnitDepRefresh;
    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:=W;
    Height:=RefreshButton.Height;
    Caption:=dlgEnvProject;
    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;
  OnClose:=@UnitDependenciesViewClose;
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.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.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.