codetools: started collecting FPC units from set

git-svn-id: trunk@26738 -

components/codetools/codetoolmanager.pas

@@ -158,6 +158,8 @@ type
     function DirectoryCachePoolFindVirtualFile(const Filename: string): string;
     function DirectoryCachePoolGetUnitFromSet(const UnitSet, AnUnitName: string
                                               ): string;
+    procedure DirectoryCachePoolIterateFPCUnitsFromSet(const UnitSet: string;
+                                              const Iterate: TCTOnIterateFile);
   public
     DefinePool: TDefinePool; // definition templates (rules)
     DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
@@ -835,6 +837,7 @@ begin
   DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString;
   DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile;
   DirectoryCachePool.OnGetUnitFromSet:=@DirectoryCachePoolGetUnitFromSet;
+  DirectoryCachePool.OnIterateFPCUnitsFromSet:=@DirectoryCachePoolIterateFPCUnitsFromSet;
   DefineTree.DirectoryCachePool:=DirectoryCachePool;
   FPCDefinesCache:=TFPCDefinesCache.Create(nil);
   FAddInheritedCodeToOverrideMethod:=true;
@@ -943,7 +946,7 @@ begin
   if FPCDefinesCache.TestFilename='' then
     FPCDefinesCache.TestFilename:=GetTempFilename('fpctest.pas','');
 
