codetools: adding heuristic to scan the Makefile.fpc files of the FPC sources

git-svn-id: trunk@10363 -

components/codetools/basiccodetools.pas

@@ -132,6 +132,7 @@ function CompareIdentifierPtrs(Identifier1, Identifier2: Pointer): integer;
 function ComparePrefixIdent(PrefixIdent, Identifier: PChar): boolean;
 function TextBeginsWith(Txt: PChar; TxtLen: integer; StartTxt: PChar;
     StartTxtLen: integer; CaseSensitive: boolean): boolean;
+function StrBeginsWith(const s, Prefix: string): boolean;
 
 // space and special chars
 function TrimCodeSpace(const ACode: string): string;
@@ -2613,6 +2614,25 @@ begin
   Result:=CompareText(Txt,StartTxtLen,StartTxt,StartTxtLen,CaseSensitive)=0;
 end;
 
+function StrBeginsWith(const s, Prefix: string): boolean;
+var
+  p1: PChar;
+  p2: PChar;
+  i: Integer;
+begin
+  Result:=false;
+  if length(s)<length(Prefix) then exit;
+  if (s='') then exit(true);
+  p1:=PChar(s);
+  p2:=PChar(Prefix);
+  for i:=1 to length(Prefix) do begin
+    if p1^<>p2^ then exit;
+    inc(p1);
+    inc(p2);
+  end;
+  Result:=true;
+end;
+
 function GetIdentifier(Identifier: PChar): string;
 var len: integer;
 begin

components/codetools/definetemplates.pas

