/ide/codebrowser.pas
Pascal | 3356 lines | 2875 code | 280 blank | 201 comment | 398 complexity | e2cb45deae453ab5eab4e6f5b1f1ff4f MD5 | raw file
Large files files are truncated, but you can click here to view the full file
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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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} 39unit CodeBrowser; 40 41{$mode objfpc}{$H+} 42 43{off $DEFINE VerboseCodeBrowser} 44 45interface 46 47uses 48 // RTL + FCL + LCL 49 Classes, SysUtils, types, AVL_Tree, 50 LCLProc, LResources, Forms, Controls, Graphics, Dialogs, Clipbrd, StdCtrls, 51 ExtCtrls, ComCtrls, Buttons, Menus, HelpIntfs, LCLIntf, 52 // CodeTools 53 BasicCodeTools, DefineTemplates, CodeTree, CodeCache, 54 CodeToolsStructs, CodeToolManager, PascalParserTool, LinkScanner, FileProcs, 55 CodeIndex, StdCodeTools, SourceLog, CustomCodeTool, 56 // LazUtils 57 LazFileUtils, LazUtilities, 58 // IDEIntf 59 IDEWindowIntf, SrcEditorIntf, IDEMsgIntf, IDEDialogs, LazConfigStorage, 60 IDEHelpIntf, PackageIntf, IDECommands, LazIDEIntf, 61 IDEExternToolIntf, 62 // IDE 63 Project, DialogProcs, PackageSystem, PackageDefs, LazarusIDEStrConsts, 64 IDEOptionDefs, etFPCMsgParser, BasePkgManager, EnvironmentOpts; 65 66 67type 68 TCodeBrowserLevel = ( 69 cblPackages, 70 cblUnits, 71 cblIdentifiers 72 ); 73 74 TCodeBrowserTextFilter = ( 75 cbtfBegins, 76 cbtfContains 77 ); 78 79const 80 CodeBrowserLevelNames: array[TCodeBrowserLevel] of string = ( 81 'Packages', 82 'Units', 83 'Identifiers' 84 ); 85 86 CodeBrowserTextFilterNames: array[TCodeBrowserTextFilter] of string = ( 87 'Begins', 88 'Contains' 89 ); 90 91 CodeBrowserIDEName = ' '+'Lazarus IDE';// Note: space is needed to avoid name clashing 92 CodeBrowserProjectName = ' '+'Project'; 93 CodeBrowserHidden = ' '; 94 CodeBrowserMaxTVIdentifiers = 5000; // the maximum amount of identifiers shown in the treeview 95 96type 97 98 { TCodeBrowserViewOptions } 99 100 TCodeBrowserViewOptions = class 101 private 102 FChangeStamp: integer; 103 FModified: boolean; 104 FScope: string; 105 FLevels: TStrings; 106 FShowEmptyNodes: boolean; 107 FShowPrivate: boolean; 108 FShowProtected: boolean; 109 FStoreWithRequiredPackages: boolean; 110 FWithRequiredPackages: boolean; 111 FLevelFilterText: array[TCodeBrowserLevel] of string; 112 FLevelFilterType: array[TCodeBrowserLevel] of TCodeBrowserTextFilter; 113 function GetLevelFilterText(Level: TCodeBrowserLevel): string; 114 function GetLevelFilterType(Level: TCodeBrowserLevel): TCodeBrowserTextFilter; 115 procedure SetLevelFilterText(Level: TCodeBrowserLevel; const AValue: string); 116 procedure SetLevelFilterType(Level: TCodeBrowserLevel; 117 const AValue: TCodeBrowserTextFilter); 118 procedure SetModified(const AValue: boolean); 119 procedure SetScope(const AValue: string); 120 procedure SetLevels(const AValue: TStrings); 121 procedure SetShowEmptyNodes(const AValue: boolean); 122 procedure SetShowPrivate(const AValue: boolean); 123 procedure SetShowProtected(const AValue: boolean); 124 procedure SetStoreWithRequiredPackages(const AValue: boolean); 125 procedure SetWithRequiredPackages(const AValue: boolean); 126 procedure IncreaseChangeStamp; 127 public 128 constructor Create; 129 destructor Destroy; override; 130 procedure Clear; 131 procedure LoadFromConfig(ConfigStore: TConfigStorage; const Path: string); 132 procedure SaveToConfig(ConfigStore: TConfigStorage; const Path: string); 133 function HasLevel(Level: TCodeBrowserLevel): boolean; 134 public 135 property Scope: string read FScope write SetScope; 136 property WithRequiredPackages: boolean read FWithRequiredPackages write SetWithRequiredPackages; 137 property StoreWithRequiredPackages: boolean read FStoreWithRequiredPackages write SetStoreWithRequiredPackages; 138 property Levels: TStrings read FLevels write SetLevels; 139 property ShowPrivate: boolean read FShowPrivate write SetShowPrivate; 140 property ShowProtected: boolean read FShowProtected write SetShowProtected; 141 property ShowEmptyNodes: boolean read FShowEmptyNodes write SetShowEmptyNodes; 142 property LevelFilterText[Level: TCodeBrowserLevel]: string read GetLevelFilterText write SetLevelFilterText; 143 property LevelFilterType[Level: TCodeBrowserLevel]: TCodeBrowserTextFilter read GetLevelFilterType write SetLevelFilterType; 144 property Modified: boolean read FModified write SetModified; 145 property ChangeStamp: integer read FChangeStamp; 146 end; 147 148 149 TCodeBrowserWorkStage = ( 150 cbwsGetScopeOptions, 151 cbwsGatherPackages, 152 cbwsFreeUnusedPackages, 153 cbwsAddNewPackages, 154 cbwsGatherFiles, 155 cbwsGatherOutdatedFiles, 156 cbwsUpdateUnits, 157 cbwsGetViewOptions, 158 cbwsUpdateTreeView, 159 cbwsFinished 160 ); 161 162 TExpandableNodeType = ( 163 entPackage, 164 entUnit, 165 entClass 166 ); 167 168 TCopyNodeType = ( 169 cntIdentifier, 170 cntDescription 171 ); 172 173 { TCodeBrowserView } 174 175 TCodeBrowserView = class(TForm) 176 AllClassesSeparatorMenuItem: TMenuItem; 177 AllPackagesSeparatorMenuItem: TMenuItem; 178 AllUnitsSeparatorMenuItem: TMenuItem; 179 BrowseTreeView: TTreeView; 180 UseIdentifierInCurUnitMenuItem: TMenuItem; 181 UseUnitInCurUnitMenuItem: TMenuItem; 182 RescanButton: TButton; 183 IdleTimer1: TIdleTimer; 184 UsePkgInProjectMenuItem: TMenuItem; 185 UsePkgInCurUnitMenuItem: TMenuItem; 186 UseSeparatorMenuItem: TMenuItem; 187 ShowEmptyNodesCheckBox: TCheckBox; 188 CollapseAllClassesMenuItem: TMenuItem; 189 CollapseAllPackagesMenuItem: TMenuItem; 190 CollapseAllUnitsMenuItem: TMenuItem; 191 CopyDescriptionMenuItem: TMenuItem; 192 CopyIdentifierMenuItem: TMenuItem; 193 CopySeparatorMenuItem: TMenuItem; 194 ExpandAllClassesMenuItem: TMenuItem; 195 ExpandAllPackagesMenuItem: TMenuItem; 196 ExpandAllUnitsMenuItem: TMenuItem; 197 ExportMenuItem: TMenuItem; 198 IdentifierFilterBeginsSpeedButton: TSpeedButton; 199 IdentifierFilterContainsSpeedButton: TSpeedButton; 200 IdentifierFilterEdit: TEdit; 201 ImageList1: TImageList; 202 LevelsGroupBox: TGroupBox; 203 OpenMenuItem: TMenuItem; 204 OptionsGroupBox: TGroupBox; 205 PackageFilterBeginsSpeedButton: TSpeedButton; 206 PackageFilterContainsSpeedButton: TSpeedButton; 207 PackageFilterEdit: TEdit; 208 PopupMenu1: TPopupMenu; 209 ProgressBar1: TProgressBar; 210 ScopeComboBox: TComboBox; 211 ScopeGroupBox: TGroupBox; 212 ScopeWithRequiredPackagesCheckBox: TCheckBox; 213 ShowIdentifiersCheckBox: TCheckBox; 214 ShowPackagesCheckBox: TCheckBox; 215 ShowPrivateCheckBox: TCheckBox; 216 ShowProtectedCheckBox: TCheckBox; 217 ShowUnitsCheckBox: TCheckBox; 218 StatusBar1: TStatusBar; 219 UnitFilterBeginsSpeedButton: TSpeedButton; 220 UnitFilterContainsSpeedButton: TSpeedButton; 221 UnitFilterEdit: TEdit; 222 procedure BrowseTreeViewMouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X, 223 {%H-}Y: Integer); 224 procedure FormDeactivate(Sender: TObject); 225 procedure UseIdentifierInCurUnitMenuItemClick(Sender: TObject); 226 procedure UsePkgInCurUnitMenuItemClick(Sender: TObject); 227 procedure UsePkgInProjectMenuItemClick(Sender: TObject); 228 procedure UseUnitInCurUnitMenuItemClick(Sender: TObject); 229 procedure BrowseTreeViewMouseDown(Sender: TOBject; {%H-}Button: TMouseButton; 230 Shift: TShiftState; X, Y: Integer); 231 procedure BrowseTreeViewShowHint(Sender: TObject; HintInfo: PHintInfo); 232 procedure CollapseAllPackagesMenuItemClick(Sender: TObject); 233 procedure CollapseAllUnitsMenuItemClick(Sender: TObject); 234 procedure CollapseAllClassesMenuItemClick(Sender: TObject); 235 procedure CopyDescriptionMenuItemClick(Sender: TObject); 236 procedure CopyIdentifierMenuItemClick(Sender: TObject); 237 procedure ExpandAllClassesMenuItemClick(Sender: TObject); 238 procedure ExpandAllPackagesMenuItemClick(Sender: TObject); 239 procedure ExpandAllUnitsMenuItemClick(Sender: TObject); 240 procedure ExportMenuItemClick(Sender: TObject); 241 procedure FormCreate(Sender: TObject); 242 procedure FormDestroy(Sender: TObject); 243 procedure IdleTimer1Timer(Sender: TObject); 244 procedure PackageFilterEditChange(Sender: TObject); 245 procedure PackageFilterEditEditingDone(Sender: TObject); 246 procedure PopupMenu1Popup(Sender: TObject); 247 procedure RescanButtonClick(Sender: TObject); 248 procedure ScopeComboBoxChange(Sender: TObject); 249 procedure ScopeWithRequiredPackagesCheckBoxChange(Sender: TObject); 250 procedure OnIdle(Sender: TObject; var Done: Boolean); 251 procedure OpenMenuItemClick(Sender: TObject); 252 procedure ShowIdentifiersCheckBoxChange(Sender: TObject); 253 procedure ShowPackagesCheckBoxChange(Sender: TObject); 254 procedure ShowPrivateCheckBoxChange(Sender: TObject); 255 procedure ShowUnitsCheckBoxChange(Sender: TObject); 256 private 257 FHintManager: THintWindowManager; 258 FIDEDescription: string; 259 FIdleConnected: boolean; 260 FOptions: TCodeBrowserViewOptions; 261 FOptionsChangeStamp: integer; 262 FProjectDescription: string; 263 FParserRoot: TCodeBrowserUnitList; 264 FScannedBytes: PtrInt; 265 FScannedIdentifiers: PtrInt; 266 FScannedLines: PtrInt; 267 FScannedPackages: integer; 268 FScannedUnits: integer; 269 FUpdateNeeded: boolean; 270 FViewRoot: TCodeBrowserUnitList; 271 FVisibleIdentifiers: PtrInt; 272 FVisiblePackages: integer; 273 FVisibleUnits: integer; 274 FWorkingParserRoot: TCodeBrowserUnitList; 275 fUpdateCount: integer; 276 fStage: TCodeBrowserWorkStage; 277 fOutdatedFiles: TAVLTree;// tree of TCodeBrowserUnit 278 fLastStatusBarUpdate: TDateTime; 279 ImgIDDefault: integer; 280 ImgIDProgramCode: Integer; 281 ImgIDUnitCode: Integer; 282 ImgIDInterfaceSection: Integer; 283 ImgIDImplementation: Integer; 284 ImgIDInitialization: Integer; 285 ImgIDFinalization: Integer; 286 ImgIDTypeSection: Integer; 287 ImgIDType: Integer; 288 ImgIDVarSection: Integer; 289 ImgIDVariable: Integer; 290 ImgIDConstSection: Integer; 291 ImgIDConst: Integer; 292 ImgIDClass: Integer; 293 ImgIDProc: Integer; 294 ImgIDProperty: Integer; 295 ImgIDPackage: Integer; 296 ImgIDProject: Integer; 297 procedure LoadOptions; 298 procedure LoadLevelsGroupBox; 299 procedure LoadFilterGroupbox; 300 procedure FillScopeComboBox; 301 procedure SetIdleConnected(AValue: boolean); 302 procedure SetScannedBytes(const AValue: PtrInt); 303 procedure SetScannedIdentifiers(const AValue: PtrInt); 304 procedure SetScannedLines(const AValue: PtrInt); 305 procedure SetScannedPackages(const AValue: integer); 306 procedure SetScannedUnits(const AValue: integer); 307 procedure SetUpdateNeeded(const AValue: boolean); 308 procedure SetVisibleIdentifiers(const AValue: PtrInt); 309 procedure SetVisiblePackages(const AValue: integer); 310 procedure SetVisibleUnits(const AValue: integer); 311 procedure Work(var Done: Boolean); 312 procedure WorkGetScopeOptions; 313 procedure WorkGatherPackages; 314 procedure WorkFreeUnusedPackages; 315 procedure WorkAddNewUnitLists; 316 procedure WorkGatherFileLists; 317 procedure WorkUpdateFileList(List: TCodeBrowserUnitList); 318 procedure WorkGatherOutdatedFiles; 319 procedure WorkUpdateUnits; 320 procedure WorkUpdateUnit(AnUnit: TCodeBrowserUnit); 321 procedure WorkGetViewOptions; 322 procedure WorkUpdateTreeView; 323 procedure FreeUnitList(List: TCodeBrowserUnitList); 324 procedure UpdateStatusBar(Lazy: boolean); 325 procedure RemoveUnit(AnUnit: TCodeBrowserUnit); 326 function CountIdentifiers(Tool: TCodeTool): integer; 327 procedure UpdateTreeView; 328 procedure ClearTreeView; 329 procedure InitTreeView; 330 function ListOwnerToText(const ListOwner: string): string; 331 procedure InitImageList; 332 function GetNodeImage(CodeNode: TObject): integer; 333 function GetTVNodeHint(TVNode: TTreeNode): string; 334 function GetCodeHelp(TVNode: TTreeNode; out BaseURL, HTMLHint: string): boolean; 335 procedure ExpandCollapseAllNodesInTreeView(NodeType: TExpandableNodeType; 336 Expand: boolean); 337 procedure CopyNode(TVNode: TTreeNode; NodeType: TCopyNodeType); 338 function GetCodeTool(AnUnit: TCodeBrowserUnit): TStandardCodeTool; 339 procedure GetNodeIdentifier(Tool: TStandardCodeTool; 340 CTNode: TCodeTreeNode; out Identifier: string); 341 procedure GetNodeDescription(Tool: TStandardCodeTool; 342 CTNode: TCodeTreeNode; Identifier: string; out Description: string); 343 function GetSelectedUnit: TCodeBrowserUnit; 344 function GetSelectedPackage: TLazPackage; 345 function GetCurUnitInSrcEditor(out FileOwner: TObject; 346 out UnitCode: TCodeBuffer): boolean; 347 function GetCurPackageInSrcEditor: TLazPackage; 348 procedure OpenTVNode(TVNode: TTreeNode); 349 procedure UseUnitInSrcEditor(InsertIdentifier: boolean); 350 procedure CloseHintWindow; 351 public 352 procedure BeginUpdate; 353 procedure EndUpdate; 354 function ExportTree: TModalResult; 355 function ExportTreeAsText(Filename: string): TModalResult; 356 function GetScopeToCurUnitOwner(UseFCLAsDefault: boolean): string; 357 function SetScopeToCurUnitOwner(UseFCLAsDefault, 358 WithRequiredPackages: boolean): boolean; 359 procedure SetFilterToSimpleIdentifier(Identifier: string); 360 procedure InvalidateStage(AStage: TCodeBrowserWorkStage); 361 public 362 property ParserRoot: TCodeBrowserUnitList read FParserRoot; 363 property WorkingParserRoot: TCodeBrowserUnitList read FWorkingParserRoot; 364 property ViewRoot: TCodeBrowserUnitList read FViewRoot; 365 property Options: TCodeBrowserViewOptions read FOptions; 366 property IDEDescription: string read FIDEDescription; 367 property ProjectDescription: string read FProjectDescription; 368 property ScannedPackages: integer read FScannedPackages write SetScannedPackages; 369 property ScannedUnits: integer read FScannedUnits write SetScannedUnits; 370 property ScannedLines: PtrInt read FScannedLines write SetScannedLines; 371 property ScannedBytes: PtrInt read FScannedBytes write SetScannedBytes; 372 property ScannedIdentifiers: PtrInt read FScannedIdentifiers write SetScannedIdentifiers; 373 property VisiblePackages: integer read FVisiblePackages write SetVisiblePackages; 374 property VisibleUnits: integer read FVisibleUnits write SetVisibleUnits; 375 property VisibleIdentifiers: PtrInt read FVisibleIdentifiers write SetVisibleIdentifiers; 376 property UpdateNeeded: boolean read FUpdateNeeded write SetUpdateNeeded; 377 property IdleConnected: boolean read FIdleConnected write SetIdleConnected; 378 end; 379 380type 381 382 { TQuickFixIdentifierNotFound_Search } 383 384 TQuickFixIdentifierNotFound_Search = class(TMsgQuickFix) 385 public 386 function IsApplicable(Msg: TMessageLine; out Identifier: string): boolean; 387 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override; 388 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override; 389 end; 390var 391 CodeBrowserView: TCodeBrowserView = nil; 392 393function StringToCodeBrowserTextFilter(const s: string): TCodeBrowserTextFilter; 394 395procedure InitCodeBrowserQuickFixItems; 396procedure CreateCodeBrowser(DisableAutoSizing: boolean); 397procedure ShowCodeBrowser(const Identifier: string); 398 399implementation 400 401{$R *.lfm} 402 403const 404 ProgressGetScopeStart=0; 405 ProgressGetScopeSize=10; 406 ProgressGatherPackagesStart=ProgressGetScopeStart+ProgressGetScopeSize; 407 ProgressGatherPackagesSize=30; 408 ProgressFreeUnusedPkgStart=ProgressGatherPackagesStart+ProgressGatherPackagesSize; 409 ProgressFreeUnusedPkgSize=100; 410 ProgressAddNewUnitListsStart=ProgressFreeUnusedPkgStart+ProgressFreeUnusedPkgSize; 411 ProgressAddNewUnitListsSize=300; 412 ProgressGatherFileListsStart=ProgressAddNewUnitListsStart+ProgressAddNewUnitListsSize; 413 ProgressGatherFileListsSize=300; 414 ProgressGatherOutdatedFilesStart=ProgressGatherFileListsStart+ProgressGatherFileListsSize; 415 ProgressGatherOutdatedFilesSize=300; 416 ProgressUpdateUnitsStart=ProgressGatherOutdatedFilesStart+ProgressGatherOutdatedFilesSize; 417 ProgressUpdateUnitsSize=3000; 418 ProgressGetViewOptionsStart=ProgressUpdateUnitsStart+ProgressUpdateUnitsSize; 419 ProgressGetViewOptionsSize=10; 420 ProgressUpdateTreeViewStart=ProgressGetViewOptionsStart+ProgressGetViewOptionsSize; 421 ProgressUpdateTreeViewSize=1000; 422 ProgressTotal=ProgressUpdateTreeViewStart+ProgressUpdateTreeViewSize; 423const 424 ProcDescFlags = [phpWithStart,phpWithParameterNames, 425 phpWithVarModifiers,phpWithResultType,phpWithoutSemicolon]; 426 ProcIdentifierFlags = [phpWithoutClassKeyword,phpWithParameterNames, 427 phpWithoutSemicolon]; 428 PropDescFlags = [phpWithoutClassKeyword,phpWithParameterNames, 429 phpWithVarModifiers,phpWithResultType]; 430 431function StringToCodeBrowserTextFilter(const s: string): TCodeBrowserTextFilter; 432begin 433 for Result:=Low(TCodeBrowserTextFilter) to High(TCodeBrowserTextFilter) do 434 if SysUtils.CompareText(CodeBrowserTextFilterNames[Result],s)=0 then exit; 435 Result:=cbtfBegins; 436end; 437 438procedure InitCodeBrowserQuickFixItems; 439begin 440 RegisterIDEMsgQuickFix(TQuickFixIdentifierNotFound_Search.Create); 441end; 442 443procedure CreateCodeBrowser(DisableAutoSizing: boolean); 444begin 445 if CodeBrowserView=nil then 446 IDEWindowCreators.CreateForm(CodeBrowserView,TCodeBrowserView, 447 DisableAutoSizing,LazarusIDE.OwningComponent) 448 else if DisableAutoSizing then 449 CodeBrowserView.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('CreateCodeBrowser'){$ENDIF}; 450end; 451 452procedure ShowCodeBrowser(const Identifier: string); 453begin 454 IDEWindowCreators.ShowForm(NonModalIDEWindowNames[nmiwCodeBrowser],true); 455 CodeBrowserView.SetScopeToCurUnitOwner(true,true); 456 CodeBrowserView.SetFilterToSimpleIdentifier(Identifier); 457end; 458 459 460{ TCodeBrowserView } 461 462procedure TCodeBrowserView.FormCreate(Sender: TObject); 463begin 464 FHintManager:=THintWindowManager.Create; 465 FOptions:=TCodeBrowserViewOptions.Create; 466 467 FIDEDescription:=lisLazarusIDE; 468 FProjectDescription:=dlgProject; 469 470 Name:=NonModalIDEWindowNames[nmiwCodeBrowser]; 471 Caption:=lisCodeBrowser; 472 473 ScopeGroupBox.Caption:=dlgSearchScope; 474 ScopeWithRequiredPackagesCheckBox.Caption:=lisWithRequiredPackages; 475 RescanButton.Caption:=lisRescan; 476 LevelsGroupBox.Caption:=lisLevels; 477 ShowPackagesCheckBox.Caption:=lisShowPackages; 478 ShowUnitsCheckBox.Caption:=lisShowUnits; 479 ShowIdentifiersCheckBox.Caption:=lisShowIdentifiers; 480 481 OptionsGroupBox.Caption:=lisFilter; 482 ShowPrivateCheckBox.Caption:=lisPrivate; 483 ShowProtectedCheckBox.Caption:=lisProtected; 484 ShowEmptyNodesCheckBox.Caption:=lisShowEmptyUnitsPackages; 485 486 ExpandAllPackagesMenuItem.Caption:=lisExpandAllPackages; 487 CollapseAllPackagesMenuItem.Caption:=lisCollapseAllPackages; 488 ExpandAllUnitsMenuItem.Caption:=lisExpandAllUnits; 489 CollapseAllUnitsMenuItem.Caption:=lisCollapseAllUnits; 490 ExpandAllClassesMenuItem.Caption:=lisExpandAllClasses; 491 CollapseAllClassesMenuItem.Caption:=lisCollapseAllClasses; 492 ExportMenuItem.Caption:=lisDlgExport; 493 OpenMenuItem.Caption:=lisOpen; 494 // UsePkgInProjectMenuItem.Caption: see PopupMenu1Popup 495 // UsePkgInCurUnitMenuItem.Caption: see PopupMenu1Popup 496 // UseUnitInCurUnitMenuItem.Caption: see PopupMenu1Popup 497 498 PackageFilterBeginsSpeedButton.Caption:=lisBegins; 499 PackageFilterBeginsSpeedButton.Hint:=lisPackageNameBeginsWith; 500 PackageFilterContainsSpeedButton.Caption:=lisContains; 501 PackageFilterContainsSpeedButton.Hint:=lisPackageNameContains; 502 UnitFilterBeginsSpeedButton.Caption:=lisBegins; 503 UnitFilterBeginsSpeedButton.Hint:=lisUnitNameBeginsWith; 504 UnitFilterContainsSpeedButton.Caption:=lisContains; 505 UnitFilterContainsSpeedButton.Hint:=lisUnitNameContains; 506 IdentifierFilterBeginsSpeedButton.Caption:=lisBegins; 507 IdentifierFilterBeginsSpeedButton.Hint:=lisIdentifierBeginsWith; 508 IdentifierFilterContainsSpeedButton.Caption:=lisContains; 509 IdentifierFilterContainsSpeedButton.Hint:=lisIdentifierContains; 510 511 ProgressBar1.Max:=ProgressTotal; 512 InitImageList; 513 LoadOptions; 514 FillScopeComboBox; 515 ScopeComboBox.ItemIndex:=0; 516 IdleConnected:=true; 517end; 518 519procedure TCodeBrowserView.FormDestroy(Sender: TObject); 520begin 521 IdleConnected:=false; 522 ClearTreeView; 523 FreeAndNil(fOutdatedFiles); 524 FreeAndNil(FViewRoot); 525 FreeAndNil(FParserRoot); 526 FreeAndNil(FWorkingParserRoot); 527 FreeAndNil(FOptions); 528 FreeAndNil(FHintManager); 529 IdleConnected:=false; 530end; 531 532procedure TCodeBrowserView.IdleTimer1Timer(Sender: TObject); 533begin 534 InvalidateStage(cbwsGetViewOptions); 535 IdleTimer1.Enabled:=false; 536end; 537 538procedure TCodeBrowserView.PackageFilterEditChange(Sender: TObject); 539begin 540 IdleTimer1.Enabled:=true; 541end; 542 543procedure TCodeBrowserView.PackageFilterEditEditingDone(Sender: TObject); 544begin 545 InvalidateStage(cbwsGetViewOptions); 546end; 547 548procedure TCodeBrowserView.PopupMenu1Popup(Sender: TObject); 549var 550 TVNode: TTreeNode; 551 Node: TObject; 552 Identifier: String; 553 UnitList: TCodeBrowserUnitList; 554 EnableUsePkgInProject: Boolean; 555 APackage: TLazPackage; 556 EnableUsePkgInCurUnit: Boolean; 557 TargetPackage: TLazPackage; 558 EnableUseUnitInCurUnit: Boolean; 559 CurUnit: TCodeBrowserUnit; 560 SrcEditUnitOwner: TObject; 561 SrcEditUnitCode: TCodeBuffer; 562 CurUnitName: String; 563 SrcEditUnitName: String; 564 CBNode: TCodeBrowserNode; 565 EnableUseIdentifierInCurUnit: Boolean; 566 SrcEdit: TSourceEditorInterface; 567begin 568 ExpandAllPackagesMenuItem.Visible:=Options.HasLevel(cblPackages); 569 CollapseAllPackagesMenuItem.Visible:=ExpandAllPackagesMenuItem.Visible; 570 AllPackagesSeparatorMenuItem.Visible:=ExpandAllPackagesMenuItem.Visible; 571 572 ExpandAllUnitsMenuItem.Visible:=Options.HasLevel(cblUnits); 573 CollapseAllUnitsMenuItem.Visible:=ExpandAllUnitsMenuItem.Visible; 574 AllUnitsSeparatorMenuItem.Visible:=ExpandAllUnitsMenuItem.Visible; 575 576 ExpandAllClassesMenuItem.Visible:=Options.HasLevel(cblIdentifiers); 577 CollapseAllClassesMenuItem.Visible:=ExpandAllClassesMenuItem.Visible; 578 AllClassesSeparatorMenuItem.Visible:=ExpandAllClassesMenuItem.Visible; 579 580 TVNode:=BrowseTreeView.Selected; 581 Node:=nil; 582 if TVNode<>nil then 583 Node:=TObject(TVNode.Data); 584 EnableUsePkgInProject:=false; 585 EnableUsePkgInCurUnit:=false; 586 EnableUseUnitInCurUnit:=false; 587 EnableUseIdentifierInCurUnit:=false; 588 if Node<>nil then begin 589 Identifier:=''; 590 APackage:=nil; 591 UnitList:=nil; 592 CurUnit:=nil; 593 TargetPackage:=nil; 594 if Node is TCodeBrowserNode then begin 595 Identifier:=TCodeBrowserNode(Node).Identifier; 596 CBNode:=TCodeBrowserNode(Node); 597 CurUnit:=CBNode.CBUnit; 598 if CurUnit<>nil then 599 UnitList:=CurUnit.UnitList; 600 end else if Node is TCodeBrowserUnit then begin 601 CurUnit:=TCodeBrowserUnit(Node); 602 UnitList:=CurUnit.UnitList; 603 end else if Node is TCodeBrowserUnitList then begin 604 UnitList:=TCodeBrowserUnitList(Node); 605 end; 606 if UnitList<>nil then begin 607 if UnitList.Owner=CodeBrowserProjectName then begin 608 // project 609 end else if UnitList.Owner=CodeBrowserIDEName then begin 610 // IDE 611 end else if UnitList.Owner=CodeBrowserHidden then begin 612 // nothing 613 end else begin 614 // package 615 APackage:=PackageGraph.FindPackageWithName(UnitList.Owner,nil); 616 if APackage<>nil then begin 617 // check if package can be added to project 618 if Project1.FindDependencyByName(APackage.Name)=nil then begin 619 EnableUsePkgInProject:=true; 620 UsePkgInProjectMenuItem.Caption:=Format(lisUsePackageInProject, [ 621 APackage.Name]); 622 end; 623 // check if package can be added to package of src editor unit 624 TargetPackage:=GetCurPackageInSrcEditor; 625 if (TargetPackage<>nil) 626 and (SysUtils.CompareText(TargetPackage.Name,APackage.Name)<>0) 627 and (TargetPackage.FindDependencyByName(APackage.Name)=nil) then begin 628 EnableUsePkgInCurUnit:=true; 629 UsePkgInCurUnitMenuItem.Caption:=Format( 630 lisUsePackageInPackage, [APackage.Name, 631 TargetPackage.Name]); 632 end; 633 // check if unit can be added to project/package 634 GetCurUnitInSrcEditor(SrcEditUnitOwner,SrcEditUnitCode); 635 if (CurUnit<>nil) and (SrcEditUnitOwner<>nil) then begin 636 CurUnitName:=ExtractFileNameOnly(CurUnit.Filename); 637 SrcEditUnitName:=ExtractFileNameOnly(SrcEditUnitCode.Filename); 638 if SysUtils.CompareText(CurUnitName,SrcEditUnitName)<>0 then begin 639 EnableUseUnitInCurUnit:=true; 640 UseUnitInCurUnitMenuItem.Caption:= 641 Format(lisUseUnitInUnit, [CurUnitName, SrcEditUnitName]); 642 if (Node is TCodeBrowserNode) and (Identifier<>'') then begin 643 EnableUseIdentifierInCurUnit:=true; 644 SrcEdit:=SourceEditorManagerIntf.ActiveEditor; 645 UseIdentifierInCurUnitMenuItem.Caption:= 646 Format(lisUseIdentifierInAt, [Identifier, ExtractFilename( 647 SrcEdit.FileName), dbgs(SrcEdit.CursorScreenXY)]); 648 end; 649 end; 650 end; 651 end; 652 end; 653 end; 654 OpenMenuItem.Visible:=true; 655 CopyDescriptionMenuItem.Caption:=lisCopyDescription; 656 CopyIdentifierMenuItem.Caption:=Format(lisCopyIdentifier, [Identifier]); 657 CopyDescriptionMenuItem.Visible:=true; 658 CopyIdentifierMenuItem.Visible:=Identifier<>''; 659 CopySeparatorMenuItem.Visible:=true; 660 661 UseUnitInCurUnitMenuItem.Enabled:=EnableUseUnitInCurUnit; 662 UseUnitInCurUnitMenuItem.Visible:=true; 663 if not EnableUseUnitInCurUnit then 664 UseUnitInCurUnitMenuItem.Caption:=lisPkgMangUseUnit; 665 666 UseIdentifierInCurUnitMenuItem.Enabled:=EnableUseIdentifierInCurUnit; 667 UseIdentifierInCurUnitMenuItem.Visible:=true; 668 if not EnableUseIdentifierInCurUnit then 669 UseIdentifierInCurUnitMenuItem.Caption:=lisUseIdentifier; 670 671 UsePkgInProjectMenuItem.Enabled:=EnableUsePkgInProject; 672 UsePkgInProjectMenuItem.Visible:=true; 673 if not EnableUsePkgInProject then 674 UsePkgInProjectMenuItem.Caption:=lisUsePackageInProject2; 675 676 UsePkgInCurUnitMenuItem.Enabled:=EnableUsePkgInCurUnit; 677 UsePkgInCurUnitMenuItem.Visible:=true; 678 if not EnableUsePkgInCurUnit then 679 UsePkgInCurUnitMenuItem.Caption:=lisUsePackageInPackage2; 680 end else begin 681 OpenMenuItem.Visible:=false; 682 CopyDescriptionMenuItem.Visible:=false; 683 CopyIdentifierMenuItem.Visible:=false; 684 CopySeparatorMenuItem.Visible:=false; 685 UseUnitInCurUnitMenuItem.Visible:=false; 686 UseIdentifierInCurUnitMenuItem.Visible:=false; 687 UsePkgInProjectMenuItem.Visible:=false; 688 UsePkgInCurUnitMenuItem.Visible:=false; 689 UseSeparatorMenuItem.Visible:=false; 690 end; 691end; 692 693procedure TCodeBrowserView.RescanButtonClick(Sender: TObject); 694begin 695 UpdateNeeded:=true; 696 InvalidateStage(cbwsGetScopeOptions); 697end; 698 699procedure TCodeBrowserView.ScopeComboBoxChange(Sender: TObject); 700begin 701 InvalidateStage(cbwsGetScopeOptions); 702end; 703 704procedure TCodeBrowserView.ScopeWithRequiredPackagesCheckBoxChange(Sender: TObject); 705begin 706 InvalidateStage(cbwsGetScopeOptions); 707end; 708 709procedure TCodeBrowserView.OnIdle(Sender: TObject; var Done: Boolean); 710begin 711 if (Screen.GetCurrentModalForm<>nil) then exit; 712 Work(Done); 713end; 714 715procedure TCodeBrowserView.OpenMenuItemClick(Sender: TObject); 716begin 717 OpenTVNode(BrowseTreeView.Selected); 718end; 719 720procedure TCodeBrowserView.ShowIdentifiersCheckBoxChange(Sender: TObject); 721begin 722 InvalidateStage(cbwsGetViewOptions); 723end; 724 725procedure TCodeBrowserView.ShowPackagesCheckBoxChange(Sender: TObject); 726begin 727 //DebugLn(['TCodeBrowserView.ShowPackagesCheckBoxChange ']); 728 InvalidateStage(cbwsGetViewOptions); 729end; 730 731procedure TCodeBrowserView.ShowPrivateCheckBoxChange(Sender: TObject); 732begin 733 InvalidateStage(cbwsGetViewOptions); 734end; 735 736procedure TCodeBrowserView.ShowUnitsCheckBoxChange(Sender: TObject); 737begin 738 InvalidateStage(cbwsGetViewOptions); 739end; 740 741procedure TCodeBrowserView.LoadOptions; 742begin 743 BeginUpdate; 744 ScopeWithRequiredPackagesCheckBox.Checked:=Options.WithRequiredPackages; 745 ScopeComboBox.Text:=Options.Scope; 746 LoadLevelsGroupBox; 747 LoadFilterGroupbox; 748 EndUpdate; 749end; 750 751procedure TCodeBrowserView.LoadLevelsGroupBox; 752begin 753 ShowPackagesCheckBox.Checked:=Options.HasLevel(cblPackages); 754 ShowUnitsCheckBox.Checked:=Options.HasLevel(cblUnits); 755 ShowIdentifiersCheckBox.Checked:=Options.HasLevel(cblIdentifiers); 756end; 757 758procedure TCodeBrowserView.LoadFilterGroupbox; 759begin 760 ShowPrivateCheckBox.Checked:=Options.ShowPrivate; 761 ShowProtectedCheckBox.Checked:=Options.ShowProtected; 762 ShowEmptyNodesCheckBox.Checked:=Options.ShowEmptyNodes; 763 764 PackageFilterEdit.Text:=Options.LevelFilterText[cblPackages]; 765 case Options.LevelFilterType[cblPackages] of 766 cbtfBegins: PackageFilterBeginsSpeedButton.Down:=true; 767 cbtfContains: PackageFilterContainsSpeedButton.Down:=true; 768 end; 769 770 UnitFilterEdit.Text:=Options.LevelFilterText[cblUnits]; 771 case Options.LevelFilterType[cblUnits] of 772 cbtfBegins: UnitFilterBeginsSpeedButton.Down:=true; 773 cbtfContains: UnitFilterContainsSpeedButton.Down:=true; 774 end; 775 776 IdentifierFilterEdit.Text:=Options.LevelFilterText[cblIdentifiers]; 777 case Options.LevelFilterType[cblIdentifiers] of 778 cbtfBegins: IdentifierFilterBeginsSpeedButton.Down:=true; 779 cbtfContains: IdentifierFilterContainsSpeedButton.Down:=true; 780 end; 781end; 782 783procedure TCodeBrowserView.FillScopeComboBox; 784var 785 sl: TStringList; 786 i: Integer; 787begin 788 if ScopeComboBox.Items.Count=0 then begin 789 sl:=TStringList.Create; 790 try 791 if PackageGraph<>nil then begin 792 for i:=0 to PackageGraph.Count-1 do 793 sl.Add(PackageGraph.Packages[i].Name); 794 end; 795 sl.Sort; 796 sl.Insert(0,IDEDescription); 797 sl.Insert(1,ProjectDescription); 798 ScopeComboBox.Items.Assign(sl); 799 finally 800 sl.Free; 801 end; 802 end; 803end; 804 805procedure TCodeBrowserView.SetIdleConnected(AValue: boolean); 806begin 807 if csDestroying in ComponentState then AValue:=false; 808 if FIdleConnected=AValue then Exit; 809 FIdleConnected:=AValue; 810 if IdleConnected then 811 Application.AddOnIdleHandler(@OnIdle) 812 else 813 Application.RemoveOnIdleHandler(@OnIdle); 814end; 815 816procedure TCodeBrowserView.InitImageList; 817begin 818 ImgIDDefault := Imagelist1.AddResourceName(HInstance, 'ce_default'); 819 ImgIDProgramCode := Imagelist1.AddResourceName(HInstance, 'ce_program'); 820 ImgIDUnitCode := Imagelist1.AddResourceName(HInstance, 'ce_unit'); 821 ImgIDInterfaceSection := Imagelist1.AddResourceName(HInstance, 'ce_interface'); 822 ImgIDImplementation := Imagelist1.AddResourceName(HInstance, 'ce_implementation'); 823 ImgIDInitialization := Imagelist1.AddResourceName(HInstance, 'ce_initialization'); 824 ImgIDFinalization := Imagelist1.AddResourceName(HInstance, 'ce_finalization'); 825 ImgIDTypeSection := Imagelist1.AddResourceName(HInstance, 'ce_type'); 826 ImgIDType := Imagelist1.AddResourceName(HInstance, 'ce_type'); 827 ImgIDVarSection := Imagelist1.AddResourceName(HInstance, 'ce_variable'); 828 ImgIDVariable := Imagelist1.AddResourceName(HInstance, 'ce_variable'); 829 ImgIDConstSection := Imagelist1.AddResourceName(HInstance, 'ce_const'); 830 ImgIDConst := Imagelist1.AddResourceName(HInstance, 'ce_const'); 831 ImgIDClass := Imagelist1.AddResourceName(HInstance, 'ce_class'); 832 ImgIDProc := Imagelist1.AddResourceName(HInstance, 'ce_procedure'); 833 ImgIDProperty := Imagelist1.AddResourceName(HInstance, 'ce_property'); 834 ImgIDPackage := Imagelist1.AddResourceName(HInstance, 'item_package'); 835 ImgIDProject := Imagelist1.AddResourceName(HInstance, 'item_project'); 836end; 837 838procedure TCodeBrowserView.SetScannedBytes(const AValue: PtrInt); 839begin 840 if FScannedBytes=AValue then exit; 841 FScannedBytes:=AValue; 842end; 843 844procedure TCodeBrowserView.SetScannedIdentifiers(const AValue: PtrInt); 845begin 846 if FScannedIdentifiers=AValue then exit; 847 FScannedIdentifiers:=AValue; 848end; 849 850procedure TCodeBrowserView.SetScannedLines(const AValue: PtrInt); 851begin 852 if FScannedLines=AValue then exit; 853 FScannedLines:=AValue; 854end; 855 856procedure TCodeBrowserView.SetScannedPackages(const AValue: integer); 857begin 858 if FScannedPackages=AValue then exit; 859 FScannedPackages:=AValue; 860end; 861 862procedure TCodeBrowserView.SetScannedUnits(const AValue: integer); 863begin 864 if FScannedUnits=AValue then exit; 865 FScannedUnits:=AValue; 866end; 867 868procedure TCodeBrowserView.SetUpdateNeeded(const AValue: boolean); 869 870 procedure InvalidateFileList(StartList: TCodeBrowserUnitList); 871 var 872 APackage: TCodeBrowserUnitList; 873 Node: TAVLTreeNode; 874 begin 875 if StartList=nil then exit; 876 StartList.UnitsValid:=false; 877 if (StartList.UnitLists=nil) then exit; 878 Node:=StartList.UnitLists.FindLowest; 879 while Node<>nil do begin 880 APackage:=TCodeBrowserUnitList(Node.Data); 881 InvalidateFileList(APackage); 882 Node:=StartList.UnitLists.FindSuccessor(Node); 883 end; 884 end; 885 886begin 887 if FUpdateNeeded=AValue then exit; 888 FUpdateNeeded:=AValue; 889 if FUpdateNeeded then begin 890 InvalidateFileList(FParserRoot); 891 InvalidateFileList(FWorkingParserRoot); 892 InvalidateStage(cbwsGetScopeOptions); 893 end; 894end; 895 896procedure TCodeBrowserView.SetVisibleIdentifiers(const AValue: PtrInt); 897begin 898 if FVisibleIdentifiers=AValue then exit; 899 FVisibleIdentifiers:=AValue; 900end; 901 902procedure TCodeBrowserView.SetVisiblePackages(const AValue: integer); 903begin 904 if FVisiblePackages=AValue then exit; 905 FVisiblePackages:=AValue; 906end; 907 908procedure TCodeBrowserView.SetVisibleUnits(const AValue: integer); 909begin 910 if FVisibleUnits=AValue then exit; 911 FVisibleUnits:=AValue; 912end; 913 914procedure TCodeBrowserView.UseUnitInSrcEditor(InsertIdentifier: boolean); 915var 916 // temporary data, that can be freed on next idle 917 SelectedUnit: TCodeBrowserUnit; 918 TVNode: TTreeNode; 919 Node: TObject; 920 IdentifierNode: TCodeBrowserNode; 921 // normal vars 922 SelectedUnitName: String; 923 SelectedCode: TCodeBuffer; 924 List: TFPList; 925 SelectedOwner: TObject; 926 APackage: TLazPackage; 927 TargetCode: TCodeBuffer; 928 TargetOwner: TObject; 929 SrcEdit: TSourceEditorInterface; 930 Code: TCodeBuffer; 931 CodeMarker: TSourceLogMarker; 932 Identifier: String; 933 SelectedUnitFilename: String; 934 IdentStart: integer; 935 IdentEnd: integer; 936 InsertStartPos: TPoint; 937 InsertEndPos: TPoint; 938begin 939 TVNode:=BrowseTreeView.Selected; 940 if TVNode=nil then exit; 941 Node:=TObject(TVNode.Data); 942 IdentifierNode:=nil; 943 SelectedUnit:=nil; 944 if Node is TCodeBrowserNode then begin 945 IdentifierNode:=TCodeBrowserNode(Node); 946 Identifier:=IdentifierNode.Identifier; 947 SelectedUnit:=IdentifierNode.CBUnit; 948 end else if Node is TCodeBrowserUnit then begin 949 SelectedUnit:=TCodeBrowserUnit(Node); 950 end else 951 exit; 952 if (SelectedUnit=nil) then exit; 953 SelectedUnitFilename:=SelectedUnit.Filename; 954 955 if InsertIdentifier then begin 956 if (IdentifierNode=nil) or (Identifier='') then exit; 957 end; 958 if SelectedUnit.UnitList=nil then begin 959 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor not implemented: ' 960 +'SelectedUnit.UnitList=nil']); 961 IDEMessageDialog('Implement me', 962 'TCodeBrowserView.UseUnitInSrcEditor not implemented: ' 963 +'SelectedUnit.UnitList=nil', 964 mtInformation, [mbOk]); 965 exit; 966 end; 967 SelectedOwner:=nil; 968 if SelectedUnit.UnitList.Owner=CodeBrowserProjectName then begin 969 // project 970 SelectedOwner:=Project1; 971 end else if SelectedUnit.UnitList.Owner=CodeBrowserIDEName then begin 972 // IDE can not be added as dependency 973 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor IDE can not be ' 974 +'added as dependency']); 975 exit; 976 end else if SelectedUnit.UnitList.Owner=CodeBrowserHidden then begin 977 // nothing 978 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor hidden unitlist'] 979 ); 980 exit; 981 end else begin 982 // package 983 APackage:=PackageGraph.FindPackageWithName(SelectedUnit.UnitList.Owner,nil); 984 if APackage=nil then begin 985 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor package not ' 986 +'found: ', SelectedUnit.UnitList.Owner]); 987 exit; 988 end; 989 SelectedOwner:=APackage; 990 end; 991 992 // get target unit 993 if not GetCurUnitInSrcEditor(TargetOwner, TargetCode) then exit; 994 if (not (TargetOwner is TProject)) 995 and (not (TargetOwner is TLazPackage)) then begin 996 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor not implemented: ' 997 +'TargetOwner=', DbgSName(TargetOwner)]); 998 IDEMessageDialog('Implement me', 999 'TCodeBrowserView.UseUnitInSrcEditor not implemented: ' 1000 +'TargetOwner='+DbgSName(TargetOwner), 1001 mtInformation, [mbOk]); 1002 exit; 1003 end; 1004 1005 if (SelectedOwner is TProject) and (TargetOwner<>SelectedOwner) then begin 1006 // unit of project can not be used by other packages/projects 1007 IDEMessageDialog(lisImpossible, 1008 lisAProjectUnitCanNotBeUsedByOtherPackagesProjects, 1009 mtError, [mbCancel]); 1010 exit; 1011 end; 1012 1013 // safety first: clear the references, they will become invalid on next idle 1014 SelectedUnit:=nil; 1015 IdentifierNode:=nil; 1016 Node:=nil; 1017 TVNode:=nil; 1018 1019 1020 List:=TFPList.Create; 1021 CodeMarker:=nil; 1022 try 1023 SrcEdit:=SourceEditorManagerIntf.ActiveEditor; 1024 if SrcEdit=nil then exit; 1025 InsertStartPos:=SrcEdit.CursorTextXY; 1026 Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer); 1027 CodeMarker:=Code.AddMarkerXY(InsertStartPos.Y,InsertStartPos.X,Self); 1028 1029 List.Add(TargetOwner); 1030 if (SelectedOwner is TLazPackage) then begin 1031 // add package to TargetOwner 1032 APackage:=TLazPackage(SelectedOwner); 1033 if PkgBoss.AddDependencyToOwners(List, APackage)<>mrOk then begin 1034 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor PkgBoss.' 1035 +'AddDependencyToOwners failed']); 1036 exit; 1037 end; 1038 end; 1039 1040 // get nice unit name 1041 LazarusIDE.SaveSourceEditorChangesToCodeCache(nil); 1042 SelectedCode:=CodeToolBoss.LoadFile(SelectedUnitFilename, true, false); 1043 if SelectedCode=nil then begin 1044 debugln(['TCodeBrowserView.UseUnitInSrcEditor failed to load SelectedUnitFilename=',SelectedUnitFilename]); 1045 exit; 1046 end; 1047 SelectedUnitName:=CodeToolBoss.GetSourceName(SelectedCode, false); 1048 1049 // add unit to uses section 1050 if not CodeToolBoss.AddUnitToMainUsesSection(TargetCode, SelectedUnitName,'') then 1051 begin 1052 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor CodeToolBoss.' 1053 +'AddUnitToMainUsesSection failed: TargetCode=', TargetCode.Filename, 1054 ' SelectedUnitName=', SelectedUnitName]); 1055 LazarusIDE.DoJumpToCodeToolBossError; 1056 end; 1057 1058 // insert identifier 1059 if InsertIdentifier then begin 1060 if CodeMarker.Deleted then begin 1061 DebugLn(['TCodeBrowserView.UseUnitInSrcEditor insert place was deleted']); 1062 exit; 1063 end; 1064 GetIdentStartEndAtPosition(Code.Source,CodeMarker.NewPosition, 1065 IdentStart,IdentEnd); 1066 Code.AbsoluteToLineCol(IdentStart,InsertStartPos.Y,InsertStartPos.X); 1067 InsertEndPos:=InsertStartPos; 1068 inc(InsertEndPos.X,IdentEnd-IdentStart); 1069 SrcEdit.ReplaceText(InsertStartPos,InsertEndPos,Identifier); 1070 end; 1071 finally 1072 List.Free; 1073 CodeMarker.Free; 1074 end; 1075end; 1076 1077procedure TCodeBrowserView.Work(var Done: Boolean); 1078// do some work 1079// This is called during OnIdle, so progress in small steps 1080var 1081 OldStage: TCodeBrowserWorkStage; 1082begin 1083 OldStage:=fStage; 1084 case fStage of 1085 cbwsGetScopeOptions: WorkGetScopeOptions; 1086 cbwsGatherPackages: WorkGatherPackages; 1087 cbwsFreeUnusedPackages: WorkFreeUnusedPackages; 1088 cbwsAddNewPackages: WorkAddNewUnitLists; 1089 cbwsGatherFiles: WorkGatherFileLists; 1090 cbwsGatherOutdatedFiles: WorkGatherOutdatedFiles; 1091 cbwsUpdateUnits: WorkUpdateUnits; 1092 cbwsGetViewOptions: WorkGetViewOptions; 1093 cbwsUpdateTreeView: WorkUpdateTreeView; 1094 else 1095 FOptionsChangeStamp:=Options.ChangeStamp; 1096 UpdateNeeded:=false; 1097 Done:=true; 1098 ProgressBar1.Position:=ProgressTotal; 1099 ProgressBar1.Visible:=false; 1100 exit; 1101 end; 1102 if ord(OldStage)<ord(cbwsFinished) then begin 1103 Done:=false; 1104 ProgressBar1.Visible:=true; 1105 UpdateStatusBar(fStage<cbwsFinished); 1106 end; 1107 //if fStage=cbwsFinished then CodeToolBoss.WriteMemoryStats; 1108end; 1109 1110procedure TCodeBrowserView.WorkGetScopeOptions; 1111var 1112 CurChangStamp: LongInt; 1113begin 1114 DebugLn(['TCodeBrowserView.WorkGetScopeOptions START']); 1115 IdleTimer1.Enabled:=false; 1116 1117 ProgressBar1.Position:=ProgressGetScopeStart; 1118 CurChangStamp:=Options.ChangeStamp; 1119 Options.WithRequiredPackages:=ScopeWithRequiredPackagesCheckBox.Checked; 1120 Options.Scope:=ScopeComboBox.Text; 1121 1122 // this stage finished -> next stage 1123 if UpdateNeeded or (Options.ChangeStamp<>CurChangStamp) then 1124 fStage:=cbwsGatherPackages 1125 else 1126 fStage:=cbwsGetViewOptions; 1127 ProgressBar1.Position:=ProgressGetScopeStart+ProgressGetScopeSize; 1128end; 1129 1130procedure TCodeBrowserView.WorkGatherPackages; 1131 1132 procedure AddPackage(APackage: TLazPackage); 1133 begin 1134 TCodeBrowserUnitList.Create(APackage.Name,FWorkingParserRoot); 1135 end; 1136 1137 procedure AddPackages(FirstDependency: TPkgDependency); 1138 var 1139 List: TFPList; 1140 i: Integer; 1141 begin 1142 List:=nil; 1143 try 1144 PackageGraph.GetAllRequiredPackages(nil,FirstDependency,List); 1145 if (List=nil) then exit; 1146 for i:=0 to List.Count-1 do begin 1147 if TObject(List[i]) is TLazPackage then 1148 AddPackage(TLazPackage(List[i])); 1149 end; 1150 finally 1151 List.Free; 1152 end; 1153 end; 1154 1155var 1156 APackage: TLazPackage; 1157 RootOwner: string; 1158 i: Integer; 1159begin 1160 // clean up 1161 if fOutdatedFiles<>nil then fOutdatedFiles.Clear; 1162 1163 // find ParserRoot 1164 RootOwner:=''; 1165 if Options.Scope=IDEDescription then begin 1166 RootOwner:=CodeBrowserIDEName; 1167 end else if Options.Scope=ProjectDescription then begin 1168 RootOwner:=CodeBrowserProjectName; 1169 end else begin 1170 APackage:=PackageGraph.FindPackageWithName(Options.Scope,nil); 1171 if APackage<>nil then 1172 RootOwner:=APackage.Name; 1173 end; 1174 DebugLn(['TCodeBrowserView.WorkGatherPackages RootOwner="',RootOwner,'"']); 1175 FreeAndNil(FWorkingParserRoot); 1176 FWorkingParserRoot:=TCodeBrowserUnitList.Create(RootOwner,nil); 1177 1178 // find required packages 1179 if Options.WithRequiredPackages then begin 1180 if SysUtils.CompareText(FWorkingParserRoot.Owner,CodeBrowserIDEName)=0 then begin 1181 for i:=0 to PackageGraph.Count-1 do 1182 AddPackage(PackageGraph[i]); 1183 end else if SysUtils.CompareText(FWorkingParserRoot.Owner,CodeBrowserProjectName)=0 1184 then begin 1185 AddPackages(Project1.FirstRequiredDependency); 1186 end else if FWorkingParserRoot.Owner<>'' then begin 1187 APackage:=PackageGraph.FindPackageWithName(FWorkingParserRoot.Owner,nil); 1188 if APackage<>nil then 1189 AddPackages(APackage.FirstRequiredDependency); 1190 end; 1191 end; 1192 1193 // update ParserRoot item (children will be updated on next Idle) 1194 if FParserRoot=nil then begin 1195 FParserRoot:=TCodeBrowserUnitList.Create(FWorkingParserRoot.Owner,nil); 1196 inc(FScannedPackages); 1197 end else begin 1198 FParserRoot.Owner:=FWorkingParserRoot.Owner; 1199 end; 1200 1201 // this stage finished -> next stage 1202 fStage:=cbwsFreeUnusedPackages; 1203 ProgressBar1.Position:=ProgressGatherPackagesStart+ProgressGatherPackagesSize; 1204end; 1205 1206procedure TCodeBrowserView.WorkFreeUnusedPackages; 1207 1208 function FindUnusedUnitList: TCodeBrowserUnitList; 1209 var 1210 Node: TAVLTreeNode; 1211 UnusedPackage: TCodeBrowserUnitList; 1212 PackageName: String; 1213 begin 1214 // find an unused package (a package in ParserRoot but not in WorkingParserRoot) 1215 Result:=nil; 1216 if (FParserRoot=nil) or (FParserRoot.UnitLists=nil) then exit; 1217 Node:=FParserRoot.UnitLists.FindLowest; 1218 while Node<>nil do begin 1219 UnusedPackage:=TCodeBrowserUnitList(Node.Data); 1220 PackageName:=UnusedPackage.Owner; 1221 if (FWorkingParserRoot=nil) 1222 or (FWorkingParserRoot.UnitLists=nil) 1223 or (FWorkingParserRoot.UnitLists.FindKey(Pointer(PackageName), 1224 @CompareAnsiStringWithUnitListOwner)=nil) 1225 then begin 1226 Result:=UnusedPackage; 1227 exit; 1228 end; 1229 Node:=FParserRoot.UnitLists.FindSuccessor(Node); 1230 end; 1231 end; 1232 1233var 1234 UnusedPackage: TCodeBrowserUnitList; 1235begin 1236 DebugLn(['TCodeBrowserView.WorkFreeUnusedPackages START']); 1237 1238 // find an unused package 1239 UnusedPackage:=FindUnusedUnitList; 1240 if UnusedPackage=nil then begin 1241 // this stage finished -> next stage 1242 fStage:=cbwsAddNewPackages; 1243 ProgressBar1.Position:=ProgressFreeUnusedPkgStart+ProgressFreeUnusedPkgSize; 1244 exit; 1245 end; 1246 1247 // free the unused package 1248 FreeUnitList(UnusedPackage); 1249end; 1250 1251procedure TCodeBrowserView.WorkAddNewUnitLists; 1252var 1253 Node: TAVLTreeNode; 1254 List: TCodeBrowserUnitList; 1255begin 1256 ProgressBar1.Position:=ProgressAddNewUnitListsStart; 1257 if (FWorkingParserRoot<>nil) and (FWorkingParserRoot.UnitLists<>nil) 1258 and (FParserRoot<>nil) then begin 1259 Node:=FWorkingParserRoot.UnitLists.FindLowest; 1260 while Node<>nil do begin 1261 List:=TCodeBrowserUnitList(Node.Data); 1262 if FParserRoot.FindUnitList(List.Owner)=nil then begin 1263 // new unit list 1264 TCodeBrowserUnitList.Create(List.Owner,FParserRoot); 1265 inc(FScannedPackages); 1266 end; 1267 Node:=FWorkingParserRoot.UnitLists.FindSuccessor(Node); 1268 end; 1269 end; 1270 1271 // this stage finished -> next stage 1272 fStage:=cbwsGatherFiles; 1273 ProgressBar1.Position:=ProgressAddNewUnitListsStart+ProgressAddNewUnitListsSize; 1274end; 1275 1276procedure TCodeBrowserView.WorkGatherFileLists; 1277 1278 function ListFilesAreValid(List: TCodeBrowserUnitList): boolean; 1279 begin 1280 Result:=List.UnitsValid; 1281 end; 1282 1283 function FindListWithInvalidFileList(StartList: TCodeBrowserUnitList 1284 ): TCodeBrowserUnitList; 1285 var 1286 APackage: TCodeBrowserUnitList; 1287 Node: TAVLTreeNode; 1288 begin 1289 Result:=nil; 1290 if StartList=nil then exit; 1291 if not ListFilesAreValid(StartList) then begin 1292 Result:=StartList; 1293 exit; 1294 end; 1295 if (StartList.UnitLists=nil) then exit; 1296 Node:=StartList.UnitLists.FindLowest; 1297 while Node<>nil do begin 1298 APackage:=TCodeBrowserUnitList(Node.Data); 1299 Result:=FindListWithInvalidFileList(APackage); 1300 if Result<>nil then exit; 1301 Node:=StartList.UnitLists.FindSuccessor(Node); 1302 end; 1303 end; 1304 1305var 1306 List: TCodeBrowserUnitList; 1307begin 1308 DebugLn(['TCodeBrowserView.WorkGatherFiles START']); 1309 // find a unit list which needs update 1310 List:=FindListWithInvalidFileList(FParserRoot); 1311 if List=nil then begin 1312 // this stage finished -> next stage 1313 fStage:=cbwsGatherOutdatedFiles; 1314 ProgressBar1.Position:=ProgressGatherFileListsStart+ProgressGatherFileListsSize; 1315 exit; 1316 end; 1317 1318 WorkUpdateFileList(List); 1319end; 1320 1321procedure TCodeBrowserView.WorkUpdateFileList(List: TCodeBrowserUnitList); 1322var 1323 NewFileList: TAVLTree; 1324 1325 procedure AddFile(const Filename: string; ClearIncludedByInfo: boolean); 1326 begin 1327 //DebugLn(['AddFile Filename="',Filename,'"']); 1328 if Filename='' then exit; 1329 if System.Pos('$',Filename)>0 then begin 1330 DebugLn(['WARNING: TCodeBrowserView.WorkUpdateFiles Macros in filename ',Filename]); 1331 exit; 1332 end; 1333 if NewFileList.FindKey(Pointer(Filename),@CompareAnsiStringWithUnitFilename)<>nil 1334 then exit; 1335 //DebugLn(['TCodeBrowserView.WorkUpdateFiles AddFile ',Filename]); 1336 NewFileList.Add(TCodeBrowserUnit.Create(Filename)); 1337 if ClearIncludedByInfo then begin 1338 CodeToolBoss.SourceCache.ClearIncludedByEntry(Filename); 1339 end; 1340 end; 1341 1342 procedure AddFilesOfProject(AProject: TProject); 1343 var 1344 AnUnitInfo: TUnitInfo; 1345 begin 1346 if AProject=nil then exit; 1347 AnUnitInfo:=AProject.FirstPartOfProject; 1348 //DebugLn(['AddFilesOfProject ',AnUnitInfo<>nil]); 1349 while AnUnitInfo<>nil do begin 1350 //DebugLn(['AddFilesOfProject ',AnUnitInfo.Filename]); 1351 if FilenameIsPascalUnit(AnUnitInfo.Filename) 1352 or (AnUnitInfo=aProject.MainUnitInfo) then 1353 AddFile(AnUnitInfo.Filename,false); 1354 AnUnitInfo:=AnUnitInfo.NextPartOfProject; 1355 end; 1356 end; 1357 1358 procedure AddFilesOfPackageFCL; 1359 var 1360 LazDir: String; 1361 UnitSetID: string; 1362 UnitSetChanged: Boolean; 1363 UnitSet: TFPCUnitSetCache; 1364 Filename: String; 1365 ConfigCache: TFPCTargetConfigCache; 1366 Node: TAVLTreeNode; 1367 Item: PStringToStringTreeItem; 1368 begin 1369 // use unitset of the lazarus source directory 1370 LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory); 1371 if (LazDir='') or (not FilenameIsAbsolute(LazDir)) then exit; 1372 UnitSetID:=CodeToolBoss.GetUnitSetIDForDirectory(LazDir); 1373 if UnitSetID='' then exit; 1374 UnitSetChanged:=false; 1375 UnitSet:=CodeToolBoss.FPCDefinesCache.FindUnitSetWithID(UnitSetID, 1376 UnitSetChanged,false); 1377 if UnitSet=nil then exit; 1378 ConfigCache:=UnitSet.GetConfigCache(false); 1379 if (ConfigCache=nil) or (ConfigCache.Units=nil) then exit; 1380 Node:=ConfigCache.Units.Tree.FindLowest; 1381 while Node<>nil do begin 1382 Item:=PStringToStringTreeItem(Node.Data); 1383 Filename:=Item^.Value; 1384 if (CompareFileExt(Filename,'ppu',false)=0) then begin 1385 // search source in fpc sources 1386 Filename:=UnitSet.GetUnitSrcFile(ExtractFileNameOnly(Filename)); 1387 end; 1388 if FilenameIsPascalUnit(Filename) then 1389 AddFile(Filename,false); 1390 Node:=ConfigCache.Units.Tree.F…
Large files files are truncated, but you can click here to view the full file