From 1d4aa7e9760b4d1d393811553b2da60fe15e7030 Mon Sep 17 00:00:00 2001 From: lazarus Date: Sat, 14 Sep 2002 10:39:40 +0000 Subject: [PATCH] MG: added expanding to unit dependencies git-svn-id: trunk@3341 - --- components/codetools/stdcodetools.pas | 12 +- ide/unitdependencies.pas | 263 ++++++++++++++++++++++++-- lcl/comctrls.pp | 7 +- lcl/include/treeview.inc | 65 ++++--- 4 files changed, 298 insertions(+), 49 deletions(-) diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 714640de35..ae9f88ee6e 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -311,7 +311,8 @@ begin if Result=nil then exit; end; Result:=Result.FirstChild; - if (Result<>nil) and (Result.Desc<>ctnUsesSection) then Result:=nil; + if (Result=nil) then exit; + if (Result.Desc<>ctnUsesSection) then Result:=nil; end; function TStandardCodeTool.FindImplementationUsesSection: TCodeTreeNode; @@ -322,7 +323,8 @@ begin Result:=Result.NextBrother; if Result=nil then exit; Result:=Result.FirstChild; - if (Result=nil) or (Result.Desc<>ctnUsesSection) then exit; + if (Result=nil) then exit; + if (Result.Desc<>ctnUsesSection) then Result:=nil; end; function TStandardCodeTool.RenameUsedUnit(const OldUpperUnitName, @@ -535,9 +537,10 @@ begin try MainUsesSection:=UsesSectionToFilenames(MainUsesNode); ImplementationUsesSection:=UsesSectionToFilenames(ImplementatioUsesNode); - finally + except FreeAndNil(MainUsesSection); FreeAndNil(ImplementationUsesSection); + raise; end; Result:=true; end; @@ -559,8 +562,9 @@ var NewCode: TCodeBuffer; UnitFilename: string; begin - MoveCursorToUsesEnd(UsesNode); Result:=TStringList.Create; + if UsesNode=nil then exit; + MoveCursorToUsesEnd(UsesNode); repeat // read prior unit name ReadPriorUsedUnit(UnitNameAtom, InAtom); diff --git a/ide/unitdependencies.pas b/ide/unitdependencies.pas index efc5635648..75b9ea548d 100644 --- a/ide/unitdependencies.pas +++ b/ide/unitdependencies.pas @@ -44,38 +44,85 @@ uses MemCheck, {$ENDIF} Classes, SysUtils, Forms, Dialogs, Buttons, ComCtrls, StdCtrls, - CodeToolManager, EnvironmentOpts, LResources, IDEOptionDefs, + CodeToolManager, CodeCache, EnvironmentOpts, LResources, IDEOptionDefs, LazarusIDEStrConsts, InputHistory; type { TUnitNode } + + TUnitNodeFlag = ( + unfImplementation,// this unit was used in an implementation uses section + unfCircle, // this unit is the parent of itself + 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 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; public constructor Create; destructor Destroy; override; + procedure ClearChilds; procedure CreateChilds; + procedure ClearGrandChildren; + procedure CreateGrandChildren; + function FindParentWithCodeBuffer(ACodeBuffer: TCodeBuffer): TUnitNode; + function HasChildren: 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; + 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; @@ -88,11 +135,16 @@ type UnitTreeView: TTreeView; RefreshButton: TBitBtn; procedure UnitDependenciesViewResize(Sender: TObject); + procedure UnitTreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); + procedure UnitTreeViewExpanding(Sender: TObject; Node: TTreeNode; + var AllowExpansion: Boolean); private + FRootCodeBuffer: TCodeBuffer; FRootFilename: string; + FRootNode: TUnitNode; FRootShortFilename: string; FRootValid: boolean; - FRootNode: TUnitNode; procedure DoResize; procedure ClearTree; procedure RebuildTree; @@ -119,6 +171,30 @@ begin DoResize; 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.DoResize; begin with UnitHistoryList do begin @@ -151,6 +227,7 @@ begin ClearTree; if RootFilename='' then exit; FRootNode:=TUnitNode.Create; + FRootNode.CodeBuffer:=FRootCodeBuffer; FRootNode.Filename:=RootFilename; FRootNode.ShortFilename:=FRootShortFilename; UnitTreeView.Items.Clear; @@ -162,6 +239,7 @@ procedure TUnitDependenciesView.SetRootFilename(const AValue: string); begin if FRootFilename=AValue then exit; FRootFilename:=AValue; + FRootCodeBuffer:=CodeToolBoss.FindFile(FRootFilename); FRootShortFilename:=FRootFilename; RebuildTree; UpdateUnitTree; @@ -238,6 +316,8 @@ begin Top:=SelectUnitButton.Top+SelectUnitButton.Height+2; Width:=Parent.ClientWidth; Height:=Parent.ClientHeight-Top; + OnExpanding:=@UnitTreeViewExpanding; + OnCollapsing:=@UnitTreeViewCollapsing; Visible:=true; end; @@ -253,13 +333,30 @@ 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 FFilename=AValue then exit; + 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; @@ -270,11 +367,12 @@ end; procedure TUnitNode.SetTreeNode(const AValue: TTreeNode); begin - if FTreeNode=AValue then exit; + if TreeNode=AValue then exit; FTreeNode:=AValue; - if FTreeNode<>nil then begin - FTreeNode.Text:=ShortFilename; - + if TreeNode<>nil then begin + TreeNode.Text:=ShortFilename; + TreeNode.Data:=Self; + TreeNode.HasChildren:=HasChildren; end; end; @@ -283,21 +381,160 @@ begin ShortFilename:=Filename; 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); + + 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 ACodeBuffer<>nil then begin + if FindParentWithCodeBuffer(ACodeBuffer)<>nil then + Include(NewNode.FFlags,unfCircle); + end else begin + Include(NewNode.FFlags,unfFileNotFound); + end; + if InImplementation then + Include(NewNode.FFlags,unfImplementation); + NewNode.Parent:=Self; +end; + +procedure TUnitNode.UpdateSourceType; +var + SourceKeyWord: string; +begin + FSourceType:=unstUnknown; + if CodeBuffer=nil then exit; + SourceKeyWord:=CodeToolBoss.GetSourceType(CodeBuffer,false); + for FSourceType:=Low(TUnitNodeSourceType) to High(TUnitNodeSourceType) do + if AnsiCompareText(SourceKeyWord,UnitNodeSourceTypeNames[FSourceType])=0 + then + exit; + FSourceType:=unstUnknown; +end; + constructor TUnitNode.Create; begin - + inherited Create; + FSourceType:=unstUnknown; end; destructor TUnitNode.Destroy; begin + ClearChilds; + Parent:=nil; inherited Destroy; end; -procedure TUnitNode.CreateChilds; -//var -// UsedInterfaceFilenames, UsedImplementation: TStrings; +procedure TUnitNode.ClearChilds; begin - //CodeToolBoss.FindUsedUnits(); + 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 + Result:=Result.Parent; +end; + +function TUnitNode.HasChildren: boolean; +begin + Result:=FChildCount>0; +end; + +function TUnitNode.IsImplementationNode: boolean; +begin + Result:=unfImplementation in FFlags; end; end. diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index e13ecf275b..e99f62c5d1 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -1396,8 +1396,8 @@ type property OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion; property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing; property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited; - property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding; property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded; + property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding; property OnGetImageIndex: TTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex; property OnGetSelectedIndex: TTVExpandedEvent @@ -1521,8 +1521,8 @@ type property OnEndDrag; property OnEnter; property OnExit; - property OnExpanding; property OnExpanded; + property OnExpanding; property OnGetImageIndex; property OnGetSelectedIndex; property OnKeyDown; @@ -1600,6 +1600,9 @@ end. { ============================================================================= $Log$ + Revision 1.47 2002/09/14 10:39:40 lazarus + MG: added expanding to unit dependencies + Revision 1.46 2002/09/14 08:38:05 lazarus MG: added TListView notification from Vincent diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 8a5c688ea7..a54c182eb4 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -107,9 +107,9 @@ destructor TTreeNode.Destroy; // Node: TTreeNode; // CheckValue: Integer; begin -{$IFDEF TREEVIEW_DEBUG} -writeln('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text); -{$ENDIF} + {$IFDEF TREEVIEW_DEBUG} + writeln('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text); + {$ENDIF} FDeleting := True; HasChildren := false; Unbind; @@ -368,8 +368,10 @@ function TTreeNode.DoCanExpand(ExpandIt: Boolean): Boolean; begin Result := False; if (TreeView<>nil) and HasChildren then begin - if ExpandIt then Result := TreeView.CanExpand(Self) - else Result := TreeView.CanCollapse(Self); + if ExpandIt then + Result := TreeView.CanExpand(Self) + else + Result := TreeView.CanCollapse(Self); end; end; @@ -584,8 +586,8 @@ procedure TTreeNode.SetHasChildren(AValue: Boolean); //var Item: TTVItem; begin if AValue=HasChildren then exit; -//writeln('[TTreeNode.SetHasChildren] Self=',HexStr(Cardinal(Self),8), -//' Self.Text=',Text,' AValue=',AValue); + //writeln('[TTreeNode.SetHasChildren] Self=',HexStr(Cardinal(Self),8), + //' Self.Text=',Text,' AValue=',AValue); if AValue then Include(FStates,nsHasChildren) else begin @@ -1024,7 +1026,7 @@ begin taInsert: begin // insert node in front of ANode -//writeln('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',HexStr(Cardinal(ANode),8)); + //writeln('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',HexStr(Cardinal(ANode),8)); FNextBrother:=ANode; FPrevBrother:=ANode.GetPrevSibling; if Owner<>nil then begin @@ -1040,12 +1042,12 @@ begin Owner.Owner.FStates:=Owner.Owner.FStates+[tvsMaxRightNeedsUpdate, tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate]; -{$IFDEF TREEVIEW_DEBUG} -write('[TTreeNode.InternalMove] END Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text -,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]); -if ANode<>nil then write(' ANode.Text=',ANode.Text); -writeln(''); -{$ENDIF} + {$IFDEF TREEVIEW_DEBUG} + write('[TTreeNode.InternalMove] END Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text + ,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]); + if ANode<>nil then write(' ANode.Text=',ANode.Text); + writeln(''); + {$ENDIF} {var I: Integer; @@ -1815,7 +1817,10 @@ begin Result:=GetLastNode; while (Result<>nil) and (Result.Expanded) do begin Node:=Result.GetLastChild; - if Node<>nil then Result:=Node; + if Node<>nil then + Result:=Node + else + exit; end; end; @@ -1956,10 +1961,10 @@ procedure TTreeNodes.MoveTopLvlNode(TopLvlFromIndex, TopLvlToIndex: integer; Node: TTreeNode); var i: integer; begin -{$IFDEF TREEVIEW_DEBUG} -writeln('[TTreeNodes.MoveTopLvlNode] TopLvlFromIndex=',TopLvlFromIndex, -' TopLvlToIndex=',TopLvlToIndex,' Node.Text=',Node.Text); -{$ENDIF} + {$IFDEF TREEVIEW_DEBUG} + writeln('[TTreeNodes.MoveTopLvlNode] TopLvlFromIndex=',TopLvlFromIndex, + ' TopLvlToIndex=',TopLvlToIndex,' Node.Text=',Node.Text); + {$ENDIF} if (TopLvlFromIndex>=FTopLvlCount) then TreeNodeError('TTreeNodes.MoveTopLvlNode TopLvlFromIndex>FTopLvlCount'); if (TopLvlToIndex>FTopLvlCount) then @@ -2155,10 +2160,10 @@ begin exit; end; inc(RealCount,Node.SubTreeCount); -//writeln(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount); + //writeln(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount); Node:=Node.FNextBrother; end; -//writeln(' ConsistencyCheck: B ',RealCount,',',FCount); + //writeln(' ConsistencyCheck: B ',RealCount,',',FCount); if RealCount<>FCount then exit(-3); if (FTopLvlCapacity<=0) and (FTopLvlItems<>nil) then exit(-4); if (FTopLvlCapacity>0) and (FTopLvlItems=nil) then exit(-5); @@ -2170,7 +2175,7 @@ begin exit(-9); if (iFTopLvlItems[i+1]) then begin -writeln(' CONSISTENCY i=',i,' FTopLvlCount=',FTopLvlCount,' FTopLvlItems[i]=',HexStr(Cardinal(FTopLvlItems[i]),8),' FTopLvlItems[i].FNextBrother=',HexStr(Cardinal(FTopLvlItems[i].FNextBrother),8),' FTopLvlItems[i+1]=',HexStr(Cardinal(FTopLvlItems[i+1]),8)); + writeln(' CONSISTENCY i=',i,' FTopLvlCount=',FTopLvlCount,' FTopLvlItems[i]=',HexStr(Cardinal(FTopLvlItems[i]),8),' FTopLvlItems[i].FNextBrother=',HexStr(Cardinal(FTopLvlItems[i].FNextBrother),8),' FTopLvlItems[i+1]=',HexStr(Cardinal(FTopLvlItems[i+1]),8)); exit(-10); end; if (i=FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>nil) then @@ -3179,18 +3184,18 @@ end; function TCustomTreeView.IsNodeVisible(ANode: TTreeNode): Boolean; begin Result:=(ANode<>nil) and (ANode.AreParentsExpanded); -//writeln('[TCustomTreeView.IsNodeVisible] A Node=',HexStr(Cardinal(ANode),8), -//' ANode.AreParentsExpanded=',ANode.AreParentsExpanded); + //writeln('[TCustomTreeView.IsNodeVisible] A Node=',HexStr(Cardinal(ANode),8), + //' ANode.AreParentsExpanded=',ANode.AreParentsExpanded); if Result then begin -//writeln('[TCustomTreeView.IsNodeVisible] B Node=',HexStr(Cardinal(ANode),8), -//' ',FScrolledTop,'>=',ANode.Top,'+',ANode.Height,' or ',FScrolledTop,'+',ClientHeight,'<',ANode.Top); + //writeln('[TCustomTreeView.IsNodeVisible] B Node=',HexStr(Cardinal(ANode),8), + //' ',FScrolledTop,'>=',ANode.Top,'+',ANode.Height,' or ',FScrolledTop,'+',ClientHeight,'<',ANode.Top); if (FScrolledTop>=ANode.Top+ANode.Height) or (FScrolledTop+(ClientHeight-ScrollBarWidth)-2*BorderWidthnil,' ',Node <> DropTarget,' ',Node = FLastDropTarget); + writeln('TCustomTreeView.DoDragOver ',Node<>nil,' ',Node <> DropTarget,' ',Node = FLastDropTarget); if (Node <> nil) and ((Node <> DropTarget) or (Node = FLastDropTarget)) then begin