-  UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(Config.FPCPath,
+  UnitSetCache:=FPCDefinesCache.FindUnitSet(Config.FPCPath,
     Config.TargetOS,Config.TargetProcessor,Config.FPCOptions,Config.FPCSrcDir,
     true);
   // parse compiler settings, fpc sources
@@ -5308,7 +5311,7 @@ var
   Changed: boolean;
   UnitSetCache: TFPCUnitSetCache;
 begin
-  UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(UnitSet,Changed,false);
+  UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
   if UnitSetCache=nil then begin
     debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
     Result:='';
@@ -5322,6 +5325,34 @@ begin
   Result:=UnitSetCache.GetUnitSrcFile(AnUnitName);
 end;
 
+procedure TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet(
+  const UnitSet: string; const Iterate: TCTOnIterateFile);
+var
+  Changed: boolean;
+  UnitSetCache: TFPCUnitSetCache;
+  aConfigCache: TFPCTargetConfigCache;
+  Node: TAVLTreeNode;
+  Item: PStringToStringTreeItem;
+begin
+  UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
+  if UnitSetCache=nil then begin
+    debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
+    exit;
+  end;
+  if Changed then begin
+    debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
+    exit;
+  end;
+  aConfigCache:=UnitSetCache.GetConfigCache(false);
+  if (aConfigCache=nil) or (aConfigCache.Units=nil) then exit;
+  Node:=aConfigCache.Units.Tree.FindLowest;
+  while Node<>nil do begin
+    Item:=PStringToStringTreeItem(Node.Data);
+    Iterate(Item^.Value);
+    Node:=aConfigCache.Units.Tree.FindSuccessor(Node);
+  end;
+end;
+
 procedure TCodeToolManager.OnToolSetWriteLock(Lock: boolean);
 begin
   if Lock then ActivateWriteLock else DeactivateWriteLock;

components/codetools/definetemplates.pas

@@ -859,10 +859,10 @@ type
     property SourceCaches: TFPCSourceCaches read FSourceCaches write SetSourceCaches;
     property ConfigCaches: TFPCTargetConfigCaches read FConfigCaches write SetConfigCaches;
     property TestFilename: string read FTestFilename write FTestFilename; // an empty file to test the compiler, will be auto created
-    function FindUnitToSrcCache(const CompilerFilename, TargetOS, TargetCPU,
+    function FindUnitSet(const CompilerFilename, TargetOS, TargetCPU,
                                 Options, FPCSrcDir: string;
                                 CreateIfNotExists: boolean): TFPCUnitSetCache;
-    function FindUnitToSrcCache(const UnitSetID: string; out Changed: boolean;
+    function FindUnitSetWithID(const UnitSetID: string; out Changed: boolean;
                                 CreateIfNotExists: boolean): TFPCUnitSetCache;
     function GetUnitSetID(CompilerFilename, TargetOS, TargetCPU, Options,
                           FPCSrcDir: string; ChangeStamp: integer): string;
@@ -8139,7 +8139,7 @@ begin
   Result:=false;
 end;
 
-function TFPCDefinesCache.FindUnitToSrcCache(const CompilerFilename, TargetOS,
+function TFPCDefinesCache.FindUnitSet(const CompilerFilename, TargetOS,
   TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean
   ): TFPCUnitSetCache;
 var
@@ -8167,7 +8167,7 @@ begin
     Result:=nil;
 end;
 
-function TFPCDefinesCache.FindUnitToSrcCache(const UnitSetID: string; out
+function TFPCDefinesCache.FindUnitSetWithID(const UnitSetID: string; out
   Changed: boolean; CreateIfNotExists: boolean): TFPCUnitSetCache;
 var
   CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string;
@@ -8176,13 +8176,13 @@ begin
   ParseUnitSetID(UnitSetID,CompilerFilename, TargetOS, TargetCPU,
                  Options, FPCSrcDir, ChangeStamp);
   //debugln(['TFPCDefinesCache.FindUnitToSrcCache UnitSetID="',dbgstr(UnitSetID),'" CompilerFilename="',CompilerFilename,'" TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',Options,'" FPCSrcDir="',FPCSrcDir,'" ChangeStamp=',ChangeStamp,' exists=',FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,Options, FPCSrcDir,false)<>nil]);
-  Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,
+  Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
                              Options, FPCSrcDir, false);
   if Result<>nil then begin
     Changed:=ChangeStamp<>Result.ChangeStamp;
   end else if CreateIfNotExists then begin
     Changed:=true;
-    Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,
+    Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
                                Options, FPCSrcDir, true);
   end else
     Changed:=false;

components/codetools/directorycacher.pas

@@ -113,6 +113,7 @@ type
     function CalcMemSize: PtrUInt;
   end;
   
+  TCTOnIterateFile = procedure(const Filename: string) of object;
   TCTDirectoryCachePool = class;
 
 
@@ -155,6 +156,7 @@ type
                                           AnyCase: boolean): string;
     function FindCompiledUnitInCompletePath(var ShortFilename: string;
                                             AnyCase: boolean): string;
+    procedure IterateFPCUnitsInSet(const Iterate: TCTOnIterateFile);
     procedure WriteListing;
   public
     property Directory: string read FDirectory;
@@ -170,6 +172,8 @@ type
                                   ): string of object;
   TCTDirCacheFindVirtualFile = function(const Filename: string): string of object;
   TCTGetUnitFromSet = function(const UnitSet, AnUnitName: string): string of object;
+  TCTIterateFPCUnitsFromSet = procedure(const UnitSet: string;
+                                     const Iterate: TCTOnIterateFile) of object;
 
   TCTDirectoryCachePool = class
   private
@@ -179,6 +183,7 @@ type
     FOnFindVirtualFile: TCTDirCacheFindVirtualFile;
     FOnGetString: TCTDirCacheGetString;
     FOnGetUnitFromSet: TCTGetUnitFromSet;
+    FOnIterateFPCUnitsFromSet: TCTIterateFPCUnitsFromSet;
     procedure DoRemove(ACache: TCTDirectoryCache);
     procedure OnFileStateCacheChangeTimeStamp(Sender: TObject);
   public
@@ -194,6 +199,8 @@ type
     procedure IncreaseConfigTimeStamp;
     function FindUnitInUnitLinks(const Directory, AUnitName: string): string;
     function FindUnitInUnitSet(const Directory, AUnitName: string): string;
+    procedure IterateFPCUnitsInSet(const Directory: string;
+                                   const Iterate: TCTOnIterateFile);
     function FindDiskFilename(const Filename: string): string;
     function FindUnitInDirectory(const Directory, AUnitName: string;
                                  AnyCase: boolean = false): string;
@@ -212,6 +219,8 @@ type
                                                    write FOnFindVirtualFile;
     property OnGetUnitFromSet: TCTGetUnitFromSet read FOnGetUnitFromSet
                                                  write FOnGetUnitFromSet;
+    property OnIterateFPCUnitsFromSet: TCTIterateFPCUnitsFromSet
+                 read FOnIterateFPCUnitsFromSet write FOnIterateFPCUnitsFromSet;
   end;
   
 function CompareCTDirectoryCaches(Data1, Data2: Pointer): integer;
@@ -1089,6 +1098,15 @@ begin
   end;
 end;
 
+procedure TCTDirectoryCache.IterateFPCUnitsInSet(const Iterate: TCTOnIterateFile
+  );
+var
+  UnitSet: string;
+begin
+  UnitSet:=Strings[ctdcsUnitSet];
+  Pool.OnIterateFPCUnitsFromSet(UnitSet,Iterate);
+end;
+
 procedure TCTDirectoryCache.WriteListing;
 var
   i: Integer;
@@ -1241,6 +1259,23 @@ begin
   Result:=Cache.FindUnitInUnitSet(AUnitName);
 end;
 
+procedure TCTDirectoryCachePool.IterateFPCUnitsInSet(const Directory: string;
+  const Iterate: TCTOnIterateFile);
+
+  procedure RaiseDirNotAbsolute;
+  begin
+    raise Exception.Create('TCTDirectoryCachePool.IterateFPCUnitsInSet not absolute Directory="'+Directory+'"');
+  end;
+
+var
+  Cache: TCTDirectoryCache;
+begin
+  if (Directory<>'') and not FilenameIsAbsolute(Directory) then
+    RaiseDirNotAbsolute;
+  Cache:=GetCache(Directory,true,false);
+  Cache.IterateFPCUnitsInSet(Iterate);
+end;
+
 function TCTDirectoryCachePool.FindDiskFilename(const Filename: string
   ): string;
 var

components/codetools/examples/identifiercompletion.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="7"/>
+    <Version Value="8"/>
     <General>
       <Flags>
         <LRSInOutputDirectory Value="False"/>
@@ -11,7 +11,7 @@
       <TargetFileExt Value=""/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
     </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
@@ -44,7 +44,12 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="9"/>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
     <Other>
       <CompilerPath Value="$(CompPath)"/>
     </Other>

components/codetools/examples/identifiercompletion.lpr

@@ -34,12 +34,12 @@ uses
 const
   ConfigFilename = 'codetools.config';
 var
-  Options: TCodeToolsOptions;
   Filename: string;
   Code: TCodeBuffer;
   X: Integer;
   Y: Integer;
-  //Tool: TCodeTool;
+  Cnt: longint;
+  i: Integer;
 begin
   if (ParamCount>=1) and (Paramcount<3) then begin
     writeln('Usage:');
@@ -47,48 +47,21 @@ begin
     writeln('  ',ParamStr(0),' <filename> <X> <Y>');
   end;
 
-  // setup the Options
+  CodeToolBoss.SimpleInit(ConfigFilename);
-  Options:=TCodeToolsOptions.Create;
-
-  // To not parse the FPC sources every time, the options are saved to a file.
-  writeln('Config=',ConfigFilename);
-  if FileExists(ConfigFilename) then begin
-    Options.LoadFromFile(ConfigFilename);
-  end else begin
-    Options.InitWithEnvironmentVariables;
-    if Options.FPCPath='' then
-      Options.FPCPath:='/usr/bin/ppc386';
-    if Options.FPCSrcDir='' then
-      Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
-    if Options.LazarusSrcDir='' then
-      Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
-  end;
 
   // optional: ProjectDir and TestPascalFile exists only to easily test some
   // things.
-  Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
+  Filename:=TrimFilename(SetDirSeparators(GetCurrentDir+'/scanexamples/identcomplexample.pas'));
-  Options.TestPascalFile:=Options.ProjectDir+'identcomplexample.pas';
   X:=20;
-  Y:=10;
+  Y:=11;
 
-  // init the codetools
-  if not Options.UnitLinkListValid then
-    writeln('Scanning FPC sources may take a while ...');
-  CodeToolBoss.Init(Options);
-
-  // save the options and the FPC unit links results.
-  Options.SaveToFile(ConfigFilename);
-
-  writeln('FPCSrcDir=',Options.FPCSrcDir);
-  writeln('FPC=',Options.FPCPath);
   if (ParamCount>=3) then begin
-    Options.TestPascalFile:=ExpandFileName(ParamStr(1));
+    Filename:=ExpandFileName(ParamStr(1));
     X:=StrToInt(ParamStr(2));
     Y:=StrToInt(ParamStr(3));
   end;
 
   // load the file
-  Filename:=Options.TestPascalFile;
   Code:=CodeToolBoss.LoadFile(Filename,false,false);
   if Code=nil then
     raise Exception.Create('loading failed '+Filename);
@@ -100,7 +73,11 @@ begin
   writeln('GatherIdentifiers ',Code.Filename,'(X=',X,',Y=',Y,')');
   if CodeToolBoss.GatherIdentifiers(Code,X,Y) then
   begin
-    writeln('Identifiers found: Count=',CodeToolBoss.IdentifierList.Count);
+    writeln('Identifiers found: Count=',CodeToolBoss.IdentifierList.Count,' FilteredCount=',CodeToolBoss.IdentifierList.GetFilteredCount);
+    Cnt:=CodeToolBoss.IdentifierList.GetFilteredCount;
+    if Cnt>10 then Cnt:=10;
+    for i:=0 to Cnt-1 do
+      writeln(i,'/',CodeToolBoss.IdentifierList.GetFilteredCount,': ',CodeToolBoss.IdentifierList.FilteredItems[i].AsString);
   end else begin
     raise Exception.Create('GatherIdentifiers failed');
   end;

components/codetools/identcompletiontool.pas

@@ -1397,6 +1397,13 @@ procedure TIdentCompletionTool.GatherUnitnames(CleanPos: integer;
 var
   TreeOfUnitFiles: TAVLTree;
 
+  {$IFDEF EnableFPCCache}
+  procedure GatherUnitsFromSet;
+  begin
+    // collect all unit files in fpc unit paths
+    //DirectoryCache.IterateFPCUnitsInSet();
+  end;
+  {$ELSE}
   procedure GatherUnitsFromUnitLinks;
   var
     UnitLinks: string;
@@ -1426,6 +1433,7 @@ var
         inc(UnitLinkStart);
     end;
   end;
+  {$ENDIF}
   
 var
   UnitPath, SrcPath: string;
@@ -1446,12 +1454,20 @@ begin
   try
     // search in unitpath
     UnitExt:='pp;pas;ppu';
+    if Scanner.CompilerMode=cmMacPas then
+      UnitExt:=UnitExt+';p';
     GatherUnitFiles(BaseDir,UnitPath,UnitExt,false,true,TreeOfUnitFiles);
     // search in srcpath
     SrcExt:='pp;pas';
+    if Scanner.CompilerMode=cmMacPas then
+      SrcExt:=SrcExt+';p';
     GatherUnitFiles(BaseDir,SrcPath,SrcExt,false,true,TreeOfUnitFiles);
     // add unitlinks
+    {$IFDEF EnableFPCCache}
+    GatherUnitsFromSet;
+    {$ELSE}
     GatherUnitsFromUnitLinks;
+    {$ENDIF}
     // create list
     CurSourceName:=GetSourceName;
     ANode:=TreeOfUnitFiles.FindLowest;