@@ -479,6 +479,10 @@ procedure SplitLazarusCPUOSWidgetCombo(const Combination: string;
 function CreateDefinesInDirectories(const SourcePaths, FlagName: string
                                     ): TDefineTemplate;
 
+procedure ReadMakefileFPC(const Filename: string; List: TStrings);
+procedure ParseMakefileFPC(const Filename, SrcOS: string;
+                           var Dirs, SubDirs: string);
+
 
 implementation
 
@@ -495,6 +499,140 @@ type
 
 // some useful functions
 
+procedure ReadMakefileFPC(const Filename: string; List: TStrings);
+var
+  MakefileFPC: TStringList;
+  i: Integer;
+  Line: string;
+  p: LongInt;
+  NameValue: String;
+begin
+  MakefileFPC:=TStringList.Create;
+  MakefileFPC.LoadFromFile(Filename);
+  i:=0;
+  while i<MakefileFPC.Count do begin
+    Line:=MakefileFPC[i];
+    if Line='' then begin
+    end else if (Line[1]='[') then begin
+      // start of section
+      p:=System.Pos(']',Line);
+      if p<1 then p:=length(Line);
+      List.Add(Line);
+    end else if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
+      // start of name=value pair
+      NameValue:=Line;
+      repeat
+        p:=length(NameValue);
+        while (p>=1) and (NameValue[p] in [' ',#9]) do dec(p);
+        //List.Add('AAA1 NameValue="'+NameValue+'" p='+IntToStr(p)+' "'+NameValue[p]+'"');
+        if (p>=1) and (NameValue[p]='\')
+        and ((p=1) or (NameValue[p-1]<>'\')) then begin
+          // append next line
+          NameValue:=copy(NameValue,1,p-1);
+          //List.Add('AAA2 NameValue="'+NameValue+'"');
+          inc(i);
+          if i>=MakefileFPC.Count then break;
+          NameValue:=NameValue+MakefileFPC[i];
+          //List.Add('AAA3 NameValue="'+NameValue+'"');
+        end else break;
+      until false;
+      List.Add(NameValue);
+    end;
+    inc(i);
+  end;
+  MakefileFPC.Free;
+end;
+
+procedure ParseMakefileFPC(const Filename, SrcOS: string;
+  var Dirs, SubDirs: string);
+
+  function MakeSearchPath(const s: string): string;
+  var
+    SrcPos: Integer;
+    DestPos: Integer;
+  begin
+    // check how much space is needed
+    SrcPos:=1;
+    DestPos:=0;
+    while (SrcPos<=length(s)) do begin
+      if s[SrcPos] in [#0..#31] then begin
+        // space is a delimiter
+        inc(SrcPos);
+        // skip multiple spaces
+        while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#31]) do inc(SrcPos);
+        if (DestPos>0) and (SrcPos<=length(s)) then begin
+          inc(DestPos);// add semicolon
+        end;
+      end else begin
+        inc(DestPos);
+        inc(SrcPos);
+      end;
+    end;
+
+    // allocate space
+    SetLength(Result,DestPos);
+
+    // create semicolon delimited search path
+    SrcPos:=1;
+    DestPos:=0;
+    while (SrcPos<=length(s)) do begin
+      if s[SrcPos] in [#0..#32] then begin
+        // space is a delimiter
+        inc(SrcPos);
+        // skip multiple spaces
+        while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#32]) do inc(SrcPos);
+        if (DestPos>0) and (SrcPos<=length(s)) then begin
+          inc(DestPos);// add semicolon
+          Result[DestPos]:=';';
+        end;
+      end else begin
+        inc(DestPos);
+        Result[DestPos]:=s[SrcPos];
+        inc(SrcPos);
+      end;
+    end;
+  end;
+
+var
+  Params: TStringList;
+  i: Integer;
+  Line: string;
+  p: LongInt;
+  Name: String;
+  SubDirsName: String;
+begin
+  SubDirs:='';
+  Dirs:='';
+  Params:=TStringList.Create;
+  try
+    ReadMakefileFPC(Filename,Params);
+
+    SubDirsName:='';
+    if SrcOS<>'' then
+      SubDirsName:='dirs_'+SrcOS;
+
+    for i:=0 to Params.Count-1 do begin
+      Line:=Params[i];
+      if Line='' then continue;
+      if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
+        p:=System.Pos('=',Line);
+        if p<1 then continue;
+        Name:=copy(Line,1,p-1);
+        if Name=SubDirsName then begin
+          SubDirs:=MakeSearchPath(copy(Line,p+1,length(Line)));
+        end else if Name='dirs' then begin
+          Dirs:=MakeSearchPath(copy(Line,p+1,length(Line)));
+        end;
+      end;
+    end;
+  except
+    on e: Exception do begin
+      debugln('ParseMakefileFPC Filename=',Filename,' E.Message=',E.Message);
+    end;
+  end;
+  Params.Free;
+end;
+
 function DefineActionNameToAction(const s: string): TDefineAction;
 begin
   for Result:=Low(TDefineAction) to High(TDefineAction) do
@@ -3039,7 +3177,7 @@ var
       Result:=FPCSrcDir+Result;
     end;
     
-    procedure BrowseDirectory(ADirPath: string);
+    procedure BrowseDirectory(ADirPath: string; Priority: integer);
     const
       IgnoreDirs: array[1..16] of shortstring =(
           '.', '..', 'CVS', '.svn', 'examples', 'example', 'tests', 'fake',
@@ -3052,18 +3190,33 @@ var
       NewUnitLink, OldUnitLink: TDefTemplUnitNameLink;
       i: integer;
       MacroCount, UsedMacroCount: integer;
-      Priority: Integer;
+      MakeFileFPC: String;
+      SubDirs, GlobalSubDirs, TargetSubDirs: String;
+      SubPriority: Integer;
     begin
       {$IFDEF VerboseFPCSrcScan}
       DebugLn('Browse ',ADirPath);
       {$ENDIF}
       if ADirPath='' then exit;
-      if not (ADirPath[length(ADirPath)]=PathDelim) then
+      ADirPath:=AppendPathDelim(ADirPath);
-        ADirPath:=ADirPath+PathDelim;
+      
+      // read Makefile.fpc to get some hints
+      MakeFileFPC:=ADirPath+'Makefile.fpc';
+      SubDirs:='';
+      if FileExists(MakeFileFPC) then begin
+        ParseMakefileFPC(MakeFileFPC,DefaultTargetOS,GlobalSubDirs,TargetSubDirs);
+        SubDirs:=GlobalSubDirs;
+        if TargetSubDirs<>'' then begin
+          if SubDirs<>'' then
+            SubDirs:=SubDirs+';';
+          SubDirs:=SubDirs+TargetSubDirs;
+        end;
+        //debugln('BrowseDirectory ADirPath="',ADirPath,'" SubDirs="',SubDirs,'" SrcOS="',DefaultTargetOS,'"');
+      end;
+
       // set directory priority
-      Priority:=0;
       if System.Pos(AppendPathDelim(FPCSrcDir)+'rtl'+PathDelim,ADirPath)>0 then
-        Priority:=1;
+        inc(Priority);
       // search sources .pp,.pas
       if FindFirst(ADirPath+FileMask,faAnyFile,FileInfo)=0 then begin
         repeat
@@ -3078,8 +3231,22 @@ var
           if i>=Low(IgnoreDirs) then continue;
           AFilename:=ADirPath+AFilename;
           if (FileInfo.Attr and faDirectory)>0 then begin
+            // directory -> recursively
             // ToDo: prevent cycling in links
-            BrowseDirectory(AFilename);
+            SubPriority:=0;
+            if CompareFilenames(AFilename,AppendPathDelim(FPCSrcDir)+'rtl')=0
+            then begin
+              // units in 'rtl' have higher priority than other directories
+              inc(SubPriority);
+            end;
+            if (SubDirs<>'')
+            and (FindPathInSearchPath(@FileInfo.Name[1],length(FileInfo.Name),
+              PChar(SubDirs),length(SubDirs))<>nil)
+            then begin
+              // units in directories compiled by the Makefile have higher prio
+              inc(SubPriority);
+            end;
+            BrowseDirectory(AFilename,SubPriority);
           end else begin
             Ext:=UpperCaseStr(ExtractFileExt(AFilename));
             if (Ext='.PP') or (Ext='.PAS') or (Ext='.P') then begin
@@ -3185,7 +3352,7 @@ var
                   then begin
                     // <FPCSrcDir>/rtl/netwlibc/libc.pp
                     // <FPCSrcDir>/packages/base/libc/libc.pp
-                    Priority:=2;
+                    inc(Priority,2);
                   end;
                   if (UsedMacroCount>OldUnitLink.UsedMacroCount)
                   or ((UsedMacroCount=OldUnitLink.UsedMacroCount)
@@ -3212,7 +3379,7 @@ var
       UnitTree:=TAVLTree.Create(@CompareUnitLinkNodes)
     else
       UnitTree.FreeAndClear;
-    BrowseDirectory(FPCSrcDir);
+    BrowseDirectory(FPCSrcDir,0);
   end;
   
 

components/codetools/examples/finddeclaration.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
+    <PathDelim Value="\"/>
     <Version Value="5"/>
     <General>
       <SessionStorage Value="InProjectDir"/>
@@ -17,7 +17,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -32,7 +32,7 @@
         <UnitName Value="finddeclaration"/>
       </Unit0>
       <Unit1>
-        <Filename Value="scanexamples/simpleunit1.pas"/>
+        <Filename Value="scanexamples\simpleunit1.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="SimpleUnit1"/>
       </Unit1>
@@ -40,8 +40,9 @@
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="5"/>
+    <PathDelim Value="\"/>
     <SearchPaths>
-      <OtherUnitFiles Value="scanexamples/"/>
+      <OtherUnitFiles Value="scanexamples\"/>
     </SearchPaths>
     <CodeGeneration>
       <Generate Value="Faster"/>

components/codetools/examples/finddeclaration.lpr

@@ -48,13 +48,13 @@ begin
     Options.LoadFromFile(ConfigFilename);
 
   // setup your paths
-  Options.FPCPath:='/usr/bin/ppc386';
+  Options.FPCPath:='C:\lazarus\fpc\2.0.4\bin\i386-win32\ppc386.exe'; //'/usr/bin/ppc386';
-  Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
+  Options.FPCSrcDir:='C:\lazarus\fpc\2.0.4\source'; // ExpandFileName('~/freepascal/fpc');
-  Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
+  Options.LazarusSrcDir:='C:\lazarus\'; // ExpandFileName('~/pascal/lazarus');
   
   // optional: ProjectDir and TestPascalFile exists only to easily test some
   // things.
-  Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
+  Options.ProjectDir:=SetDirSeparators(GetCurrentDir+'/scanexamples/');
   Options.TestPascalFile:=Options.ProjectDir+'simpleunit1.pas';
 
   // init the codetools
@@ -73,7 +73,7 @@ begin
     raise Exception.Create('loading failed '+Options.TestPascalFile);
 
   // Step 2: find declaration
-  if CodeToolBoss.FindDeclaration(Code,22,33,NewCode,NewX,NewY,NewTopLine) then
+  if CodeToolBoss.FindDeclaration(Code,22,30,NewCode,NewX,NewY,NewTopLine) then
   begin
     writeln('Declaration found: ',NewCode.Filename,' Line=',NewY,' Column=',NewX);
   end else begin

components/codetools/examples/scanexamples/simpleunit1.pas

@@ -27,7 +27,7 @@ unit SimpleUnit1;
 interface
 
 uses
-  Classes, SysUtils; 
+  Classes, SysUtils, zlib;
   
 type
   TMyClass = class(TObject)

components/images/lazjpg.pas

@@ -45,7 +45,7 @@ type
     class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
   public
     property CompressionQuality: TJPGQualityRange read FQuality write FQuality;
-    property ProgressiveEncoding: boolean read FProgressiveEncoding;
+    property ProgressiveEncoding: boolean read FProgressiveEncoding write FProgressiveEncoding;
     property Performance: TJPGPerformance read FPerformance write FPerformance;
   end;
 

ide/lazconf.pp

@@ -309,8 +309,8 @@ begin
   if DirPathExists(ADirectory) then begin
     Dir:=AppendPathDelim(ADirectory);
     Result:=DirPathExists(Dir+'lcl')
-        and DirPathExists(Dir+'lcl'+PathDelim+'units')
         and DirPathExists(Dir+'components')
+        and DirPathExists(Dir+'ide')
         and DirPathExists(Dir+'ideintf')
         and DirPathExists(Dir+'designer')
         and DirPathExists(Dir+'debugger');

ide/revision.inc

@@ -1,2 +1,2 @@
 // Created by Svn2RevisionInc
-const RevisionStr = '10289M';
+const RevisionStr = '10362';