IDE: find overloads: progress

git-svn-id: trunk@19745 -

ide/findoverloadsdlg.lfm

@@ -8,6 +8,7 @@ object FindOverloadsDialog: TFindOverloadsDialog
   ClientHeight = 338
   ClientWidth = 548
   OnCreate = FormCreate
+  OnDestroy = FormDestroy
   Position = poScreenCenter
   LCLVersion = '0.9.27'
   object ButtonPanel1: TButtonPanel
@@ -16,6 +17,7 @@ object FindOverloadsDialog: TFindOverloadsDialog
     Top = 288
     Width = 536
     TabOrder = 0
+    ShowButtons = [pbOK, pbCancel, pbClose]
   end
   object CurGroupBox: TGroupBox
     Left = 6

ide/findoverloadsdlg.lrs

@@ -4,22 +4,23 @@ LazarusResources.Add('TFindOverloadsDialog','FORMDATA',[
   'TPF0'#20'TFindOverloadsDialog'#19'FindOverloadsDialog'#4'Left'#3')'#1#6'Heig'
   +'ht'#3'R'#1#3'Top'#3#171#0#5'Width'#3'$'#2#13'ActiveControl'#7#11'CurTreeVie'
   +'w'#7'Caption'#6#19'FindOverloadsDialog'#12'ClientHeight'#3'R'#1#11'ClientWi'
-  +'dth'#3'$'#2#8'OnCreate'#7#10'FormCreate'#8'Position'#7#14'poScreenCenter'#10
+  +'dth'#3'$'#2#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#8'P'
-  +'LCLVersion'#6#6'0.9.27'#0#12'TButtonPanel'#12'ButtonPanel1'#4'Left'#2#6#6'H'
+  +'osition'#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.27'#0#12'TButtonPanel'
-  +'eight'#2','#3'Top'#3' '#1#5'Width'#3#24#2#8'TabOrder'#2#0#0#0#9'TGroupBox'
+  +#12'ButtonPanel1'#4'Left'#2#6#6'Height'#2','#3'Top'#3' '#1#5'Width'#3#24#2#8
-  +#11'CurGroupBox'#4'Left'#2#6#6'Height'#2'H'#3'Top'#2#6#5'Width'#3#24#2#5'Ali'
+  +'TabOrder'#2#0#11'ShowButtons'#11#4'pbOK'#8'pbCancel'#7'pbClose'#0#0#0#9'TGr'
-  +'gn'#7#5'alTop'#20'BorderSpacing.Around'#2#6#7'Caption'#6#11'CurGroupBox'#12
+  +'oupBox'#11'CurGroupBox'#4'Left'#2#6#6'Height'#2'H'#3'Top'#2#6#5'Width'#3#24
-  +'ClientHeight'#2'5'#11'ClientWidth'#3#20#2#8'TabOrder'#2#1#0#9'TTreeView'#11
+  +#2#5'Align'#7#5'alTop'#20'BorderSpacing.Around'#2#6#7'Caption'#6#11'CurGroup'
-  +'CurTreeView'#4'Left'#2#0#6'Height'#2'5'#3'Top'#2#0#5'Width'#3#20#2#5'Align'
+  +'Box'#12'ClientHeight'#2'5'#11'ClientWidth'#3#20#2#8'TabOrder'#2#1#0#9'TTree'
-  +#7#8'alClient'#17'DefaultItemHeight'#2#19#8'TabOrder'#2#0#0#0#0#9'TGroupBox'
+  +'View'#11'CurTreeView'#4'Left'#2#0#6'Height'#2'5'#3'Top'#2#0#5'Width'#3#20#2
-  +#15'ResultsGroupBox'#4'Left'#2#6#6'Height'#3#198#0#3'Top'#2'T'#5'Width'#3#24
+  +#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#19#8'TabOrder'#2#0#0#0#0#9'T'
-  +#2#5'Align'#7#8'alClient'#20'BorderSpacing.Around'#2#6#7'Caption'#6#15'Resul'
+  +'GroupBox'#15'ResultsGroupBox'#4'Left'#2#6#6'Height'#3#198#0#3'Top'#2'T'#5'W'
-  +'tsGroupBox'#12'ClientHeight'#3#179#0#11'ClientWidth'#3#20#2#8'TabOrder'#2#2
+  +'idth'#3#24#2#5'Align'#7#8'alClient'#20'BorderSpacing.Around'#2#6#7'Caption'
-  +#0#9'TTreeView'#15'ResultsTreeView'#4'Left'#2#0#6'Height'#3#136#0#3'Top'#2#0
+  +#6#15'ResultsGroupBox'#12'ClientHeight'#3#179#0#11'ClientWidth'#3#20#2#8'Tab'
-  +#5'Width'#3#20#2#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#19#8'TabOrde'
+  +'Order'#2#2#0#9'TTreeView'#15'ResultsTreeView'#4'Left'#2#0#6'Height'#3#136#0
-  +'r'#2#0#0#0#12'TProgressBar'#18'ResultsProgressBar'#4'Left'#2#0#6'Height'#2
+  +#3'Top'#2#0#5'Width'#3#20#2#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#19
-  +#21#3'Top'#3#136#0#5'Width'#3#20#2#5'Align'#7#8'alBottom'#8'TabOrder'#2#1#0#0
+  +#8'TabOrder'#2#0#0#0#12'TProgressBar'#18'ResultsProgressBar'#4'Left'#2#0#6'H'
-  +#9'TCheckBox'#17'SearchAllCheckBox'#4'Left'#2#0#6'Height'#2#22#3'Top'#3#157#0
+  +'eight'#2#21#3'Top'#3#136#0#5'Width'#3#20#2#5'Align'#7#8'alBottom'#8'TabOrde'
-  +#5'Width'#3#20#2#5'Align'#7#8'alBottom'#7'Caption'#6#17'SearchAllCheckBox'#8
+  +'r'#2#1#0#0#9'TCheckBox'#17'SearchAllCheckBox'#4'Left'#2#0#6'Height'#2#22#3
-  +'TabOrder'#2#2#0#0#0#0
+  +'Top'#3#157#0#5'Width'#3#20#2#5'Align'#7#8'alBottom'#7'Caption'#6#17'SearchA'
+  +'llCheckBox'#8'TabOrder'#2#2#0#0#0#0
 ]);

