PageRenderTime 136ms CodeModel.GetById 9ms app.highlight 113ms RepoModel.GetById 1ms app.codeStats 1ms

/ide/codebrowser.pas

http://github.com/graemeg/lazarus
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