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 Browser for packages, classes, methods, functions.
25 Scope:
26 Browse units of IDE, or a project or a package.
27 Browse with required packages or without.
28 Sort:
29 Owner, unit, class, visibility, type (procedure, var, const, ...), identifier
30
31 Notes:
32 The codetools provides TCodeTree of every unit.
33
34 ToDo:
35 - pause
36 - scan recently used packages
37 - scan packages in global links
38 }
39 unit CodeBrowser;
40
41 {$mode objfpc}{$H+}
42 {$modeswitch typehelpers}
43
44 {off $DEFINE VerboseCodeBrowser}
45
46 interface
47
48 uses
49 // RTL + FCL
50 Classes, SysUtils, types, Laz_AVL_Tree,
51 // LCL
52 LCLProc, Forms, Controls, Graphics, Dialogs, Clipbrd, StdCtrls,
53 ExtCtrls, ComCtrls, Buttons, Menus, HelpIntfs,
54 // CodeTools
55 BasicCodeTools, DefineTemplates, CodeTree, CodeCache, CodeToolManager,
56 PascalParserTool, LinkScanner, FileProcs, CodeIndex, StdCodeTools, SourceLog,
57 // LazUtils
58 LazFileUtils, LazStringUtils, LazUTF8, AvgLvlTree,
59 // IDEIntf
60 IDEWindowIntf, SrcEditorIntf, IDEMsgIntf, IDEDialogs, LazConfigStorage,
61 IDEHelpIntf, PackageIntf, IDECommands, LazIDEIntf, IDEExternToolIntf,
62 IDEImagesIntf,
63 // IDE
64 Project, DialogProcs, PackageSystem, PackageDefs, LazarusIDEStrConsts,
65 IDEOptionDefs, etFPCMsgParser, BasePkgManager, EnvironmentOpts;
66
67
68 type
69 TCodeBrowserLevel = (
70 cblPackages,
71 cblUnits,
72 cblIdentifiers
73 );
74
75 TCodeBrowserTextFilter = (
76 cbtfBegins,
77 cbtfContains
78 );
79
80 const
81 CodeBrowserLevelNames: array[TCodeBrowserLevel] of string = (
82 'Packages',
83 'Units',
84 'Identifiers'
85 );
86
87 CodeBrowserTextFilterNames: array[TCodeBrowserTextFilter] of string = (
88 'Begins',
89 'Contains'
90 );
91
92 CodeBrowserIDEName = ' '+'Lazarus IDE';// Note: space is needed to avoid name clashing
93 CodeBrowserProjectName = ' '+'Project';
94 CodeBrowserHidden = ' ';
95 CodeBrowserMaxTVIdentifiers = 5000; // the maximum amount of identifiers shown in the treeview
96
97 type
98
99 { TCodeBrowserViewOptions }
100
101 TCodeBrowserViewOptions = class
102 private
103 FChangeStamp: integer;
104 FModified: boolean;
105 FScope: string;
106 FLevels: TStrings;
107 FShowEmptyNodes: boolean;
108 FShowPrivate: boolean;
109 FShowProtected: boolean;
110 FStoreWithRequiredPackages: boolean;
111 FWithRequiredPackages: boolean;
112 FLevelFilterText: array[TCodeBrowserLevel] of string;
113 FLevelFilterType: array[TCodeBrowserLevel] of TCodeBrowserTextFilter;
GetLevelFilterTextnull114 function GetLevelFilterText(Level: TCodeBrowserLevel): string;
GetLevelFilterTypenull115 function GetLevelFilterType(Level: TCodeBrowserLevel): TCodeBrowserTextFilter;
116 procedure SetLevelFilterText(Level: TCodeBrowserLevel; const AValue: string);
117 procedure SetLevelFilterType(Level: TCodeBrowserLevel;
118 const AValue: TCodeBrowserTextFilter);
119 procedure SetModified(const AValue: boolean);
120 procedure SetScope(const AValue: string);
121 procedure SetLevels(const AValue: TStrings);
122 procedure SetShowEmptyNodes(const AValue: boolean);
123 procedure SetShowPrivate(const AValue: boolean);
124 procedure SetShowProtected(const AValue: boolean);
125 procedure SetStoreWithRequiredPackages(const AValue: boolean);
126 procedure SetWithRequiredPackages(const AValue: boolean);
127 procedure IncreaseChangeStamp;
128 public
129 constructor Create;
130 destructor Destroy; override;
131 procedure Clear;
132 procedure LoadFromConfig(ConfigStore: TConfigStorage; const Path: string);
133 procedure SaveToConfig(ConfigStore: TConfigStorage; const Path: string);
HasLevelnull134 function HasLevel(Level: TCodeBrowserLevel): boolean;
135 public
136 property Scope: string read FScope write SetScope;
137 property WithRequiredPackages: boolean read FWithRequiredPackages write SetWithRequiredPackages;
138 property StoreWithRequiredPackages: boolean read FStoreWithRequiredPackages write SetStoreWithRequiredPackages;
139 property Levels: TStrings read FLevels write SetLevels;
140 property ShowPrivate: boolean read FShowPrivate write SetShowPrivate;
141 property ShowProtected: boolean read FShowProtected write SetShowProtected;
142 property ShowEmptyNodes: boolean read FShowEmptyNodes write SetShowEmptyNodes;
143 property LevelFilterText[Level: TCodeBrowserLevel]: string read GetLevelFilterText write SetLevelFilterText;
144 property LevelFilterType[Level: TCodeBrowserLevel]: TCodeBrowserTextFilter read GetLevelFilterType write SetLevelFilterType;
145 property Modified: boolean read FModified write SetModified;
146 property ChangeStamp: integer read FChangeStamp;
147 end;
148
149
150 TCodeBrowserWorkStage = (
151 cbwsGetScopeOptions,
152 cbwsGatherPackages,
153 cbwsFreeUnusedPackages,
154 cbwsAddNewPackages,
155 cbwsGatherFiles,
156 cbwsGatherOutdatedFiles,
157 cbwsUpdateUnits,
158 cbwsGetViewOptions,
159 cbwsUpdateTreeView,
160 cbwsFinished
161 );
162
163 const
164 SCodeBrowserWorkStage: array[TCodeBrowserWorkStage] of String = (
165 'GetScopeOptions',
166 'GatherPackages',
167 'FreeUnusedPackages',
168 'AddNewPackages',
169 'GatherFiles',
170 'GatherOutdatedFiles',
171 'UpdateUnits',
172 'GetViewOptions',
173 'UpdateTreeView',
174 'Finished'
175 );
176
177 type
178
179 { TCodeBrowserWorkStageHelper }
180
181 TCodeBrowserWorkStageHelper = type helper for TCodeBrowserWorkStage
ToStringnull182 function ToString: String;
183 end;
184
185 TExpandableNodeType = (
186 entPackage,
187 entUnit,
188 entClass
189 );
190
191 TCopyNodeType = (
192 cntIdentifier,
193 cntDescription
194 );
195
196 { TCodeBrowserView }
197
198 TCodeBrowserView = class(TForm)
199 AllClassesSeparatorMenuItem: TMenuItem;
200 AllPackagesSeparatorMenuItem: TMenuItem;
201 AllUnitsSeparatorMenuItem: TMenuItem;
202 BrowseTreeView: TTreeView;
203 UseIdentifierInCurUnitMenuItem: TMenuItem;
204 UseUnitInCurUnitMenuItem: TMenuItem;
205 RescanButton: TButton;
206 IdleTimer1: TIdleTimer;
207 UsePkgInProjectMenuItem: TMenuItem;
208 UsePkgInCurUnitMenuItem: TMenuItem;
209 UseSeparatorMenuItem: TMenuItem;
210 ShowEmptyNodesCheckBox: TCheckBox;
211 CollapseAllClassesMenuItem: TMenuItem;
212 CollapseAllPackagesMenuItem: TMenuItem;
213 CollapseAllUnitsMenuItem: TMenuItem;
214 CopyDescriptionMenuItem: TMenuItem;
215 CopyIdentifierMenuItem: TMenuItem;
216 CopySeparatorMenuItem: TMenuItem;
217 ExpandAllClassesMenuItem: TMenuItem;
218 ExpandAllPackagesMenuItem: TMenuItem;
219 ExpandAllUnitsMenuItem: TMenuItem;
220 ExportMenuItem: TMenuItem;
221 IdentifierFilterBeginsSpeedButton: TSpeedButton;
222 IdentifierFilterContainsSpeedButton: TSpeedButton;
223 IdentifierFilterEdit: TEdit;
224 LevelsGroupBox: TGroupBox;
225 OpenMenuItem: TMenuItem;
226 OptionsGroupBox: TGroupBox;
227 PackageFilterBeginsSpeedButton: TSpeedButton;
228 PackageFilterContainsSpeedButton: TSpeedButton;
229 PackageFilterEdit: TEdit;
230 PopupMenu1: TPopupMenu;
231 ProgressBar1: TProgressBar;
232 ScopeComboBox: TComboBox;
233 ScopeGroupBox: TGroupBox;
234 ScopeWithRequiredPackagesCheckBox: TCheckBox;
235 ShowIdentifiersCheckBox: TCheckBox;
236 ShowPackagesCheckBox: TCheckBox;
237 ShowPrivateCheckBox: TCheckBox;
238 ShowProtectedCheckBox: TCheckBox;
239 ShowUnitsCheckBox: TCheckBox;
240 StatusBar1: TStatusBar;
241 UnitFilterBeginsSpeedButton: TSpeedButton;
242 UnitFilterContainsSpeedButton: TSpeedButton;
243 UnitFilterEdit: TEdit;
244 procedure BrowseTreeViewMouseMove(Sender: TObject; {%H-}Shift: TShiftState;
245 {%H-}X,{%H-}Y: Integer);
246 procedure FormActivate(Sender: TObject);
247 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
248 procedure FormDeactivate(Sender: TObject);
249 procedure UseIdentifierInCurUnitMenuItemClick(Sender: TObject);
250 procedure UsePkgInCurUnitMenuItemClick(Sender: TObject);
251 procedure UsePkgInProjectMenuItemClick(Sender: TObject);
252 procedure UseUnitInCurUnitMenuItemClick(Sender: TObject);
253 procedure BrowseTreeViewMouseDown(Sender: TOBject; {%H-}Button: TMouseButton;
254 Shift: TShiftState; X, Y: Integer);
255 procedure BrowseTreeViewShowHint(Sender: TObject; HintInfo: PHintInfo);
256 procedure CollapseAllPackagesMenuItemClick(Sender: TObject);
257 procedure CollapseAllUnitsMenuItemClick(Sender: TObject);
258 procedure CollapseAllClassesMenuItemClick(Sender: TObject);
259 procedure CopyDescriptionMenuItemClick(Sender: TObject);
260 procedure CopyIdentifierMenuItemClick(Sender: TObject);
261 procedure ExpandAllClassesMenuItemClick(Sender: TObject);
262 procedure ExpandAllPackagesMenuItemClick(Sender: TObject);
263 procedure ExpandAllUnitsMenuItemClick(Sender: TObject);
264 procedure ExportMenuItemClick(Sender: TObject);
265 procedure FormCreate(Sender: TObject);
266 procedure FormDestroy(Sender: TObject);
267 procedure IdleTimer1Timer(Sender: TObject);
268 procedure PackageFilterEditChange(Sender: TObject);
269 procedure PackageFilterEditEditingDone(Sender: TObject);
270 procedure PopupMenu1Popup(Sender: TObject);
271 procedure RescanButtonClick(Sender: TObject);
272 procedure ScopeComboBoxChange(Sender: TObject);
273 procedure ScopeWithRequiredPackagesCheckBoxChange(Sender: TObject);
274 procedure OnIdle(Sender: TObject; var Done: Boolean);
275 procedure OpenMenuItemClick(Sender: TObject);
276 procedure ShowIdentifiersCheckBoxChange(Sender: TObject);
277 procedure ShowPackagesCheckBoxChange(Sender: TObject);
278 procedure ShowPrivateCheckBoxChange(Sender: TObject);
279 procedure ShowUnitsCheckBoxChange(Sender: TObject);
280 private
281 FHintManager: THintWindowManager;
282 FIDEDescription: string;
283 FIdleConnected: boolean;
284 FOptions: TCodeBrowserViewOptions;
285 FOptionsChangeStamp: integer;
286 FProjectDescription: string;
287 FParserRoot: TCodeBrowserUnitList;
288 FScannedBytes: PtrInt;
289 FScannedIdentifiers: PtrInt;
290 FScannedLines: PtrInt;
291 FScannedPackages: integer;
292 FScannedUnits: integer;
293 FUpdateNeeded: boolean;
294 FViewRoot: TCodeBrowserUnitList;
295 FVisibleIdentifiers: PtrInt;
296 FVisiblePackages: integer;
297 FVisibleUnits: integer;
298 FWorkingParserRoot: TCodeBrowserUnitList;
299 fUpdateCount: integer;
300 fStage: TCodeBrowserWorkStage;
301 fOutdatedFiles: TAVLTree;// tree of TCodeBrowserUnit
302 fLastStatusBarUpdate: TDateTime;
303 ImgIDDefault: integer;
304 ImgIDProgramCode: Integer;
305 ImgIDUnitCode: Integer;
306 ImgIDInterfaceSection: Integer;
307 ImgIDImplementation: Integer;
308 ImgIDInitialization: Integer;
309 ImgIDFinalization: Integer;
310 ImgIDTypeSection: Integer;
311 ImgIDType: Integer;
312 ImgIDVarSection: Integer;
313 ImgIDVariable: Integer;
314 ImgIDConstSection: Integer;
315 ImgIDConst: Integer;
316 ImgIDClass: Integer;
317 ImgIDProc: Integer;
318 ImgIDProperty: Integer;
319 ImgIDPackage: Integer;
320 ImgIDProject: Integer;
321 procedure LoadOptions;
322 procedure LoadLevelsGroupBox;
323 procedure LoadFilterGroupbox;
324 procedure FillScopeComboBox;
325 procedure SetIdleConnected(AValue: boolean);
326 procedure SetScannedBytes(const AValue: PtrInt);
327 procedure SetScannedIdentifiers(const AValue: PtrInt);
328 procedure SetScannedLines(const AValue: PtrInt);
329 procedure SetScannedPackages(const AValue: integer);
330 procedure SetScannedUnits(const AValue: integer);
331 procedure SetUpdateNeeded(const AValue: boolean);
332 procedure SetVisibleIdentifiers(const AValue: PtrInt);
333 procedure SetVisiblePackages(const AValue: integer);
334 procedure SetVisibleUnits(const AValue: integer);
335 procedure Work(var Done: Boolean);
336 procedure WorkGetScopeOptions;
337 procedure WorkGatherPackages;
338 procedure WorkFreeUnusedPackages;
339 procedure WorkAddNewUnitLists;
340 procedure WorkGatherFileLists;
341 procedure WorkUpdateFileList(List: TCodeBrowserUnitList);
342 procedure WorkGatherOutdatedFiles;
343 procedure WorkUpdateUnits;
344 procedure WorkUpdateUnit(AnUnit: TCodeBrowserUnit);
345 procedure WorkGetViewOptions;
346 procedure WorkUpdateTreeView;
347 procedure FreeUnitList(List: TCodeBrowserUnitList);
348 procedure UpdateStatusBar(Lazy: boolean);
349 procedure RemoveUnit(AnUnit: TCodeBrowserUnit);
CountIdentifiersnull350 function CountIdentifiers(Tool: TCodeTool): integer;
351 procedure UpdateTreeView;
352 procedure ClearTreeView;
353 procedure InitTreeView;
ListOwnerToTextnull354 function ListOwnerToText(const ListOwner: string): string;
355 procedure InitImageList;
GetNodeImagenull356 function GetNodeImage(CodeNode: TObject): integer;
GetTVNodeHintnull357 function GetTVNodeHint(TVNode: TTreeNode): string;
GetCodeHelpnull358 function GetCodeHelp(TVNode: TTreeNode; out BaseURL, HTMLHint: string): boolean;
359 procedure ExpandCollapseAllNodesInTreeView(NodeType: TExpandableNodeType;
360 Expand: boolean);
361 procedure CopyNode(TVNode: TTreeNode; NodeType: TCopyNodeType);
GetCodeToolnull362 function GetCodeTool(AnUnit: TCodeBrowserUnit): TStandardCodeTool;
363 procedure GetNodeIdentifier(Tool: TStandardCodeTool;
364 CTNode: TCodeTreeNode; out Identifier: string);
365 procedure GetNodeDescription(Tool: TStandardCodeTool;
366 CTNode: TCodeTreeNode; Identifier: string; out Description: string);
GetSelectedUnitnull367 function GetSelectedUnit: TCodeBrowserUnit;
GetSelectedPackagenull368 function GetSelectedPackage: TLazPackage;
GetCurUnitInSrcEditornull369 function GetCurUnitInSrcEditor(out FileOwner: TObject;
370 out UnitCode: TCodeBuffer): boolean;
GetCurPackageInSrcEditornull371 function GetCurPackageInSrcEditor: TLazPackage;
372 procedure OpenTVNode(TVNode: TTreeNode);
373 procedure UseUnitInSrcEditor(InsertIdentifier: boolean);
374 procedure CloseHintWindow;
375 public
376 procedure BeginUpdate;
377 procedure EndUpdate;
ExportTreenull378 function ExportTree: TModalResult;
ExportTreeAsTextnull379 function ExportTreeAsText(Filename: string): TModalResult;
GetScopeToCurUnitOwnernull380 function GetScopeToCurUnitOwner(UseFCLAsDefault: boolean): string;
SetScopeToCurUnitOwnernull381 function SetScopeToCurUnitOwner(UseFCLAsDefault,
382 WithRequiredPackages: boolean): boolean;
383 procedure SetFilterToSimpleIdentifier(Identifier: string);
384 procedure InvalidateStage(AStage: TCodeBrowserWorkStage);
385 public
386 property ParserRoot: TCodeBrowserUnitList read FParserRoot;
387 property WorkingParserRoot: TCodeBrowserUnitList read FWorkingParserRoot;
388 property ViewRoot: TCodeBrowserUnitList read FViewRoot;
389 property Options: TCodeBrowserViewOptions read FOptions;
390 property IDEDescription: string read FIDEDescription;
391 property ProjectDescription: string read FProjectDescription;
392 property ScannedPackages: integer read FScannedPackages write SetScannedPackages;
393 property ScannedUnits: integer read FScannedUnits write SetScannedUnits;
394 property ScannedLines: PtrInt read FScannedLines write SetScannedLines;
395 property ScannedBytes: PtrInt read FScannedBytes write SetScannedBytes;
396 property ScannedIdentifiers: PtrInt read FScannedIdentifiers write SetScannedIdentifiers;
397 property VisiblePackages: integer read FVisiblePackages write SetVisiblePackages;
398 property VisibleUnits: integer read FVisibleUnits write SetVisibleUnits;
399 property VisibleIdentifiers: PtrInt read FVisibleIdentifiers write SetVisibleIdentifiers;
400 property UpdateNeeded: boolean read FUpdateNeeded write SetUpdateNeeded;
401 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
402 end;
403
404 type
405
406 { TQuickFixIdentifierNotFound_Search }
407
408 TQuickFixIdentifierNotFound_Search = class(TMsgQuickFix)
409 public
IsApplicablenull410 function IsApplicable(Msg: TMessageLine; out Identifier: string): boolean;
411 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
412 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
413 end;
414 var
415 CodeBrowserView: TCodeBrowserView = nil;
416
StringToCodeBrowserTextFilternull417 function StringToCodeBrowserTextFilter(const s: string): TCodeBrowserTextFilter;
418
419 procedure InitCodeBrowserQuickFixItems;
420 procedure CreateCodeBrowser(DisableAutoSizing: boolean);
421 procedure ShowCodeBrowser(const Identifier: string);
422
423 implementation
424
425 {$R *.lfm}
426
427 const
428 ProgressGetScopeStart=0;
429 ProgressGetScopeSize=10;
430 ProgressGatherPackagesStart=ProgressGetScopeStart+ProgressGetScopeSize;
431 ProgressGatherPackagesSize=30;
432 ProgressFreeUnusedPkgStart=ProgressGatherPackagesStart+ProgressGatherPackagesSize;
433 ProgressFreeUnusedPkgSize=100;
434 ProgressAddNewUnitListsStart=ProgressFreeUnusedPkgStart+ProgressFreeUnusedPkgSize;
435 ProgressAddNewUnitListsSize=300;
436 ProgressGatherFileListsStart=ProgressAddNewUnitListsStart+ProgressAddNewUnitListsSize;
437 ProgressGatherFileListsSize=300;
438 ProgressGatherOutdatedFilesStart=ProgressGatherFileListsStart+ProgressGatherFileListsSize;
439 ProgressGatherOutdatedFilesSize=300;
440 ProgressUpdateUnitsStart=ProgressGatherOutdatedFilesStart+ProgressGatherOutdatedFilesSize;
441 ProgressUpdateUnitsSize=3000;
442 ProgressGetViewOptionsStart=ProgressUpdateUnitsStart+ProgressUpdateUnitsSize;
443 ProgressGetViewOptionsSize=10;
444 ProgressUpdateTreeViewStart=ProgressGetViewOptionsStart+ProgressGetViewOptionsSize;
445 ProgressUpdateTreeViewSize=1000;
446 ProgressTotal=ProgressUpdateTreeViewStart+ProgressUpdateTreeViewSize;
447 const
448 ProcDescFlags = [phpWithStart,phpWithParameterNames,
449 phpWithVarModifiers,phpWithResultType,phpWithoutSemicolon];
450 ProcIdentifierFlags = [phpWithoutClassKeyword,phpWithParameterNames,
451 phpWithoutSemicolon];
452 PropDescFlags = [phpWithoutClassKeyword,phpWithParameterNames,
453 phpWithVarModifiers,phpWithResultType];
454
StringToCodeBrowserTextFilternull455 function StringToCodeBrowserTextFilter(const s: string): TCodeBrowserTextFilter;
456 begin
457 for Result:=Low(TCodeBrowserTextFilter) to High(TCodeBrowserTextFilter) do
458 if SysUtils.CompareText(CodeBrowserTextFilterNames[Result],s)=0 then exit;
459 Result:=cbtfBegins;
460 end;
461
462 procedure InitCodeBrowserQuickFixItems;
463 begin
464 RegisterIDEMsgQuickFix(TQuickFixIdentifierNotFound_Search.Create);
465 end;
466
467 procedure CreateCodeBrowser(DisableAutoSizing: boolean);
468 begin
469 if CodeBrowserView=nil then
470 IDEWindowCreators.CreateForm(CodeBrowserView,TCodeBrowserView,
471 DisableAutoSizing,LazarusIDE.OwningComponent)
472 else if DisableAutoSizing then
473 CodeBrowserView.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('CreateCodeBrowser'){$ENDIF};
474 end;
475
476 procedure ShowCodeBrowser(const Identifier: string);
477 begin
478 IDEWindowCreators.ShowForm(NonModalIDEWindowNames[nmiwCodeBrowser],true);
479 CodeBrowserView.SetScopeToCurUnitOwner(true,true);
480 CodeBrowserView.SetFilterToSimpleIdentifier(Identifier);
481 end;
482
483 { TCodeBrowserWorkStageHelper }
484
TCodeBrowserWorkStageHelper.ToStringnull485 function TCodeBrowserWorkStageHelper.ToString: String;
486 begin
487 Result := SCodeBrowserWorkStage[Self];
488 end;
489
490 { TCodeBrowserView }
491
492 procedure TCodeBrowserView.FormCreate(Sender: TObject);
493 begin
494 FHintManager:=THintWindowManager.Create;
495 FOptions:=TCodeBrowserViewOptions.Create;
496
497 FIDEDescription:=lisLazarusIDE;
498 FProjectDescription:=dlgProject;
499
500 Name:=NonModalIDEWindowNames[nmiwCodeBrowser];
501 Caption:=lisCodeBrowser;
502
503 ScopeGroupBox.Caption:=dlgSearchScope;
504 ScopeWithRequiredPackagesCheckBox.Caption:=lisWithRequiredPackages;
505 RescanButton.Caption:=lisRescan;
506 LevelsGroupBox.Caption:=lisLevels;
507 ShowPackagesCheckBox.Caption:=lisShowPackages;
508 ShowUnitsCheckBox.Caption:=lisShowUnits;
509 ShowIdentifiersCheckBox.Caption:=lisShowIdentifiers;
510
511 OptionsGroupBox.Caption:=lisFilter;
512 ShowPrivateCheckBox.Caption:=lisPrivate;
513 ShowProtectedCheckBox.Caption:=lisProtected;
514 ShowEmptyNodesCheckBox.Caption:=lisShowEmptyUnitsPackages;
515
516 ExpandAllPackagesMenuItem.Caption:=lisExpandAllPackages;
517 CollapseAllPackagesMenuItem.Caption:=lisCollapseAllPackages;
518 ExpandAllUnitsMenuItem.Caption:=lisExpandAllUnits;
519 CollapseAllUnitsMenuItem.Caption:=lisCollapseAllUnits;
520 ExpandAllClassesMenuItem.Caption:=lisExpandAllClasses;
521 CollapseAllClassesMenuItem.Caption:=lisCollapseAllClasses;
522 ExportMenuItem.Caption:=lisDlgExport;
523 OpenMenuItem.Caption:=lisOpen;
524 // UsePkgInProjectMenuItem.Caption: see PopupMenu1Popup
525 // UsePkgInCurUnitMenuItem.Caption: see PopupMenu1Popup
526 // UseUnitInCurUnitMenuItem.Caption: see PopupMenu1Popup
527
528 PackageFilterBeginsSpeedButton.Caption:=lisBegins;
529 PackageFilterBeginsSpeedButton.Hint:=lisPackageNameBeginsWith;
530 PackageFilterContainsSpeedButton.Caption:=lisContains;
531 PackageFilterContainsSpeedButton.Hint:=lisPackageNameContains;
532 UnitFilterBeginsSpeedButton.Caption:=lisBegins;
533 UnitFilterBeginsSpeedButton.Hint:=lisUnitNameBeginsWith;
534 UnitFilterContainsSpeedButton.Caption:=lisContains;
535 UnitFilterContainsSpeedButton.Hint:=lisUnitNameContains;
536 IdentifierFilterBeginsSpeedButton.Caption:=lisBegins;
537 IdentifierFilterBeginsSpeedButton.Hint:=lisIdentifierBeginsWith;
538 IdentifierFilterContainsSpeedButton.Caption:=lisContains;
539 IdentifierFilterContainsSpeedButton.Hint:=lisIdentifierContains;
540
541 ProgressBar1.Max:=ProgressTotal;
542 InitImageList;
543 LoadOptions;
544 FillScopeComboBox;
545 ScopeComboBox.ItemIndex:=0;
546 IdleConnected:=true;
547 end;
548
549 procedure TCodeBrowserView.FormDestroy(Sender: TObject);
550 begin
551 IdleConnected:=false;
552 ClearTreeView;
553 FreeAndNil(fOutdatedFiles);
554 FreeAndNil(FViewRoot);
555 FreeAndNil(FParserRoot);
556 FreeAndNil(FWorkingParserRoot);
557 FreeAndNil(FOptions);
558 FreeAndNil(FHintManager);
559 IdleConnected:=false;
560 end;
561
562 procedure TCodeBrowserView.FormDeactivate(Sender: TObject);
563 begin
564 CloseHintWindow;
565 end;
566
567 procedure TCodeBrowserView.FormClose(Sender: TObject; var CloseAction: TCloseAction);
568 // CloseAction=caHide by default
569 begin
570 IdleConnected:=false;
571 end;
572
573 procedure TCodeBrowserView.BrowseTreeViewMouseMove(Sender: TObject;
574 Shift: TShiftState; X, Y: Integer);
575 begin
576 CloseHintWindow;
577 end;
578
579 procedure TCodeBrowserView.IdleTimer1Timer(Sender: TObject);
580 begin
581 InvalidateStage(cbwsGetViewOptions);
582 IdleTimer1.Enabled:=false;
583 end;
584
585 procedure TCodeBrowserView.PackageFilterEditChange(Sender: TObject);
586 begin
587 IdleTimer1.Enabled:=true;
588 end;
589
590 procedure TCodeBrowserView.PackageFilterEditEditingDone(Sender: TObject);
591 begin
592 InvalidateStage(cbwsGetViewOptions);
593 end;
594
595 procedure TCodeBrowserView.PopupMenu1Popup(Sender: TObject);
596 var
597 TVNode: TTreeNode;
598 Node: TObject;
599 Identifier: String;
600 UnitList: TCodeBrowserUnitList;
601 EnableUsePkgInProject: Boolean;
602 APackage: TLazPackage;
603 EnableUsePkgInCurUnit: Boolean;
604 TargetPackage: TLazPackage;
605 EnableUseUnitInCurUnit: Boolean;
606 CurUnit: TCodeBrowserUnit;
607 SrcEditUnitOwner: TObject;
608 SrcEditUnitCode: TCodeBuffer;
609 CurUnitName: String;
610 SrcEditUnitName: String;
611 CBNode: TCodeBrowserNode;
612 EnableUseIdentifierInCurUnit: Boolean;
613 SrcEdit: TSourceEditorInterface;
614 begin
615 ExpandAllPackagesMenuItem.Visible:=Options.HasLevel(cblPackages);
616 CollapseAllPackagesMenuItem.Visible:=ExpandAllPackagesMenuItem.Visible;
617 AllPackagesSeparatorMenuItem.Visible:=ExpandAllPackagesMenuItem.Visible;
618
619 ExpandAllUnitsMenuItem.Visible:=Options.HasLevel(cblUnits);
620 CollapseAllUnitsMenuItem.Visible:=ExpandAllUnitsMenuItem.Visible;
621 AllUnitsSeparatorMenuItem.Visible:=ExpandAllUnitsMenuItem.Visible;
622
623 ExpandAllClassesMenuItem.Visible:=Options.HasLevel(cblIdentifiers);
624 CollapseAllClassesMenuItem.Visible:=ExpandAllClassesMenuItem.Visible;
625 AllClassesSeparatorMenuItem.Visible:=ExpandAllClassesMenuItem.Visible;
626
627 TVNode:=BrowseTreeView.Selected;
628 Node:=nil;
629 if TVNode<>nil then
630 Node:=TObject(TVNode.Data);
631 EnableUsePkgInProject:=false;
632 EnableUsePkgInCurUnit:=false;
633 EnableUseUnitInCurUnit:=false;
634 EnableUseIdentifierInCurUnit:=false;
635 if Node<>nil then begin
636 Identifier:='';
637 APackage:=nil;
638 UnitList:=nil;
639 CurUnit:=nil;
640 TargetPackage:=nil;
641 if Node is TCodeBrowserNode then begin
642 Identifier:=TCodeBrowserNode(Node).Identifier;
643 CBNode:=TCodeBrowserNode(Node);
644 CurUnit:=CBNode.CBUnit;
645 if CurUnit<>nil then
646 UnitList:=CurUnit.UnitList;
647 end else if Node is TCodeBrowserUnit then begin
648 CurUnit:=TCodeBrowserUnit(Node);
649 UnitList:=CurUnit.UnitList;
650 end else if Node is TCodeBrowserUnitList then begin
651 UnitList:=TCodeBrowserUnitList(Node);
652 end;
653 if UnitList<>nil then begin
654 if UnitList.Owner=CodeBrowserProjectName then begin
655 // project
656 end else if UnitList.Owner=CodeBrowserIDEName then begin
657 // IDE
658 end else if UnitList.Owner=CodeBrowserHidden then begin
659 // nothing
660 end else begin
661 // package
662 APackage:=PackageGraph.FindPackageWithName(UnitList.Owner,nil);
663 if APackage<>nil then begin
664 // check if package can be added to project
665 if Project1.FindDependencyByName(APackage.Name)=nil then begin
666 EnableUsePkgInProject:=true;
667 UsePkgInProjectMenuItem.Caption:=Format(lisUsePackageInProject, [
668 APackage.Name]);
669 end;
670 // check if package can be added to package of src editor unit
671 TargetPackage:=GetCurPackageInSrcEditor;
672 if (TargetPackage<>nil)
673 and (SysUtils.CompareText(TargetPackage.Name,APackage.Name)<>0)
674 and (TargetPackage.FindDependencyByName(APackage.Name)=nil) then begin
675 EnableUsePkgInCurUnit:=true;
676 UsePkgInCurUnitMenuItem.Caption:=Format(
677 lisUsePackageInPackage, [APackage.Name,
678 TargetPackage.Name]);
679 end;
680 // check if unit can be added to project/package
681 GetCurUnitInSrcEditor(SrcEditUnitOwner,SrcEditUnitCode);
682 if (CurUnit<>nil) and (SrcEditUnitOwner<>nil) then begin
683 CurUnitName:=ExtractFileNameOnly(CurUnit.Filename);
684 SrcEditUnitName:=ExtractFileNameOnly(SrcEditUnitCode.Filename);
685 if SysUtils.CompareText(CurUnitName,SrcEditUnitName)<>0 then begin
686 EnableUseUnitInCurUnit:=true;
687 UseUnitInCurUnitMenuItem.Caption:=
688 Format(lisUseUnitInUnit, [CurUnitName, SrcEditUnitName]);
689 if (Node is TCodeBrowserNode) and (Identifier<>'') then begin
690 EnableUseIdentifierInCurUnit:=true;
691 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
692 UseIdentifierInCurUnitMenuItem.Caption:=
693 Format(lisUseIdentifierInAt, [Identifier, ExtractFilename(
694 SrcEdit.FileName), dbgs(SrcEdit.CursorScreenXY)]);
695 end;
696 end;
697 end;
698 end;
699 end;
700 end;
701 OpenMenuItem.Visible:=true;
702 CopyDescriptionMenuItem.Caption:=lisCopyDescription;
703 CopyIdentifierMenuItem.Caption:=Format(lisCopyIdentifier, [Identifier]);
704 CopyDescriptionMenuItem.Visible:=true;
705 CopyIdentifierMenuItem.Visible:=Identifier<>'';
706 CopySeparatorMenuItem.Visible:=true;
707
708 UseUnitInCurUnitMenuItem.Enabled:=EnableUseUnitInCurUnit;
709 UseUnitInCurUnitMenuItem.Visible:=true;
710 if not EnableUseUnitInCurUnit then
711 UseUnitInCurUnitMenuItem.Caption:=lisPkgMangUseUnit;
712
713 UseIdentifierInCurUnitMenuItem.Enabled:=EnableUseIdentifierInCurUnit;
714 UseIdentifierInCurUnitMenuItem.Visible:=true;
715 if not EnableUseIdentifierInCurUnit then
716 UseIdentifierInCurUnitMenuItem.Caption:=lisUseIdentifier;
717
718 UsePkgInProjectMenuItem.Enabled:=EnableUsePkgInProject;
719 UsePkgInProjectMenuItem.Visible:=true;
720 if not EnableUsePkgInProject then
721 UsePkgInProjectMenuItem.Caption:=lisUsePackageInProject2;
722
723 UsePkgInCurUnitMenuItem.Enabled:=EnableUsePkgInCurUnit;
724 UsePkgInCurUnitMenuItem.Visible:=true;
725 if not EnableUsePkgInCurUnit then
726 UsePkgInCurUnitMenuItem.Caption:=lisUsePackageInPackage2;
727 end else begin
728 OpenMenuItem.Visible:=false;
729 CopyDescriptionMenuItem.Visible:=false;
730 CopyIdentifierMenuItem.Visible:=false;
731 CopySeparatorMenuItem.Visible:=false;
732 UseUnitInCurUnitMenuItem.Visible:=false;
733 UseIdentifierInCurUnitMenuItem.Visible:=false;
734 UsePkgInProjectMenuItem.Visible:=false;
735 UsePkgInCurUnitMenuItem.Visible:=false;
736 UseSeparatorMenuItem.Visible:=false;
737 end;
738 end;
739
740 procedure TCodeBrowserView.RescanButtonClick(Sender: TObject);
741 begin
742 UpdateNeeded:=true;
743 InvalidateStage(cbwsGetScopeOptions);
744 end;
745
746 procedure TCodeBrowserView.ScopeComboBoxChange(Sender: TObject);
747 begin
748 InvalidateStage(cbwsGetScopeOptions);
749 end;
750
751 procedure TCodeBrowserView.ScopeWithRequiredPackagesCheckBoxChange(Sender: TObject);
752 begin
753 InvalidateStage(cbwsGetScopeOptions);
754 end;
755
756 procedure TCodeBrowserView.OnIdle(Sender: TObject; var Done: Boolean);
757 begin
758 if (Screen.GetCurrentModalForm<>nil) then exit;
759 Work(Done);
760 end;
761
762 procedure TCodeBrowserView.OpenMenuItemClick(Sender: TObject);
763 begin
764 OpenTVNode(BrowseTreeView.Selected);
765 end;
766
767 procedure TCodeBrowserView.ShowIdentifiersCheckBoxChange(Sender: TObject);
768 begin
769 InvalidateStage(cbwsGetViewOptions);
770 end;
771
772 procedure TCodeBrowserView.ShowPackagesCheckBoxChange(Sender: TObject);
773 begin
774 //DebugLn(['TCodeBrowserView.ShowPackagesCheckBoxChange ']);
775 InvalidateStage(cbwsGetViewOptions);
776 end;
777
778 procedure TCodeBrowserView.ShowPrivateCheckBoxChange(Sender: TObject);
779 begin
780 InvalidateStage(cbwsGetViewOptions);
781 end;
782
783 procedure TCodeBrowserView.ShowUnitsCheckBoxChange(Sender: TObject);
784 begin
785 InvalidateStage(cbwsGetViewOptions);
786 end;
787
788 procedure TCodeBrowserView.LoadOptions;
789 begin
790 BeginUpdate;
791 ScopeWithRequiredPackagesCheckBox.Checked:=Options.WithRequiredPackages;
792 ScopeComboBox.Text:=Options.Scope;
793 LoadLevelsGroupBox;
794 LoadFilterGroupbox;
795 EndUpdate;
796 end;
797
798 procedure TCodeBrowserView.LoadLevelsGroupBox;
799 begin
800 ShowPackagesCheckBox.Checked:=Options.HasLevel(cblPackages);
801 ShowUnitsCheckBox.Checked:=Options.HasLevel(cblUnits);
802 ShowIdentifiersCheckBox.Checked:=Options.HasLevel(cblIdentifiers);
803 end;
804
805 procedure TCodeBrowserView.LoadFilterGroupbox;
806 begin
807 ShowPrivateCheckBox.Checked:=Options.ShowPrivate;
808 ShowProtectedCheckBox.Checked:=Options.ShowProtected;
809 ShowEmptyNodesCheckBox.Checked:=Options.ShowEmptyNodes;
810
811 PackageFilterEdit.Text:=Options.LevelFilterText[cblPackages];
812 case Options.LevelFilterType[cblPackages] of
813 cbtfBegins: PackageFilterBeginsSpeedButton.Down:=true;
814 cbtfContains: PackageFilterContainsSpeedButton.Down:=true;
815 end;
816
817 UnitFilterEdit.Text:=Options.LevelFilterText[cblUnits];
818 case Options.LevelFilterType[cblUnits] of
819 cbtfBegins: UnitFilterBeginsSpeedButton.Down:=true;
820 cbtfContains: UnitFilterContainsSpeedButton.Down:=true;
821 end;
822
823 IdentifierFilterEdit.Text:=Options.LevelFilterText[cblIdentifiers];
824 case Options.LevelFilterType[cblIdentifiers] of
825 cbtfBegins: IdentifierFilterBeginsSpeedButton.Down:=true;
826 cbtfContains: IdentifierFilterContainsSpeedButton.Down:=true;
827 end;
828 end;
829
830 procedure TCodeBrowserView.FillScopeComboBox;
831 var
832 sl: TStringListUTF8Fast;
833 i: Integer;
834 begin
835 if ScopeComboBox.Items.Count=0 then begin
836 sl:=TStringListUTF8Fast.Create;
837 try
838 if PackageGraph<>nil then begin
839 for i:=0 to PackageGraph.Count-1 do
840 sl.Add(PackageGraph.Packages[i].Name);
841 end;
842 sl.Sort;
843 sl.Insert(0,IDEDescription);
844 sl.Insert(1,ProjectDescription);
845 ScopeComboBox.Items.Assign(sl);
846 finally
847 sl.Free;
848 end;
849 end;
850 end;
851
852 procedure TCodeBrowserView.FormActivate(Sender: TObject);
853 begin
854 ScopeComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
855 end;
856
857 procedure TCodeBrowserView.SetIdleConnected(AValue: boolean);
858 begin
859 if csDestroying in ComponentState then AValue:=false;
860 if FIdleConnected=AValue then Exit;
861 FIdleConnected:=AValue;
862 if IdleConnected then
863 Application.AddOnIdleHandler(@OnIdle)
864 else
865 Application.RemoveOnIdleHandler(@OnIdle);
866 end;
867
868 procedure TCodeBrowserView.InitImageList;
869 begin
870 BrowseTreeView.Images := IDEImages.Images_16;
871 ImgIDDefault := IDEImages.GetImageIndex('ce_default');
872 ImgIDProgramCode := IDEImages.GetImageIndex('ce_program');
873 ImgIDUnitCode := IDEImages.GetImageIndex('cc_unit');
874 ImgIDInterfaceSection := IDEImages.GetImageIndex('ce_interface');
875 ImgIDImplementation := IDEImages.GetImageIndex('ce_implementation');
876 ImgIDInitialization := IDEImages.GetImageIndex('ce_initialization');
877 ImgIDFinalization := IDEImages.GetImageIndex('ce_finalization');
878 ImgIDTypeSection := IDEImages.GetImageIndex('cc_type');
879 ImgIDType := IDEImages.GetImageIndex('cc_type');
880 ImgIDVarSection := IDEImages.GetImageIndex('cc_variable');
881 ImgIDVariable := IDEImages.GetImageIndex('cc_variable');
882 ImgIDConstSection := IDEImages.GetImageIndex('cc_constant');
883 ImgIDConst := IDEImages.GetImageIndex('cc_constant');
884 ImgIDClass := IDEImages.GetImageIndex('cc_class');
885 ImgIDProc := IDEImages.GetImageIndex('cc_procedure');
886 ImgIDProperty := IDEImages.GetImageIndex('cc_property');
887 ImgIDPackage := IDEImages.GetImageIndex('item_package');
888 ImgIDProject := IDEImages.GetImageIndex('item_project');
889 end;
890
891 procedure TCodeBrowserView.SetScannedBytes(const AValue: PtrInt);
892 begin
893 if FScannedBytes=AValue then exit;
894 FScannedBytes:=AValue;
895 end;
896
897 procedure TCodeBrowserView.SetScannedIdentifiers(const AValue: PtrInt);
898 begin
899 if FScannedIdentifiers=AValue then exit;
900 FScannedIdentifiers:=AValue;
901 end;
902
903 procedure TCodeBrowserView.SetScannedLines(const AValue: PtrInt);
904 begin
905 if FScannedLines=AValue then exit;
906 FScannedLines:=AValue;
907 end;
908
909 procedure TCodeBrowserView.SetScannedPackages(const AValue: integer);
910 begin
911 if FScannedPackages=AValue then exit;
912 FScannedPackages:=AValue;
913 end;
914
915 procedure TCodeBrowserView.SetScannedUnits(const AValue: integer);
916 begin
917 if FScannedUnits=AValue then exit;
918 FScannedUnits:=AValue;
919 end;
920
921 procedure TCodeBrowserView.SetUpdateNeeded(const AValue: boolean);
922
923 procedure InvalidateFileList(StartList: TCodeBrowserUnitList);
924 var
925 APackage: TCodeBrowserUnitList;
926 Node: TAVLTreeNode;
927 begin
928 if StartList=nil then exit;
929 StartList.UnitsValid:=false;
930 if (StartList.UnitLists=nil) then exit;
931 Node:=StartList.UnitLists.FindLowest;
932 while Node<>nil do begin
933 APackage:=TCodeBrowserUnitList(Node.Data);
934 InvalidateFileList(APackage);
935 Node:=StartList.UnitLists.FindSuccessor(Node);
936 end;
937 end;
938
939 begin
940 if FUpdateNeeded=AValue then exit;
941 FUpdateNeeded:=AValue;
942 if FUpdateNeeded then begin
943 InvalidateFileList(FParserRoot);
944 InvalidateFileList(FWorkingParserRoot);
945 InvalidateStage(cbwsGetScopeOptions);
946 end;
947 end;
948
949 procedure TCodeBrowserView.SetVisibleIdentifiers(const AValue: PtrInt);
950 begin
951 if FVisibleIdentifiers=AValue then exit;
952 FVisibleIdentifiers:=AValue;
953 end;
954
955 procedure TCodeBrowserView.SetVisiblePackages(const AValue: integer);
956 begin
957 if FVisiblePackages=AValue then exit;
958 FVisiblePackages:=AValue;
959 end;
960
961 procedure TCodeBrowserView.SetVisibleUnits(const AValue: integer);
962 begin
963 if FVisibleUnits=AValue then exit;
964 FVisibleUnits:=AValue;
965 end;
966
967 procedure TCodeBrowserView.UseUnitInSrcEditor(InsertIdentifier: boolean);
968 var
969 // temporary data, that can be freed on next idle
970 SelectedUnit: TCodeBrowserUnit;
971 TVNode: TTreeNode;
972 Node: TObject;
973 IdentifierNode: TCodeBrowserNode;
974 // normal vars
975 SelectedUnitName: String;
976 SelectedCode: TCodeBuffer;
977 List: TFPList;
978 SelectedOwner: TObject;
979 APackage: TLazPackage;
980 TargetCode: TCodeBuffer;
981 TargetOwner: TObject;
982 SrcEdit: TSourceEditorInterface;
983 Code: TCodeBuffer;
984 CodeMarker: TSourceLogMarker;
985 Identifier: String;
986 SelectedUnitFilename: String;
987 IdentStart: integer;
988 IdentEnd: integer;
989 InsertStartPos: TPoint;
990 InsertEndPos: TPoint;
991 begin
992 TVNode:=BrowseTreeView.Selected;
993 if TVNode=nil then exit;
994 Node:=TObject(TVNode.Data);
995 IdentifierNode:=nil;
996 SelectedUnit:=nil;
997 if Node is TCodeBrowserNode then begin
998 IdentifierNode:=TCodeBrowserNode(Node);
999 Identifier:=IdentifierNode.Identifier;
1000 SelectedUnit:=IdentifierNode.CBUnit;
1001 end else if Node is TCodeBrowserUnit then begin
1002 SelectedUnit:=TCodeBrowserUnit(Node);
1003 end else
1004 exit;
1005 if (SelectedUnit=nil) then exit;
1006 SelectedUnitFilename:=SelectedUnit.Filename;
1007
1008 if InsertIdentifier then begin
1009 if (IdentifierNode=nil) or (Identifier='') then exit;
1010 end;
1011 if SelectedUnit.UnitList=nil then begin
1012 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor not implemented: '
1013 +'SelectedUnit.UnitList=nil']);
1014 IDEMessageDialog('Implement me',
1015 'TCodeBrowserView.UseUnitInSrcEditor not implemented: '
1016 +'SelectedUnit.UnitList=nil',
1017 mtInformation, [mbOk]);
1018 exit;
1019 end;
1020 SelectedOwner:=nil;
1021 if SelectedUnit.UnitList.Owner=CodeBrowserProjectName then begin
1022 // project
1023 SelectedOwner:=Project1;
1024 end else if SelectedUnit.UnitList.Owner=CodeBrowserIDEName then begin
1025 // IDE can not be added as dependency
1026 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor IDE can not be '
1027 +'added as dependency']);
1028 exit;
1029 end else if SelectedUnit.UnitList.Owner=CodeBrowserHidden then begin
1030 // nothing
1031 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor hidden unitlist']
1032 );
1033 exit;
1034 end else begin
1035 // package
1036 APackage:=PackageGraph.FindPackageWithName(SelectedUnit.UnitList.Owner,nil);
1037 if APackage=nil then begin
1038 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor package not '
1039 +'found: ', SelectedUnit.UnitList.Owner]);
1040 exit;
1041 end;
1042 SelectedOwner:=APackage;
1043 end;
1044
1045 // get target unit
1046 if not GetCurUnitInSrcEditor(TargetOwner, TargetCode) then exit;
1047 if (not (TargetOwner is TProject))
1048 and (not (TargetOwner is TLazPackage)) then begin
1049 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor not implemented: '
1050 +'TargetOwner=', DbgSName(TargetOwner)]);
1051 IDEMessageDialog('Implement me',
1052 'TCodeBrowserView.UseUnitInSrcEditor not implemented: '
1053 +'TargetOwner='+DbgSName(TargetOwner),
1054 mtInformation, [mbOk]);
1055 exit;
1056 end;
1057
1058 if (SelectedOwner is TProject) and (TargetOwner<>SelectedOwner) then begin
1059 // unit of project can not be used by other packages/projects
1060 IDEMessageDialog(lisImpossible,
1061 lisAProjectUnitCanNotBeUsedByOtherPackagesProjects,
1062 mtError, [mbCancel]);
1063 exit;
1064 end;
1065
1066 // safety first: clear the references, they will become invalid on next idle
1067 SelectedUnit:=nil;
1068 IdentifierNode:=nil;
1069 Node:=nil;
1070 TVNode:=nil;
1071
1072
1073 List:=TFPList.Create;
1074 CodeMarker:=nil;
1075 try
1076 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
1077 if SrcEdit=nil then exit;
1078 InsertStartPos:=SrcEdit.CursorTextXY;
1079 Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer);
1080 CodeMarker:=Code.AddMarkerXY(InsertStartPos.Y,InsertStartPos.X,Self);
1081
1082 List.Add(TargetOwner);
1083 if (SelectedOwner is TLazPackage) then begin
1084 // add package to TargetOwner
1085 APackage:=TLazPackage(SelectedOwner);
1086 if PkgBoss.AddDependencyToOwners(List, APackage)<>mrOk then begin
1087 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor PkgBoss.'
1088 +'AddDependencyToOwners failed']);
1089 exit;
1090 end;
1091 end;
1092
1093 // get nice unit name
1094 LazarusIDE.SaveSourceEditorChangesToCodeCache(nil);
1095 SelectedCode:=CodeToolBoss.LoadFile(SelectedUnitFilename, true, false);
1096 if SelectedCode=nil then begin
1097 debugln(['TCodeBrowserView.UseUnitInSrcEditor failed to load SelectedUnitFilename=',SelectedUnitFilename]);
1098 exit;
1099 end;
1100 SelectedUnitName:=CodeToolBoss.GetSourceName(SelectedCode, false);
1101
1102 // add unit to uses section
1103 if not CodeToolBoss.AddUnitToMainUsesSection(TargetCode, SelectedUnitName,'') then
1104 begin
1105 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor CodeToolBoss.'
1106 +'AddUnitToMainUsesSection failed: TargetCode=', TargetCode.Filename,
1107 ' SelectedUnitName=', SelectedUnitName]);
1108 LazarusIDE.DoJumpToCodeToolBossError;
1109 end;
1110
1111 // insert identifier
1112 if InsertIdentifier then begin
1113 if CodeMarker.Deleted then begin
1114 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor insert place was deleted']);
1115 exit;
1116 end;
1117 GetIdentStartEndAtPosition(Code.Source,CodeMarker.NewPosition,
1118 IdentStart,IdentEnd);
1119 Code.AbsoluteToLineCol(IdentStart,InsertStartPos.Y,InsertStartPos.X);
1120 InsertEndPos:=InsertStartPos;
1121 inc(InsertEndPos.X,IdentEnd-IdentStart);
1122 SrcEdit.ReplaceText(InsertStartPos,InsertEndPos,Identifier);
1123 end;
1124 finally
1125 List.Free;
1126 CodeMarker.Free;
1127 end;
1128 end;
1129
1130 procedure TCodeBrowserView.Work(var Done: Boolean);
1131 // do some work
1132 // This is called during OnIdle, so progress in small steps
1133 var
1134 OldStage: TCodeBrowserWorkStage;
1135 begin
1136 OldStage:=fStage;
1137 {$IFDEF VerboseCodeBrowser}
1138 debugln('TCodeBrowserView.Work ', fStage.ToString);
1139 {$ENDIF}
1140 case fStage of
1141 cbwsGetScopeOptions: WorkGetScopeOptions;
1142 cbwsGatherPackages: WorkGatherPackages;
1143 cbwsFreeUnusedPackages: WorkFreeUnusedPackages;
1144 cbwsAddNewPackages: WorkAddNewUnitLists;
1145 cbwsGatherFiles: WorkGatherFileLists;
1146 cbwsGatherOutdatedFiles: WorkGatherOutdatedFiles;
1147 cbwsUpdateUnits: WorkUpdateUnits;
1148 cbwsGetViewOptions: WorkGetViewOptions;
1149 cbwsUpdateTreeView: WorkUpdateTreeView;
1150 else
1151 FOptionsChangeStamp:=Options.ChangeStamp;
1152 UpdateNeeded:=false;
1153 Done:=true;
1154 ProgressBar1.Position:=ProgressTotal;
1155 ProgressBar1.Visible:=false;
1156 IdleConnected:=false;
1157 exit;
1158 end;
1159 if ord(OldStage)<ord(cbwsFinished) then begin
1160 Done:=false;
1161 ProgressBar1.Visible:=true;
1162 UpdateStatusBar(fStage<cbwsFinished);
1163 end;
1164 //if fStage=cbwsFinished then CodeToolBoss.WriteMemoryStats;
1165 end;
1166
1167 procedure TCodeBrowserView.WorkGetScopeOptions;
1168 var
1169 CurChangStamp: LongInt;
1170 begin
1171 DebugLn(['TCodeBrowserView.WorkGetScopeOptions START']);
1172 IdleTimer1.Enabled:=false;
1173
1174 ProgressBar1.Position:=ProgressGetScopeStart;
1175 CurChangStamp:=Options.ChangeStamp;
1176 Options.WithRequiredPackages:=ScopeWithRequiredPackagesCheckBox.Checked;
1177 Options.Scope:=ScopeComboBox.Text;
1178
1179 // this stage finished -> next stage
1180 if UpdateNeeded or (Options.ChangeStamp<>CurChangStamp) then
1181 fStage:=cbwsGatherPackages
1182 else
1183 fStage:=cbwsGetViewOptions;
1184 ProgressBar1.Position:=ProgressGetScopeStart+ProgressGetScopeSize;
1185 end;
1186
1187 procedure TCodeBrowserView.WorkGatherPackages;
1188
1189 procedure AddPackage(APackage: TLazPackage);
1190 begin
1191 TCodeBrowserUnitList.Create(APackage.Name,FWorkingParserRoot);
1192 end;
1193
1194 procedure AddPackages(FirstDependency: TPkgDependency);
1195 var
1196 List: TFPList;
1197 i: Integer;
1198 begin
1199 List:=nil;
1200 try
1201 PackageGraph.GetAllRequiredPackages(nil,FirstDependency,List);
1202 if (List=nil) then exit;
1203 for i:=0 to List.Count-1 do begin
1204 if TObject(List[i]) is TLazPackage then
1205 AddPackage(TLazPackage(List[i]));
1206 end;
1207 finally
1208 List.Free;
1209 end;
1210 end;
1211
1212 var
1213 APackage: TLazPackage;
1214 RootOwner: string;
1215 i: Integer;
1216 begin
1217 // clean up
1218 if fOutdatedFiles<>nil then fOutdatedFiles.Clear;
1219
1220 // find ParserRoot
1221 RootOwner:='';
1222 if Options.Scope=IDEDescription then begin
1223 RootOwner:=CodeBrowserIDEName;
1224 end else if Options.Scope=ProjectDescription then begin
1225 RootOwner:=CodeBrowserProjectName;
1226 end else begin
1227 APackage:=PackageGraph.FindPackageWithName(Options.Scope,nil);
1228 if APackage<>nil then
1229 RootOwner:=APackage.Name;
1230 end;
1231 DebugLn(['TCodeBrowserView.WorkGatherPackages RootOwner="',RootOwner,'"']);
1232 FreeAndNil(FWorkingParserRoot);
1233 FWorkingParserRoot:=TCodeBrowserUnitList.Create(RootOwner,nil);
1234
1235 // find required packages
1236 if Options.WithRequiredPackages then begin
1237 if SysUtils.CompareText(FWorkingParserRoot.Owner,CodeBrowserIDEName)=0 then begin
1238 for i:=0 to PackageGraph.Count-1 do
1239 AddPackage(PackageGraph[i]);
1240 end else if SysUtils.CompareText(FWorkingParserRoot.Owner,CodeBrowserProjectName)=0
1241 then begin
1242 AddPackages(Project1.FirstRequiredDependency);
1243 end else if FWorkingParserRoot.Owner<>'' then begin
1244 APackage:=PackageGraph.FindPackageWithName(FWorkingParserRoot.Owner,nil);
1245 if APackage<>nil then
1246 AddPackages(APackage.FirstRequiredDependency);
1247 end;
1248 end;
1249
1250 // update ParserRoot item (children will be updated on next Idle)
1251 if FParserRoot=nil then begin
1252 FParserRoot:=TCodeBrowserUnitList.Create(FWorkingParserRoot.Owner,nil);
1253 inc(FScannedPackages);
1254 end else begin
1255 FParserRoot.Owner:=FWorkingParserRoot.Owner;
1256 end;
1257
1258 // this stage finished -> next stage
1259 fStage:=cbwsFreeUnusedPackages;
1260 ProgressBar1.Position:=ProgressGatherPackagesStart+ProgressGatherPackagesSize;
1261 end;
1262
1263 procedure TCodeBrowserView.WorkFreeUnusedPackages;
1264
FindUnusedUnitListnull1265 function FindUnusedUnitList: TCodeBrowserUnitList;
1266 var
1267 Node: TAVLTreeNode;
1268 UnusedPackage: TCodeBrowserUnitList;
1269 PackageName: String;
1270 begin
1271 // find an unused package (a package in ParserRoot but not in WorkingParserRoot)
1272 Result:=nil;
1273 if (FParserRoot=nil) or (FParserRoot.UnitLists=nil) then exit;
1274 Node:=FParserRoot.UnitLists.FindLowest;
1275 while Node<>nil do begin
1276 UnusedPackage:=TCodeBrowserUnitList(Node.Data);
1277 PackageName:=UnusedPackage.Owner;
1278 if (FWorkingParserRoot=nil)
1279 or (FWorkingParserRoot.UnitLists=nil)
1280 or (FWorkingParserRoot.UnitLists.FindKey(Pointer(PackageName),
1281 @CompareAnsiStringWithUnitListOwner)=nil)
1282 then begin
1283 Result:=UnusedPackage;
1284 exit;
1285 end;
1286 Node:=FParserRoot.UnitLists.FindSuccessor(Node);
1287 end;
1288 end;
1289
1290 var
1291 UnusedPackage: TCodeBrowserUnitList;
1292 begin
1293 DebugLn(['TCodeBrowserView.WorkFreeUnusedPackages START']);
1294
1295 // find an unused package
1296 UnusedPackage:=FindUnusedUnitList;
1297 if UnusedPackage=nil then begin
1298 // this stage finished -> next stage
1299 fStage:=cbwsAddNewPackages;
1300 ProgressBar1.Position:=ProgressFreeUnusedPkgStart+ProgressFreeUnusedPkgSize;
1301 exit;
1302 end;
1303
1304 // free the unused package
1305 FreeUnitList(UnusedPackage);
1306 end;
1307
1308 procedure TCodeBrowserView.WorkAddNewUnitLists;
1309 var
1310 Node: TAVLTreeNode;
1311 List: TCodeBrowserUnitList;
1312 begin
1313 ProgressBar1.Position:=ProgressAddNewUnitListsStart;
1314 if (FWorkingParserRoot<>nil) and (FWorkingParserRoot.UnitLists<>nil)
1315 and (FParserRoot<>nil) then begin
1316 Node:=FWorkingParserRoot.UnitLists.FindLowest;
1317 while Node<>nil do begin
1318 List:=TCodeBrowserUnitList(Node.Data);
1319 if FParserRoot.FindUnitList(List.Owner)=nil then begin
1320 // new unit list
1321 TCodeBrowserUnitList.Create(List.Owner,FParserRoot);
1322 inc(FScannedPackages);
1323 end;
1324 Node:=FWorkingParserRoot.UnitLists.FindSuccessor(Node);
1325 end;
1326 end;
1327
1328 // this stage finished -> next stage
1329 fStage:=cbwsGatherFiles;
1330 ProgressBar1.Position:=ProgressAddNewUnitListsStart+ProgressAddNewUnitListsSize;
1331 end;
1332
1333 procedure TCodeBrowserView.WorkGatherFileLists;
1334
ListFilesAreValidnull1335 function ListFilesAreValid(List: TCodeBrowserUnitList): boolean;
1336 begin
1337 Result:=List.UnitsValid;
1338 end;
1339
FindListWithInvalidFileListnull1340 function FindListWithInvalidFileList(StartList: TCodeBrowserUnitList
1341 ): TCodeBrowserUnitList;
1342 var
1343 APackage: TCodeBrowserUnitList;
1344 Node: TAVLTreeNode;
1345 begin
1346 Result:=nil;
1347 if StartList=nil then exit;
1348 if not ListFilesAreValid(StartList) then begin
1349 Result:=StartList;
1350 exit;
1351 end;
1352 if (StartList.UnitLists=nil) then exit;
1353 Node:=StartList.UnitLists.FindLowest;
1354 while Node<>nil do begin
1355 APackage:=TCodeBrowserUnitList(Node.Data);
1356 Result:=FindListWithInvalidFileList(APackage);
1357 if Result<>nil then exit;
1358 Node:=StartList.UnitLists.FindSuccessor(Node);
1359 end;
1360 end;
1361
1362 var
1363 List: TCodeBrowserUnitList;
1364 begin
1365 DebugLn(['TCodeBrowserView.WorkGatherFiles START']);
1366 // find a unit list which needs update
1367 List:=FindListWithInvalidFileList(FParserRoot);
1368 if List=nil then begin
1369 // this stage finished -> next stage
1370 fStage:=cbwsGatherOutdatedFiles;
1371 ProgressBar1.Position:=ProgressGatherFileListsStart+ProgressGatherFileListsSize;
1372 exit;
1373 end;
1374
1375 WorkUpdateFileList(List);
1376 end;
1377
1378 procedure TCodeBrowserView.WorkUpdateFileList(List: TCodeBrowserUnitList);
1379 var
1380 NewFileList: TAVLTree;
1381
1382 procedure AddFile(const Filename: string; ClearIncludedByInfo: boolean);
1383 begin
1384 //DebugLn(['AddFile Filename="',Filename,'"']);
1385 if Filename='' then exit;
1386 if System.Pos('$',Filename)>0 then begin
1387 DebugLn(['WARNING: TCodeBrowserView.WorkUpdateFiles Macros in filename ',Filename]);
1388 exit;
1389 end;
1390 if NewFileList.FindKey(Pointer(Filename),@CompareAnsiStringWithUnitFilename)<>nil
1391 then exit;
1392 //DebugLn(['TCodeBrowserView.WorkUpdateFiles AddFile ',Filename]);
1393 NewFileList.Add(TCodeBrowserUnit.Create(Filename));
1394 if ClearIncludedByInfo then begin
1395 CodeToolBoss.SourceCache.ClearIncludedByEntry(Filename);
1396 end;
1397 end;
1398
1399 procedure AddFilesOfProject(AProject: TProject);
1400 var
1401 AnUnitInfo: TUnitInfo;
1402 begin
1403 if AProject=nil then exit;
1404 AnUnitInfo:=AProject.FirstPartOfProject;
1405 //DebugLn(['AddFilesOfProject ',AnUnitInfo<>nil]);
1406 while AnUnitInfo<>nil do begin
1407 //DebugLn(['AddFilesOfProject ',AnUnitInfo.Filename]);
1408 if FilenameIsPascalUnit(AnUnitInfo.Filename)
1409 or (AnUnitInfo=aProject.MainUnitInfo) then
1410 AddFile(AnUnitInfo.Filename,false);
1411 AnUnitInfo:=AnUnitInfo.NextPartOfProject;
1412 end;
1413 end;
1414
1415 procedure AddFilesOfPackageFCL;
1416 var
1417 LazDir: String;
1418 UnitSetID: string;
1419 UnitSetChanged: Boolean;
1420 UnitSet: TFPCUnitSetCache;
1421 Filename: String;
1422 ConfigCache: TPCTargetConfigCache;
1423 Node: TAVLTreeNode;
1424 Item: PStringToStringItem;
1425 begin
1426 // use unitset of the lazarus source directory
1427 LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
1428 if (LazDir='') or (not FilenameIsAbsolute(LazDir)) then exit;
1429 UnitSetID:=CodeToolBoss.GetUnitSetIDForDirectory(LazDir);
1430 if UnitSetID='' then exit;
1431 UnitSetChanged:=false;
1432 UnitSet:=CodeToolBoss.CompilerDefinesCache.FindUnitSetWithID(UnitSetID,
1433 UnitSetChanged,false);
1434 if UnitSet=nil then exit;
1435 ConfigCache:=UnitSet.GetConfigCache(false);
1436 if (ConfigCache=nil) or (ConfigCache.Units=nil) then exit;
1437 Node:=ConfigCache.Units.Tree.FindLowest;
1438 while Node<>nil do begin
1439 Item:=PStringToStringItem(Node.Data);
1440 Filename:=Item^.Value;
1441 if FilenameExtIs(Filename,'ppu',true) then begin
1442 // search source in fpc sources
1443 Filename:=UnitSet.GetUnitSrcFile(ExtractFileNameOnly(Filename));
1444 end;
1445 if FilenameIsPascalUnit(Filename) then
1446 AddFile(Filename,false);
1447 Node:=ConfigCache.Units.Tree.FindSuccessor(Node);
1448 end;
1449 end;
1450
1451 procedure AddFilesOfPackage(APackage: TLazPackage);
1452 var
1453 i: Integer;
1454 PkgFile: TPkgFile;
1455 aFilename: String;
1456 begin
1457 if APackage=nil then exit;
1458 for i:=0 to APackage.FileCount-1 do begin
1459 PkgFile:=APackage.Files[i];
1460 if (PkgFile.FileType in PkgFileUnitTypes) then begin
1461 aFilename:=PkgFile.GetFullFilename;
1462 if not FilenameIsPascalUnit(aFilename) then begin
1463 debugln(['WARNING: AddFilesOfPackage: package ',APackage.Filename,' has a unit with a non unit extension: ',aFilename]);
1464 end;
1465 AddFile(aFilename,true);
1466 end;
1467 end;
1468 if APackage.Name='FCL' then begin
1469 AddFilesOfPackageFCL;
1470 end;
1471 end;
1472
1473 procedure AddFilesOfDirectory(const Directory: string;
1474 ClearIncludedByInfo: boolean);
1475 // ! needs ending PathDelim !
1476 var
1477 FileInfo: TSearchRec;
1478 begin
1479 //DebugLn(['AddFilesOfDirectory Directory="',Directory,'"']);
1480 if (not FilenameIsAbsolute(Directory))
1481 or (not DirectoryExistsUTF8(Directory)) then begin
1482 DebugLn(['AddFilesOfDirectory WARNING: does not exist: "',Directory,'"']);
1483 exit;
1484 end;
1485 if FindFirstUTF8(Directory+FileMask,faAnyFile,FileInfo)=0 then begin
1486 repeat
1487 // check if special file
1488 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
1489 then
1490 continue;
1491 if FilenameIsPascalUnit(FileInfo.Name) then
1492 AddFile(Directory+FileInfo.Name,ClearIncludedByInfo);
1493 until FindNextUTF8(FileInfo)<>0;
1494 end;
1495 FindCloseUTF8(FileInfo);
1496 end;
1497
1498 procedure AddFilesOfSearchPath(const SrcPath, BaseDir: string;
1499 ClearIncludedByInfo: boolean);
1500 var
1501 Dir: String;
1502 p: Integer;
1503 begin
1504 //DebugLn(['AddFilesOfSearchPath SrcPath="',SrcPath,'" BaseDir="',BaseDir,'"']);
1505 p:=1;
1506 while (p<=length(SrcPath)) do begin
1507 Dir:=GetNextDelimitedItem(SrcPath,';',p);
1508 if Dir<>'' then begin
1509 if not FilenameIsAbsolute(Dir) then
1510 Dir:=BaseDir+PathDelim+Dir;
1511 Dir:=CleanAndExpandDirectory(Dir);
1512 AddFilesOfDirectory(Dir,ClearIncludedByInfo);
1513 end;
1514 end;
1515 end;
1516
1517 procedure AddFilesOfIDE;
1518 var
1519 LazDefines: TDefineTemplate;
1520 LazSrcDir: TDefineTemplate;
1521 LazIDEDir: TDefineTemplate;
1522 LazIDESrcPath: TDefineTemplate;
1523 SrcPath: String;
1524 LazDir: String;
1525 begin
1526 LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
1527 if not DirectoryExistsUTF8(LazDir) then begin
1528 DebugLn(['AddFilesOfIDE WARNING: lazarus directory not found: "',LazDir,'"']);
1529 exit;
1530 end;
1531 // get the SrcPath template of the lazarus/ide directory
1532 LazDefines:=CodeToolBoss.DefineTree
1533 .FindDefineTemplateByName(StdDefTemplLazarusSources,true);
1534 if LazDefines=nil then begin
1535 DebugLn(['AddFilesOfIDE WARNING: codetools define templates for lazarus not found']);
1536 exit;
1537 end;
1538 LazSrcDir:=LazDefines.FindChildByName(StdDefTemplLazarusSrcDir);
1539 if LazSrcDir=nil then begin
1540 DebugLn(['AddFilesOfIDE WARNING: codetools define templates for lazarus directory not found']);
1541 exit;
1542 end;
1543 LazIDEDir:=LazSrcDir.FindChildByName('ide');
1544 if LazIDEDir=nil then begin
1545 DebugLn(['AddFilesOfIDE WARNING: codetools define templates for lazarus ide directory not found']);
1546 exit;
1547 end;
1548 LazIDESrcPath:=LazIDEDir.FindChildByName('IDE path addition');
1549 if LazIDESrcPath=nil then begin
1550 DebugLn(['AddFilesOfIDE WARNING: codetools define templates for src path of lazarus ide directory not found']);
1551 exit;
1552 end;
1553 SrcPath:=StringReplace(LazIDESrcPath.Value,'$(#LazarusDir)',LazDir,
1554 [rfReplaceAll, rfIgnoreCase]);
1555 AddFilesOfSearchPath(SrcPath+';.',LazDir+'ide'+PathDelim,true);
1556 end;
1557
1558 procedure DeleteUnusedFiles;
1559 var
1560 Node: TAVLTreeNode;
1561 CurUnit: TCodeBrowserUnit;
1562 NextNode: TAVLTreeNode;
1563 begin
1564 if List.Units=nil then exit;
1565 Node:=List.Units.FindLowest;
1566 while Node<>nil do begin
1567 NextNode:=List.Units.FindSuccessor(Node);
1568 CurUnit:=TCodeBrowserUnit(Node.Data);
1569 if NewFileList.FindKey(Pointer(CurUnit.Filename),
1570 @CompareAnsiStringWithUnitFilename)=nil
1571 then begin
1572 // this unit is not part of List anymore -> delete
1573 RemoveUnit(CurUnit);
1574 List.DeleteUnit(CurUnit);
1575 end;
1576 Node:=NextNode;
1577 end;
1578 end;
1579
1580 procedure AddNewFiles;
1581 var
1582 Node: TAVLTreeNode;
1583 AnUnit: TCodeBrowserUnit;
1584 begin
1585 Node:=NewFileList.FindLowest;
1586 while Node<>nil do begin
1587 AnUnit:=TCodeBrowserUnit(Node.Data);
1588 //DebugLn(['AddNewFiles ',AnUnit.Filename,' exists=',List.FindUnit(AnUnit.Filename)<>nil]);
1589 if List.FindUnit(AnUnit.Filename)=nil then begin
1590 // this unit was not part of List -> add
1591 //DebugLn(['AddNewFiles "',List.Owner,'" "',AnUnit.Filename,'"']);
1592 List.AddUnit(AnUnit.Filename);
1593 end;
1594 Node:=NewFileList.FindSuccessor(Node);
1595 end;
1596 end;
1597
1598 var
1599 APackage: TLazPackage;
1600 begin
1601 DebugLn(['TCodeBrowserView.WorkUpdateFiles ',List.Owner]);
1602 NewFileList:=TAVLTree.Create(@CompareUnitFilenames);
1603 try
1604 // get new list of files
1605 if List.Owner=CodeBrowserIDEName then begin
1606 AddFilesOfIDE;
1607 end else if List.Owner=CodeBrowserProjectName then begin
1608 AddFilesOfProject(Project1);
1609 end else begin
1610 APackage:=PackageGraph.FindPackageWithName(List.Owner,nil);
1611 AddFilesOfPackage(APackage);
1612 end;
1613
1614 // update file list
1615 DeleteUnusedFiles;
1616 AddNewFiles;
1617
1618 List.UnitsValid:=true;
1619 finally
1620 NewFileList.FreeAndClear;
1621 NewFileList.Free;
1622 end;
1623 end;
1624
1625 procedure TCodeBrowserView.WorkGatherOutdatedFiles;
1626 // add all files to fOutdatedFiles
1627
1628 procedure AddFile(AnUnit: TCodeBrowserUnit);
1629 begin
1630 if fOutdatedFiles=nil then
1631 fOutdatedFiles:=TAVLTree.Create(@CompareUnitFilenames);
1632 if fOutdatedFiles.Find(AnUnit)<>nil then exit;
1633 fOutdatedFiles.Add(AnUnit);
1634 end;
1635
1636 procedure AddFiles(List: TCodeBrowserUnitList);
1637 var
1638 Node: TAVLTreeNode;
1639 begin
1640 if List.Units<>nil then begin
1641 Node:=List.Units.FindLowest;
1642 while Node<>nil do begin
1643 AddFile(TCodeBrowserUnit(Node.Data));
1644 Node:=List.Units.FindSuccessor(Node);
1645 end;
1646 end;
1647 if List.UnitLists<>nil then begin
1648 Node:=List.UnitLists.FindLowest;
1649 while Node<>nil do begin
1650 AddFiles(TCodeBrowserUnitList(Node.Data));
1651 Node:=List.UnitLists.FindSuccessor(Node);
1652 end;
1653 end;
1654 end;
1655
1656 begin
1657 if fOutdatedFiles<>nil then
1658 fOutdatedFiles.Clear;
1659 AddFiles(ParserRoot);
1660
1661 // this stage finished -> next stage
1662 fStage:=cbwsUpdateUnits;
1663 ProgressBar1.Position:=ProgressGatherOutdatedFilesStart+ProgressGatherOutdatedFilesSize;
1664 end;
1665
1666 procedure TCodeBrowserView.WorkUpdateUnits;
1667
FindOutdatedUnitnull1668 function FindOutdatedUnit: TCodeBrowserUnit;
1669 var
1670 Node: TAVLTreeNode;
1671 begin
1672 Result:=nil;
1673 if fOutdatedFiles=nil then exit;
1674 Node:=fOutdatedFiles.FindLowest;
1675 if Node=nil then exit;
1676 Result:=TCodeBrowserUnit(Node.Data);
1677 end;
1678
1679 const
1680 SmallTimeStep = (1/86400)/5;
1681 var
1682 AnUnit: TCodeBrowserUnit;
1683 StartTime: TDateTime;
1684 begin
1685 //DebugLn(['TCodeBrowserView.WorkUpdateUnits START']);
1686 CodeToolBoss.ActivateWriteLock;
1687 try
1688 // parse units
1689 StartTime:=Now;
1690 repeat
1691 AnUnit:=FindOutdatedUnit;
1692 if AnUnit=nil then begin
1693 // this stage finished -> next stage
1694 fStage:=cbwsGetViewOptions;
1695 ProgressBar1.Position:=ProgressUpdateUnitsStart+ProgressUpdateUnitsSize;
1696 exit;
1697 end;
1698
1699 WorkUpdateUnit(AnUnit);
1700 until Abs(Now-StartTime)>SmallTimeStep;
1701 finally
1702 CodeToolBoss.DeactivateWriteLock;
1703 end;
1704 end;
1705
1706 procedure TCodeBrowserView.WorkUpdateUnit(AnUnit: TCodeBrowserUnit);
1707
1708 procedure UpdateScannedCounters(Tool: TCodeTool);
1709 var
1710 LineCnt: Integer;
1711 ByteCnt: Integer;
1712 i: Integer;
1713 Link: TSourceLink;
1714 CodeBuf: TCodeBuffer;
1715 LastCode: TCodeBuffer;
1716 begin
1717 if (Tool=nil) or (Tool.Scanner=nil) then exit;
1718 LineCnt:=0;
1719 ByteCnt:=0;
1720 LastCode:=nil;
1721 for i:=0 to Tool.Scanner.LinkCount-1 do begin
1722 Link:=Tool.Scanner.Links[i];
1723 CodeBuf:=TCodeBuffer(Link.Code);
1724 if CodeBuf=nil then continue;
1725 if CodeBuf<>LastCode then begin
1726 inc(LineCnt,CodeBuf.LineCount);
1727 inc(ByteCnt,CodeBuf.SourceLength);
1728 LastCode:=CodeBuf;
1729 end;
1730 end;
1731 AnUnit.ScannedBytes:=ByteCnt;
1732 AnUnit.ScannedLines:=LineCnt;
1733 AnUnit.ScannedIdentifiers:=CountIdentifiers(Tool);
1734 AnUnit.CodeTool:=Tool;
1735 inc(FScannedBytes,AnUnit.ScannedBytes);
1736 inc(FScannedLines,AnUnit.ScannedLines);
1737 inc(FScannedIdentifiers,AnUnit.ScannedIdentifiers);
1738 //DebugLn(['UpdateScannedCounters ',ExtractFileName(AnUnit.Filename),' LineCnt=',LineCnt,' ByteCnt=',ByteCnt,' ',DbgSName(AnUnit.CodeTool)]);
1739 end;
1740
1741 var
1742 MainCodeBuf: TCodeBuffer;
1743 Tool: TCodeTool;
1744 begin
1745 //DebugLn(['TCodeBrowserView.WorkUpdateUnit START ',AnUnit.Filename]);
1746 // mark as updated
1747 fOutdatedFiles.Remove(AnUnit);
1748 // reset scanning counters
1749 if AnUnit.Scanned then begin
1750 dec(FScannedBytes,AnUnit.ScannedBytes);
1751 dec(FScannedLines,AnUnit.ScannedLines);
1752 dec(FScannedIdentifiers,AnUnit.ScannedIdentifiers);
1753 AnUnit.ScannedBytes:=0;
1754 AnUnit.ScannedLines:=0;
1755 AnUnit.ScannedIdentifiers:=0;
1756 dec(FScannedUnits);
1757 end;
1758 AnUnit.Scanned:=true;
1759 inc(FScannedUnits);
1760 // load the file
1761 AnUnit.CodeBuffer:=CodeToolBoss.LoadFile(AnUnit.Filename,false,false);
1762 if AnUnit.CodeBuffer=nil then exit;
1763 // check if this is a unit
1764 MainCodeBuf:=CodeToolBoss.GetMainCode(AnUnit.CodeBuffer);
1765 if MainCodeBuf<>AnUnit.CodeBuffer then begin
1766 // this file was used as an include file
1767 DebugLn(['TCodeBrowserView.WorkUpdateUnit HINT: this is not a unit: ',AnUnit.Filename,
1768 ' (it was included by ',MainCodeBuf.Filename,')']);
1769 exit;
1770 end;
1771 // scan
1772 CodeToolBoss.Explore(AnUnit.CodeBuffer,Tool,false,true);
1773 UpdateScannedCounters(Tool);
1774 //DebugLn(['TCodeBrowserView.WorkUpdateUnit END ',AnUnit.Filename]);
1775 end;
1776
1777 procedure TCodeBrowserView.WorkGetViewOptions;
1778 var
1779 NewLevels: TStringList;
1780 begin
1781 //DebugLn(['TCodeBrowserView.WorkGetViewOptions START']);
1782 Options.ShowPrivate:=ShowPrivateCheckBox.Checked;
1783 Options.ShowProtected:=ShowProtectedCheckBox.Checked;
1784 Options.ShowEmptyNodes:=ShowEmptyNodesCheckBox.Checked;
1785
1786 // levels
1787 NewLevels:=TStringList.Create;
1788 if ShowPackagesCheckBox.Checked then
1789 NewLevels.Add(CodeBrowserLevelNames[cblPackages]);
1790 if ShowUnitsCheckBox.Checked then
1791 NewLevels.Add(CodeBrowserLevelNames[cblUnits]);
1792 if ShowIdentifiersCheckBox.Checked then
1793 NewLevels.Add(CodeBrowserLevelNames[cblIdentifiers]);
1794 Options.Levels:=NewLevels;
1795 NewLevels.Free;
1796
1797 // level filter
1798 Options.LevelFilterText[cblPackages]:=PackageFilterEdit.Text;
1799 if PackageFilterBeginsSpeedButton.Down then
1800 Options.LevelFilterType[cblPackages]:=cbtfBegins;
1801 if PackageFilterContainsSpeedButton.Down then
1802 Options.LevelFilterType[cblPackages]:=cbtfContains;
1803
1804 Options.LevelFilterText[cblUnits]:=UnitFilterEdit.Text;
1805 //DebugLn(['TCodeBrowserView.WorkGetOptions UnitFIlter=',Options.LevelFilterText[cblUnits],' Edit=',UnitFilterEdit.Text]);
1806 if UnitFilterBeginsSpeedButton.Down then
1807 Options.LevelFilterType[cblUnits]:=cbtfBegins;
1808 if UnitFilterContainsSpeedButton.Down then
1809 Options.LevelFilterType[cblUnits]:=cbtfContains;
1810
1811 Options.LevelFilterText[cblIdentifiers]:=IdentifierFilterEdit.Text;
1812 if IdentifierFilterBeginsSpeedButton.Down then
1813 Options.LevelFilterType[cblIdentifiers]:=cbtfBegins;
1814 if IdentifierFilterContainsSpeedButton.Down then
1815 Options.LevelFilterType[cblIdentifiers]:=cbtfContains;
1816
1817 DebugLn(['TCodeBrowserView.WorkGetViewOptions UpdateNeeded=',UpdateNeeded,' ChangeStamp=',Options.ChangeStamp<>FOptionsChangeStamp]);
1818
1819 // this stage finished -> next stage
1820 if UpdateNeeded or (Options.ChangeStamp<>FOptionsChangeStamp) then
1821 fStage:=cbwsUpdateTreeView
1822 else
1823 fStage:=cbwsFinished;
1824 ProgressBar1.Position:=ProgressGetViewOptionsStart+ProgressGetViewOptionsSize;
1825 end;
1826
1827 procedure TCodeBrowserView.WorkUpdateTreeView;
1828 begin
1829 ProgressBar1.Position:=ProgressUpdateTreeViewStart;
1830 UpdateTreeView;
1831 // this stage finished -> next stage
1832 fStage:=cbwsFinished;
1833 ProgressBar1.Position:=ProgressUpdateTreeViewStart+ProgressUpdateTreeViewSize;
1834 end;
1835
1836 procedure TCodeBrowserView.FreeUnitList(List: TCodeBrowserUnitList);
1837 var
1838 Node: TAVLTreeNode;
1839 AnUnit: TCodeBrowserUnit;
1840 begin
1841 //DebugLn(['TCodeBrowserView.FreeUnitList ',List.Owner]);
1842 dec(FScannedPackages);
1843 if List.Units<>nil then begin
1844 Node:=List.Units.FindLowest;
1845 while Node<>nil do begin
1846 AnUnit:=TCodeBrowserUnit(Node.Data);
1847 RemoveUnit(AnUnit);
1848 Node:=List.Units.FindSuccessor(Node);
1849 end;
1850 end;
1851 List.Free;
1852 end;
1853
1854 procedure TCodeBrowserView.UpdateStatusBar(Lazy: boolean);
1855 const
1856 SmallTimeStep = 1/86400;
1857
BigIntToStrnull1858 function BigIntToStr(i: integer): string;
1859 var
1860 p: Integer;
1861 ThousandSep: String;
1862 begin
1863 if i=0 then begin
1864 Result:='0';
1865 exit;
1866 end;
1867 Result:='';
1868 if i>=100000 then begin
1869 i:=i div 1000;
1870 Result:='k';
1871 if i>=100000 then begin
1872 i:=i div 1000;
1873 Result:='m';
1874 if i>=100000 then begin
1875 i:=i div 1000;
1876 Result:='g';
1877 if i>=100000 then begin
1878 i:=i div 1000;
1879 Result:='t';
1880 end;
1881 end;
1882 end;
1883 end;
1884
1885 p:=0;
1886 ThousandSep:=AnsiToUTF8(DefaultFormatSettings.ThousandSeparator);
1887 while i>0 do begin
1888 if p=3 then begin
1889 Result:=ThousandSep+Result;
1890 p:=0;
1891 end;
1892 Result:=chr((i mod 10)+ord('0'))+Result;
1893 i:=i div 10;
1894 inc(p);
1895 end;
1896 end;
1897 var
1898 s: String;
1899 begin
1900 if Lazy and (Abs(Now-fLastStatusBarUpdate)<SmallTimeStep) then begin
1901 // the last update is not long ago
1902 // => skip update
1903 exit;
1904 end;
1905 fLastStatusBarUpdate:=Now;
1906 s:=Format(lisPackagesUnitsIdentifiersLinesBytes, [BigIntToStr(VisiblePackages)
1907 , BigIntToStr(ScannedPackages), BigIntToStr(VisibleUnits), BigIntToStr(
1908 ScannedUnits), BigIntToStr(VisibleIdentifiers), BigIntToStr(
1909 ScannedIdentifiers), BigIntToStr(ScannedLines), BigIntToStr(ScannedBytes)]);
1910 if fStage<>cbwsFinished then
1911 s:=Format(lisScanning2, [s]);
1912 StatusBar1.SimpleText:=s;
1913 end;
1914
TCodeBrowserView.GetCodeToolnull1915 function TCodeBrowserView.GetCodeTool(AnUnit: TCodeBrowserUnit): TStandardCodeTool;
1916 begin
1917 //DebugLn(['TCodeBrowserView.GetCodeTool ',AnUnit.CodeTool<>nil,' ',AnUnit.CodeBuffer<>nil]);
1918 Result:=AnUnit.CodeTool;
1919 if Result<>nil then exit;
1920 if AnUnit.CodeBuffer=nil then exit;
1921 Result:=CodeToolBoss.GetCodeToolForSource(AnUnit.CodeBuffer,true,false)
1922 as TCodeTool;
1923 AnUnit.CodeTool:=Result;
1924 //DebugLn(['TCodeBrowserView.GetCodeTool END ',AnUnit.Filename,' ',Result<>nil]);
1925 end;
1926
Shortennull1927 function Shorten(const s: string): string;
1928 const
1929 MAX_LEN=100;
1930 begin
1931 Result:=DbgStr(s);
1932 if Length(Result)>MAX_LEN then
1933 Result:=LeftStr(Result, MAX_LEN)+'...';
1934 end;
1935
1936 procedure TCodeBrowserView.GetNodeIdentifier(Tool: TStandardCodeTool;
1937 CTNode: TCodeTreeNode; out Identifier: string);
1938 begin
1939 if CTNode.StartPos>=CTNode.EndPos then begin
1940 Identifier:='';
1941 exit;
1942 end;
1943 case CTNode.Desc of
1944 ctnProcedure:
1945 begin
1946 Identifier:=Tool.ExtractProcName(CTNode,ProcIdentifierFlags);
1947 end;
1948 ctnVarDefinition:
1949 begin
1950 Identifier:=Tool.ExtractDefinitionName(CTNode);
1951 end;
1952 ctnConstDefinition:
1953 begin
1954 Identifier:=Tool.ExtractDefinitionName(CTNode);
1955 end;
1956 ctnTypeDefinition,ctnGenericType:
1957 begin
1958 Identifier:=Tool.ExtractDefinitionName(CTNode);
1959 end;
1960 ctnProperty:
1961 begin
1962 Identifier:=Tool.ExtractPropName(CTNode,false);
1963 end;
1964 ctnEnumIdentifier:
1965 begin
1966 Identifier:=Tool.ExtractIdentifier(CTNode.StartPos);
1967 end;
1968 end;
1969 end;
1970
1971 procedure TCodeBrowserView.GetNodeDescription(Tool: TStandardCodeTool;
1972 CTNode: TCodeTreeNode; Identifier: string; out Description: string);
1973 const
1974 NodeFlags = [];
1975 var
1976 Inheritance: String;
1977 begin
1978 if CTNode.StartPos>=CTNode.EndPos then begin
1979 Description:='';
1980 exit;
1981 end;
1982 case CTNode.Desc of
1983 ctnProcedure:
1984 begin
1985 Description:=Tool.ExtractProcHead(CTNode,ProcDescFlags);
1986 end;
1987 ctnVarDefinition:
1988 begin
1989 Description:='var '+Identifier
1990 +' : '+Shorten(Tool.ExtractDefinitionNodeType(CTNode));
1991 end;
1992 ctnConstDefinition:
1993 begin
1994 Description:='const '+Shorten(Tool.ExtractNode(CTNode,NodeFlags));
1995 end;
1996 ctnTypeDefinition,ctnGenericType:
1997 begin
1998 Description:='type '+Identifier;
1999 if CTNode.FirstChild<>nil then begin
2000 case CTNode.FirstChild.Desc of
2001 ctnClass,ctnClassInterface,ctnObject,
2002 ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,
2003 ctnCPPClass,
2004 ctnClassHelper,ctnRecordHelper,ctnTypeHelper:
2005 begin
2006 case CTNode.FirstChild.Desc of
2007 ctnClassInterface:
2008 Description:=Description+' = interface';
2009 ctnObject:
2010 Description:=Description+' = object';
2011 ctnObjCClass:
2012 Description:=Description+' = objcclass';
2013 ctnObjCCategory:
2014 Description:=Description+' = objccategory';
2015 ctnObjCProtocol:
2016 Description:=Description+' = objcprotocol';
2017 ctnCPPClass:
2018 Description:=Description+' = cppclass';
2019 ctnClassHelper:
2020 Description:=Description+' = class helper';
2021 ctnRecordHelper:
2022 Description:=Description+' = record helper';
2023 ctnTypeHelper:
2024 Description:=Description+' = type helper';
2025 else
2026 Description:=Description+' = class';
2027 end;
2028 Inheritance:=Tool.ExtractClassInheritance(CTNode.FirstChild,[]);
2029 if Inheritance<>'' then
2030 Description:=Description+'('+Inheritance+')';
2031 end;
2032 ctnRecordType:
2033 Description:=Description+' = record';
2034 end;
2035 end;
2036 end;
2037 ctnProperty:
2038 begin
2039 Description:='property '+Shorten(Tool.ExtractProperty(CTNode,PropDescFlags));
2040 end;
2041 ctnEnumIdentifier:
2042 begin
2043 Description:='enum '+Identifier;
2044 end;
2045 end;
2046 end;
2047
2048 procedure TCodeBrowserView.UpdateTreeView;
2049 var
2050 ShowPackages: boolean;
2051 ShowUnits: boolean;
2052 ShowIdentifiers: boolean;
2053 ShowPrivate: boolean;
2054 ShowProtected: boolean;
2055 ShowEmptyNodes: boolean;
2056 NewPackageCount: integer;
2057 NewUnitCount: integer;
2058 NewIdentifierCount, ShownIdentifierCount: PtrInt;
2059 UsedMem: PtrUInt;
2060
2061 LevelFilterText: array[TCodeBrowserLevel] of string;
2062 LevelFilterType: array[TCodeBrowserLevel] of TCodeBrowserTextFilter;
2063
IncUsedMemnull2064 function IncUsedMem(c: integer): boolean;
2065 begin
2066 Result:=(UsedMem div 16384)<>((UsedMem{%H-}+c) div 16384);
2067 {%H-}inc(UsedMem,c);
2068 end;
2069
IdentifierFitsFilternull2070 function IdentifierFitsFilter(LvlType: TCodeBrowserLevel;
2071 const Identifier: string): boolean;
2072 begin
2073 //DebugLn(['IdentifierFitsFilter Identifier=',Identifier,' Filter=',LevelFilterText[LvlType]]);
2074 if (LevelFilterText[LvlType]='') then exit(true);
2075 if Identifier='' then exit(false);
2076
2077 case LevelFilterType[LvlType] of
2078 cbtfBegins:
2079 Result:=ComparePrefixIdent(PChar(Pointer(LevelFilterText[LvlType])),
2080 PChar(Pointer(Identifier)));
2081 cbtfContains:
2082 begin
2083 Result:=IdentifierPos(PChar(Pointer(LevelFilterText[LvlType])),
2084 PChar(Pointer(Identifier)))>=0;
2085 //if Result then
2086 // debugln(['IdentifierFitsFilter Identifier="',Identifier,'" Filter="',LevelFilterText[LvlType],'"']);
2087 end
2088 else
2089 Result:=true;
2090 end;
2091 end;
2092
2093 procedure AddUnitNodes(SrcUnit: TCodeBrowserUnit; var DestUnit: TObject);
2094 var
2095 CTTool: TStandardCodeTool;
2096
2097 procedure AddChildNode(ParentBrowserNode: TCodeBrowserNode;
2098 CTNode: TCodeTreeNode);
2099 var
2100 NewChildNode: TCodeBrowserNode;
2101 ChildDescription, ChildIdentifier: string;
2102 NewCodePos: TCodePosition;
2103 begin
2104 if ShownIdentifierCount>=CodeBrowserMaxTVIdentifiers then exit;
2105
2106 if (CTNode.Parent.Desc=ctnClassPrivate) and (not ShowPrivate) then
2107 exit;
2108 if (CTNode.Parent.Desc=ctnClassProtected) and (not ShowProtected)
2109 then
2110 exit;
2111 GetNodeIdentifier(CTTool,CTNode,ChildIdentifier);
2112
2113 if IdentifierFitsFilter(cblIdentifiers,ChildIdentifier) then begin
2114 inc(ShownIdentifierCount);
2115 GetNodeDescription(CTTool,CTNode,ChildIdentifier,ChildDescription);
2116 NewChildNode:=ParentBrowserNode.AddNode(ChildDescription,ChildIdentifier);
2117 //DebugLn(['AddChildNode ',CTNode.DescAsString,' ',ChildDescription]);
2118 if NewChildNode<>nil then begin
2119 NewChildNode.Desc:=CTNode.Desc;
2120 CTTool.CleanPosToCodePos(CTNode.StartPos,NewCodePos);
2121 NewChildNode.CodePos:=NewCodePos;
2122 {$IFDEF VerboseCodeBrowser}
2123 if (length(ChildDescription)>1000) then
2124 debugln(['AddChildNode WARNING: big description ',SrcUnit.Filename,' desc=',ChildDescription]);
2125 if IncUsedMem(NewChildNode.GetMemSize) then
2126 debugln(['AddChildNode used mem ',UsedMem]);
2127 {$ENDIF}
2128 end;
2129 end;
2130 end;
2131
2132 procedure AddIdentifierNode(CTNode: TCodeTreeNode);
2133 var
2134 NewNode: TCodeBrowserNode;
2135 ChildCTNode: TCodeTreeNode;
2136 Description, Identifier: string;
2137 CurUnit: TCodeBrowserUnit;
2138 NewCodePos: TCodePosition;
2139 begin
2140 if not ShowIdentifiers then exit;
2141 if ShownIdentifierCount>CodeBrowserMaxTVIdentifiers then exit;
2142
2143 if DestUnit=nil then
2144 DestUnit:=TCodeBrowserUnit.Create('');
2145 CurUnit:=TCodeBrowserUnit(DestUnit);
2146 //DebugLn(['AddIdentifierNode ',CTNode.DescAsString]);
2147 GetNodeIdentifier(CTTool,CTNode,Identifier);
2148 NewNode:=CurUnit.AddNode('',Identifier);
2149 {$IFDEF VerboseCodeBrowser}
2150 if (length(Description)>100) then
2151 debugln(['AddIdentifierNode WARNING: big description ',CurUnit.Filename,' desc=',Description]);
2152 if IncUsedMem(NewNode.GetMemSize) then
2153 debugln(['AddIdentifierNode used mem ',UsedMem,' ',CurUnit.Filename,' ',CurUnit.ChildNodeCount]);
2154 {$ENDIF}
2155 NewNode.Desc:=CTNode.Desc;
2156 CTTool.CleanPosToCodePos(CTNode.StartPos,NewCodePos);
2157 NewNode.CodePos:=NewCodePos;
2158 //DebugLn(['AddIdentifierNode Code=',NewNode.CodePos.Code<>nil,' P=',NewNode.CodePos.P]);
2159
2160 if (CTNode.Desc in [ctnTypeDefinition,ctnGenericType])
2161 and (CTNode.FirstChild<>nil)
2162 and (CTNode.FirstChild.Desc in AllClasses+[ctnRecordType,ctnEnumerationType])
2163 then begin
2164 // add child nodes
2165 ChildCTNode:=CTNode.FirstChild;
2166 while (ChildCTNode<>nil) and (ChildCTNode.StartPos<CTNode.EndPos) do
2167 begin
2168 if ChildCTNode.Desc in
2169 [ctnProcedure,ctnVarDefinition,ctnProperty,ctnEnumIdentifier]
2170 then begin
2171 AddChildNode(NewNode,ChildCTNode);
2172 end;
2173 if ChildCTNode.Desc=ctnProcedureHead then
2174 ChildCTNode:=ChildCTNode.NextSkipChilds
2175 else
2176 ChildCTNode:=ChildCTNode.Next;
2177 end;
2178 end;
2179
2180 if (NewNode.ChildNodes=nil)
2181 and (not IdentifierFitsFilter(cblIdentifiers,Identifier)) then begin
2182 // identifier is not needed -> remove
2183 // ToDo: remove nodes later
2184 CurUnit.DeleteNode(NewNode);
2185 end else begin
2186 // keep node, set Description
2187 GetNodeDescription(CTTool,CTNode,Identifier,Description);
2188 NewNode.Description:=Description;
2189 inc(ShownIdentifierCount);
2190 end;
2191 end;
2192
2193 var
2194 CTNode: TCodeTreeNode;
2195 begin
2196 if SrcUnit=nil then exit;
2197 //DebugLn(['AddUnitNodes SrcUnit.Filename="',SrcUnit.Filename,'"']);
2198 CTTool:=GetCodeTool(SrcUnit);
2199 if CTTool=nil then exit;
2200 if CTTool.Tree=nil then exit;
2201
2202 CTNode:=CTTool.Tree.Root;
2203 while CTNode<>nil do begin
2204 //DebugLn(['AddUnitNodes ',CTNode.DescAsString]);
2205 case CTNode.Desc of
2206 ctnProcedure:
2207 if not CTTool.NodeIsMethodBody(CTNode) then
2208 AddIdentifierNode(CTNode);
2209 ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnGenericType:
2210 if not CTTool.NodeIsForwardDeclaration(CTNode) then
2211 AddIdentifierNode(CTNode);
2212 end;
2213
2214 // go to next node
2215 case CTNode.Desc of
2216 ctnProgram,ctnLibrary,ctnPackage,ctnUnit,ctnInterface,
2217 ctnTypeSection,ctnConstSection,ctnVarSection,ctnResStrSection:
2218 // go into child nodes
2219 CTNode:=CTNode.Next;
2220 ctnImplementation, ctnBeginBlock, ctnAsmBlock: break;
2221 else
2222 // skip children and go to next sibling or parent
2223 CTNode:=CTNode.NextSkipChilds;
2224 end;
2225 end;
2226 end;
2227
2228 procedure AddUnits(SrcList: TCodeBrowserUnitList; var DestParentList: TCodeBrowserUnitList);
2229 var
2230 Node: TAVLTreeNode;
2231 CurUnit, NewUnit: TCodeBrowserUnit;
2232 List, OldDestParentList: TCodeBrowserUnitList;
2233 begin
2234 if SrcList=nil then exit;
2235 //DebugLn(['AddUnits SrcList.Owner="',SrcList.Owner,'" HasUnits=',SrcList.Units<>nil]);
2236 if SrcList.Units=nil then exit;
2237 OldDestParentList:=DestParentList;
2238 NewUnit:=nil;
2239 Node:=SrcList.Units.FindLowest;
2240 while Node<>nil do begin
2241 CurUnit:=TCodeBrowserUnit(Node.Data);
2242 if (CurUnit.Filename='')
2243 or IdentifierFitsFilter(cblUnits,ExtractFileNameOnly(CurUnit.Filename))
2244 then begin
2245 if DestParentList=nil then
2246 DestParentList:=TCodeBrowserUnitList.Create(CodeBrowserHidden,nil);
2247 List:=DestParentList;
2248 if ShowUnits then begin
2249 // create a unit node
2250 NewUnit:=List.AddUnit(CurUnit.Filename);
2251 NewUnit.CodeBuffer:=CurUnit.CodeBuffer;
2252 NewUnit.CodeTool:=CurUnit.CodeTool;
2253 end else if NewUnit=nil then begin
2254 // create a dummy unit node to add all identifiers
2255 NewUnit:=List.FindUnit('');
2256 if NewUnit=nil then
2257 NewUnit:=List.AddUnit('');
2258 end;
2259 //DebugLn(['AddUnits AddUnitNodes ',CurUnit.Filename]);
2260 AddUnitNodes(CurUnit,TObject(NewUnit));
2261 if (not ShowEmptyNodes) and (NewUnit.ChildNodeCount=0) then begin
2262 // remove empty unit
2263 List.DeleteUnit(NewUnit);
2264 NewUnit:=nil;
2265 if OldDestParentList=nil then begin
2266 FreeAndNil(DestParentList);
2267 end;
2268 end;
2269 if (NewUnit<>nil) and (NewUnit.UnitList=nil) and (List<>nil) then
2270 List.AddUnit(NewUnit);
2271 end;
2272 Node:=SrcList.Units.FindSuccessor(Node);
2273 end;
2274 end;
2275
2276 procedure AddUnitLists(SrcList: TCodeBrowserUnitList;
2277 var DestParentList: TCodeBrowserUnitList);
2278 var
2279 Node: TAVLTreeNode;
2280 SubList, NewList, OldDestParentList: TCodeBrowserUnitList;
2281 NewListCreated, CreateNode: Boolean;
2282 begin
2283 if SrcList=nil then exit;
2284 //DebugLn(['AddUnitLists SrcList.Owner="',SrcList.Owner,'"']);
2285
2286 OldDestParentList:=DestParentList;
2287
2288 // check filter
2289 CreateNode:=IdentifierFitsFilter(cblPackages,SrcList.Owner);
2290
2291 // create node
2292 NewListCreated:=false;
2293 NewList:=Nil;
2294 if CreateNode then begin
2295 if ShowPackages then begin
2296 if DestParentList=nil then
2297 DestParentList:=TCodeBrowserUnitList.Create(CodeBrowserHidden,nil);
2298 NewList:=TCodeBrowserUnitList.Create(SrcList.Owner,DestParentList);
2299 NewListCreated:=true;
2300 end else
2301 NewList:=DestParentList;
2302 end;
2303 // create nodes for unitlists
2304 if SrcList.UnitLists<>nil then begin
2305 Node:=SrcList.UnitLists.FindLowest;
2306 while Node<>nil do begin
2307 SubList:=TCodeBrowserUnitList(Node.Data);
2308 AddUnitLists(SubList,DestParentList);// DestParentList because: as sibling not as child!
2309 Node:=SrcList.UnitLists.FindSuccessor(Node);
2310 end;
2311 end;
2312 if CreateNode then begin
2313 // create nodes for units
2314 AddUnits(SrcList,NewList);
2315 // remove empty unit lists
2316 if (not ShowEmptyNodes) and NewListCreated and (NewList.IsEmpty) then begin
2317 //DebugLn(['AddUnitLists EMPTY ',NewList.Owner,' ',NewList.UnitListCount,' ',NewList.UnitCount]);
2318 if DestParentList=NewList then
2319 DestParentList:=nil;
2320 FreeAndNil(NewList);
2321 if (OldDestParentList=nil) and (DestParentList<>nil) and DestParentList.IsEmpty then
2322 FreeAndNil(DestParentList);
2323 end;
2324 // update DestParentList
2325 if (DestParentList=nil) then
2326 DestParentList:=NewList;
2327 end;
2328 end;
2329
2330 procedure AddTreeNodes(CodeNode: TObject; ParentViewNode: TTreeNode);
2331 var
2332 TVNode: TTreeNode;
2333
2334 procedure RecursiveAdd(Tree: TAVLTree);
2335 var
2336 Node: TAVLTreeNode;
2337 begin
2338 if Tree<>nil then begin
2339 Node:=Tree.FindLowest;
2340 while Node<>nil do begin
2341 AddTreeNodes(TObject(Node.Data), TVNode);
2342 Node:=Tree.FindSuccessor(Node);
2343 end;
2344 end;
2345 end;
2346
2347 {off $DEFINE DisableTreeViewNodes}
2348 procedure AddToTreeView(Name: String);
2349 begin
2350 {$IFNDEF DisableTreeViewNodes}
2351 TVNode:=BrowseTreeView.Items.AddChildObject(
2352 ParentViewNode, Name, CodeNode);
2353 TVNode.ImageIndex:=GetNodeImage(CodeNode);
2354 TVNode.SelectedIndex:=TVNode.ImageIndex;
2355 {$ENDIF}
2356 end;
2357
2358 // create visual nodes (TTreeNode)
2359 var
2360 CurList: TCodeBrowserUnitList;
2361 CurListName: String;
2362 CurUnit: TCodeBrowserUnit;
2363 CurUnitName: String;
2364 CurTool: TStandardCodeTool;
2365 CurNode: TCodeBrowserNode;
2366 ExpandParent: Boolean;
2367 begin
2368 if CodeNode=nil then exit;
2369 ExpandParent:=true;
2370 //DebugLn(['AddTreeNodes ',DbgSName(CodeNode)]);
2371 TVNode:=ParentViewNode;
2372
2373 if CodeNode is TCodeBrowserUnitList then begin
2374 CurList:=TCodeBrowserUnitList(CodeNode);
2375 //DebugLn(['AddTreeNodes ',CurList.Owner]);
2376 if CurList.Owner=CodeBrowserHidden then begin
2377 TVNode:=ParentViewNode;
2378 end else begin
2379 CurListName:=ListOwnerToText(CurList.Owner);
2380 inc(NewPackageCount);
2381 AddToTreeView(CurListName);
2382 end;
2383 RecursiveAdd(CurList.UnitLists);
2384 RecursiveAdd(CurList.Units);
2385 end
2386 else if CodeNode is TCodeBrowserUnit then begin
2387 CurUnit:=TCodeBrowserUnit(CodeNode);
2388 CurTool:=nil;
2389 if CurUnit.Filename<>'' then
2390 CurTool:=GetCodeTool(CurUnit);
2391 if CurTool<>nil then begin
2392 // add a tree node for this unit
2393 CurUnitName:=TCodeTool(CurTool).GetCachedSourceName;
2394 if CurUnitName='' then
2395 CurUnitName:=ExtractFileNameOnly(CurTool.MainFilename);
2396 inc(NewUnitCount);
2397 AddToTreeView(CurUnitName);
2398 end else begin
2399 // do not add a tree node for this unit
2400 TVNode:=ParentViewNode;
2401 end;
2402 // create tree nodes for code nodes
2403 RecursiveAdd(CurUnit.ChildNodes);
2404 end
2405 else if CodeNode is TCodeBrowserNode then begin
2406 CurNode:=TCodeBrowserNode(CodeNode);
2407 if CurNode.Description<>'' then begin
2408 inc(NewIdentifierCount);
2409 //if (NewIdentifierCount mod 100)=0 then
2410 // DebugLn(['AddTreeNodes ',NewIdentifierCount,' ',CurNode.Description]);
2411 AddToTreeView(CurNode.Description);
2412 // create tree nodes for child code nodes
2413 RecursiveAdd(CurNode.ChildNodes);
2414 // do not expand unit nodes
2415 if (ParentViewNode<>nil)
2416 and (TObject(ParentViewNode.Data) is TCodeBrowserUnit) then
2417 ExpandParent:=false;
2418 end;
2419 end;
2420 if ParentViewNode<>nil then
2421 ParentViewNode.Expanded:=ExpandParent;
2422 end;
2423
2424 var
2425 lvl: TCodeBrowserLevel;
2426 i: Integer;
2427 begin
2428 UsedMem:=0;
2429 ShowPackages:=Options.HasLevel(cblPackages);
2430 ShowUnits:=Options.HasLevel(cblUnits);
2431 ShowIdentifiers:=Options.HasLevel(cblIdentifiers);
2432 ShowPrivate:=Options.ShowPrivate;
2433 ShowProtected:=Options.ShowProtected;
2434 ShowEmptyNodes:=Options.ShowEmptyNodes;
2435 NewPackageCount:=0;
2436 NewUnitCount:=0;
2437 NewIdentifierCount:=0;
2438 ShownIdentifierCount:=0;
2439
2440 for lvl:=Low(TCodeBrowserLevel) to High(TCodeBrowserLevel) do begin
2441 LevelFilterText[lvl]:=Options.LevelFilterText[lvl];
2442 LevelFilterType[lvl]:=Options.LevelFilterType[lvl];
2443 debugln(['TCodeBrowserView.UpdateTreeView lvl=',ord(lvl),' type=',ord(LevelFilterType[lvl]),' filter="',LevelFilterText[lvl],'"']);
2444 end;
2445
2446 //DebugLn(['TCodeBrowserView.UpdateTreeView ShowPackages=',ShowPackages,' ShowUnits=',ShowUnits,' ShowIdentifiers=',ShowIdentifiers]);
2447
2448 BrowseTreeView.Cursor:=crHourGlass;
2449 BrowseTreeView.BeginUpdate;
2450 CodeToolBoss.ActivateWriteLock;
2451 try
2452 InitTreeView;
2453
2454 // create internal nodes
2455 AddUnitLists(ParserRoot,fViewRoot);
2456
2457 // create treeview nodes
2458 AddTreeNodes(ViewRoot,nil);
2459
2460 // if there are only a few items expand the whole tree
2461 if BrowseTreeView.Items.Count<30 then
2462 for i:=0 to BrowseTreeView.Items.TopLvlCount-1 do
2463 BrowseTreeView.Items.TopLvlItems[i].Expand(true);
2464 finally
2465 CodeToolBoss.DeactivateWriteLock;
2466 //DebugLn(['TCodeBrowserView.UpdateTreeView EndUpdate']);
2467 BrowseTreeView.EndUpdate;
2468 //DebugLn(['TCodeBrowserView.UpdateTreeView AFER ENDUPDATE']);
2469 BrowseTreeView.Cursor:=crDefault;
2470 end;
2471 VisiblePackages:=NewPackageCount;
2472 VisibleUnits:=NewUnitCount;
2473 VisibleIdentifiers:=NewIdentifierCount;
2474 UpdateStatusBar(false);
2475 end;
2476
2477 procedure TCodeBrowserView.RemoveUnit(AnUnit: TCodeBrowserUnit);
2478 begin
2479 if AnUnit.Scanned then begin
2480 dec(FScannedUnits);
2481 dec(FScannedLines,AnUnit.ScannedLines);
2482 dec(FScannedBytes,AnUnit.ScannedBytes);
2483 dec(FScannedIdentifiers,AnUnit.ScannedIdentifiers);
2484 AnUnit.Scanned:=false;
2485 if fOutdatedFiles<>nil then
2486 fOutdatedFiles.Remove(AnUnit);
2487 end;
2488 end;
2489
CountIdentifiersnull2490 function TCodeBrowserView.CountIdentifiers(Tool: TCodeTool): integer;
2491 var
2492 Node: TCodeTreeNode;
2493 begin
2494 Result:=0;
2495 if (Tool=nil) or (Tool.Tree=nil) then exit;
2496 Node:=Tool.Tree.Root;
2497 while Node<>nil do begin
2498 if Node.Desc=ctnImplementation then break;
2499 if (Node.Desc in (AllIdentifierDefinitions+[ctnProcedure,ctnProperty]))
2500 and (not Tool.NodeIsForwardDeclaration(Node)) then
2501 inc(Result);
2502 if not (Node.Desc in [ctnProcedure,ctnBeginBlock,ctnAsmBlock]) then
2503 Node:=Node.Next
2504 else
2505 Node:=Node.NextSkipChilds;
2506 end;
2507 end;
2508
2509 procedure TCodeBrowserView.ClearTreeView;
2510 begin
2511 BrowseTreeView.Items.Clear;
2512 FreeAndNil(FViewRoot);
2513 end;
2514
2515 procedure TCodeBrowserView.InitTreeView;
2516 begin
2517 ClearTreeView;
2518 end;
2519
ListOwnerToTextnull2520 function TCodeBrowserView.ListOwnerToText(const ListOwner: string): string;
2521 begin
2522 if ListOwner=CodeBrowserIDEName then
2523 Result:=IDEDescription
2524 else if ListOwner=CodeBrowserProjectName then
2525 Result:=ProjectDescription
2526 else
2527 Result:=ListOwner;
2528 end;
2529
GetNodeImagenull2530 function TCodeBrowserView.GetNodeImage(CodeNode: TObject): integer;
2531 var
2532 List: TCodeBrowserUnitList;
2533 Node: TCodeBrowserNode;
2534 begin
2535 Result:=ImgIDDefault;
2536
2537 if CodeNode is TCodeBrowserUnit then begin
2538 Result:=ImgIDUnitCode;
2539 end else if CodeNode is TCodeBrowserUnitList then begin
2540 List:=TCodeBrowserUnitList(CodeNode);
2541 if List.Owner=IDEDescription then
2542 Result:=ImgIDProject
2543 else if List.Owner=ProjectDescription then
2544 Result:=ImgIDProject
2545 else
2546 Result:=ImgIDPackage;
2547 end else if CodeNode is TCodeBrowserNode then begin
2548 Node:=TCodeBrowserNode(CodeNode);
2549 case Node.Desc of
2550 ctnProgram,ctnLibrary,ctnPackage:
2551 Result:=ImgIDProgramCode;
2552 ctnUnit:
2553 Result:=ImgIDUnitCode;
2554 ctnInterface:
2555 Result:=ImgIDInterfaceSection;
2556 ctnImplementation:
2557 Result:=ImgIDImplementation;
2558 ctnInitialization:
2559 Result:=ImgIDInitialization;
2560 ctnFinalization:
2561 Result:=ImgIDFinalization;
2562 ctnTypeSection:
2563 Result:=ImgIDTypeSection;
2564 ctnTypeDefinition,ctnGenericType:
2565 Result:=ImgIDType;
2566 ctnVarSection:
2567 Result:=ImgIDVarSection;
2568 ctnVarDefinition:
2569 Result:=ImgIDVariable;
2570 ctnConstSection,ctnResStrSection:
2571 Result:=ImgIDConstSection;
2572 ctnConstDefinition:
2573 Result:=ImgIDConst;
2574 ctnClass,ctnObject,ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,ctnCPPClass:
2575 Result:=ImgIDClass;
2576 ctnProcedure:
2577 Result:=ImgIDProc;
2578 ctnProperty:
2579 Result:=ImgIDProperty;
2580 end;
2581 end;
2582 end;
2583
TCodeBrowserView.GetTVNodeHintnull2584 function TCodeBrowserView.GetTVNodeHint(TVNode: TTreeNode): string;
2585 var
2586 NodeData: TObject;
2587 CurUnit: TCodeBrowserUnit;
2588 Node: TCodeBrowserNode;
2589 Line, Column: integer;
2590 BaseURL, HTMLHint: String;
2591 begin
2592 Result:='';
2593 if (TVNode=nil) or (TVNode.Data=nil) then exit;
2594 NodeData:=TObject(TVNode.Data);
2595 //DebugLn(['TCodeBrowserView.GetTVNodeHint ',DbgSName(NodeData)]);
2596 if NodeData is TCodeBrowserUnitList then begin
2597
2598 end else if NodeData is TCodeBrowserUnit then begin
2599 CurUnit:=TCodeBrowserUnit(NodeData);
2600 if CurUnit.Filename<>'' then
2601 Result:=TVNode.Text+LineEnding+CurUnit.Filename;
2602 end else if NodeData is TCodeBrowserNode then begin
2603 Node:=TCodeBrowserNode(NodeData);
2604 if Node.CodePos.Code<>nil then begin
2605 Result:=TVNode.Text+LineEnding+Node.CodePos.Code.Filename;
2606 Node.CodePos.Code.AbsoluteToLineCol(Node.CodePos.P,Line,Column);
2607 if Line>0 then
2608 Result:=Result+' ('+IntToStr(Line)+','+IntToStr(Column)+')';
2609 if GetCodeHelp(TVNode, BaseURL, HTMLHint) then
2610 Result := HTMLHint;
2611 end;
2612 end;
2613 end;
2614
GetCodeHelpnull2615 function TCodeBrowserView.GetCodeHelp(TVNode: TTreeNode; out BaseURL,
2616 HTMLHint: string): boolean;
2617 var
2618 NodeData: TObject;
2619 Node: TCodeBrowserNode;
2620 Tool: TCodeTool;
2621 CleanPos: integer;
2622 CTNode: TCodeTreeNode;
2623 NewCodePos: TCodeXYPosition;
2624 begin
2625 Result:=false;
2626 BaseURL:='';
2627 HTMLHint:='';
2628 if (TVNode=nil) or (TVNode.Data=nil) then exit;
2629 NodeData:=TObject(TVNode.Data);
2630 if NodeData is TCodeBrowserNode then begin
2631 Node:=TCodeBrowserNode(NodeData);
2632 if Node.CodePos.Code=nil then exit;
2633 if not LazarusIDE.BeginCodeTools then // commit source editor changes to codetools
2634 exit;
2635 // parse unit
2636 CodeToolBoss.Explore(Node.CodePos.Code,Tool,false,false);
2637 if Tool=nil then exit;
2638 // find source position in parsed code
2639 if Tool.CodePosToCleanPos(Node.CodePos,CleanPos)<>0 then exit;
2640 // find node
2641 CTNode:=Tool.FindDeepestNodeAtPos(CleanPos,false);
2642 if (CTNode=nil) or (CTNode.Desc<>Node.Desc) then
2643 exit; // source has changed
2644
2645 // find cleanpos of identifier
2646 case CTNode.Desc of
2647 ctnProcedure:
2648 begin
2649 if SysUtils.CompareText(Tool.ExtractProcName(CTNode,ProcIdentifierFlags),
2650 Node.Identifier)<>0
2651 then
2652 exit; // source has changed
2653 Tool.MoveCursorToProcName(CTNode,true);
2654 CleanPos:=Tool.CurPos.StartPos;
2655 end;
2656 ctnProperty:
2657 begin
2658 if SysUtils.CompareText(Tool.ExtractPropName(CTNode,false),Node.Identifier)<>0
2659 then
2660 exit; // source has changed
2661 Tool.MoveCursorToPropName(CTNode);
2662 CleanPos:=Tool.CurPos.StartPos;
2663 end;
2664 ctnGenericType:
2665 begin
2666 Tool.ExtractDefinitionName(CTNode);
2667 if CTNode.FirstChild<>nil then
2668 CleanPos:=CTNode.FirstChild.StartPos;
2669 if SysUtils.CompareText(Tool.ExtractIdentifier(CleanPos),Node.Identifier)<>0
2670 then
2671 exit; // source has changed
2672 end;
2673 ctnVarDefinition,ctnTypeDefinition,ctnConstDefinition,
2674 ctnEnumIdentifier:
2675 if SysUtils.CompareText(Tool.ExtractIdentifier(CleanPos),Node.Identifier)<>0
2676 then
2677 exit; // source has changed
2678 else
2679 exit;
2680 end;
2681
2682 // get source position
2683 if not Tool.CleanPosToCaret(CleanPos,NewCodePos) then exit;
2684
2685 // ask the help system about the identifier
2686 if LazarusHelp.GetHintForSourcePosition(NewCodePos.Code.Filename,
2687 Point(NewCodePos.X,NewCodePos.Y),BaseURL,HTMLHint)<>shrSuccess then exit;
2688
2689 if HTMLHint <> '' then
2690 Result:=true;
2691 end;
2692 end;
2693
2694 procedure TCodeBrowserView.ExpandCollapseAllNodesInTreeView(
2695 NodeType: TExpandableNodeType; Expand: boolean);
2696 var
2697 Node: TTreeNode;
2698 begin
2699 BrowseTreeView.BeginUpdate;
2700 Node:=BrowseTreeView.Items.GetFirstNode;
2701 while Node<>nil do begin
2702 if (Node.Data<>nil) then begin
2703 case NodeType of
2704 entPackage:
2705 if TObject(Node.Data) is TCodeBrowserUnitList then
2706 Node.Expanded:=Expand;
2707 entUnit:
2708 if TObject(Node.Data) is TCodeBrowserUnit then
2709 Node.Expanded:=Expand;
2710 entClass:
2711 if (TObject(Node.Data) is TCodeBrowserNode) then
2712 Node.Expanded:=Expand;
2713 end;
2714 end;
2715 Node:=Node.GetNext;
2716 end;
2717 BrowseTreeView.EndUpdate;
2718 end;
2719
2720 procedure TCodeBrowserView.CopyNode(TVNode: TTreeNode; NodeType: TCopyNodeType);
2721 var
2722 Node: TCodeBrowserNode;
2723 s: string;
2724 begin
2725 if (TVNode=nil) or (TVNode.Data=nil) then exit;
2726 s:='';
2727 if TObject(TVNode.Data) is TCodeBrowserUnitList then begin
2728 s:=TVNode.Text;
2729 end;
2730 if TObject(TVNode.Data) is TCodeBrowserUnit then begin
2731 s:=TVNode.Text;
2732 end;
2733 if (TObject(TVNode.Data) is TCodeBrowserNode) then begin
2734 Node:=TCodeBrowserNode(TVNode.Data);
2735 if NodeType=cntIdentifier then
2736 s:=Node.Identifier
2737 else
2738 s:=Node.Description;
2739 end;
2740 Clipboard.AsText:=s;
2741 end;
2742
2743 procedure TCodeBrowserView.InvalidateStage(AStage: TCodeBrowserWorkStage);
2744 begin
2745 if ord(fStage)<=ord(AStage) then exit;
2746 fStage:=AStage;
2747 IdleConnected:=true;
2748 end;
2749
GetSelectedUnitnull2750 function TCodeBrowserView.GetSelectedUnit: TCodeBrowserUnit;
2751 var
2752 TVNode: TTreeNode;
2753 Node: TObject;
2754 begin
2755 Result:=nil;
2756 TVNode:=BrowseTreeView.Selected;
2757 if TVNode=nil then exit;
2758 Node:=TObject(TVNode.Data);
2759 if Node=nil then exit;
2760 if not (Node is TCodeBrowserUnit) then exit;
2761 Result:=TCodeBrowserUnit(Node);
2762 end;
2763
TCodeBrowserView.GetSelectedPackagenull2764 function TCodeBrowserView.GetSelectedPackage: TLazPackage;
2765 var
2766 TVNode: TTreeNode;
2767 Node: TObject;
2768 UnitList: TCodeBrowserUnitList;
2769 begin
2770 Result:=nil;
2771 TVNode:=BrowseTreeView.Selected;
2772 if TVNode=nil then exit;
2773 Node:=TObject(TVNode.Data);
2774 if Node=nil then exit;
2775 if not (Node is TCodeBrowserUnitList) then exit;
2776 UnitList:=TCodeBrowserUnitList(Node);
2777 Result:=PackageGraph.FindPackageWithName(UnitList.Owner,nil);
2778 end;
2779
GetCurUnitInSrcEditornull2780 function TCodeBrowserView.GetCurUnitInSrcEditor(out FileOwner: TObject; out
2781 UnitCode: TCodeBuffer): boolean;
2782 var
2783 SrcEdit: TSourceEditorInterface;
2784 Code: TCodeBuffer;
2785 Owners: TFPList;
2786 begin
2787 FileOwner:=nil;
2788 UnitCode:=nil;
2789 Result:=false;
2790 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2791 if SrcEdit=nil then exit;
2792 Code:=CodeToolBoss.GetMainCode(TCodeBuffer(SrcEdit.CodeToolsBuffer));
2793 if Code=nil then exit;
2794 Owners:=PkgBoss.GetOwnersOfUnit(Code.FileName);
2795 try
2796 if (Owners=nil) or (Owners.Count=0) then exit;
2797 FileOwner:=TObject(Owners[0]);
2798 UnitCode:=Code;
2799 Result:=true;
2800 finally
2801 Owners.Free;
2802 end;
2803 end;
2804
GetCurPackageInSrcEditornull2805 function TCodeBrowserView.GetCurPackageInSrcEditor: TLazPackage;
2806 var
2807 SrcEdit: TSourceEditorInterface;
2808 Owners: TFPList;
2809 i: Integer;
2810 begin
2811 Result:=nil;
2812 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2813 if SrcEdit=nil then exit;
2814 Owners:=PkgBoss.GetOwnersOfUnit(SrcEdit.FileName);
2815 try
2816 if (Owners=nil) then exit;
2817 for i:=0 to Owners.Count-1 do begin
2818 if TObject(Owners[i]) is TLazPackage then begin
2819 Result:=TLazPackage(Owners[i]);
2820 exit;
2821 end;
2822 end;
2823 finally
2824 Owners.Free;
2825 end;
2826 end;
2827
2828 procedure TCodeBrowserView.OpenTVNode(TVNode: TTreeNode);
2829 var
2830 NodeData: TObject;
2831 List: TCodeBrowserUnitList;
2832 APackage: TLazPackage;
2833 CurUnit: TCodeBrowserUnit;
2834 Node: TCodeBrowserNode;
2835 Line,Column: integer;
2836 begin
2837 if (TVNode=nil) or (TVNode.Data=nil) then exit;
2838 NodeData:=TObject(TVNode.Data);
2839 if NodeData is TCodeBrowserUnitList then begin
2840 List:=TCodeBrowserUnitList(NodeData);
2841 DebugLn(['TCodeBrowserView.OpenSelected "',List.Owner,'=',CodeBrowserProjectName,'"']);
2842 if List.Owner=CodeBrowserProjectName then begin
2843 // open project inspector
2844 DebugLn(['TCodeBrowserView.OpenSelected open project inspector']);
2845 ExecuteIDECommand(Self,ecProjectInspector);
2846 end else if List.Owner=CodeBrowserIDEName then begin
2847 // open the IDE -> already open
2848 end else if List.Owner=CodeBrowserHidden then begin
2849 // nothing
2850 end else begin
2851 // open package
2852 APackage:=PackageGraph.FindPackageWithName(List.Owner,nil);
2853 if APackage<>nil then begin
2854 PackageEditingInterface.DoOpenPackageWithName(List.Owner,[],false);
2855 end;
2856 end;
2857 end else if NodeData is TCodeBrowserUnit then begin
2858 CurUnit:=TCodeBrowserUnit(NodeData);
2859 if CurUnit.Filename<>'' then begin
2860 LazarusIDE.DoOpenEditorFile(CurUnit.Filename,-1,-1,[ofOnlyIfExists]);
2861 end;
2862 end else if NodeData is TCodeBrowserNode then begin
2863 Node:=TCodeBrowserNode(NodeData);
2864 if (Node.CodePos.Code<>nil)
2865 and (Node.CodePos.Code.Filename<>'') then begin
2866 Node.CodePos.Code.AbsoluteToLineCol(Node.CodePos.P,Line,Column);
2867 LazarusIDE.DoOpenFileAndJumpToPos(Node.CodePos.Code.Filename,
2868 Point(Column,Line),-1,-1,-1,[ofOnlyIfExists]);
2869 end;
2870 end;
2871 end;
2872
2873 procedure TCodeBrowserView.BeginUpdate;
2874 begin
2875 inc(fUpdateCount);
2876 BrowseTreeView.BeginUpdate;
2877 end;
2878
2879 procedure TCodeBrowserView.EndUpdate;
2880 begin
2881 dec(fUpdateCount);
2882 BrowseTreeView.EndUpdate;
2883 end;
2884
TCodeBrowserView.ExportTreenull2885 function TCodeBrowserView.ExportTree: TModalResult;
2886 var
2887 SaveDialog: TSaveDialog;
2888 begin
2889 SaveDialog:=IDESaveDialogClass.Create(nil);
2890 try
2891 InitIDEFileDialog(SaveDialog);
2892 SaveDialog.Title:='Save tree as text (*.txt) ...';
2893 SaveDialog.FileName:='identifiers.txt';
2894 SaveDialog.DefaultExt:='txt';
2895 if not SaveDialog.Execute then exit(mrCancel);
2896 Result:=ExportTreeAsText(SaveDialog.FileName);
2897 finally
2898 StoreIDEFileDialog(SaveDialog);
2899 SaveDialog.Free;
2900 end;
2901 end;
2902
ExportTreeAsTextnull2903 function TCodeBrowserView.ExportTreeAsText(Filename: string): TModalResult;
2904
2905 procedure WriteNode(var List: TStrings; Node: TTreeNode; Prefix: String='');
2906 const
2907 CodeBrowserTypes: array[1..3] of TClass =
2908 (TCodeBrowserUnitList, TCodeBrowserUnit, TCodeBrowserNode);
2909 NodeIndent = ' ';
2910 var
2911 Child: TTreeNode;
2912 i: Integer;
2913 begin
2914 if Node=nil then exit;
2915 for i:=Low(CodeBrowserTypes) to High(CodeBrowserTypes) do begin
2916 if TObject(Node.Data) is CodeBrowserTypes[i] then begin
2917 List.Add(prefix+Node.Text);
2918 Prefix:=Prefix+NodeIndent;
2919 break;
2920 end;
2921 end;
2922 Child:=Node.GetFirstChild;
2923 while Child<>nil do begin
2924 WriteNode(List,Child,Prefix);
2925 Child:=Child.GetNextSibling;
2926 end;
2927 end;
2928
2929 var
2930 List: TStrings;
2931 begin
2932 Filename:=TrimAndExpandFilename(Filename);
2933 if Filename='' then exit(mrCancel);
2934 Result:=CheckCreatingFile(Filename,true,true,true);
2935 if Result<>mrOk then exit;
2936 List:=TStringList.Create;
2937 try
2938 WriteNode(List,BrowseTreeView.Items.GetFirstNode);
2939 Result:=SaveStringToFile(Filename,List.Text,[],
2940 'exporting identifiers as text');
2941 finally
2942 List.Free;
2943 end;
2944 end;
2945
TCodeBrowserView.GetScopeToCurUnitOwnernull2946 function TCodeBrowserView.GetScopeToCurUnitOwner(UseFCLAsDefault: boolean): string;
2947 var
2948 SrcEdit: TSourceEditorInterface;
2949 Code: TCodeBuffer;
2950 MainCode: TCodeBuffer;
2951 Owners: TFPList;
2952 begin
2953 Result:='';
2954 if UseFCLAsDefault then
2955 Result:=PackageGraph.FCLPackage.Name;
2956 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
2957 if SrcEdit=nil then exit;
2958 Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer);
2959 if Code=nil then exit;
2960 MainCode:=CodeToolBoss.GetMainCode(Code);
2961 if MainCode<>nil then
2962 Code:=MainCode;
2963
2964 Owners:=PkgBoss.GetPossibleOwnersOfUnit(Code.FileName,[]);
2965 try
2966 if (Owners=nil) or (Owners.Count=0) then exit;
2967 if TObject(Owners[0])=Project1 then begin
2968 Result:=ProjectDescription;
2969 exit;
2970 end;
2971 if TObject(Owners[0]) is TLazPackage then begin
2972 Result:=TLazPackage(Owners[0]).Name;
2973 exit;
2974 end;
2975 finally
2976 Owners.Free;
2977 end;
2978 end;
2979
TCodeBrowserView.SetScopeToCurUnitOwnernull2980 function TCodeBrowserView.SetScopeToCurUnitOwner(UseFCLAsDefault,
2981 WithRequiredPackages: boolean): boolean;
2982 var
2983 NewScope: String;
2984 begin
2985 Result:=false;
2986 NewScope:=GetScopeToCurUnitOwner(UseFCLAsDefault);
2987 if NewScope='' then exit;
2988 ScopeComboBox.Text:=NewScope;
2989 ScopeWithRequiredPackagesCheckBox.Checked:=WithRequiredPackages;
2990 InvalidateStage(cbwsGetScopeOptions);
2991 end;
2992
2993 procedure TCodeBrowserView.SetFilterToSimpleIdentifier(Identifier: string);
2994 begin
2995 ShowPackagesCheckBox.Checked:=true;
2996 PackageFilterEdit.Text:='';
2997 PackageFilterContainsSpeedButton.Down:=true;
2998
2999 ShowUnitsCheckBox.Checked:=true;
3000 UnitFilterEdit.Text:='';
3001 UnitFilterContainsSpeedButton.Down:=true;
3002
3003 ShowIdentifiersCheckBox.Checked:=true;
3004 IdentifierFilterEdit.Text:=Identifier;
3005 IdentifierFilterBeginsSpeedButton.Down:=true;
3006
3007 ShowEmptyNodesCheckBox.Checked:=false;
3008
3009 InvalidateStage(cbwsGetViewOptions);
3010 end;
3011
3012 procedure TCodeBrowserView.BrowseTreeViewShowHint(Sender: TObject; HintInfo: PHintInfo);
3013 var
3014 TVNode: TTreeNode;
3015 HintStr: String;
3016 begin
3017 //DebugLn(['TCodeBrowserView.BrowseTreeViewShowHint ',dbgs(HintInfo^.CursorPos)]);
3018 HintStr:='';
3019 TVNode:=BrowseTreeView.GetNodeAt(HintInfo^.CursorPos.X, HintInfo^.CursorPos.Y);
3020 if TVNode<>nil then
3021 HintStr:=GetTVNodeHint(TVNode);
3022 HintInfo^.HintStr:=''; // do not use the normal mechanism,
3023 // ... open a THintWindow with LazarusHelp instead
3024 if csDestroying in ComponentState then exit;
3025 FHintManager.ShowHint(HintInfo^.HintPos, HintStr);
3026 end;
3027
3028 procedure TCodeBrowserView.CloseHintWindow;
3029 begin
3030 FHintManager.HideHint;
3031 end;
3032
3033 procedure TCodeBrowserView.CollapseAllPackagesMenuItemClick(Sender: TObject);
3034 begin
3035 ExpandCollapseAllNodesInTreeView(entPackage,false);
3036 end;
3037
3038 procedure TCodeBrowserView.CollapseAllUnitsMenuItemClick(Sender: TObject);
3039 begin
3040 ExpandCollapseAllNodesInTreeView(entUnit,false);
3041 end;
3042
3043 procedure TCodeBrowserView.CollapseAllClassesMenuItemClick(Sender: TObject);
3044 begin
3045 ExpandCollapseAllNodesInTreeView(entClass,false);
3046 end;
3047
3048 procedure TCodeBrowserView.CopyDescriptionMenuItemClick(Sender: TObject);
3049 begin
3050 CopyNode(BrowseTreeView.Selected,cntDescription);
3051 end;
3052
3053 procedure TCodeBrowserView.CopyIdentifierMenuItemClick(Sender: TObject);
3054 begin
3055 CopyNode(BrowseTreeView.Selected,cntIdentifier);
3056 end;
3057
3058 procedure TCodeBrowserView.ExpandAllClassesMenuItemClick(Sender: TObject);
3059 begin
3060 ExpandCollapseAllNodesInTreeView(entClass,true);
3061 end;
3062
3063 procedure TCodeBrowserView.ExpandAllPackagesMenuItemClick(Sender: TObject);
3064 begin
3065 ExpandCollapseAllNodesInTreeView(entPackage,true);
3066 end;
3067
3068 procedure TCodeBrowserView.ExpandAllUnitsMenuItemClick(Sender: TObject);
3069 begin
3070 ExpandCollapseAllNodesInTreeView(entUnit,true);
3071 end;
3072
3073 procedure TCodeBrowserView.ExportMenuItemClick(Sender: TObject);
3074 begin
3075 ExportTree;
3076 end;
3077
3078 procedure TCodeBrowserView.BrowseTreeViewMouseDown(Sender: TOBject;
3079 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3080 begin
3081 if ssDouble in Shift then
3082 OpenTVNode(BrowseTreeView.GetNodeAt(X,Y));
3083 end;
3084
3085 procedure TCodeBrowserView.UsePkgInProjectMenuItemClick(Sender: TObject);
3086 var
3087 APackage: TLazPackage;
3088 begin
3089 APackage:=GetSelectedPackage;
3090 if APackage=nil then exit;
3091 PkgBoss.AddProjectDependency(Project1,APackage);
3092 end;
3093
3094 procedure TCodeBrowserView.UseUnitInCurUnitMenuItemClick(Sender: TObject);
3095 begin
3096 UseUnitInSrcEditor(false);
3097 end;
3098
3099 procedure TCodeBrowserView.UsePkgInCurUnitMenuItemClick(Sender: TObject);
3100 var
3101 APackage: TLazPackage;
3102 TargetPackage: TLazPackage;
3103 List: TFPList;
3104 begin
3105 APackage:=GetSelectedPackage;
3106 if APackage=nil then exit;
3107 TargetPackage:=GetCurPackageInSrcEditor;
3108 if TargetPackage=nil then exit;
3109 List:=TFPList.Create;
3110 try
3111 List.Add(TargetPackage);
3112 if PkgBoss.AddDependencyToOwners(List,APackage)=mrOk then begin
3113 PackageEditingInterface.DoOpenPackageWithName(TargetPackage.Name,[],false);
3114 end;
3115 finally
3116 List.Free;
3117 end;
3118 end;
3119
3120 procedure TCodeBrowserView.UseIdentifierInCurUnitMenuItemClick(Sender: TObject);
3121 begin
3122 UseUnitInSrcEditor(true);
3123 end;
3124
3125 { TCodeBrowserViewOptions }
3126
3127 procedure TCodeBrowserViewOptions.SetModified(const AValue: boolean);
3128 begin
3129 if AValue then
3130 IncreaseChangeStamp;
3131 if FModified=AValue then exit;
3132 FModified:=AValue;
3133 end;
3134
TCodeBrowserViewOptions.GetLevelFilterTextnull3135 function TCodeBrowserViewOptions.GetLevelFilterText(Level: TCodeBrowserLevel
3136 ): string;
3137 begin
3138 Result:=FLevelFilterText[Level];
3139 end;
3140
TCodeBrowserViewOptions.GetLevelFilterTypenull3141 function TCodeBrowserViewOptions.GetLevelFilterType(Level: TCodeBrowserLevel
3142 ): TCodeBrowserTextFilter;
3143 begin
3144 Result:=FLevelFilterType[Level];
3145 end;
3146
3147 procedure TCodeBrowserViewOptions.SetLevelFilterText(Level: TCodeBrowserLevel;
3148 const AValue: string);
3149 begin
3150 if FLevelFilterText[Level]=AValue then exit;
3151 FLevelFilterText[Level]:=AValue;
3152 Modified:=true;
3153 end;
3154
3155 procedure TCodeBrowserViewOptions.SetLevelFilterType(Level: TCodeBrowserLevel;
3156 const AValue: TCodeBrowserTextFilter);
3157 begin
3158 if FLevelFilterType[Level]=AValue then exit;
3159 FLevelFilterType[Level]:=AValue;
3160 Modified:=true;
3161 end;
3162
3163 procedure TCodeBrowserViewOptions.SetScope(const AValue: string);
3164 begin
3165 if FScope=AValue then exit;
3166 FScope:=AValue;
3167 Modified:=true;
3168 end;
3169
3170 procedure TCodeBrowserViewOptions.SetLevels(const AValue: TStrings);
3171 begin
3172 if FLevels=AValue then exit;
3173 if FLevels.Text=AValue.Text then exit;
3174 FLevels.Assign(AValue);
3175 Modified:=true;
3176 end;
3177
3178 procedure TCodeBrowserViewOptions.SetShowEmptyNodes(const AValue: boolean);
3179 begin
3180 if FShowEmptyNodes=AValue then exit;
3181 FShowEmptyNodes:=AValue;
3182 Modified:=true;
3183 end;
3184
3185 procedure TCodeBrowserViewOptions.SetShowPrivate(const AValue: boolean);
3186 begin
3187 if FShowPrivate=AValue then exit;
3188 FShowPrivate:=AValue;
3189 Modified:=true;
3190 end;
3191
3192 procedure TCodeBrowserViewOptions.SetShowProtected(const AValue: boolean);
3193 begin
3194 if FShowProtected=AValue then exit;
3195 FShowProtected:=AValue;
3196 Modified:=true;
3197 end;
3198
3199 procedure TCodeBrowserViewOptions.SetStoreWithRequiredPackages(
3200 const AValue: boolean);
3201 begin
3202 if FStoreWithRequiredPackages=AValue then exit;
3203 FStoreWithRequiredPackages:=AValue;
3204 end;
3205
3206 procedure TCodeBrowserViewOptions.SetWithRequiredPackages(const AValue: boolean);
3207 begin
3208 if FWithRequiredPackages=AValue then exit;
3209 FWithRequiredPackages:=AValue;
3210 Modified:=true;
3211 end;
3212
3213 procedure TCodeBrowserViewOptions.IncreaseChangeStamp;
3214 begin
3215 CTIncreaseChangeStamp(FChangeStamp);
3216 end;
3217
3218 constructor TCodeBrowserViewOptions.Create;
3219 begin
3220 FLevels:=TStringList.Create;
3221 FChangeStamp:=CTInvalidChangeStamp;
3222 Clear;
3223 end;
3224
3225 destructor TCodeBrowserViewOptions.Destroy;
3226 begin
3227 FreeAndNil(FLevels);
3228 inherited Destroy;
3229 end;
3230
3231 procedure TCodeBrowserViewOptions.Clear;
3232 var
3233 l: TCodeBrowserLevel;
3234 begin
3235 FLevels.Clear;
3236 FLevels.Text:=CodeBrowserLevelNames[cblPackages]+#13
3237 +CodeBrowserLevelNames[cblUnits]+#13
3238 +CodeBrowserLevelNames[cblIdentifiers];
3239 WithRequiredPackages:=false;
3240 ShowPrivate:=false;
3241 ShowProtected:=true;
3242 Scope:='Project';
3243 for l:=Low(TCodeBrowserLevel) to High(TCodeBrowserLevel) do begin
3244 FLevelFilterType[l]:=cbtfContains;
3245 FLevelFilterText[l]:='';
3246 end;
3247 IncreaseChangeStamp;
3248 Modified:=false;
3249 end;
3250
3251 procedure TCodeBrowserViewOptions.LoadFromConfig(ConfigStore: TConfigStorage;
3252 const Path: string);
3253 var
3254 l: TCodeBrowserLevel;
3255 SubPath: String;
3256 begin
3257 Clear;
3258 WithRequiredPackages:=ConfigStore.GetValue(Path+'WithRequiredPackages/Value',false);
3259 Scope:=ConfigStore.GetValue(Path+'Scope/Value','Project');
3260 ShowPrivate:=ConfigStore.GetValue(Path+'ShowPrivate/Value',false);
3261 ShowProtected:=ConfigStore.GetValue(Path+'ShowProtected/Value',true);
3262 ShowEmptyNodes:=ConfigStore.GetValue(Path+'ShowEmptyNodes/Value',true);
3263 ConfigStore.GetValue(Path+'Levels/',FLevels);
3264 for l:=Low(TCodeBrowserLevel) to High(TCodeBrowserLevel) do begin
3265 SubPath:=Path+'LevelFilter/'+CodeBrowserLevelNames[l];
3266 FLevelFilterType[l]:=StringToCodeBrowserTextFilter(
3267 ConfigStore.GetValue(SubPath+'/Type',''));
3268 FLevelFilterText[l]:=ConfigStore.GetValue(SubPath+'/Text','');
3269 end;
3270 Modified:=false;
3271 end;
3272
3273 procedure TCodeBrowserViewOptions.SaveToConfig(ConfigStore: TConfigStorage;
3274 const Path: string);
3275 var
3276 l: TCodeBrowserLevel;
3277 SubPath: String;
3278 b: Boolean;
3279 begin
3280 b:=WithRequiredPackages;
3281 if not StoreWithRequiredPackages then
3282 b:=false;
3283 ConfigStore.SetDeleteValue(Path+'WithRequiredPackages/Value',b,false);
3284 ConfigStore.SetDeleteValue(Path+'Scope/Value',Scope,'Project');
3285 ConfigStore.SetDeleteValue(Path+'ShowPrivate/Value',ShowPrivate,false);
3286 ConfigStore.SetDeleteValue(Path+'ShowProtected/Value',ShowProtected,true);
3287 ConfigStore.SetDeleteValue(Path+'ShowEmptyNodes/Value',ShowEmptyNodes,true);
3288 ConfigStore.SetValue(Path+'Levels/',FLevels);
3289 for l:=Low(TCodeBrowserLevel) to High(TCodeBrowserLevel) do begin
3290 SubPath:=Path+'LevelFilter/'+CodeBrowserLevelNames[l];
3291 ConfigStore.SetDeleteValue(SubPath+'/Type',
3292 CodeBrowserTextFilterNames[FLevelFilterType[l]],
3293 CodeBrowserTextFilterNames[cbtfBegins]);
3294 ConfigStore.SetDeleteValue(SubPath+'/Text',FLevelFilterText[l],'');
3295 end;
3296 Modified:=false;
3297 end;
3298
TCodeBrowserViewOptions.HasLevelnull3299 function TCodeBrowserViewOptions.HasLevel(Level: TCodeBrowserLevel): boolean;
3300 begin
3301 Result:=Levels.IndexOf(CodeBrowserLevelNames[Level])>=0;
3302 end;
3303
3304 { TQuickFixIdentifierNotFound_Search }
3305
IsApplicablenull3306 function TQuickFixIdentifierNotFound_Search.IsApplicable(Msg: TMessageLine; out
3307 Identifier: string): boolean;
3308 var
3309 Dummy: string;
3310 begin
3311 Result:=false;
3312 Identifier:='';
3313 if not Msg.HasSourcePosition then exit;
3314 Result:=TIDEFPCParser.MsgLineIsId(Msg,5000,Identifier,Dummy);
3315 end;
3316
3317 procedure TQuickFixIdentifierNotFound_Search.CreateMenuItems(
3318 Fixes: TMsgQuickFixes);
3319 var
3320 Msg: TMessageLine;
3321 Identifier: string;
3322 i: Integer;
3323 begin
3324 for i:=0 to Fixes.LineCount-1 do begin
3325 Msg:=Fixes.Lines[i];
3326 if not IsApplicable(Msg,Identifier) then continue;
3327 Fixes.AddMenuItem(Self,Msg,lisQuickFixSearchIdentifier);
3328 exit;
3329 end;
3330 end;
3331
3332 procedure TQuickFixIdentifierNotFound_Search.QuickFix(Fixes: TMsgQuickFixes;
3333 Msg: TMessageLine);
3334 var
3335 Identifier: String;
3336 KnownFilename: String;
3337 Caret: TPoint;
3338 Filename: String;
3339 begin
3340 if not IsApplicable(Msg,Identifier) then exit;
3341 if not LazarusIDE.BeginCodeTools then begin
3342 DebugLn(['TQuickFixIdentifierNotFound_Search.Execute failed because IDE busy']);
3343 exit;
3344 end;
3345
3346 // get identifier
3347 if not IsValidIdent(Identifier) then begin
3348 DebugLn(['TQuickFixIdentifierNotFound_Search.Execute not an identifier "',dbgstr(Identifier),'"']);
3349 exit;
3350 end;
3351
3352 Filename:=Msg.GetFullFilename;
3353 KnownFilename:= LazarusIDE.FindSourceFile(Filename, Project1.Directory,
3354 [fsfSearchForProject, fsfUseIncludePaths, fsfMapTempToVirtualFiles]);
3355 Caret:=Point(Msg.Line,Msg.Column);
3356
3357 if (KnownFilename <> '') and (KnownFilename <> Filename) then begin
3358 if LazarusIDE.DoOpenFileAndJumpToPos(KnownFilename,Caret,-1,-1,-1,OpnFlagsPlainFile)<>mrOk
3359 then
3360 if LazarusIDE.DoOpenFileAndJumpToPos(Filename,Caret,-1,-1,-1,OpnFlagsPlainFile)<>mrOk
3361 then exit;
3362 end
3363 else
3364 if LazarusIDE.DoOpenFileAndJumpToPos(Filename,Caret,-1,-1,-1,OpnFlagsPlainFile
3365 )<>mrOk
3366 then exit;
3367
3368 // start code browser
3369 ShowCodeBrowser(Identifier);
3370 end;
3371
3372 end.
3373
3374