ide/findoverloadsdlg.pas

@@ -30,13 +30,12 @@ unit FindOverloadsDlg;
 interface
 
 uses
-  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  Classes, SysUtils, LCLProc,FileUtil, LResources, Forms, Controls, Graphics,
-  ExtCtrls, StdCtrls, Buttons, ButtonPanel, ComCtrls, AvgLvlTree,
+  Dialogs, ExtCtrls, StdCtrls, Buttons, ButtonPanel, ComCtrls, AvgLvlTree,
   // codetools
-  CodeTree, CodeCache,
+  CodeTree, CodeCache, LazIDEIntf, ProjectIntf,
   // IDE
-  SrcEditorIntf
+  SrcEditorIntf, IDEProcs;
-  ;
 
 type
   TFOWNode = class
@@ -67,7 +66,7 @@ type
   TFindOverloadScope = (
     fosProject,
     fosPackages,
-    fosFPC
+    fosOtherSources
     );
   TFindOverloadScopes = set of TFindOverloadScope;
 
@@ -82,6 +81,14 @@ type
   private
     FFiles: TAvgLvlTree;
     FScanFiles: TAvgLvlTree;
+    FStagePosition: integer;
+    FStagePosMax: integer;
+    FStageTitle: string;
+    procedure CollectProjectFiles;
+    procedure CollectPackageFiles;
+    procedure CollectOtherSourceFiles;
+    procedure ScanSomeFiles;
+    procedure ScanFile(AFile: TFOWFile);
   public
     Scopes: TFindOverloadScopes;
     CompletedScopes: TFindOverloadScopes;
@@ -90,8 +97,15 @@ type
     procedure Clear;
     procedure Work;
     function Done: boolean;
+    procedure StopSearching;
+    function AddFileToScan(const Filename: string;
+                           CheckExtension: boolean = true): TFOWFile;
+    function FindFile(const Filename: string): TFOWFile;
     property Files: TAvgLvlTree read FFiles; // tree of TFindOverloadWorkerFile
     property ScanFiles: TAvgLvlTree read FScanFiles;// tree of TFindOverloadWorkerFile
+    property StageTitle: string read FStageTitle write FStageTitle;
+    property StagePosition: integer read FStagePosition write FStagePosition;
+    property StagePosMax: integer read FStagePosMax write FStagePosMax;
   end;
 
   { TFindOverloadsDialog }
@@ -104,14 +118,27 @@ type
     ResultsGroupBox: TGroupBox;
     CurTreeView: TTreeView;
     ResultsTreeView: TTreeView;
+    procedure ButtonPanel1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure OnIdle(Sender: TObject; var Done: Boolean);
   private
+    FIdleConnected: boolean;
+    fWorker: TFindOverloadWorker;
+    procedure SetIdleConnected(const AValue: boolean);
+    procedure UpdateProgress;
+    procedure StopWorking;
   public
