1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 IDE Window showing dependencies of units and packages.
25
26 ToDo:
27 - show unit selected in TV on units graph
28 }
29 unit UnitDependencies;
30
31 {$mode objfpc}{$H+}
32
33 {$I ide.inc}
34
35 interface
36
37 uses
38 // RTL + FCL
39 Classes, SysUtils, types, math, Laz_AVL_Tree,
40 // LCL
41 Forms, Controls, ExtCtrls, ComCtrls, StdCtrls, Buttons, Dialogs, Menus,
42 Clipbrd, CheckLst,
43 // CodeTools
44 CodeToolManager, DefineTemplates, CTUnitGraph, CTUnitGroupGraph,
45 FileProcs, CodeCache, AvgLvlTree,
46 // LazUtils
47 LazLoggerBase, LazFileUtils, LazFileCache, LazStringUtils, LazUTF8, LvlGraphCtrl,
48 // IDE interface
49 LazIDEIntf, ProjectIntf, IDEWindowIntf, PackageIntf, SrcEditorIntf, IDEImagesIntf,
50 IDEMsgIntf, IDEExternToolIntf, IDECommands, IDEDialogs,
51 // IDE
52 IDEOptionDefs, LazarusIDEStrConsts, UnusedUnitsDlg, DependencyGraphOptions,
53 MainIntf, EnvironmentOpts;
54
55 const
56 GroupPrefixProject = '-Project-';
57 GroupPrefixFPCSrc = 'FPC:';
58 GroupNone = '-None-';
59 type
60
61 { TUDSCCNode }
62
63 TUDSCCNode = class
64 public
65 UDItem: TObject; // a TUDUnit or TUDUses
66 InIntfCycle: boolean;
67 InImplCycle: boolean;
68 TarjanIndex: integer;
69 TarjanLowLink: integer;
70 TarjanVisiting: boolean; // currently on stack
AsStringnull71 function AsString: string;
72 constructor Create(Item: TObject);
73 end;
74
75 { TUDUnit }
76
77 TUDUnit = class(TUGGroupUnit)
78 public
79 SCCNode: TUDSCCNode;
GetSCCNodenull80 function GetSCCNode: TUDSCCNode;
HasImplementationUsesnull81 function HasImplementationUses: boolean;
82 destructor Destroy; override;
83 end;
84
85 { TUDUses }
86
87 TUDUses = class(TUGUses)
88 public
89 SCCNode: TUDSCCNode;
GetSCCNodenull90 function GetSCCNode: TUDSCCNode;
91 destructor Destroy; override;
92 end;
93
94 TUDNodeType = (
95 udnNone,
96 udnGroup,
97 udnDirectory,
98 udnInterface,
99 udnImplementation,
100 udnUsedByInterface,
101 udnUsedByImplementation,
102 udnUnit
103 );
104 TUDNodeTypes = set of TUDNodeType;
105
106 { TUDBaseNode }
107
108 TUDBaseNode = class
109 public
110 TVNode: TTreeNode;
111 NodeText: string;
112 Typ: TUDNodeType;
113 Identifier: string; // GroupName, Directory, Filename
114 Group: string;
115 HasChildren: boolean;
116 IntfCycle: boolean;
117 ImplCycle: boolean;
118 HasImplementationUses: boolean;
119 end;
120
121 { TUDNode }
122
123 TUDNode = class(TUDBaseNode)
124 public
125 Parent: TUDNode;
126 ChildNodes: TAVLTree; // tree of TUDNode sorted for Typ and NodeText
127 constructor Create;
128 destructor Destroy; override;
129 procedure Clear;
GetNodenull130 function GetNode(aTyp: TUDNodeType; const ANodeText: string;
131 CreateIfNotExists: boolean = false): TUDNode;
FindFirstnull132 function FindFirst(aTyp: TUDNodeType): TUDNode;
FindUnitnull133 function FindUnit(const aUnitName: string): TUDNode;
Countnull134 function Count: integer;
135 end;
136
137 TUDWFlag = (
138 udwParsing,
139 udwNeedUpdateGroupsLvlGraph, // rebuild GroupsLvlGraph
140 udwNeedUpdateUnitsLvlGraph, // rebuild UnitsLvlGraph
141 udwNeedUpdateAllUnitsTreeView, // rebuild AllUnitsTreeView
142 udwNeedUpdateAllUnitsTVSearch, // update search in AllUnitsTreeView
143 udwNeedUpdateSelUnitsTreeView, // rebuild SelUnitsTreeView
144 udwNeedUpdateSelUnitsTVSearch // update search in SelUnitsTreeView
145 );
146 TUDWFlags = set of TUDWFlag;
147
148 { TUnitDependenciesWindow }
149
150 TUnitDependenciesWindow = class(TForm)
151 AllUnitsFilterEdit: TEdit;
152 AllUnitsSearchEdit: TEdit;
153 AllUnitsSearchNextSpeedButton: TSpeedButton;
154 AllUnitsSearchPrevSpeedButton: TSpeedButton;
155 AllUnitsGroupBox: TGroupBox;
156 AllUnitsShowDirsSpeedButton: TSpeedButton;
157 AllUnitsShowGroupNodesSpeedButton: TSpeedButton;
158 AllUnitsTreeView: TTreeView; // Node.Data is TUDNode
159 GraphPopupMenu: TPopupMenu;
160 GraphOptsMenuItem: TMenuItem;
161 PopupMenu1: TPopupMenu;
162 UnitGraphFilter: TCheckListBox;
163 MainPageControl: TPageControl;
164 UnitGraphOptionSplitter: TSplitter;
165 UnitGraphOptionPanel: TPanel;
166 UnitGraphPanel: TPanel;
167 UnitsTVOpenFileMenuItem: TMenuItem;
168 RefreshButton: TButton;
169 StatsLabel: TLabel;
170 StatusPanel: TPanel;
171 Timer1: TTimer;
172 UnitsTVUnusedUnitsMenuItem: TMenuItem;
173 UnitsTVCopyFilenameMenuItem: TMenuItem;
174 UnitsTVCollapseAllMenuItem: TMenuItem;
175 UnitsTVExpandAllMenuItem: TMenuItem;
176 ProgressBar1: TProgressBar;
177 GroupsTabSheet: TTabSheet;
178 GroupsSplitter: TSplitter;
179 SearchPkgsCheckBox: TCheckBox;
180 SearchSrcEditCheckBox: TCheckBox;
181 SelectedUnitsGroupBox: TGroupBox;
182 SelUnitsSearchEdit: TEdit;
183 SelUnitsSearchNextSpeedButton: TSpeedButton;
184 SelUnitsSearchPrevSpeedButton: TSpeedButton;
185 SelUnitsTreeView: TTreeView;
186 SearchCustomFilesBrowseButton: TButton;
187 SearchCustomFilesCheckBox: TCheckBox;
188 ScopePanel: TPanel;
189 SearchCustomFilesComboBox: TComboBox;
190 UnitsSplitter: TSplitter;
191 UnitsTabSheet: TTabSheet;
192 UnitsTVPopupMenu: TPopupMenu;
193 procedure AllUnitsFilterEditChange(Sender: TObject);
194 procedure AllUnitsSearchEditChange(Sender: TObject);
195 procedure AllUnitsSearchNextSpeedButtonClick(Sender: TObject);
196 procedure AllUnitsSearchPrevSpeedButtonClick(Sender: TObject);
197 procedure AllUnitsShowDirsSpeedButtonClick(Sender: TObject);
198 procedure AllUnitsShowGroupNodesSpeedButtonClick(Sender: TObject);
199 procedure FormActivate(Sender: TObject);
200 procedure FormShow(Sender: TObject);
201 procedure GraphOptsMenuItemClick(Sender: TObject);
202 procedure RefreshButtonClick(Sender: TObject);
203 procedure SelUnitsTreeViewExpanding(Sender: TObject; Node: TTreeNode;
204 var AllowExpansion: Boolean);
205 procedure Timer1Timer(Sender: TObject);
206 procedure UnitGraphFilterItemClick(Sender: TObject; {%H-}Index: integer);
207 procedure UnitGraphFilterSelectionChange(Sender: TObject; User: boolean);
208 procedure UnitsLvlGraphMouseDown(Sender: TObject; Button: TMouseButton;
209 Shift: TShiftState; X, Y: Integer);
210 procedure UnitsLvlGraphSelectionChanged(Sender: TObject);
211 procedure UnitsTreeViewShowHint(Sender: TObject; HintInfo: PHintInfo);
212 procedure UnitsTreeViewMouseDown(Sender: TObject; Button: TMouseButton;
213 Shift: TShiftState; X, Y: Integer);
214 procedure AllUnitsTreeViewSelectionChanged(Sender: TObject);
215 procedure FormCreate(Sender: TObject);
216 procedure FormDestroy(Sender: TObject);
217 procedure GroupsLvlGraphSelectionChanged(Sender: TObject);
218 procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
219 procedure SearchPkgsCheckBoxChange(Sender: TObject);
220 procedure SearchSrcEditCheckBoxChange(Sender: TObject);
221 procedure SelUnitsSearchEditChange(Sender: TObject);
222 procedure SelUnitsSearchNextSpeedButtonClick(Sender: TObject);
223 procedure SelUnitsSearchPrevSpeedButtonClick(Sender: TObject);
224 procedure SearchCustomFilesBrowseButtonClick(Sender: TObject);
225 procedure SearchCustomFilesCheckBoxChange(Sender: TObject);
226 procedure SearchCustomFilesComboBoxChange(Sender: TObject);
227 procedure UnitsTVCollapseAllMenuItemClick(Sender: TObject);
228 procedure UnitsTVCopyFilenameMenuItemClick(Sender: TObject);
229 procedure UnitsTVExpandAllMenuItemClick(Sender: TObject);
230 procedure UnitsTVOpenFileMenuItemClick(Sender: TObject);
231 procedure UnitsTVPopupMenuPopup(Sender: TObject);
232 procedure UnitsTVUnusedUnitsMenuItemClick(Sender: TObject);
233 private
234 FPackageGraphOpts: TLvlGraphOptions;
235 FUnitGraphOpts: TLvlGraphOptions;
236 FCurrentUnit: TUGUnit;
237 FIdleConnected: boolean;
238 FPendingUnitDependencyRoute: TStrings;
239 FUsesGraph: TUsesGraph;
240 FGroups: TUGGroups; // referenced by Nodes.Data of GroupsLvlGraph
241 FNewUsesGraph: TUsesGraph; // on idle the units are scanned and this graph
242 // is filled up, when parsing is complete it becomes the new UsesGraph
243 FNewGroups: TUGGroups;
244 FAllUnitsRootUDNode: TUDNode;
245 FSelUnitsRootUDNode: TUDNode;
246 FFlags: TUDWFlags;
247 fImgIndexProject: integer;
248 fImgIndexUnit: integer;
249 fImgIndexPackage: integer;
250 fImgIndexPackageRequired: integer;
251 fImgIndexDirectory: integer;
252 fImgIndexOverlayImplUses: integer;
253 fImgIndexOverlayIntfCycle: integer;
254 fImgIndexOverlayImplCycle: integer;
255 fAllUnitsTVSearchStartNode: TTreeNode;
256 fSelUnitsTVSearchStartNode: TTreeNode;
257 FGroupLvlGraphSelectionsList: TStringListUTF8Fast;
CreateAllUnitsTreenull258 function CreateAllUnitsTree: TUDNode;
CreateSelUnitsTreenull259 function CreateSelUnitsTree: TUDNode;
260 procedure DoLoadedOpts(Sender: TObject);
261 procedure ExpandPendingUnitDependencyRoute(RootNode: TUDNode);
262 procedure ConvertUnitNameRouteToPath(Route: TStrings); // inserts missing links
263 procedure AddUsesSubNodes(UDNode: TUDNode);
264 procedure CreateTVNodes(TV: TTreeView;
265 ParentTVNode: TTreeNode; ParentUDNode: TUDNode; Expand: boolean);
266 procedure FreeUsesGraph;
GetPopupTV_UDNodenull267 function GetPopupTV_UDNode(out UDNode: TUDNode): boolean;
268 procedure GraphOptsApplyClicked(AnOpts: TLvlGraphOptions; AGraph: TLvlGraph
269 );
270 procedure SelectNextSearchTV(TV: TTreeView; StartTVNode: TTreeNode;
271 SearchNext, SkipStart: boolean);
FindNextTVNodenull272 function FindNextTVNode(StartNode: TTreeNode;
273 LowerSearch: string; SearchNext, SkipStart: boolean): TTreeNode;
FindUnitTVNodeWithFilenamenull274 function FindUnitTVNodeWithFilename(TV: TTreeView; aFilename: string): TTreeNode;
FindUnitTVNodeWithUnitNamenull275 function FindUnitTVNodeWithUnitName(TV: TTreeView; aUnitName: string): TTreeNode;
276 procedure SetCurrentUnit(AValue: TUGUnit);
277 procedure SetIdleConnected(AValue: boolean);
278 procedure CreateGroups;
CreateProjectGroupnull279 function CreateProjectGroup(AProject: TLazProject): TUGGroup;
CreatePackageGroupnull280 function CreatePackageGroup(APackage: TIDEPackage): TUGGroup;
281 procedure CreateFPCSrcGroups;
282 procedure GuessGroupOfUnits;
283 procedure MarkCycles(WithImplementationUses: boolean);
284 procedure SetPendingUnitDependencyRoute(AValue: TStrings);
285 procedure StartParsing;
286 procedure ScopeChanged;
287 procedure AddStartAndTargetUnits;
288 procedure AddAdditionalFilesAsStartUnits;
289 procedure SetupGroupsTabSheet;
290 procedure SetupUnitsTabSheet;
291 procedure StoreGroupLvlGraphSelections;
292 procedure UpdateUnitsButtons;
293 procedure UpdateAll;
294 procedure UpdateGroupsLvlGraph;
295 procedure UpdateUnitsLvlGraph;
296 procedure UpdateAllUnitsTreeView;
297 procedure UpdateSelUnitsTreeView;
298 procedure UpdateAllUnitsTreeViewSearch;
299 procedure UpdateSelUnitsTreeViewSearch;
GetImgIndexnull300 function GetImgIndex(Node: TUDNode): integer;
NodeTextToUnitnull301 function NodeTextToUnit(NodeText: string): TUGUnit;
UGUnitToNodeTextnull302 function UGUnitToNodeText(UGUnit: TUGUnit): string;
GetFPCSrcDirnull303 function GetFPCSrcDir: string;
IsFPCSrcGroupnull304 function IsFPCSrcGroup(Group: TUGGroup): boolean;
IsProjectGroupnull305 function IsProjectGroup(Group: TUGGroup): boolean;
IsProjectGroupnull306 function IsProjectGroup(GroupName: string): boolean;
GetFilenamenull307 function GetFilename(UDNode: TUDNode): string;
GetAllUnitsFilternull308 function GetAllUnitsFilter(Lower: boolean): string;
GetAllUnitsSearchnull309 function GetAllUnitsSearch(Lower: boolean): string;
GetSelUnitsSearchnull310 function GetSelUnitsSearch(Lower: boolean): string;
ResStrFilternull311 function ResStrFilter: string;
ResStrSearchnull312 function ResStrSearch: string;
NodeTextFitsFilternull313 function NodeTextFitsFilter(const NodeText, LowerFilter: string): boolean;
314 procedure CreateUsesGraph(out TheUsesGraph: TUsesGraph; out TheGroups: TUGGroups);
315 public
316 GroupsLvlGraph: TLvlGraphControl; // Nodes.Data are TUGGroup of Groups
317 UnitsLvlGraph: TLvlGraphControl; // Nodes.Data are Units in Groups
318 public
319 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
320 property UsesGraph: TUsesGraph read FUsesGraph;
321 property Groups: TUGGroups read FGroups;
322 property CurrentUnit: TUGUnit read FCurrentUnit write SetCurrentUnit;
323 property PendingUnitDependencyRoute: TStrings read FPendingUnitDependencyRoute
324 write SetPendingUnitDependencyRoute; // list of unit names, missing links are automatically found
325 end;
326
327 type
328
329 { TQuickFixCircularUnitReference }
330
331 TQuickFixCircularUnitReference = class(TMsgQuickFix)
332 public
IsApplicablenull333 function IsApplicable(Msg: TMessageLine; out Unitname1, Unitname2: string): boolean;
334 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
335 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
336 end;
337
338 var
339 UnitDependenciesWindow: TUnitDependenciesWindow;
340
341 procedure ShowUnitDependenciesClicked(Sender: TObject);
342 procedure ShowUnitDependencies(State: TIWGetFormState = iwgfShowOnTop);
343 procedure InitUnitDependenciesQuickFixItems;
344
CompareUDBaseNodesnull345 function CompareUDBaseNodes(UDNode1, UDNode2: Pointer): integer;
346
347 implementation
348
349 {$R *.lfm}
350
351 procedure ShowUnitDependenciesClicked(Sender: TObject);
352 begin
353 ShowUnitDependencies;
354 end;
355
356 procedure ShowUnitDependencies(State: TIWGetFormState);
357 begin
358 if UnitDependenciesWindow = Nil then
359 IDEWindowCreators.CreateForm(UnitDependenciesWindow,TUnitDependenciesWindow,
360 State=iwgfDisabled,LazarusIDE.OwningComponent)
361 else if State=iwgfDisabled then
362 UnitDependenciesWindow.DisableAlign;
363 if State>=iwgfShow then
364 IDEWindowCreators.ShowForm(UnitDependenciesWindow,State=iwgfShowOnTop);
365 end;
366
367 procedure InitUnitDependenciesQuickFixItems;
368 begin
369 RegisterIDEMsgQuickFix(TQuickFixCircularUnitReference.Create);
370 end;
371
CompareUDBaseNodesnull372 function CompareUDBaseNodes(UDNode1, UDNode2: Pointer): integer;
373 var
374 Node1: TUDBaseNode absolute UDNode1;
375 Node2: TUDBaseNode absolute UDNode2;
376 begin
377 Result:=ord(Node1.Typ)-ord(Node2.Typ);
378 if Result<>0 then exit;
379 case Node1.Typ of
380 udnDirectory: Result:=CompareFilenames(Node1.NodeText,Node2.NodeText);
381 else Result:=SysUtils.CompareText(Node1.NodeText,Node2.NodeText);
382 end;
383 end;
384
385 { TUDSCCNode }
386
AsStringnull387 function TUDSCCNode.AsString: string;
388 begin
389 if UDItem is TUDUnit then
390 Result:='Unit="'+ExtractFileNameOnly(TUDUnit(UDItem).Filename)+'"'
391 else
392 Result:='Uses="'+ExtractFileNameOnly(TUDUses(UDItem).Owner.Filename)+'"->"'+ExtractFileNameOnly(TUDUses(UDItem).UsesUnit.Filename)+'"';
393 Result+=',Index='+dbgs(TarjanIndex)+',LowLink='+dbgs(TarjanLowLink)+',Visiting='+dbgs(TarjanVisiting);
394 end;
395
396 constructor TUDSCCNode.Create(Item: TObject);
397 begin
398 UDItem:=Item;
399 TarjanIndex:=-1;
400 end;
401
402 { TUDUses }
403
TUDUses.GetSCCNodenull404 function TUDUses.GetSCCNode: TUDSCCNode;
405 begin
406 if SCCNode=nil then
407 SCCNode:=TUDSCCNode.Create(Self);
408 Result:=SCCNode;
409 end;
410
411 destructor TUDUses.Destroy;
412 begin
413 FreeAndNil(SCCNode);
414 inherited Destroy;
415 end;
416
417 { TUDUnit }
418
TUDUnit.GetSCCNodenull419 function TUDUnit.GetSCCNode: TUDSCCNode;
420 begin
421 if SCCNode=nil then
422 SCCNode:=TUDSCCNode.Create(Self);
423 Result:=SCCNode;
424 end;
425
TUDUnit.HasImplementationUsesnull426 function TUDUnit.HasImplementationUses: boolean;
427 var
428 i: Integer;
429 begin
430 Result:=false;
431 if UsesUnits=nil then exit;
432 for i:=0 to UsesUnits.Count-1 do
433 if TUDUses(UsesUnits[i]).InImplementation then
434 exit(true);
435 end;
436
437 destructor TUDUnit.Destroy;
438 begin
439 FreeAndNil(SCCNode);
440 inherited Destroy;
441 end;
442
443 { TQuickFixCircularUnitReference }
444
TQuickFixCircularUnitReference.IsApplicablenull445 function TQuickFixCircularUnitReference.IsApplicable(Msg: TMessageLine; out
446 Unitname1, Unitname2: string): boolean;
447 begin
448 Result:=IDEFPCParser.MsgLineIsId(Msg,10020,Unitname1,Unitname2);
449 end;
450
451 procedure TQuickFixCircularUnitReference.CreateMenuItems(Fixes: TMsgQuickFixes);
452 var
453 Msg: TMessageLine;
454 Unitname1: string;
455 Unitname2: string;
456 i: Integer;
457 begin
458 for i:=0 to Fixes.LineCount-1 do begin
459 Msg:=Fixes.Lines[i];
460 if not IsApplicable(Msg,Unitname1,Unitname2) then continue;
461 Fixes.AddMenuItem(Self,Msg,'Show unit dependencies');
462 exit;
463 end;
464 end;
465
466 procedure TQuickFixCircularUnitReference.QuickFix(Fixes: TMsgQuickFixes;
467 Msg: TMessageLine);
468 var
469 UnitName1: String;
470 UnitName2: String;
471 Path: TStringList;
472 begin
473 if not IsApplicable(Msg,UnitName1,UnitName2) then exit;
474 ShowUnitDependencies;
475 Path:=TStringList.Create;
476 try
477 Path.Add(UnitName1);
478 Path.Add(UnitName2);
479 Path.Add(UnitName1);
480 UnitDependenciesWindow.PendingUnitDependencyRoute:=Path;
481 finally
482 Path.Free;
483 end;
484 end;
485
486 { TUDNode }
487
488 constructor TUDNode.Create;
489 begin
490 ChildNodes:=TAVLTree.Create(@CompareUDBaseNodes);
491 end;
492
493 destructor TUDNode.Destroy;
494 begin
495 Clear;
496 FreeAndNil(ChildNodes);
497 inherited Destroy;
498 end;
499
500 procedure TUDNode.Clear;
501 begin
502 ChildNodes.FreeAndClear;
503 end;
504
GetNodenull505 function TUDNode.GetNode(aTyp: TUDNodeType; const ANodeText: string;
506 CreateIfNotExists: boolean): TUDNode;
507 var
508 Node: TUDBaseNode;
509 AVLNode: TAVLTreeNode;
510 begin
511 Node:=TUDBaseNode.Create;
512 Node.Typ:=aTyp;
513 Node.NodeText:=ANodeText;
514 AVLNode:=ChildNodes.Find(Node);
515 Node.Free;
516 if AVLNode<>nil then begin
517 Result:=TUDNode(AVLNode.Data);
518 end else if CreateIfNotExists then begin
519 Result:=TUDNode.Create;
520 Result.Typ:=aTyp;
521 Result.NodeText:=ANodeText;
522 ChildNodes.Add(Result);
523 Result.Parent:=Self;
524 end else
525 Result:=nil;
526 end;
527
TUDNode.FindFirstnull528 function TUDNode.FindFirst(aTyp: TUDNodeType): TUDNode;
529 var
530 AVLNode: TAVLTreeNode;
531 begin
532 AVLNode:=ChildNodes.FindLowest;
533 while AVLNode<>nil do begin
534 Result:=TUDNode(AVLNode.Data);
535 if Result.Typ=aTyp then exit;
536 AVLNode:=ChildNodes.FindSuccessor(AVLNode);
537 end;
538 Result:=nil;
539 end;
540
FindUnitnull541 function TUDNode.FindUnit(const aUnitName: string): TUDNode;
542 var
543 AVLNode: TAVLTreeNode;
544 begin
545 AVLNode:=ChildNodes.FindLowest;
546 while AVLNode<>nil do begin
547 Result:=TUDNode(AVLNode.Data);
548 if (Result.Typ=udnUnit)
549 and (CompareText(ExtractFileNameOnly(Result.Identifier),aUnitName)=0) then
550 exit;
551 AVLNode:=ChildNodes.FindSuccessor(AVLNode);
552 end;
553 Result:=nil;
554 end;
555
TUDNode.Countnull556 function TUDNode.Count: integer;
557 begin
558 Result:=ChildNodes.Count;
559 end;
560
561 { TUnitDependenciesWindow }
562
563 procedure TUnitDependenciesWindow.FormCreate(Sender: TObject);
564 begin
565 Name := NonModalIDEWindowNames[nmiwUnitDependencies];
566
567 FGroupLvlGraphSelectionsList := TStringListUTF8Fast.Create;
568 FPendingUnitDependencyRoute:=TStringList.Create;
569 CreateUsesGraph(FUsesGraph,FGroups);
570
571 fImgIndexProject := IDEImages.LoadImage('item_project');
572 fImgIndexUnit := IDEImages.LoadImage('item_unit');
573 fImgIndexPackage := IDEImages.LoadImage('item_package');
574 fImgIndexPackageRequired := IDEImages.LoadImage('pkg_required');
575 fImgIndexDirectory := IDEImages.LoadImage('pkg_files');
576 fImgIndexOverlayImplUses := IDEImages.LoadImage('pkg_core_overlay');
577 fImgIndexOverlayIntfCycle := IDEImages.LoadImage('ce_cycleinterface');
578 fImgIndexOverlayImplCycle := IDEImages.LoadImage('ce_cycleimplementation');
579 AllUnitsTreeView.Images:=IDEImages.Images_16;
580 SelUnitsTreeView.Images:=IDEImages.Images_16;
581
582 Caption:=lisMenuViewUnitDependencies;
583 RefreshButton.Caption:=dlgUnitDepRefresh;
584 GraphOptsMenuItem.Caption := ShowOptions;
585
586 MainPageControl.ActivePage:=UnitsTabSheet;
587
588 SetupUnitsTabSheet;
589 SetupGroupsTabSheet;
590
591 FPackageGraphOpts := TLvlGraphOptions.Create;
592 FPackageGraphOpts.OnLoaded := @DoLoadedOpts;
593 FUnitGraphOpts := TLvlGraphOptions.Create;
594 FUnitGraphOpts.OnLoaded := @DoLoadedOpts;
595 EnvironmentOptions.RegisterSubConfig(FPackageGraphOpts, 'UnitDependencies/PackageGraph');
596 EnvironmentOptions.RegisterSubConfig(FUnitGraphOpts, 'UnitDependencies/UnitGraph');
597
598 StartParsing;
599 end;
600
601 procedure TUnitDependenciesWindow.AllUnitsSearchEditChange(Sender: TObject);
602 begin
603 Include(FFlags,udwNeedUpdateAllUnitsTVSearch);
604 IdleConnected:=true;
605 end;
606
607 procedure TUnitDependenciesWindow.AllUnitsSearchNextSpeedButtonClick(Sender: TObject);
608 begin
609 SelectNextSearchTV(AllUnitsTreeView,AllUnitsTreeView.Selected,true,true);
610 fAllUnitsTVSearchStartNode:=AllUnitsTreeView.Selected;
611 end;
612
613 procedure TUnitDependenciesWindow.AllUnitsSearchPrevSpeedButtonClick(Sender: TObject);
614 begin
615 SelectNextSearchTV(AllUnitsTreeView,AllUnitsTreeView.Selected,false,true);
616 fAllUnitsTVSearchStartNode:=AllUnitsTreeView.Selected;
617 end;
618
619 procedure TUnitDependenciesWindow.AllUnitsShowDirsSpeedButtonClick(Sender: TObject);
620 begin
621 Include(FFlags,udwNeedUpdateAllUnitsTreeView);
622 IdleConnected:=true;
623 end;
624
625 procedure TUnitDependenciesWindow.AllUnitsShowGroupNodesSpeedButtonClick(Sender: TObject);
626 begin
627 Include(FFlags,udwNeedUpdateAllUnitsTreeView);
628 IdleConnected:=true;
629 end;
630
631 procedure TUnitDependenciesWindow.FormShow(Sender: TObject);
632 begin
633 AllUnitsFilterEdit.TextHint:=ResStrFilter;
634 AllUnitsSearchEdit.TextHint:=ResStrSearch;
635 SelUnitsSearchEdit.TextHint:=ResStrSearch;
636 end;
637
638 procedure TUnitDependenciesWindow.GraphOptsMenuItemClick(Sender: TObject);
639 begin
640 if GraphPopupMenu.PopupComponent = GroupsLvlGraph then begin
641 if ShowDependencyGraphOptions(FPackageGraphOpts, GroupsLvlGraph.Graph,
642 UnitDepOptionsForPackage, @GraphOptsApplyClicked) = mrOK then begin
643 FPackageGraphOpts.WriteToGraph(GroupsLvlGraph);
644 UpdateGroupsLvlGraph;
645 MainIDEInterface.SaveEnvironment;
646 end;
647 end
648 else
649 begin
650 if ShowDependencyGraphOptions(FUnitGraphOpts, UnitsLvlGraph.Graph,
651 UnitDepOptionsForUnit, @GraphOptsApplyClicked) = mrOK then begin
652 FUnitGraphOpts.WriteToGraph(UnitsLvlGraph);
653 UpdateUnitsLvlGraph;
654 MainIDEInterface.SaveEnvironment;
655 end;
656 end;
657 end;
658
659 procedure TUnitDependenciesWindow.RefreshButtonClick(Sender: TObject);
660 begin
661 if udwParsing in FFlags then exit;
662 StartParsing;
663 end;
664
665 procedure TUnitDependenciesWindow.SelUnitsTreeViewExpanding(Sender: TObject;
666 Node: TTreeNode; var AllowExpansion: Boolean);
667 var
668 UDNode: TUDNode;
669 begin
670 if Node.Count>0 then exit;
671 if not (TObject(Node.Data) is TUDNode) then exit;
672 UDNode:=TUDNode(Node.Data);
673 if UDNode.Typ=udnUnit then begin
674 AddUsesSubNodes(UDNode);
675 CreateTVNodes(SelUnitsTreeView,Node,UDNode,false);
676 AllowExpansion:=true;
677 end;
678 end;
679
680 procedure TUnitDependenciesWindow.Timer1Timer(Sender: TObject);
681 var
682 Cnt: Integer;
683 begin
684 if (FNewUsesGraph=nil) then exit;
685 Cnt:=0;
686 if FNewUsesGraph.FilesTree<>nil then
687 Cnt:=FNewUsesGraph.FilesTree.Count;
688 StatsLabel.Caption:=Format(lisUDScanningUnits, [IntToStr(Cnt)]);
689 end;
690
691 procedure TUnitDependenciesWindow.UnitGraphFilterItemClick(Sender: TObject;
692 Index: integer);
693 begin
694 UpdateUnitsLvlGraph;
695 end;
696
697 procedure TUnitDependenciesWindow.UnitGraphFilterSelectionChange(
698 Sender: TObject; User: boolean);
699 var
700 n: TLvlGraphNode;
701 begin
702 if not User then
703 exit;
704 n := UnitsLvlGraph.Graph.GetNode(UnitGraphFilter.GetSelectedText, False);
705 if n <> nil then
706 UnitsLvlGraph.SelectedNode := n;
707 end;
708
709 procedure TUnitDependenciesWindow.UnitsLvlGraphMouseDown(Sender: TObject;
710 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
711 var
712 GraphNode: TLvlGraphNode;
713 UGUnit: TUGUnit;
714 begin
715 GraphNode:=UnitsLvlGraph.GetNodeAt(X,Y);
716 if (Button=mbLeft) and (ssDouble in Shift) then begin
717 if (GraphNode<>nil) and (GraphNode.Data<>nil) then begin
718 UGUnit:=TUGUnit(GraphNode.Data);
719 LazarusIDE.DoOpenEditorFile(UGUnit.Filename,-1,-1,[ofAddToRecent]);
720 end;
721 end;
722 end;
723
724 procedure TUnitDependenciesWindow.UnitsLvlGraphSelectionChanged(Sender: TObject);
725 var
726 GraphNode: TLvlGraphNode;
727 UGUnit: TUGUnit;
728 i: Integer;
729 begin
730 GraphNode:=UnitsLvlGraph.Graph.FirstSelected;
731 if GraphNode <> nil then begin
732 i := UnitGraphFilter.Items.IndexOf(TUGUnit(GraphNode.Data).TheUnitName);
733 if i >= 0 then
734 UnitGraphFilter.ItemIndex := i;
735 end;
736 while GraphNode<>nil do begin
737 UGUnit:=TUGUnit(GraphNode.Data);
738 if UGUnit<>nil then begin
739
740 end;
741 GraphNode:=GraphNode.NextSelected;
742 end;
743 end;
744
745 procedure TUnitDependenciesWindow.UnitsTreeViewShowHint(Sender: TObject;
746 HintInfo: PHintInfo);
747
748 procedure CountUses(List: TFPList; out IntfCnt, ImplCnt: integer);
749 var
750 i: Integer;
751 begin
752 IntfCnt:=0;
753 ImplCnt:=0;
754 if List=nil then exit;
755 for i:=0 to List.Count-1 do
756 if TUDUses(List[i]).InImplementation then
757 inc(ImplCnt)
758 else
759 inc(IntfCnt);
760 end;
761
762 var
763 TV: TTreeView;
764 TVNode: TTreeNode;
765 p: types.TPoint;
766 UDNode: TUDNode;
767 Filename: String;
768 s: String;
769 UGUnit: TUGUnit;
770 UsedByIntf: Integer;
771 UsedByImpl: Integer;
772 UsesIntf: integer;
773 UsesImpl: integer;
774 begin
775 TV:=Sender as TTreeView;
776 p:=HintInfo^.CursorPos;
777 TVNode:=TV.GetNodeAt(p.X,p.Y);
778 if (TVNode=nil) or not (TObject(TVNode.Data) is TUDNode) then exit;
779 UDNode:=TUDNode(TVNode.Data);
780 Filename:=GetFilename(UDNode);
781 if Filename='' then exit;
782 s:=Format(lisUDFile, [Filename]);
783 if UDNode.Typ=udnUnit then begin
784 UGUnit:=UsesGraph.GetUnit(Filename,false);
785 if UGUnit<>nil then begin
786 CountUses(UGUnit.UsesUnits,UsesIntf,UsesImpl);
787 CountUses(UGUnit.UsedByUnits,UsedByIntf,UsedByImpl);
788 if UsesIntf>0 then
789 s+=LineEnding+Format(lisUDInterfaceUses, [IntToStr(UsesIntf)]);
790 if UsesImpl>0 then
791 s+=LineEnding+Format(lisUDImplementationUses, [IntToStr(UsesImpl)]);
792 if UsedByIntf>0 then
793 s+=LineEnding+Format(lisUDUsedByInterfaces, [IntToStr(UsedByIntf)]);
794 if UsedByImpl>0 then
795 s+=LineEnding+Format(lisUDUsedByImplementations, [IntToStr(UsedByImpl)]
796 );
797 end;
798 end;
799 HintInfo^.HintStr:=s;
800 end;
801
802 procedure TUnitDependenciesWindow.UnitsTreeViewMouseDown(Sender: TObject;
803 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
804 var
805 TVNode: TTreeNode;
806 UDNode: TUDNode;
807 UGGroup: TUGGroup;
808 TV: TTreeView;
809 begin
810 TV:=Sender as TTreeView;
811 TVNode:=TV.GetNodeAt(X,Y);
812 if TVNode=nil then exit;
813 UDNode:=nil;
814 if TObject(TVNode.Data) is TUDNode then
815 UDNode:=TUDNode(TVNode.Data);
816 if (Button=mbLeft) and (ssDouble in Shift) and (UDNode<>nil) then begin
817 if UDNode.Typ=udnUnit then
818 // open unit in source editor
819 LazarusIDE.DoOpenEditorFile(UDNode.Identifier,-1,-1,[ofAddToRecent])
820 else if UDNode.Typ=udnGroup then begin
821 UGGroup:=Groups.GetGroup(UDNode.Group,false);
822 if UGGroup=nil then exit;
823 if IsProjectGroup(UGGroup) then begin
824 // open project inspector
825 ExecuteIDECommand(Self,ecProjectInspector);
826 end else begin
827 // open package editor
828 PackageEditingInterface.DoOpenPackageWithName(UGGroup.Name,[pofAddToRecent],false);
829 end;
830 end;
831 end;
832 end;
833
834 procedure TUnitDependenciesWindow.AllUnitsTreeViewSelectionChanged(
835 Sender: TObject);
836 begin
837 Include(FFlags,udwNeedUpdateSelUnitsTreeView);
838 IdleConnected:=true;
839 end;
840
841 procedure TUnitDependenciesWindow.AllUnitsFilterEditChange(Sender: TObject);
842 begin
843 Include(FFlags,udwNeedUpdateAllUnitsTreeView);
844 IdleConnected:=true;
845 end;
846
847
848 procedure TUnitDependenciesWindow.FormDestroy(Sender: TObject);
849 begin
850 IdleConnected:=false;
851
852 FreeUsesGraph;
853 FreeAndNil(FNewGroups);
854 FreeAndNil(FNewUsesGraph);
855 FreeAndNil(FPendingUnitDependencyRoute);
856 FreeAndNil(FGroupLvlGraphSelectionsList);
857 if EnvironmentOptions <> nil then begin
858 EnvironmentOptions.UnRegisterSubConfig(FPackageGraphOpts);
859 EnvironmentOptions.UnRegisterSubConfig(FUnitGraphOpts);
860 end;
861 FreeAndNil(FPackageGraphOpts);
862 FreeAndNil(FUnitGraphOpts);
863 end;
864
865 procedure TUnitDependenciesWindow.GroupsLvlGraphSelectionChanged(Sender: TObject
866 );
867 begin
868 UpdateUnitsLvlGraph;
869 end;
870
871 procedure TUnitDependenciesWindow.OnIdle(Sender: TObject; var Done: Boolean);
872 var
873 Completed: boolean;
874 begin
875 if udwParsing in FFlags then begin
876 fNewUsesGraph.Parse(true,Completed,200);
877 if Completed then begin
878 Exclude(FFlags,udwParsing);
879 // free old uses graph
880 FreeUsesGraph;
881 // switch to new UsesGraph
882 FUsesGraph:=FNewUsesGraph;
883 FNewUsesGraph:=nil;
884 FGroups:=FNewGroups;
885 FNewGroups:=nil;
886 // create Groups
887 CreateGroups;
888 // mark cycles
889 MarkCycles(false);
890 MarkCycles(true);
891 // hide progress bar and update stats
892 ProgressBar1.Visible:=false;
893 ProgressBar1.Style:=pbstNormal;
894 RefreshButton.Enabled:=true;
895 Timer1.Enabled:=false;
896 StatsLabel.Caption:=Format(lisUDUnits2, [IntToStr(
897 FUsesGraph.FilesTree.Count)]);
898 // update controls
899 UpdateAll;
900 end;
901 end else if udwNeedUpdateGroupsLvlGraph in FFlags then
902 UpdateGroupsLvlGraph
903 else if udwNeedUpdateUnitsLvlGraph in FFlags then
904 UpdateUnitsLvlGraph
905 else if udwNeedUpdateAllUnitsTreeView in FFlags then
906 UpdateAllUnitsTreeView
907 else if udwNeedUpdateAllUnitsTVSearch in FFlags then
908 UpdateAllUnitsTreeViewSearch
909 else if udwNeedUpdateSelUnitsTreeView in FFlags then
910 UpdateSelUnitsTreeView
911 else if udwNeedUpdateSelUnitsTVSearch in FFlags then
912 UpdateSelUnitsTreeViewSearch
913 else
914 IdleConnected:=false;
915 Done:=not IdleConnected;
916 end;
917
918 procedure TUnitDependenciesWindow.SearchPkgsCheckBoxChange(Sender: TObject);
919 begin
920 ScopeChanged;
921 end;
922
923 procedure TUnitDependenciesWindow.SearchSrcEditCheckBoxChange(Sender: TObject);
924 begin
925 ScopeChanged;
926 end;
927
928 procedure TUnitDependenciesWindow.SelUnitsSearchEditChange(Sender: TObject);
929 begin
930 Include(FFlags,udwNeedUpdateSelUnitsTVSearch);
931 IdleConnected:=true;
932 end;
933
934 procedure TUnitDependenciesWindow.SelUnitsSearchNextSpeedButtonClick(Sender: TObject);
935 begin
936 SelectNextSearchTV(SelUnitsTreeView,SelUnitsTreeView.Selected,true,true);
937 fSelUnitsTVSearchStartNode:=SelUnitsTreeView.Selected;
938 end;
939
940 procedure TUnitDependenciesWindow.SelUnitsSearchPrevSpeedButtonClick(Sender: TObject);
941 begin
942 SelectNextSearchTV(SelUnitsTreeView,SelUnitsTreeView.Selected,false,true);
943 fSelUnitsTVSearchStartNode:=SelUnitsTreeView.Selected;
944 end;
945
946 procedure TUnitDependenciesWindow.SearchCustomFilesBrowseButtonClick(Sender: TObject);
947 var
948 Dlg: TSelectDirectoryDialog;
949 s: TCaption;
950 aFilename: String;
951 p: Integer;
952 begin
953 Dlg:=TSelectDirectoryDialog.Create(nil);
954 try
955 InitIDEFileDialog(Dlg);
956 Dlg.Options:=Dlg.Options+[ofPathMustExist];
957 if not Dlg.Execute then exit;
958 aFilename:=TrimFilename(Dlg.FileName);
959 s:=SearchCustomFilesComboBox.Text;
960 p:=1;
961 if FindNextDelimitedItem(s,';',p,aFilename)<>'' then exit;
962 if s<>'' then s+=';';
963 s+=aFilename;
964 SearchCustomFilesComboBox.Text:=s;
965 ScopeChanged;
966 finally
967 Dlg.Free;
968 end;
969 end;
970
971 procedure TUnitDependenciesWindow.SearchCustomFilesCheckBoxChange(Sender: TObject);
972 begin
973 UpdateUnitsButtons;
974 ScopeChanged;
975 end;
976
977 procedure TUnitDependenciesWindow.SearchCustomFilesComboBoxChange(Sender: TObject);
978 begin
979 ScopeChanged;
980 end;
981
982 procedure TUnitDependenciesWindow.UnitsTVCollapseAllMenuItemClick(Sender: TObject);
983 var
984 TV: TTreeView;
985 i: Integer;
986 begin
987 TV:=TTreeView(UnitsTVPopupMenu.PopupComponent);
988 if not (TV is TTreeView) then exit;
989 TV.BeginUpdate;
990 for i:=0 to TV.Items.TopLvlCount-1 do
991 TV.Items.TopLvlItems[i].Collapse(true);
992 TV.EndUpdate;
993 end;
994
995 procedure TUnitDependenciesWindow.UnitsTVCopyFilenameMenuItemClick(Sender: TObject);
996 var
997 UDNode: TUDNode;
998 begin
999 if not GetPopupTV_UDNode(UDNode) then exit;
1000 Clipboard.AsText:=GetFilename(UDNode);
1001 end;
1002
1003 procedure TUnitDependenciesWindow.UnitsTVExpandAllMenuItemClick(Sender: TObject);
1004 var
1005 TV: TTreeView;
1006 i: Integer;
1007 begin
1008 TV:=TTreeView(UnitsTVPopupMenu.PopupComponent);
1009 if not (TV is TTreeView) then exit;
1010 TV.BeginUpdate;
1011 for i:=0 to TV.Items.TopLvlCount-1 do
1012 TV.Items.TopLvlItems[i].Expand(true);
1013 TV.EndUpdate;
1014 end;
1015
1016 procedure TUnitDependenciesWindow.UnitsTVOpenFileMenuItemClick(Sender: TObject);
1017 var
1018 UDNode: TUDNode;
1019 begin
1020 if not GetPopupTV_UDNode(UDNode) then exit;
1021 LazarusIDE.DoOpenEditorFile(GetFilename(UDNode),-1,-1,OpnFlagsPlainFile);
1022 end;
1023
1024 procedure TUnitDependenciesWindow.UnitsTVPopupMenuPopup(Sender: TObject);
1025 var
1026 TV: TTreeView;
1027 TVNode: TTreeNode;
1028 UDNode: TUDNode;
1029 aFilename: String;
1030 ShortFilename: String;
1031 begin
1032 TV:=UnitsTVPopupMenu.PopupComponent as TTreeView;
1033 UnitsTVExpandAllMenuItem.Visible:=TV=AllUnitsTreeView;
1034 TVNode:=TV.Selected;
1035 if (TVNode<>nil) and (TObject(TVNode.Data) is TUDNode) then begin
1036 UDNode:=TUDNode(TVNode.Data);
1037 UnitsTVUnusedUnitsMenuItem.Enabled:=UDNode.Typ=udnUnit;
1038 aFilename:=GetFilename(UDNode);
1039 if aFilename<>'' then begin
1040 ShortFilename:=aFilename;
1041 if length(ShortFilename)>50 then
1042 ShortFilename:='...'+ExtractFilename(ShortFilename);
1043 UnitsTVCopyFilenameMenuItem.Enabled:=true;
1044 UnitsTVCopyFilenameMenuItem.Caption:=Format(lisCopyFilename, [
1045 ShortFilename]);
1046 UnitsTVOpenFileMenuItem.Visible:=true;
1047 UnitsTVOpenFileMenuItem.Caption:=Format(lisOpenLfm, [ShortFilename]);
1048 end else begin
1049 UnitsTVCopyFilenameMenuItem.Enabled:=false;
1050 UnitsTVCopyFilenameMenuItem.Caption:=uemCopyFilename;
1051 UnitsTVOpenFileMenuItem.Visible:=false;
1052 end;
1053 end else
1054 UnitsTVUnusedUnitsMenuItem.Enabled:=false;
1055 end;
1056
1057 procedure TUnitDependenciesWindow.UnitsTVUnusedUnitsMenuItemClick(Sender: TObject);
1058 var
1059 TV: TTreeView;
1060 TVNode: TTreeNode;
1061 UDNode: TUDNode;
1062 Filename: String;
1063 Code: TCodeBuffer;
1064 begin
1065 TV:=TTreeView(UnitsTVPopupMenu.PopupComponent);
1066 if not (TV is TTreeView) then exit;
1067 TVNode:=TV.Selected;
1068 if (TVNode=nil) or not (TObject(TVNode.Data) is TUDNode) then exit;
1069 UDNode:=TUDNode(TVNode.Data);
1070 if UDNode.Typ<>udnUnit then exit;
1071 Filename:=GetFilename(UDNode);
1072 Code:=CodeToolBoss.LoadFile(Filename,true,false);
1073 ShowUnusedUnitsDialog(Code);
1074 end;
1075
1076 procedure TUnitDependenciesWindow.SetIdleConnected(AValue: boolean);
1077 begin
1078 if FIdleConnected=AValue then Exit;
1079 FIdleConnected:=AValue;
1080 if IdleConnected then
1081 Application.AddOnIdleHandler(@OnIdle)
1082 else
1083 Application.RemoveOnIdleHandler(@OnIdle);
1084 end;
1085
1086 procedure TUnitDependenciesWindow.CreateGroups;
1087 var
1088 i: Integer;
1089 begin
1090 if FGroups=nil then
1091 RaiseCatchableException('');
1092 CreateProjectGroup(LazarusIDE.ActiveProject);
1093 for i:=0 to PackageEditingInterface.GetPackageCount-1 do
1094 CreatePackageGroup(PackageEditingInterface.GetPackages(i));
1095 CreateFPCSrcGroups;
1096 GuessGroupOfUnits;
1097 end;
1098
TUnitDependenciesWindow.CreateProjectGroupnull1099 function TUnitDependenciesWindow.CreateProjectGroup(AProject: TLazProject): TUGGroup;
1100 var
1101 i: Integer;
1102 Filename: String;
1103 CurUnit: TUGUnit;
1104 ProjFile: TLazProjectFile;
1105 begin
1106 if AProject=nil then exit(nil);
1107 Result:=Groups.GetGroup(GroupPrefixProject,true);
1108 Result.BaseDir:=ExtractFilePath(AProject.ProjectInfoFile);
1109 if not FilenameIsAbsolute(Result.BaseDir) then
1110 Result.BaseDir:='';
1111 //debugln(['TUnitDependenciesDialog.CreateProjectGroup ',Result.Name,' FileCount=',AProject.FileCount]);
1112 for i:=0 to AProject.FileCount-1 do begin
1113 ProjFile:=AProject.Files[i];
1114 if not ProjFile.IsPartOfProject then continue;
1115 Filename:=AProject.Files[i].Filename;
1116 CurUnit:=UsesGraph.GetUnit(Filename,false);
1117 if CurUnit=nil then continue;
1118 if not (CurUnit is TUDUnit) then begin
1119 debugln(['TUnitDependenciesDialog.CreateProjectGroup WARNING: ',CurUnit.Filename,' ',CurUnit.Classname,' should be TUGGroupUnit']);
1120 continue;
1121 end;
1122 if TUDUnit(CurUnit).Group<>nil then continue;
1123 Result.AddUnit(TUDUnit(CurUnit));
1124 end;
1125 end;
1126
TUnitDependenciesWindow.CreatePackageGroupnull1127 function TUnitDependenciesWindow.CreatePackageGroup(APackage: TIDEPackage): TUGGroup;
1128 var
1129 i: Integer;
1130 Filename: String;
1131 CurUnit: TUGUnit;
1132 begin
1133 if APackage=nil then exit(nil);
1134 Result:=Groups.GetGroup(APackage.Name,true);
1135 Result.BaseDir:=APackage.DirectoryExpanded;
1136 if not FilenameIsAbsolute(Result.BaseDir) then
1137 Result.BaseDir:='';
1138 //debugln(['TUnitDependenciesDialog.CreatePackageGroup ',Result.Name]);
1139 for i:=0 to APackage.FileCount-1 do begin
1140 Filename:=APackage.Files[i].GetFullFilename;
1141 CurUnit:=UsesGraph.GetUnit(Filename,false);
1142 if CurUnit is TUDUnit then begin
1143 if TUDUnit(CurUnit).Group<>nil then continue;
1144 Result.AddUnit(TUDUnit(CurUnit));
1145 end;
1146 end;
1147 end;
1148
1149 procedure TUnitDependenciesWindow.CreateFPCSrcGroups;
1150
ExtractFilePathStartnull1151 function ExtractFilePathStart(Filename: string; DirCount: integer): string;
1152 var
1153 p: Integer;
1154 begin
1155 p:=1;
1156 while p<=length(Filename) do begin
1157 if Filename[p]=PathDelim then begin
1158 DirCount-=1;
1159 if DirCount=0 then begin
1160 Result:=LeftStr(Filename,p-1);
1161 exit;
1162 end;
1163 end;
1164 inc(p);
1165 end;
1166 Result:=Filename;
1167 end;
1168
1169 var
1170 FPCSrcDir: String;
1171 Node: TAVLTreeNode;
1172 CurUnit: TUDUnit;
1173 Directory: String;
1174 Grp: TUGGroup;
1175 BaseDir: String;
1176 begin
1177 FPCSrcDir:=AppendPathDelim(GetFPCSrcDir);
1178
1179 // for each unit in the fpc source directory:
1180 // if in rtl/ put into group GroupPrefixFPCSrc+RTL
1181 // if in packages/<name>, put in group GroupPrefixFPCSrc+<name>
1182 Node:=UsesGraph.FilesTree.FindLowest;
1183 while Node<>nil do begin
1184 CurUnit:=TUDUnit(Node.Data);
1185 Node:=UsesGraph.FilesTree.FindSuccessor(Node);
1186 if TUDUnit(CurUnit).Group<>nil then continue;
1187 if CompareFilenames(FPCSrcDir,LeftStr(CurUnit.Filename,length(FPCSrcDir)))<>0
1188 then
1189 continue;
1190 // a unit in the FPC sources
1191 BaseDir:=ExtractFilePath(CurUnit.Filename);
1192 Directory:=copy(BaseDir,length(FPCSrcDir)+1,length(BaseDir));
1193 Directory:=ExtractFilePathStart(Directory,2);
1194 if LeftStr(Directory,length('rtl'))='rtl' then
1195 Directory:='RTL'
1196 else if LeftStr(Directory,length('packages'))='packages' then
1197 System.Delete(Directory,1,length('packages'+PathDelim));
1198 Grp:=Groups.GetGroup(GroupPrefixFPCSrc+Directory,true);
1199 if Grp.BaseDir='' then
1200 Grp.BaseDir:=BaseDir;
1201 //debugln(['TUnitDependenciesDialog.CreateFPCSrcGroups ',Grp.Name]);
1202 Grp.AddUnit(TUDUnit(CurUnit));
1203 end;
1204 end;
1205
1206 procedure TUnitDependenciesWindow.GuessGroupOfUnits;
1207 var
1208 Node: TAVLTreeNode;
1209 CurUnit: TUDUnit;
1210 Filename: String;
1211 Owners: TFPList;
1212 i: Integer;
1213 Group: TUGGroup;
1214 CurDirectory: String;
1215 LastDirectory: Char;
1216 begin
1217 Owners:=nil;
1218 LastDirectory:='.';
1219 Node:=UsesGraph.FilesTree.FindLowest;
1220 while Node<>nil do begin
1221 CurUnit:=TUDUnit(Node.Data);
1222 if CurUnit.Group=nil then begin
1223 Filename:=CurUnit.Filename;
1224 //debugln(['TUnitDependenciesDialog.GuessGroupOfUnits no group for ',Filename]);
1225 CurDirectory:=ExtractFilePath(Filename);
1226 if CompareFilenames(CurDirectory,LastDirectory)<>0 then begin
1227 FreeAndNil(Owners);
1228 Owners:=PackageEditingInterface.GetPossibleOwnersOfUnit(Filename,[piosfIncludeSourceDirectories]);
1229 end;
1230 Group:=nil;
1231 if (Owners<>nil) then begin
1232 for i:=0 to Owners.Count-1 do begin
1233 if TObject(Owners[i]) is TLazProject then begin
1234 Group:=Groups.GetGroup(GroupPrefixProject,true);
1235 //debugln(['TUnitDependenciesDialog.GuessGroupOfUnits ',Group.Name]);
1236 break;
1237 end else if TObject(Owners[i]) is TIDEPackage then begin
1238 Group:=Groups.GetGroup(TIDEPackage(Owners[i]).Name,true);
1239 //debugln(['TUnitDependenciesDialog.GuessGroupOfUnits ',Group.Name]);
1240 break;
1241 end;
1242 end;
1243 end;
1244 if Group=nil then begin
1245 Group:=Groups.GetGroup(GroupNone,true);
1246 //debugln(['TUnitDependenciesDialog.GuessGroupOfUnits ',Group.Name]);
1247 end;
1248 Group.AddUnit(TUDUnit(CurUnit));
1249 end;
1250 Node:=UsesGraph.FilesTree.FindSuccessor(Node);
1251 end;
1252 FreeAndNil(Owners);
1253 end;
1254
1255 procedure TUnitDependenciesWindow.MarkCycles(WithImplementationUses: boolean);
1256 { Using Tarjan's strongly connected components (SCC) algorithm
1257 }
1258 var
1259 TarjanIndex: integer;
1260 Stack: TFPList; // stack of TUDSCCNode
1261
GetNodenull1262 function GetNode(UDItem: TObject): TUDSCCNode;
1263 begin
1264 if UDItem is TUDUnit then
1265 Result:=TUDUnit(UDItem).GetSCCNode
1266 else
1267 Result:=TUDUses(UDItem).GetSCCNode;
1268 end;
1269
1270 procedure ClearNode(Node: TUDSCCNode);
1271 begin
1272 Node.TarjanIndex:=-1;
1273 Node.TarjanLowLink:=-1;
1274 Node.TarjanVisiting:=false;
1275 if WithImplementationUses then
1276 Node.InImplCycle:=false
1277 else
1278 Node.InIntfCycle:=false;
1279 end;
1280
1281 procedure SearchNode(Node: TUDSCCNode); forward;
1282
1283 procedure SearchEdge(FromNode, ToNode: TUDSCCNode);
1284 begin
1285 if ToNode.TarjanIndex<0 then begin
1286 // not yet visited
1287 SearchNode(ToNode);
1288 FromNode.TarjanLowLink:=Min(FromNode.TarjanLowLink,ToNode.TarjanLowLink);
1289 end else if ToNode.TarjanVisiting then begin
1290 // currently visiting => ToNode is in current SCC
1291 FromNode.TarjanLowLink:=Min(FromNode.TarjanLowLink,ToNode.TarjanIndex);
1292 end;
1293 end;
1294
1295 procedure SearchNode(Node: TUDSCCNode);
1296 var
1297 UDUnit: TUDUnit;
1298 UDUses: TUDUses;
1299 i: Integer;
1300 CycleNode: TUDSCCNode;
1301 MoreThanOneNode: Boolean; // true = there is a cycle with more than one node
1302 begin
1303 //debugln(['SearchNode ',Node.AsString]);
1304 // Set the depth index for Node to the smallest unused index
1305 Node.TarjanIndex := TarjanIndex;
1306 Node.TarjanLowLink := TarjanIndex;
1307 inc(TarjanIndex);
1308 Stack.Add(Node);
1309 Node.TarjanVisiting:=true;
1310
1311 // search all edges
1312 if Node.UDItem is TUDUnit then begin
1313 UDUnit:=TUDUnit(Node.UDItem);
1314 if UDUnit.UsesUnits<>nil then
1315 for i:=0 to UDUnit.UsesUnits.Count-1 do begin
1316 UDUses:=TUDUses(UDUnit.UsesUnits[i]);
1317 if (not WithImplementationUses) and UDUses.InImplementation then
1318 continue;
1319 SearchEdge(Node,GetNode(UDUses));
1320 end;
1321 end else begin
1322 UDUses:=TUDUses(Node.UDItem);
1323 SearchEdge(Node,GetNode(UDUses.UsesUnit));
1324 end;
1325
1326 if Node.TarjanIndex=Node.TarjanLowLink then begin
1327 // this is a root node of a SCC
1328 MoreThanOneNode:=TUDSCCNode(Stack[Stack.Count-1])<>Node;
1329 repeat
1330 CycleNode:=TUDSCCNode(Stack[Stack.Count-1]);
1331 Stack.Delete(Stack.Count-1);
1332 CycleNode.TarjanVisiting:=false;
1333 if MoreThanOneNode then begin
1334 if WithImplementationUses then
1335 CycleNode.InImplCycle:=true
1336 else
1337 CycleNode.InIntfCycle:=true;
1338 //debugln(['SearchNode WithImpl=',WithImplementationUses,' Cycle=',CycleNode.AsString]);
1339 end;
1340 until CycleNode=Node;
1341 end;
1342 end;
1343
1344 var
1345 AVLNode: TAVLTreeNode;
1346 UDUnit: TUDUnit;
1347 Node: TUDSCCNode;
1348 i: Integer;
1349 begin
1350 // init
1351 TarjanIndex:=0;
1352 for AVLNode in FUsesGraph.FilesTree do begin
1353 UDUnit:=TUDUnit(AVLNode.Data);
1354 Node:=GetNode(UDUnit);
1355 ClearNode(Node);
1356 if UDUnit.UsesUnits<>nil then
1357 for i:=0 to UDUnit.UsesUnits.Count-1 do
1358 ClearNode(GetNode(TObject(UDUnit.UsesUnits[i])));
1359 end;
1360 Stack:=TFPList.Create;
1361 try
1362 // depth first search through the forest
1363 for AVLNode in FUsesGraph.FilesTree do begin
1364 UDUnit:=TUDUnit(AVLNode.Data);
1365 //debugln(['TUnitDependenciesWindow.MarkCycles ',dbgsname(UDUnit)]);
1366 Node:=GetNode(UDUnit);
1367 if Node.TarjanIndex<0 then
1368 SearchNode(Node);
1369 end;
1370 finally
1371 Stack.Free;
1372 end;
1373 end;
1374
1375 procedure TUnitDependenciesWindow.SetPendingUnitDependencyRoute(AValue: TStrings);
1376 begin
1377 if FPendingUnitDependencyRoute.Equals(AValue) then Exit;
1378 FPendingUnitDependencyRoute.Assign(AValue);
1379 FFlags:=FFlags+[udwNeedUpdateAllUnitsTreeView,udwNeedUpdateSelUnitsTreeView];
1380 IdleConnected:=true;
1381 end;
1382
1383 procedure TUnitDependenciesWindow.StartParsing;
1384 begin
1385 if (FNewUsesGraph<>nil) or (udwParsing in FFlags) then
1386 RaiseCatchableException('');
1387 Include(FFlags,udwParsing);
1388
1389 ProgressBar1.Visible:=true;
1390 ProgressBar1.Style:=pbstMarquee;
1391 StatsLabel.Caption:=lisUDScanning;
1392 Timer1.Enabled:=true;
1393 RefreshButton.Enabled:=false;
1394
1395 CreateUsesGraph(FNewUsesGraph,FNewGroups);
1396
1397 LazarusIDE.BeginCodeTools;
1398 AddStartAndTargetUnits;
1399
1400 IdleConnected:=true;
1401 end;
1402
1403 procedure TUnitDependenciesWindow.ScopeChanged;
1404 begin
1405 FreeAndNil(FNewGroups);
1406 FreeAndNil(FNewUsesGraph);
1407 Exclude(FFlags,udwParsing);
1408 StartParsing;
1409 end;
1410
1411 procedure TUnitDependenciesWindow.SetCurrentUnit(AValue: TUGUnit);
1412 begin
1413 if FCurrentUnit=AValue then Exit;
1414 FCurrentUnit:=AValue;
1415 end;
1416
CreateAllUnitsTreenull1417 function TUnitDependenciesWindow.CreateAllUnitsTree: TUDNode;
1418 var
1419 Node: TUDNode;
1420 ParentNode: TUDNode;
1421 GroupName: String;
1422 ShowDirectories: Boolean;
1423 ShowGroups: Boolean;
1424 NodeText: String;
1425 RootNode: TUDNode;
1426 Filter: String;
1427 UGUnit: TUDUnit;
1428 AVLNode: TAVLTreeNode;
1429 Group: TUGGroup;
1430 GroupNode: TUDNode;
1431 Filename: String;
1432 p: Integer;
1433 Dir: String;
1434 DirNode: TUDNode;
1435 BaseDir: String;
1436 CurDir: String;
1437 begin
1438 Filter:=GetAllUnitsFilter(true);
1439 ShowGroups:=AllUnitsShowGroupNodesSpeedButton.Down;
1440 ShowDirectories:=AllUnitsShowDirsSpeedButton.Down;
1441 RootNode:=TUDNode.Create;
1442 for AVLNode in UsesGraph.FilesTree do begin
1443 UGUnit:=TUDUnit(AVLNode.Data);
1444 Filename:=UGUnit.Filename;
1445 NodeText:=ExtractFileName(Filename);
1446 if (Filter<>'') and (Pos(Filter, UTF8LowerCase(NodeText))<1) then
1447 continue;
1448 Group:=UGUnit.Group;
1449 BaseDir:='';
1450 if Group=nil then begin
1451 GroupName:=GroupNone
1452 end else begin
1453 GroupName:=Group.Name;
1454 if FilenameIsAbsolute(Group.BaseDir) then
1455 BaseDir:=ChompPathDelim(Group.BaseDir);
1456 end;
1457 ParentNode:=RootNode;
1458 if ShowGroups then begin
1459 // create group nodes
1460 GroupNode:=ParentNode.GetNode(udnGroup,GroupName,true);
1461 if GroupNode.Identifier='' then begin
1462 GroupNode.Identifier:=GroupName;
1463 GroupNode.Group:=GroupName;
1464 end;
1465 ParentNode:=GroupNode;
1466 if FilenameIsAbsolute(BaseDir) and FilenameIsAbsolute(Filename) then
1467 Filename:=CreateRelativePath(Filename,BaseDir);
1468 end;
1469 if ShowDirectories then begin
1470 // create directory nodes
1471 CurDir:=BaseDir;
1472 p:=1;
1473 repeat
1474 Dir:=FindNextDirectoryInFilename(Filename,p);
1475 if p>length(Filename) then break;
1476 if Dir<>'' then begin
1477 DirNode:=ParentNode.GetNode(udnDirectory,Dir,true);
1478 CurDir+=PathDelim+Dir;
1479 if DirNode.Identifier='' then begin
1480 DirNode.Identifier:=CurDir;
1481 end;
1482 ParentNode:=DirNode;
1483 end;
1484 until false;
1485 end;
1486 Node:=ParentNode.GetNode(udnUnit, NodeText, true);
1487 Node.Identifier:=UGUnit.Filename;
1488 Node.Group:=GroupName;
1489 Node.IntfCycle:=UGUnit.GetSCCNode.InIntfCycle;
1490 Node.ImplCycle:=UGUnit.GetSCCNode.InImplCycle;
1491 Node.HasImplementationUses:=UGUnit.HasImplementationUses;
1492 end;
1493 Result:=RootNode;
1494 end;
1495
CreateSelUnitsTreenull1496 function TUnitDependenciesWindow.CreateSelUnitsTree: TUDNode;
1497 var
1498 RootNode: TUDNode;
1499 SelTVNode: TTreeNode;
1500 SelUDNode: TUDNode;
1501 UDNode: TUDNode;
1502 begin
1503 RootNode:=TUDNode.Create;
1504 SelTVNode:=AllUnitsTreeView.GetFirstMultiSelected;
1505 if SelTVNode=nil then
1506 SelTVNode:=AllUnitsTreeView.Selected;
1507 //debugln(['TUnitDependenciesWindow.CreateSelUnitsTree SelTVNode=',SelTVNode<>nil]);
1508 while SelTVNode<>nil do begin
1509 if TObject(SelTVNode.Data) is TUDNode then begin
1510 SelUDNode:=TUDNode(SelTVNode.Data);
1511 if SelUDNode.Typ=udnUnit then begin
1512 UDNode:=RootNode.GetNode(udnUnit,SelUDNode.NodeText,true);
1513 UDNode.Identifier:=SelUDNode.Identifier;
1514 UDNode.Group:=SelUDNode.Group;
1515 AddUsesSubNodes(UDNode);
1516 end;
1517 end;
1518 SelTVNode:=SelTVNode.GetNextMultiSelected;
1519 end;
1520
1521 ExpandPendingUnitDependencyRoute(RootNode);
1522
1523 Result:=RootNode;
1524 end;
1525
1526 procedure TUnitDependenciesWindow.DoLoadedOpts(Sender: TObject);
1527 begin
1528 if Sender = FPackageGraphOpts then
1529 FPackageGraphOpts.WriteToGraph(GroupsLvlGraph)
1530 else
1531 FUnitGraphOpts.WriteToGraph(UnitsLvlGraph);
1532 end;
1533
1534 procedure TUnitDependenciesWindow.ExpandPendingUnitDependencyRoute(RootNode: TUDNode);
1535 var
1536 i: Integer;
1537 CurUnitName: String;
1538 UDNode: TUDNode;
1539 IntfUDNode: TUDNode;
1540 ParentUDNode: TUDNode;
1541 begin
1542 if PendingUnitDependencyRoute.Count=0 then exit;
1543 ConvertUnitNameRouteToPath(PendingUnitDependencyRoute);
1544 try
1545 ParentUDNode:=RootNode;
1546 for i:=0 to PendingUnitDependencyRoute.Count-1 do begin
1547 CurUnitName:=PendingUnitDependencyRoute[i];
1548 UDNode:=ParentUDNode.FindUnit(CurUnitName);
1549 //debugln(['TUnitDependenciesWindow.ExpandPendingUnitDependencyPath CurUnitName="',CurUnitName,'" UDNode=',DbgSName(UDNode)]);
1550 if UDNode=nil then exit;
1551 if i=PendingUnitDependencyRoute.Count-1 then exit;
1552 IntfUDNode:=UDNode.FindFirst(udnInterface);
1553 if IntfUDNode=nil then begin
1554 if UDNode.Count>0 then
1555 exit; // already expanded -> has no interface
1556 // expand
1557 AddUsesSubNodes(UDNode);
1558 IntfUDNode:=UDNode.FindFirst(udnInterface);
1559 if IntfUDNode=nil then exit;
1560 end;
1561 ParentUDNode:=IntfUDNode;
1562 end;
1563 finally
1564 // apply only once => clear pending
1565 PendingUnitDependencyRoute.Clear;
1566 end;
1567 end;
1568
1569 procedure TUnitDependenciesWindow.ConvertUnitNameRouteToPath(Route: TStrings);
1570 var
1571 UGUnitList: TFPList;
1572 UGUnit: TUGUnit;
1573 i: Integer;
1574 begin
1575 if Route.Count<=1 then exit;
1576 UGUnitList:=TFPList.Create;
1577 try
1578 // convert unit names to TUGUnit
1579 for i:=0 to Route.Count-1 do begin
1580 UGUnit:=FUsesGraph.FindUnit(Route[i]);
1581 if UGUnit=nil then continue;
1582 UGUnitList.Add(UGUnit);
1583 end;
1584 // insert missing links
1585 FUsesGraph.InsertMissingLinks(UGUnitList);
1586 // convert TUGUnit to unit names
1587 Route.Clear;
1588 for i:=0 to UGUnitList.Count-1 do
1589 Route.Add(ExtractFileNameOnly(TUGUnit(UGUnitList[i]).Filename));
1590 finally
1591 UGUnitList.Free;
1592 end;
1593 end;
1594
1595 procedure TUnitDependenciesWindow.AddUsesSubNodes(UDNode: TUDNode);
1596
1597 procedure AddUses(ParentUDNode: TUDNode; UsesList: TFPList;
1598 NodeTyp: TUDNodeType);
1599 var
1600 i: Integer;
1601 UGUses: TUDUses;
1602 NodeText: String;
1603 SectionUDNode: TUDNode;
1604 InImplementation: Boolean;
1605 UsedBy: Boolean;
1606 OtherUnit: TUDUnit;
1607 Filename: String;
1608 UDNode: TUDNode;
1609 GroupName: String;
1610 Cnt: Integer;
1611 HasIntfCycle: Boolean;
1612 HasImplCycle: Boolean;
1613 begin
1614 if ParentUDNode=nil then exit;
1615 if UsesList=nil then exit;
1616 if not (NodeTyp in [udnInterface,udnImplementation,udnUsedByInterface,udnUsedByImplementation])
1617 then exit;
1618 InImplementation:=(NodeTyp in [udnImplementation,udnUsedByImplementation]);
1619 UsedBy:=(NodeTyp in [udnUsedByInterface,udnUsedByImplementation]);
1620
1621 // count the number of uses
1622 Cnt:=0;
1623 HasIntfCycle:=false;
1624 HasImplCycle:=false;
1625 for i:=0 to UsesList.Count-1 do begin
1626 UGUses:=TUDUses(UsesList[i]);
1627 if UGUses.InImplementation<>InImplementation then continue;
1628 HasIntfCycle:=HasIntfCycle or UGUses.GetSCCNode.InIntfCycle;
1629 HasImplCycle:=HasImplCycle or UGUses.GetSCCNode.InImplCycle;
1630 inc(Cnt);
1631 end;
1632 if Cnt=0 then exit;
1633
1634 // create a section node
1635 NodeText:=IntToStr(Cnt);
1636 case NodeTyp of
1637 udnInterface: NodeText:=Format(lisUDInterfaceUses2, [NodeText]);
1638 udnImplementation: NodeText:=Format(lisUDImplementationUses2, [NodeText]);
1639 udnUsedByInterface: NodeText:=Format(lisUDUsedByInterfaces2, [NodeText]);
1640 udnUsedByImplementation: NodeText:=Format(lisUDUsedByImplementations2, [
1641 NodeText]);
1642 else exit;
1643 end;
1644 SectionUDNode:=ParentUDNode.GetNode(NodeTyp,NodeText,true);
1645 SectionUDNode.IntfCycle:=HasIntfCycle;
1646 SectionUDNode.ImplCycle:=HasImplCycle;
1647
1648 // create unit nodes
1649 for i:=0 to UsesList.Count-1 do begin
1650 UGUses:=TUDUses(UsesList[i]);
1651 if UGUses.InImplementation<>InImplementation then continue;
1652 if UsedBy then
1653 OtherUnit:=TUDUnit(UGUses.Owner)
1654 else
1655 OtherUnit:=TUDUnit(UGUses.UsesUnit);
1656 Filename:=OtherUnit.Filename;
1657 NodeText:=ExtractFileName(Filename);
1658 UDNode:=SectionUDNode.GetNode(udnUnit,NodeText,true);
1659 UDNode.Identifier:=Filename;
1660 if OtherUnit.Group<>nil then
1661 GroupName:=OtherUnit.Group.Name
1662 else
1663 GroupName:=GroupNone;
1664 UDNode.Group:=GroupName;
1665 UDNode.HasChildren:=
1666 ((OtherUnit.UsedByUnits<>nil) and (OtherUnit.UsedByUnits.Count>0))
1667 or ((OtherUnit.UsesUnits<>nil) and (OtherUnit.UsesUnits.Count>0));
1668 UDNode.IntfCycle:=UGUses.GetSCCNode.InIntfCycle;
1669 UDNode.ImplCycle:=UGUses.GetSCCNode.InImplCycle;
1670 end;
1671 end;
1672
1673 var
1674 Filename: String;
1675 UGUnit: TUDUnit;
1676 begin
1677 // add connected units
1678 Filename:=UDNode.Identifier;
1679 UGUnit:=TUDUnit(UsesGraph.GetUnit(Filename,false));
1680 if UGUnit<>nil then begin
1681 AddUses(UDNode,UGUnit.UsesUnits,udnInterface);
1682 AddUses(UDNode,UGUnit.UsesUnits,udnImplementation);
1683 AddUses(UDNode,UGUnit.UsedByUnits,udnUsedByInterface);
1684 AddUses(UDNode,UGUnit.UsedByUnits,udnUsedByImplementation);
1685 end;
1686 end;
1687
1688 procedure TUnitDependenciesWindow.SelectNextSearchTV(TV: TTreeView;
1689 StartTVNode: TTreeNode; SearchNext, SkipStart: boolean);
1690 var
1691 TVNode: TTreeNode;
1692 NextTVNode: TTreeNode;
1693 PrevTVNode: TTreeNode;
1694 LowerSearch: String;
1695 begin
1696 //debugln(['TUnitDependenciesWindow.SelectNextSearchTV START ',DbgSName(TV),' ',StartTVNode<>nil,' SearchNext=',SearchNext,' SkipStart=',SkipStart]);
1697 TV.BeginUpdate;
1698 try
1699 TVNode:=StartTVNode;
1700 if TVNode=nil then begin
1701 if SearchNext then
1702 TVNode:=TV.Items.GetFirstNode
1703 else
1704 TVNode:=TV.Items.GetLastNode;
1705 SkipStart:=false;
1706 end;
1707 if TV=AllUnitsTreeView then
1708 LowerSearch:=GetAllUnitsSearch(true)
1709 else
1710 LowerSearch:=GetSelUnitsSearch(true);
1711 //if TVNode<>nil then debugln(['TUnitDependenciesWindow.SelectNextSearchTV searching "',LowerSearch,'" TVNode=',TVNode.Text,' SearchNext=',SearchNext,' SkipStart=',SkipStart]);
1712 TVNode:=FindNextTVNode(TVNode,LowerSearch,SearchNext,SkipStart);
1713 //if TVNode<>nil then debugln(['TUnitDependenciesWindow.SelectNextSearchTV found TVNode=',TVNode.Text]);
1714 NextTVNode:=nil;
1715 PrevTVNode:=nil;
1716 if TVNode<>nil then begin
1717 TV.Items.ClearMultiSelection(True);
1718 TV.Selected:=TVNode;
1719 TV.MakeSelectionVisible;
1720 NextTVNode:=FindNextTVNode(TVNode,LowerSearch,true,true);
1721 PrevTVNode:=FindNextTVNode(TVNode,LowerSearch,false,true);
1722 end;
1723 if TV=AllUnitsTreeView then begin
1724 AllUnitsSearchNextSpeedButton.Enabled:=NextTVNode<>nil;
1725 AllUnitsSearchPrevSpeedButton.Enabled:=PrevTVNode<>nil;
1726 end else begin
1727 SelUnitsSearchNextSpeedButton.Enabled:=NextTVNode<>nil;
1728 SelUnitsSearchPrevSpeedButton.Enabled:=PrevTVNode<>nil;
1729 end;
1730 finally
1731 TV.EndUpdate;
1732 end;
1733 //debugln(['TUnitDependenciesWindow.SelectNextSearchTV END']);
1734 end;
1735
1736 procedure TUnitDependenciesWindow.AddStartAndTargetUnits;
1737 var
1738 aProject: TLazProject;
1739 i: Integer;
1740 SrcEdit: TSourceEditorInterface;
1741 AFilename: String;
1742 Pkg: TIDEPackage;
1743 j: Integer;
1744 PkgFile: TLazPackageFile;
1745 GraphGroup: TLvlGraphNode;
1746 UnitGroup: TUGGroup;
1747 begin
1748 FNewUsesGraph.TargetAll:=true;
1749
1750 // project lpr
1751 aProject:=LazarusIDE.ActiveProject;
1752 if (aProject<>nil) and (aProject.MainFile<>nil) then
1753 FNewUsesGraph.AddStartUnit(aProject.MainFile.Filename);
1754
1755 // add all open packages
1756 if SearchPkgsCheckBox.Checked then begin
1757 for i:=0 to PackageEditingInterface.GetPackageCount-1 do begin
1758 Pkg:=PackageEditingInterface.GetPackages(i);
1759 if not FilenameIsAbsolute(Pkg.Filename) then continue;
1760 for j:=0 to Pkg.FileCount-1 do begin
1761 PkgFile:=Pkg.Files[j];
1762 if PkgFile.Removed then continue;
1763 if not (PkgFile.FileType in PkgFileRealUnitTypes) then continue;
1764 if not PkgFile.InUses then continue;
1765 aFilename:=PkgFile.GetFullFilename;
1766 if FilenameIsAbsolute(AFilename)
1767 and FilenameIsPascalUnit(AFilename) then
1768 FNewUsesGraph.AddStartUnit(AFilename);
1769 end;
1770 end;
1771 end;
1772
1773 // add all source editor files
1774 if SearchSrcEditCheckBox.Checked then begin
1775 for i:=0 to SourceEditorManagerIntf.SourceEditorCount-1 do begin
1776 SrcEdit:=SourceEditorManagerIntf.SourceEditors[i];
1777 AFilename:=SrcEdit.FileName;
1778 if FilenameIsPascalUnit(AFilename) then
1779 FNewUsesGraph.AddStartUnit(AFilename);
1780 end;
1781 end;
1782
1783 if udwNeedUpdateUnitsLvlGraph in FFlags then begin
1784 GraphGroup:=GroupsLvlGraph.Graph.FirstSelected;
1785 while GraphGroup<>nil do begin
1786 UnitGroup:=TUGGroup(GraphGroup.Data);
1787 if UnitGroup<>nil then begin
1788 if UnitGroup.Units.FindLowest = nil then begin
1789 Pkg := PackageEditingInterface.FindPackageWithName(UnitGroup.Name);
1790 if (Pkg <> nil) and (Pkg.FileCount > 0) and (FilenameIsAbsolute(Pkg.Filename)) then begin
1791 for j:=0 to Pkg.FileCount-1 do begin
1792 PkgFile:=Pkg.Files[j];
1793 if PkgFile.Removed then continue;
1794 if not (PkgFile.FileType in PkgFileRealUnitTypes) then continue;
1795 if not PkgFile.InUses then continue;
1796 aFilename:=PkgFile.GetFullFilename;
1797 if FilenameIsAbsolute(AFilename)
1798 and FilenameIsPascalUnit(AFilename) then
1799 FNewUsesGraph.AddStartUnit(AFilename);
1800 end;
1801 end;
1802 end;
1803 end;
1804 GraphGroup:=GraphGroup.NextSelected;
1805 end;
1806 end;
1807
1808 // additional units and directories
1809 if SearchCustomFilesCheckBox.Checked then
1810 AddAdditionalFilesAsStartUnits;
1811 end;
1812
1813 procedure TUnitDependenciesWindow.AddAdditionalFilesAsStartUnits;
1814 var
1815 List: TCaption;
1816 aFilename: String;
1817 Files: TStrings;
1818 i: Integer;
1819 p: Integer;
1820 begin
1821 List:=SearchCustomFilesComboBox.Text;
1822 p:=1;
1823 while p<=length(List) do begin
1824 aFilename:=TrimAndExpandFilename(GetNextDelimitedItem(List,';',p));
1825 if (AFilename='') then continue;
1826 if not FileExistsCached(aFilename) then continue;
1827 if DirPathExistsCached(aFilename) then begin
1828 aFilename:=AppendPathDelim(aFilename);
1829 // add all units in directory
1830 Files:=nil;
1831 try
1832 CodeToolBoss.DirectoryCachePool.GetListing(aFilename,Files,false);
1833 if Files<>nil then begin
1834 for i:=0 to Files.Count-1 do begin
1835 if FilenameIsPascalUnit(Files[i]) then
1836 fNewUsesGraph.AddStartUnit(aFilename+Files[i]);
1837 end;
1838 end;
1839 finally
1840 Files.Free;
1841 end;
1842 end else begin
1843 // add a single file
1844 fNewUsesGraph.AddStartUnit(aFilename);
1845 end;
1846 end;
1847 end;
1848
1849 procedure TUnitDependenciesWindow.SetupGroupsTabSheet;
1850 begin
1851 GroupsTabSheet.Caption:=lisUDProjectsAndPackages;
1852
1853 GroupsLvlGraph:=TLvlGraphControl.Create(Self);
1854 with GroupsLvlGraph do
1855 begin
1856 Name:='GroupsLvlGraph';
1857 Caption:='';
1858 Align:=alTop;
1859 Height:=200;
1860 NodeStyle.GapBottom:=5;
1861 Parent:=GroupsTabSheet;
1862 Options := Options + [lgoMinimizeEdgeLens];
1863 OnSelectionChanged:=@GroupsLvlGraphSelectionChanged;
1864 Images:=IDEImages.Images_16;
1865 PopupMenu := GraphPopupMenu;
1866 end;
1867
1868 GroupsSplitter.Top:=GroupsLvlGraph.Height;
1869
1870 UnitsLvlGraph:=TLvlGraphControl.Create(Self);
1871 with UnitsLvlGraph do
1872 begin
1873 Name:='UnitsLvlGraph';
1874 Caption:='';
1875 Align:=alClient;
1876 NodeStyle.GapBottom:=5;
1877 Parent:=UnitGraphPanel;
1878 Options := Options + [lgoMinimizeEdgeLens];
1879 OnSelectionChanged:=@UnitsLvlGraphSelectionChanged;
1880 OnMouseDown:=@UnitsLvlGraphMouseDown;
1881 Images:=IDEImages.Images_16;
1882 PopupMenu := GraphPopupMenu;
1883 end;
1884 end;
1885
1886 procedure TUnitDependenciesWindow.SetupUnitsTabSheet;
1887 begin
1888 UnitsTabSheet.Caption:=lisUDUnits;
1889
1890 // start searching
1891 SearchCustomFilesCheckBox.Caption:=lisUDAdditionalDirectories;
1892 SearchCustomFilesCheckBox.Hint:=
1893 lisUDByDefaultOnlyTheProjectUnitsAndTheSourceEditorUnit;
1894 SearchCustomFilesComboBox.Text:='';
1895 SearchCustomFilesBrowseButton.Caption:=lisPathEditBrowse;
1896
1897 SearchPkgsCheckBox.Caption:=lisUDAllPackageUnits;
1898 SearchSrcEditCheckBox.Caption:=lisUDAllSourceEditorUnits;
1899
1900 // view all units
1901 AllUnitsGroupBox.Caption:=lisUDAllUnits;
1902
1903 AllUnitsShowDirsSpeedButton.Hint:=lisUDShowNodesForDirectories;
1904 IDEImages.AssignImage(AllUnitsShowDirsSpeedButton, 'pkg_hierarchical');
1905 AllUnitsShowDirsSpeedButton.Down:=true;
1906 AllUnitsShowGroupNodesSpeedButton.Hint:=lisUDShowNodesForProjectAndPackages;
1907 IDEImages.AssignImage(AllUnitsShowGroupNodesSpeedButton, 'pkg_hierarchical');
1908 AllUnitsShowGroupNodesSpeedButton.Down:=true;
1909
1910 AllUnitsSearchNextSpeedButton.Hint:=lisUDSearchNextOccurrenceOfThisPhrase;
1911 IDEImages.AssignImage(AllUnitsSearchNextSpeedButton, 'arrow_down');
1912 AllUnitsSearchPrevSpeedButton.Hint:=lisUDSearchPreviousOccurrenceOfThisPhrase;
1913 IDEImages.AssignImage(AllUnitsSearchPrevSpeedButton, 'arrow_up');
1914
1915 // selected units
1916 SelectedUnitsGroupBox.Caption:=lisUDSelectedUnits;
1917 SelUnitsSearchNextSpeedButton.Hint:=lisUDSearchNextUnitOfThisPhrase;
1918 IDEImages.AssignImage(SelUnitsSearchNextSpeedButton, 'arrow_down');
1919 SelUnitsSearchPrevSpeedButton.Hint:=lisUDSearchPreviousUnitOfThisPhrase;
1920 IDEImages.AssignImage(SelUnitsSearchPrevSpeedButton, 'arrow_up');
1921
1922 // popup menu
1923 UnitsTVCopyFilenameMenuItem.Caption:=uemCopyFilename;
1924 UnitsTVUnusedUnitsMenuItem.Caption:=lisShowUnusedUnits;
1925 UnitsTVExpandAllMenuItem.Caption:=lisUDExpandAllNodes;
1926 UnitsTVCollapseAllMenuItem.Caption:=lisUDCollapseAllNodes;
1927
1928 UpdateUnitsButtons;
1929 end;
1930
1931 procedure TUnitDependenciesWindow.StoreGroupLvlGraphSelections;
1932 var
1933 SelNode: TLvlGraphNode;
1934 begin
1935 SelNode := GroupsLvlGraph.Graph.FirstSelected;
1936 if SelNode = nil then
1937 exit;
1938 FGroupLvlGraphSelectionsList.Clear;
1939 while SelNode <> nil do begin
1940 FGroupLvlGraphSelectionsList.Add(SelNode.Caption);
1941 SelNode := SelNode.NextSelected;
1942 end;
1943 end;
1944
1945 procedure TUnitDependenciesWindow.UpdateUnitsButtons;
1946 begin
1947 SearchCustomFilesComboBox.Enabled:=SearchCustomFilesCheckBox.Checked;
1948 SearchCustomFilesBrowseButton.Enabled:=SearchCustomFilesCheckBox.Checked;
1949 end;
1950
1951 procedure TUnitDependenciesWindow.UpdateAll;
1952 begin
1953 UpdateGroupsLvlGraph;
1954 UpdateUnitsLvlGraph;
1955 UpdateAllUnitsTreeView;
1956 end;
1957
1958 procedure TUnitDependenciesWindow.UpdateGroupsLvlGraph;
1959 var
1960 AVLNode: TAVLTreeNode;
1961 Group: TUGGroup;
1962 Graph: TLvlGraph;
1963 PkgList: TFPList;
1964 i: Integer;
1965 RequiredPkg: TIDEPackage;
1966 GroupObj: TObject;
1967 GraphGroup, ReqNode: TLvlGraphNode;
1968 UnitNode: TAVLTreeNode;
1969 GrpUnit: TUDUnit;
1970 UsedUnit: TUDUnit;
1971 begin
1972 Exclude(FFlags,udwNeedUpdateGroupsLvlGraph);
1973 GroupsLvlGraph.BeginUpdate;
1974 GroupsLvlGraph.OnSelectionChanged:=nil;
1975 Graph:=GroupsLvlGraph.Graph;
1976
1977 StoreGroupLvlGraphSelections;
1978 Graph.Clear;
1979 AVLNode:=Groups.Groups.FindLowest;
1980 while AVLNode<>nil do begin
1981 Group:=TUGGroup(AVLNode.Data);
1982 AVLNode:=Groups.Groups.FindSuccessor(AVLNode);
1983 GraphGroup:=Graph.GetNode(Group.Name,true);
1984 if FGroupLvlGraphSelectionsList.IndexOf(Group.Name) >= 0 then
1985 GraphGroup.Selected := True;
1986 GraphGroup.Data:=Group;
1987 GroupObj:=nil;
1988 if IsProjectGroup(Group) then begin
1989 // project
1990 GroupObj:=LazarusIDE.ActiveProject;
1991 GraphGroup.Selected:=(FGroupLvlGraphSelectionsList.Count=0)
1992 or (FGroupLvlGraphSelectionsList.IndexOf(Group.Name)>=0);
1993 GraphGroup.ImageIndex := fImgIndexProject;
1994 end else begin
1995 // package
1996 GroupObj:=PackageEditingInterface.FindPackageWithName(Group.Name);
1997 GraphGroup.ImageIndex := fImgIndexPackage;
1998 end;
1999 if GroupObj<>nil then begin
2000 // add lpk dependencies
2001 PkgList:=nil;
2002 try
2003 PackageEditingInterface.GetRequiredPackages(GroupObj,PkgList,[pirNotRecursive]);
2004 if (PkgList<>nil) then begin
2005 // add for each dependency an edge in the Graph
2006 for i:=0 to PkgList.Count-1 do begin
2007 RequiredPkg:=TIDEPackage(PkgList[i]);
2008 ReqNode:=Graph.GetNode(RequiredPkg.Name,true);
2009 if FGroupLvlGraphSelectionsList.IndexOf(RequiredPkg.Name) >= 0 then
2010 ReqNode.Selected := True;
2011 ReqNode.ImageIndex := fImgIndexPackage;
2012 Graph.GetEdge(GraphGroup,ReqNode,true);
2013 end;
2014 end;
2015 finally
2016 PkgList.Free;
2017 end;
2018 end else if IsFPCSrcGroup(Group) then begin
2019 // add FPC source dependencies
2020 UnitNode:=Group.Units.FindLowest;
2021 while UnitNode<>nil do begin
2022 GrpUnit:=TUDUnit(UnitNode.Data);
2023 UnitNode:=Group.Units.FindSuccessor(UnitNode);
2024 if GrpUnit.UsesUnits=nil then continue;
2025 for i:=0 to GrpUnit.UsesUnits.Count-1 do begin
2026 UsedUnit:=TUDUnit(TUDUses(GrpUnit.UsesUnits[i]).UsesUnit);
2027 if (UsedUnit.Group=nil) or (UsedUnit.Group=Group) then continue;
2028 ReqNode := Graph.GetNode(UsedUnit.Group.Name,true);
2029 if FGroupLvlGraphSelectionsList.IndexOf(UsedUnit.Group.Name) >= 0 then
2030 ReqNode.Selected := True;
2031 Graph.GetEdge(GraphGroup,ReqNode,true);
2032 end;
2033 end;
2034 end;
2035 end;
2036 GroupsLvlGraph.EndUpdate;
2037 GroupsLvlGraph.OnSelectionChanged:=@GroupsLvlGraphSelectionChanged;
2038 FGroupLvlGraphSelectionsList.Clear;
2039 end;
2040
2041 procedure TUnitDependenciesWindow.UpdateUnitsLvlGraph;
2042
UnitToCaptionnull2043 function UnitToCaption(AnUnit: TUGUnit): string;
2044 begin
2045 Result:=ExtractFileNameOnly(AnUnit.Filename);
2046 end;
2047
2048 var
2049 GraphGroup: TLvlGraphNode;
2050 NewUnits: TFilenameToPointerTree;
2051 UnitGroup: TUGGroup;
2052 AVLNode: TAVLTreeNode;
2053 GroupUnit: TUDUnit;
2054 i, j: Integer;
2055 HasChanged: Boolean;
2056 Graph: TLvlGraph;
2057 CurUses: TUDUses;
2058 SourceGraphNode: TLvlGraphNode;
2059 TargetGraphNode: TLvlGraphNode;
2060 NewGroups: TStringToPointerTree;
2061 UsedUnit: TUDUnit;
2062 Pkg: TIDEPackage;
2063 c: String;
2064 begin
2065 Exclude(FFlags,udwNeedUpdateUnitsLvlGraph);
2066 NewGroups:=TStringToPointerTree.Create(false);
2067 NewUnits:=TFilenameToPointerTree.Create(false);
2068 try
2069 // fetch new list of units
2070 GraphGroup:=GroupsLvlGraph.Graph.FirstSelected;
2071 while GraphGroup<>nil do begin
2072 UnitGroup:=TUGGroup(GraphGroup.Data);
2073 if UnitGroup<>nil then begin
2074 NewGroups[UnitGroup.Name]:=UnitGroup;
2075 AVLNode:=UnitGroup.Units.FindLowest;
2076 if AVLNode = nil then begin
2077 if IsProjectGroup(UnitGroup.Name) and (LazarusIDE.ActiveProject.FileCount <> 0) then begin
2078 Include(FFlags,udwNeedUpdateUnitsLvlGraph)
2079 end
2080 else begin
2081 Pkg := PackageEditingInterface.FindPackageWithName(UnitGroup.Name);
2082 if (Pkg <> nil) and (Pkg.FileCount > 0) and (FilenameIsAbsolute(Pkg.Filename))
2083 then
2084 Include(FFlags,udwNeedUpdateUnitsLvlGraph);
2085 end
2086 end;
2087 while AVLNode<>nil do begin
2088 GroupUnit:=TUDUnit(AVLNode.Data);
2089 NewUnits[GroupUnit.Filename]:=GroupUnit;
2090 AVLNode:=UnitGroup.Units.FindSuccessor(AVLNode);
2091 end;
2092 end;
2093 GraphGroup:=GraphGroup.NextSelected;
2094 end;
2095 if udwNeedUpdateUnitsLvlGraph in FFlags then
2096 StartParsing;
2097
2098 // check if something changed
2099 Graph:=UnitsLvlGraph.Graph;
2100 HasChanged:=false;
2101 i:=0;
2102 AVLNode:=NewUnits.Tree.FindLowest;
2103 while AVLNode<>nil do begin
2104 GroupUnit:=TUDUnit(NewUnits.GetNodeData(AVLNode)^.Value);
2105 if (Graph.NodeCount<=i) or (Graph.Nodes[i].Data<>Pointer(GroupUnit)) then
2106 begin
2107 HasChanged:=true;
2108 break;
2109 end;
2110 i+=1;
2111 AVLNode:=NewUnits.Tree.FindSuccessor(AVLNode);
2112 end;
2113 if i<Graph.NodeCount then HasChanged:=true;
2114 if not HasChanged then exit;
2115
2116 // units changed -> update level graph of units
2117 UnitsLvlGraph.BeginUpdate;
2118 Graph.Clear;
2119 for j := 0 to UnitGraphFilter.Count - 1 do
2120 UnitGraphFilter.Items.Objects[j] := TObject(1);
2121 AVLNode:=NewUnits.Tree.FindLowest;
2122 while AVLNode<>nil do begin
2123 GroupUnit:=TUDUnit(NewUnits.GetNodeData(AVLNode)^.Value);
2124 c := UnitToCaption(GroupUnit);
2125 j := UnitGraphFilter.Items.IndexOf(c);
2126 if (j >= 0) then begin
2127 UnitGraphFilter.Items.Objects[j] := nil;
2128 if (not UnitGraphFilter.Checked[j]) then begin
2129 AVLNode:=NewUnits.Tree.FindSuccessor(AVLNode);
2130 Continue;
2131 end;
2132 end
2133 else begin
2134 j := UnitGraphFilter.Items.Add(c);
2135 UnitGraphFilter.Checked[j] := True;
2136 end;
2137 SourceGraphNode:=Graph.GetNode(c,true);
2138 SourceGraphNode.Data:=GroupUnit;
2139 SourceGraphNode.ImageIndex := fImgIndexUnit;
2140 if GroupUnit.UsesUnits<>nil then begin
2141 for i:=0 to GroupUnit.UsesUnits.Count-1 do begin
2142 CurUses:=TUDUses(GroupUnit.UsesUnits[i]);
2143 UsedUnit:=TUDUnit(CurUses.UsesUnit);
2144 if UsedUnit.Group=nil then continue;
2145 if not NewGroups.Contains(UsedUnit.Group.Name) then continue;
2146 c := UnitToCaption(UsedUnit);
2147 j := UnitGraphFilter.Items.IndexOf(c);
2148 if (j >= 0) then begin
2149 UnitGraphFilter.Items.Objects[j] := nil;
2150 if (not UnitGraphFilter.Checked[j]) then begin
2151 AVLNode:=NewUnits.Tree.FindSuccessor(AVLNode);
2152 Continue;
2153 end;
2154 end
2155 else begin
2156 j := UnitGraphFilter.Items.Add(c);
2157 UnitGraphFilter.Checked[j] := True;
2158 end;
2159 TargetGraphNode:=Graph.GetNode(c,true);
2160 TargetGraphNode.Data:=UsedUnit;
2161 TargetGraphNode.ImageIndex := fImgIndexUnit;
2162 Graph.GetEdge(SourceGraphNode,TargetGraphNode,true);
2163 end;
2164 end;
2165 AVLNode:=NewUnits.Tree.FindSuccessor(AVLNode);
2166 end;
2167 j := UnitGraphFilter.Count - 1;
2168 while j >= 0 do begin
2169 if UnitGraphFilter.Items.Objects[j] <> nil then
2170 UnitGraphFilter.Items.Delete(j);
2171 dec(j);
2172 end;
2173
2174 UnitsLvlGraph.EndUpdate;
2175 finally
2176 NewGroups.Free;
2177 NewUnits.Free;
2178 end;
2179 end;
2180
2181 procedure TUnitDependenciesWindow.CreateTVNodes(TV: TTreeView;
2182 ParentTVNode: TTreeNode; ParentUDNode: TUDNode; Expand: boolean);
2183 var
2184 AVLNode: TAVLTreeNode;
2185 UDNode: TUDNode;
2186 TVNode: TTreeNode;
2187 begin
2188 if ParentUDNode=nil then exit;
2189 AVLNode:=ParentUDNode.ChildNodes.FindLowest;
2190 while AVLNode<>nil do begin
2191 UDNode:=TUDNode(AVLNode.Data);
2192 TVNode:=TV.Items.AddChild(ParentTVNode,UDNode.NodeText);
2193 UDNode.TVNode:=TVNode;
2194 TVNode.Data:=UDNode;
2195 TVNode.ImageIndex:=GetImgIndex(UDNode);
2196 TVNode.SelectedIndex:=TVNode.ImageIndex;
2197 TVNode.HasChildren:=UDNode.HasChildren;
2198 if UDNode.IntfCycle then
2199 TVNode.OverlayIndex:=fImgIndexOverlayIntfCycle
2200 else if UDNode.ImplCycle then
2201 TVNode.OverlayIndex:=fImgIndexOverlayImplCycle
2202 else if UDNode.HasImplementationUses then
2203 TVNode.OverlayIndex:=fImgIndexOverlayImplUses;
2204 //if TVNode.OverlayIndex>=0 then
2205 // debugln(['TUnitDependenciesWindow.CreateTVNodes ',TVNode.Text,' Overlay=',TVNode.OverlayIndex,' ',TV.Images.Count]);
2206 CreateTVNodes(TV,TVNode,UDNode,Expand);
2207 TVNode.Expanded:=Expand and (TVNode.Count>0);
2208 AVLNode:=ParentUDNode.ChildNodes.FindSuccessor(AVLNode);
2209 end;
2210 end;
2211
2212 procedure TUnitDependenciesWindow.FreeUsesGraph;
2213 begin
2214 FreeAndNil(FAllUnitsRootUDNode);
2215 FreeAndNil(FSelUnitsRootUDNode);
2216 StoreGroupLvlGraphSelections;
2217 GroupsLvlGraph.OnSelectionChanged:=nil;
2218 GroupsLvlGraph.Clear;
2219 GroupsLvlGraph.OnSelectionChanged:=@GroupsLvlGraphSelectionChanged;
2220 UnitsLvlGraph.Clear;
2221 FreeAndNil(FGroups);
2222 FreeAndNil(FUsesGraph);
2223 end;
2224
GetPopupTV_UDNodenull2225 function TUnitDependenciesWindow.GetPopupTV_UDNode(out UDNode: TUDNode
2226 ): boolean;
2227 var
2228 TV: TTreeView;
2229 TVNode: TTreeNode;
2230 begin
2231 Result:=false;
2232 UDNode:=nil;
2233 TV:=TTreeView(UnitsTVPopupMenu.PopupComponent);
2234 if not (TV is TTreeView) then exit;
2235 TVNode:=TV.Selected;
2236 if (TVNode=nil) or not (TObject(TVNode.Data) is TUDNode) then exit;
2237 UDNode:=TUDNode(TVNode.Data);
2238 Result:=true;
2239 end;
2240
2241 procedure TUnitDependenciesWindow.GraphOptsApplyClicked(
2242 AnOpts: TLvlGraphOptions; AGraph: TLvlGraph);
2243 begin
2244 if AGraph = GroupsLvlGraph.Graph then begin
2245 AnOpts.WriteToGraph(GroupsLvlGraph);
2246 UpdateGroupsLvlGraph;
2247 GroupsLvlGraph.AutoLayout;
2248 end
2249 else begin
2250 AnOpts.WriteToGraph(UnitsLvlGraph);
2251 UpdateUnitsLvlGraph;
2252 UnitsLvlGraph.AutoLayout;
2253 end;
2254 MainIDEInterface.SaveEnvironment;
2255 end;
2256
2257 procedure TUnitDependenciesWindow.UpdateAllUnitsTreeView;
2258 var
2259 TV: TTreeView;
2260 OldExpanded: TTreeNodeExpandedState;
2261 SrcEdit: TSourceEditorInterface;
2262 SelPath: String;
2263 begin
2264 Exclude(FFlags,udwNeedUpdateAllUnitsTreeView);
2265 TV:=AllUnitsTreeView;
2266 TV.BeginUpdate;
2267 // save old expanded state
2268 if (TV.Items.Count>1) and (GetAllUnitsFilter(false)='') then
2269 OldExpanded:=TTreeNodeExpandedState.Create(TV)
2270 else
2271 OldExpanded:=nil;
2272 SelPath:='';
2273 if TV.Selected<>nil then
2274 SelPath:=TV.Selected.GetTextPath;
2275 // clear
2276 FreeAndNil(FAllUnitsRootUDNode);
2277 fAllUnitsTVSearchStartNode:=nil;
2278 TV.Items.Clear;
2279 // create nodes
2280 FAllUnitsRootUDNode:=CreateAllUnitsTree;
2281 CreateTVNodes(TV,nil,FAllUnitsRootUDNode,true);
2282 // restore old expanded state
2283 if OldExpanded<>nil then begin
2284 OldExpanded.Apply(TV);
2285 OldExpanded.Free;
2286 end;
2287 // update search
2288 UpdateAllUnitsTreeViewSearch;
2289 // select an unit
2290 if PendingUnitDependencyRoute.Count>0 then begin
2291 TV.Selected:=FindUnitTVNodeWithUnitName(TV,PendingUnitDependencyRoute[0]);
2292 end;
2293 if (TV.Selected=nil) and (SelPath<>'') then begin
2294 TV.Selected:=TV.Items.FindNodeWithTextPath(SelPath);
2295 end;
2296 if (TV.Selected=nil) then begin
2297 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2298 if SrcEdit<>nil then
2299 TV.Selected:=FindUnitTVNodeWithFilename(TV,SrcEdit.FileName);
2300 end;
2301 if (TV.Selected=nil) and (LazarusIDE.ActiveProject<>nil)
2302 and (LazarusIDE.ActiveProject.MainFile<>nil) then
2303 TV.Selected:=FindUnitTVNodeWithFilename(TV,LazarusIDE.ActiveProject.MainFile.Filename);
2304
2305 TV.EndUpdate;
2306 end;
2307
2308 procedure TUnitDependenciesWindow.UpdateSelUnitsTreeView;
2309 var
2310 TV: TTreeView;
2311 begin
2312 //debugln(['TUnitDependenciesWindow.UpdateSelUnitsTreeView START']);
2313 Exclude(FFlags,udwNeedUpdateSelUnitsTreeView);
2314 TV:=SelUnitsTreeView;
2315 TV.BeginUpdate;
2316 // clear
2317 FreeAndNil(FSelUnitsRootUDNode);
2318 fSelUnitsTVSearchStartNode:=nil;
2319 TV.Items.Clear;
2320 // create nodes
2321 FSelUnitsRootUDNode:=CreateSelUnitsTree;
2322 CreateTVNodes(TV,nil,FSelUnitsRootUDNode,true);
2323 // update search
2324 UpdateSelUnitsTreeViewSearch;
2325 TV.EndUpdate;
2326 end;
2327
2328 procedure TUnitDependenciesWindow.UpdateAllUnitsTreeViewSearch;
2329 begin
2330 Exclude(FFlags,udwNeedUpdateAllUnitsTVSearch);
2331 SelectNextSearchTV(AllUnitsTreeView,fAllUnitsTVSearchStartNode,true,false);
2332 AllUnitsTreeView.Invalidate;
2333 end;
2334
2335 procedure TUnitDependenciesWindow.UpdateSelUnitsTreeViewSearch;
2336 begin
2337 Exclude(FFlags,udwNeedUpdateSelUnitsTVSearch);
2338 SelectNextSearchTV(SelUnitsTreeView,fSelUnitsTVSearchStartNode,true,false);
2339 SelUnitsTreeView.Invalidate;
2340 end;
2341
TUnitDependenciesWindow.FindNextTVNodenull2342 function TUnitDependenciesWindow.FindNextTVNode(StartNode: TTreeNode;
2343 LowerSearch: string; SearchNext, SkipStart: boolean): TTreeNode;
2344 begin
2345 Result:=StartNode;
2346 while Result<>nil do begin
2347 if ((Result<>StartNode) or (not SkipStart))
2348 and NodeTextFitsFilter(Result.Text,LowerSearch) then
2349 exit;
2350 if SearchNext then
2351 Result:=Result.GetNext
2352 else
2353 Result:=Result.GetPrev;
2354 end;
2355 end;
2356
FindUnitTVNodeWithFilenamenull2357 function TUnitDependenciesWindow.FindUnitTVNodeWithFilename(TV: TTreeView;
2358 aFilename: string): TTreeNode;
2359 var
2360 i: Integer;
2361 UDNode: TUDNode;
2362 begin
2363 for i:=0 to TV.Items.Count-1 do begin
2364 Result:=TV.Items[i];
2365 if TObject(Result.Data) is TUDNode then begin
2366 UDNode:=TUDNode(Result.Data);
2367 if (UDNode.Typ in [udnDirectory,udnUnit])
2368 and (CompareFilenames(UDNode.Identifier,aFilename)=0) then
2369 exit;
2370 end;
2371 end;
2372 Result:=nil;
2373 end;
2374
FindUnitTVNodeWithUnitNamenull2375 function TUnitDependenciesWindow.FindUnitTVNodeWithUnitName(TV: TTreeView;
2376 aUnitName: string): TTreeNode;
2377 var
2378 i: Integer;
2379 UDNode: TUDNode;
2380 begin
2381 for i:=0 to TV.Items.Count-1 do begin
2382 Result:=TV.Items[i];
2383 if TObject(Result.Data) is TUDNode then begin
2384 UDNode:=TUDNode(Result.Data);
2385 if (UDNode.Typ in [udnUnit])
2386 and (CompareText(ExtractFileNameOnly(UDNode.Identifier),aUnitName)=0) then
2387 exit;
2388 end;
2389 end;
2390 Result:=nil;
2391 end;
2392
2393 procedure TUnitDependenciesWindow.FormActivate(Sender: TObject);
2394 begin
2395 SearchCustomFilesComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
2396 end;
2397
TUnitDependenciesWindow.GetImgIndexnull2398 function TUnitDependenciesWindow.GetImgIndex(Node: TUDNode): integer;
2399 begin
2400 case Node.Typ of
2401 //udnNone: ;
2402 udnGroup:
2403 if IsProjectGroup(Node.Group) then
2404 Result:=fImgIndexProject
2405 else
2406 Result:=fImgIndexPackageRequired;
2407 udnDirectory: Result:=fImgIndexDirectory;
2408 //udnInterface: ;
2409 //udnImplementation: ;
2410 //udnUsedByInterface: ;
2411 //udnUsedByImplementation: ;
2412 udnUnit: Result:=fImgIndexUnit;
2413 else
2414 Result:=fImgIndexDirectory;
2415 end;
2416 end;
2417
TUnitDependenciesWindow.NodeTextToUnitnull2418 function TUnitDependenciesWindow.NodeTextToUnit(NodeText: string): TUGUnit;
2419 var
2420 AVLNode: TAVLTreeNode;
2421 begin
2422 AVLNode:=UsesGraph.FilesTree.FindLowest;
2423 while AVLNode<>nil do begin
2424 Result:=TUGUnit(AVLNode.Data);
2425 if NodeText=UGUnitToNodeText(Result) then exit;
2426 AVLNode:=UsesGraph.FilesTree.FindSuccessor(AVLNode);
2427 end;
2428 Result:=nil;
2429 end;
2430
TUnitDependenciesWindow.UGUnitToNodeTextnull2431 function TUnitDependenciesWindow.UGUnitToNodeText(UGUnit: TUGUnit): string;
2432 begin
2433 Result:=ExtractFileName(UGUnit.Filename);
2434 end;
2435
TUnitDependenciesWindow.GetFPCSrcDirnull2436 function TUnitDependenciesWindow.GetFPCSrcDir: string;
2437 var
2438 UnitSet: TFPCUnitSetCache;
2439 begin
2440 UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
2441 Result:=UnitSet.FPCSourceDirectory;
2442 end;
2443
TUnitDependenciesWindow.IsFPCSrcGroupnull2444 function TUnitDependenciesWindow.IsFPCSrcGroup(Group: TUGGroup): boolean;
2445 begin
2446 Result:=(Group<>nil) and (LeftStr(Group.Name,length(GroupPrefixFPCSrc))=GroupPrefixFPCSrc);
2447 end;
2448
IsProjectGroupnull2449 function TUnitDependenciesWindow.IsProjectGroup(Group: TUGGroup): boolean;
2450 begin
2451 Result:=(Group<>nil) and IsProjectGroup(Group.Name);
2452 end;
2453
IsProjectGroupnull2454 function TUnitDependenciesWindow.IsProjectGroup(GroupName: string): boolean;
2455 begin
2456 Result:=(GroupName=GroupPrefixProject);
2457 end;
2458
TUnitDependenciesWindow.GetFilenamenull2459 function TUnitDependenciesWindow.GetFilename(UDNode: TUDNode): string;
2460 var
2461 Pkg: TIDEPackage;
2462 begin
2463 Result:='';
2464 if UDNode.Typ in [udnUnit,udnDirectory] then
2465 Result:=UDNode.Identifier
2466 else if UDNode.Typ=udnGroup then begin
2467 if IsProjectGroup(UDNode.Group) then begin
2468 if (LazarusIDE.ActiveProject<>nil) then
2469 Result:=LazarusIDE.ActiveProject.ProjectInfoFile;
2470 end else begin
2471 Pkg:=PackageEditingInterface.FindPackageWithName(UDNode.Group);
2472 if Pkg<>nil then
2473 Result:=Pkg.Filename;
2474 end;
2475 end;
2476 end;
2477
TUnitDependenciesWindow.GetAllUnitsFilternull2478 function TUnitDependenciesWindow.GetAllUnitsFilter(Lower: boolean): string;
2479 begin
2480 Result:=AllUnitsFilterEdit.Text;
2481 if Lower then
2482 Result:=UTF8LowerCase(Result);
2483 end;
2484
TUnitDependenciesWindow.GetAllUnitsSearchnull2485 function TUnitDependenciesWindow.GetAllUnitsSearch(Lower: boolean): string;
2486 begin
2487 Result:=AllUnitsSearchEdit.Text;
2488 if Lower then
2489 Result:=UTF8LowerCase(Result);
2490 end;
2491
GetSelUnitsSearchnull2492 function TUnitDependenciesWindow.GetSelUnitsSearch(Lower: boolean): string;
2493 begin
2494 Result:=SelUnitsSearchEdit.Text;
2495 if Lower then
2496 Result:=UTF8LowerCase(Result);
2497 end;
2498
ResStrFilternull2499 function TUnitDependenciesWindow.ResStrFilter: string;
2500 begin
2501 Result:=lisUDFilter;
2502 end;
2503
TUnitDependenciesWindow.ResStrSearchnull2504 function TUnitDependenciesWindow.ResStrSearch: string;
2505 begin
2506 Result:=lisUDSearch;
2507 end;
2508
NodeTextFitsFilternull2509 function TUnitDependenciesWindow.NodeTextFitsFilter(const NodeText,
2510 LowerFilter: string): boolean;
2511 begin
2512 Result:=Pos(LowerFilter,UTF8LowerCase(NodeText))>0;
2513 end;
2514
2515 procedure TUnitDependenciesWindow.CreateUsesGraph(out TheUsesGraph: TUsesGraph;
2516 out TheGroups: TUGGroups);
2517 begin
2518 TheUsesGraph:=CodeToolBoss.CreateUsesGraph;
2519 TheGroups:=TUGGroups.Create(TheUsesGraph);
2520 if not TUDUnit.InheritsFrom(TheUsesGraph.UnitClass) then
2521 RaiseCatchableException('');
2522 TheUsesGraph.UnitClass:=TUDUnit;
2523 if not TUDUses.InheritsFrom(TheUsesGraph.UsesClass) then
2524 RaiseCatchableException('');
2525 TheUsesGraph.UsesClass:=TUDUses;
2526 end;
2527
2528 end.
2529
2530