+    property Worker: TFindOverloadWorker read fWorker;
+    property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
   end;
 
 function ShowFindOverloadsDialog: TModalResult;
 function ShowFindOverloadsDialog(Code: TCodeBuffer; X, Y: integer): TModalResult;
 
+function CompareFOWFiles(File1, File2: TFOWFile): integer;
+function CompareFilenameWithFOWFile(FilenameAnsiString, FOWFile: Pointer): integer;
+
 implementation
 
 function ShowFindOverloadsDialog: TModalResult;
@@ -141,6 +168,17 @@ begin
   end;
 end;
 
+function CompareFOWFiles(File1, File2: TFOWFile): integer;
+begin
+  Result:=CompareFilenames(File1.Filename,File2.Filename);
+end;
+
+function CompareFilenameWithFOWFile(FilenameAnsiString, FOWFile: Pointer
+  ): integer;
+begin
+  Result:=CompareFilenames(ansistring(FilenameAnsiString),TFOWFile(FOWFile).Filename);
+end;
+
 { TFindOverloadsDialog }
 
 procedure TFindOverloadsDialog.FormCreate(Sender: TObject);
@@ -148,6 +186,67 @@ begin
   Caption:='Find overloads';
   CurGroupBox.Caption:='Current identifier';
   ResultsGroupBox.Caption:='Overloads';
+  SearchAllCheckBox.Caption:='Search in other sources too';
+  SearchAllCheckBox.ShowHint:=true;
+  SearchAllCheckBox.Hint:='Enable this to search in system sources too. For example the RTL and FCL sources. This can take some minutes on slow machines.';
+
+  ButtonPanel1.CancelButton.OnClick:=@ButtonPanel1Click;
+
+  fWorker:=TFindOverloadWorker.Create;
+  IdleConnected:=true;
+  UpdateProgress;
+end;
+
+procedure TFindOverloadsDialog.ButtonPanel1Click(Sender: TObject);
+begin
+  StopWorking;
+end;
+
+procedure TFindOverloadsDialog.FormDestroy(Sender: TObject);
+begin
+  IdleConnected:=false;
+  FreeAndNil(fWorker);
+end;
+
+procedure TFindOverloadsDialog.OnIdle(Sender: TObject; var Done: Boolean);
+begin
+  fWorker.Work;
+  Done:=fWorker.Done;
+  if Done then
+    IdleConnected:=false;
+  UpdateProgress;
+end;
+
+procedure TFindOverloadsDialog.SetIdleConnected(const AValue: boolean);
+begin
+  if FIdleConnected=AValue then exit;
+  FIdleConnected:=AValue;
+  if FIdleConnected then begin
+    ButtonPanel1.CancelButton.Enabled:=true;
+    ButtonPanel1.CloseButton.Enabled:=false;
+    Application.AddOnIdleHandler(@OnIdle)
+  end else begin
+    ButtonPanel1.CancelButton.Enabled:=false;
+    ButtonPanel1.CloseButton.Enabled:=true;
+    Application.RemoveOnIdleHandler(@OnIdle);
+  end;
+end;
+
+procedure TFindOverloadsDialog.UpdateProgress;
+begin
+  if Worker.Done then
+    ResultsProgressBar.Visible:=false
+  else begin
+    ResultsProgressBar.Max:=Worker.StagePosMax;
+    ResultsProgressBar.Position:=Worker.StagePosition;
+    ResultsProgressBar.Visible:=true;
+  end;
+end;
+
+procedure TFindOverloadsDialog.StopWorking;
+begin
+  IdleConnected:=false;
+  Worker.StopSearching;
 end;
 
 { TFOWFile }
@@ -176,29 +275,150 @@ end;
 
 { TFindOverloadWorker }
 
-constructor TFindOverloadWorker.Create;
+procedure TFindOverloadWorker.CollectProjectFiles;
+var
+  AProject: TLazProject;
+  i: Integer;
+  ProjFile: TLazProjectFile;
+begin
+  AProject:=LazarusIDE.ActiveProject;
+  if AProject<>nil then begin
+    for i:=0 to AProject.FileCount-1 do begin
+      ProjFile:=AProject.Files[i];
+      if ProjFile.IsPartOfProject then
+        AddFileToScan(ProjFile.Filename);
+    end;
+  end;
+  Include(CompletedScopes,fosProject);
+end;
+
+procedure TFindOverloadWorker.CollectPackageFiles;
 begin
 
+  Include(CompletedScopes,fosPackages);
+end;
+
+procedure TFindOverloadWorker.CollectOtherSourceFiles;
+begin
+
+  Include(CompletedScopes,fosOtherSources);
+end;
+
+procedure TFindOverloadWorker.ScanSomeFiles;
+const
+  MaxScanTime = 0.3/86400; // 0.3 seconds
+var
+  StartTime: TDateTime;
+  CurFile: TFOWFile;
+begin
+  StartTime:=Now;
+  while FScanFiles.Count>0 do begin
+    CurFile:=TFOWFile(FScanFiles.FindLowest.Data);
+    ScanFile(CurFile);
+    if Now-StartTime>=MaxScanTime then
+      break;
+  end;
+end;
+
+procedure TFindOverloadWorker.ScanFile(AFile: TFOWFile);
+begin
+  FScanFiles.Remove(AFile);
+  if AFile.Scanned then exit;
+  AFile.Scanned:=true;
+  DebugLn(['TFindOverloadWorker.ScanFile ',AFile.Filename]);
+end;
+
+function TFindOverloadWorker.AddFileToScan(const Filename: string;
+  CheckExtension: boolean): TFOWFile;
+begin
+  if CheckExtension and (not FilenameIsPascalSource(Filename)) then
+    exit;
+  Result:=FindFile(Filename);
+  if Result<>nil then exit;
+  Result:=TFOWFile.Create(Filename);
+  FFiles.Add(Result);
+  FScanFiles.Add(Result);
+end;
+
+function TFindOverloadWorker.FindFile(const Filename: string): TFOWFile;
+var
+  AVLNode: TAvgLvlTreeNode;
+begin
+  AVLNode:=FFiles.FindKey(Pointer(Filename),@CompareFilenameWithFOWFile);
+  if AVLNode<>nil then
+    Result:=TFOWFile(AVLNode.Data)
+  else
+    Result:=nil;
+end;
+
+constructor TFindOverloadWorker.Create;
+begin
+  Scopes:=[fosProject,fosPackages];
+  FFiles:=TAvgLvlTree.Create(TListSortCompare(@CompareFOWFiles));
+  FScanFiles:=TAvgLvlTree.Create(TListSortCompare(@CompareFOWFiles));
+  FStagePosMax:=100;
 end;
 
 destructor TFindOverloadWorker.Destroy;
 begin
+  Clear;
+  FreeAndNil(FFiles);
+  FreeAndNil(FScanFiles);
   inherited Destroy;
 end;
 
 procedure TFindOverloadWorker.Clear;
 begin
-
+  FFiles.FreeAndClear;
+  FScanFiles.Clear;
+  FStageTitle:='Finished';
+  FStagePosition:=0;
+  FStagePosMax:=100;
 end;
 
 procedure TFindOverloadWorker.Work;
 begin
-
+  DebugLn(['TFindOverloadWorker.Work START']);
+  if FScanFiles.Count>0 then begin
+    // scan files
+    ScanSomeFiles;
+  end
+  else if (fosProject in Scopes) and not (fosProject in CompletedScopes) then
+  begin
+    // collect project files
+    StageTitle:='Scanning project ...';
+    StagePosition:=1;
+    CollectProjectFiles;
+  end
+  else if (fosPackages in Scopes) and not (fosPackages in CompletedScopes) then
+  begin
+    // collect package files
+    StageTitle:='Scanning packages ...';
+    StagePosition:=10;
+    CollectPackageFiles;
+  end
+  else if (fosOtherSources in Scopes) and not (fosOtherSources in CompletedScopes)
+  then begin
+    // collect other sources
+    StageTitle:='Scanning other sources ...';
+    StagePosition:=30;
+    CollectOtherSourceFiles;
+  end else begin
+    StageTitle:='Finished';
+    StagePosition:=StagePosMax;
+  end;
+  DebugLn(['TFindOverloadWorker.Work END ',StageTitle,' ',StagePosition,'/',StagePosMax]);
 end;
 
 function TFindOverloadWorker.Done: boolean;
 begin
-  Result:=true;
+  Result:=(Scopes-CompletedScopes=[]) and (FScanFiles.Count=0);
+end;
+
+procedure TFindOverloadWorker.StopSearching;
+begin
+  CompletedScopes:=Scopes;
+  FScanFiles.Clear;
 end;
 
 initialization

ide/main.pp

@@ -2800,6 +2800,9 @@ begin
   ecRemoveUnusedUnits:
     DoRemoveUnusedUnits;
 
+  ecFindOverloads:
+    DoFindOverloads;
+
   ecFindBlockOtherEnd:
     DoGoToPascalBlockOtherEnd;