MG: outputfilter can now find include files

git-svn-id: trunk@858 -

ide/ideprocs.pp

@@ -1,6 +1,8 @@
 {
-  Simple functions for file access, not yet in fpc.
-
+  Simple functions
+   - for file access, not yet in fpc.
+   - recent list
+   - xmlconfig formats
 }
 unit IDEProcs;
 
@@ -17,7 +19,7 @@ const
   EndOfLine:shortstring={$IFDEF win32}#13+{$ENDIF}#10;
 
 // files
-function FilenameIsAbsolute(TheFilename: string):boolean;
+function FilenameIsAbsolute(Filename: string):boolean;
 function DirectoryExists(DirectoryName: string): boolean;
 function ForceDirectory(DirectoryName: string): boolean;
 function ExtractFileNameOnly(const AFilename: string): string;
@@ -27,22 +29,24 @@ function FileIsReadable(const AFilename: string): boolean;
 function FileIsWritable(const AFilename: string): boolean;
 function FileIsText(const AFilename: string): boolean;
 function CompareFilenames(const Filename1, Filename2: string): integer;
+function AppendPathDelim(const Path: string): string;
+function SearchFileInPath(const Filename, BasePath, SearchPath,
+                          Delimiter: string): string;
 
 // XMLConfig
 procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStringList; 
   const Path: string);
 procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStringList; 
   const Path: string);
+procedure AddToRecentList(const s: string; RecentList: TStringList;
+  Max: integer);
 procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; var ARect:TRect);
 procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; var ARect:TRect);
 
-// various
-procedure AddToRecentList(const s: string; RecentList: TStringList;
-  Max: integer);
-
 
 implementation
 
+
 // to get more detailed error messages consider the os
 {$IFDEF Win32}
 {$ELSE}
@@ -165,15 +169,15 @@ begin
   Result:=copy(Result,1,length(Result)-ExtLen);
 end;
 
-function FilenameIsAbsolute(TheFilename: string):boolean;
+function FilenameIsAbsolute(Filename: string):boolean;
 begin
-  DoDirSeparators(TheFilename);
+  DoDirSeparators(Filename);
   {$IFDEF win32}
   // windows
-  Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and 
-     (upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
+  Result:=(copy(Filename,1,2)='\\') or ((length(Filename)>3) and
+     (upcase(Filename[1]) in ['A'..'Z']) and (copy(Filename,2,2)=':\'));
   {$ELSE}
-  Result:=(TheFilename<>'') and (TheFilename[1]='/');
+  Result:=(Filename<>'') and (Filename[1]='/');
   {$ENDIF}
 end;
 
@@ -262,4 +266,42 @@ begin
   end;
 end;
 
+function AppendPathDelim(const Path: string): string;
+begin
+  if (Path<>'') and (Path[length(Path)]<>PathDelim) then
+    Result:=Path+PathDelim
+  else
+    Result:=Path;
+end;
+
+function SearchFileInPath(const Filename, BasePath, SearchPath,
+  Delimiter: string): string;
+var
+  p, StartPos, l: integer;
+  CurPath, Base: string;
+begin
+  if (Filename='')
+  or (FilenameIsAbsolute(Filename) and FileExists(Filename))
+  then begin
+    Result:=Filename;
+    exit;
+  end;
+  Base:=ExpandFilename(AppendPathDelim(BasePath));
+  StartPos:=1;
+  l:=length(SearchPath);
+  while StartPos<=l do begin
+    p:=StartPos;
+    while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do inc(p);
+    CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos));
+    if CurPath<>'' then begin
+      if not FilenameIsAbsolute(CurPath) then
+        CurPath:=Base+CurPath;
+      Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename);
+      if FileExists(Result) then exit;
+    end;
+    StartPos:=p+1;
+  end;
+  Result:='';
+end;
+
 end.

ide/outputfilter.pas

@@ -29,7 +29,8 @@ uses
   IDEProcs;
 
 type
-  TOnOutputString = procedure (const Value: String) of Object;
+  TOnOutputString = procedure(const Value: String) of Object;
+  TOnGetIncludePath = function(const Directory: string): string of object;
   
   TOuputFilterOption = (
         ofoSearchForFPCMessages, // scan for freepascal compiler messages
@@ -51,11 +52,13 @@ type
     fLastMessageType: TOutputMessageType;
     fCompilingHistory: TStringList;
     fMakeDirHistory: TStringList;
+    fOnGetIncludePath: TOnGetIncludePath;
     fOnOutputString: TOnOutputString;
     fOptions: TOuputFilterOptions;
     fProject: TProject;
     fPrgSourceFilename: string;
     procedure DoAddFilteredLine(const s: string);
+    function SearchIncludeFile(const ShortIncFilename: string): string;
   public
     procedure Execute(TheProcess: TProcess);
     function GetSourcePosition(const Line: string; var Filename:string;
@@ -75,6 +78,8 @@ type
     property LastMessageType: TOutputMessageType read fLastMessageType;
     property PrgSourceFilename: string
       read fPrgSourceFilename write fPrgSourceFilename;
+    property OnGetIncludePath: TOnGetIncludePath
+      read fOnGetIncludePath write fOnGetIncludePath;
     property OnOutputString: TOnOutputString
       read fOnOutputString write fOnOutputString;
     property Options: TOuputFilterOptions read fOptions write fOptions;
@@ -196,9 +201,11 @@ var i, j, FilenameEndPos: integer;
 begin
   Result:=false;
   if ('Compiling '=copy(s,1,length('Compiling '))) then begin
+    // for example 'Compiling ./subdir/unit1.pas'
     fLastMessageType:=omtFPC;
     fLastErrorType:=etNone;
     Result:=true;
+    // add path to history
     if fCompilingHistory=nil then fCompilingHistory:=TStringList.Create;
     i:=length('Compiling ');
     if (length(s)>=i+2) and (s[i+1]='.') and (s[i+2]=PathDelim) then
@@ -299,9 +306,14 @@ begin
         end;
       end else
         SkipMessage:=false;
+      // beautify compiler message
+      
+      // the compiler always gives short filenames, even if it has gone into a
+      // subdirectory
+      // -> prepend the current subdirectory
       Msg:=s;
       if (fCompilingHistory<>nil) then begin
-        Filename:=copy(s,1,FilenameEndPos);
+        Filename:=copy(Msg,1,FilenameEndPos);
         if not FilenameIsAbsolute(Filename) then begin
           i:=fCompilingHistory.Count-1;
           while (i>=0) do begin
@@ -314,10 +326,18 @@ begin
             end;
             dec(i);
           end;
+          if i<0 then begin
+            // this file is not a compiled pascal soure
+            // -> search for include files
+            Filename:=SearchIncludeFile(Filename);
+            Msg:=Filename+copy(Msg,FileNameEndPos+1,length(Msg)-FileNameEndPos);
+            FileNameEndPos:=length(Filename);
+          end;
         end;
       end;
+      
       if (ofoMakeFilenamesAbsolute in Options) then begin
-        Filename:=copy(s,1,FilenameEndPos);
+        Filename:=copy(Msg,1,FilenameEndPos);
         if not FilenameIsAbsolute(Filename) then begin
           Msg:=fCurrentDirectory+Msg;
         end;
@@ -419,6 +439,48 @@ begin
     OnOutputString(s);
 end;
 
+function TOutputFilter.SearchIncludeFile(const ShortIncFilename: string
+  ): string;
+// search the include file and make it relative to the current start directory
+var SearchedDirectories: TStringList;
+  FullDir, RelativeDir, IncludePath: string;
+  p: integer;
+begin
+  if fCompilingHistory=nil then begin
+    Result:=ShortIncFilename;
+    exit;
+  end;
+  SearchedDirectories:=TStringList.Create;
+  try
+    // try every compiled pascal source
+    for p:=fCompilingHistory.Count-1 downto 0 do begin
+      RelativeDir:=AppendPathDelim(ExtractFilePath(fCompilingHistory[p]));
+      FullDir:=AppendPathDelim(ExpandFilename(fCurrentDirectory+RelativeDir));
+      if SearchedDirectories.IndexOf(FullDir)>=0 then continue;
+      // new directory start a search
+      if FileExists(FullDir+ShortIncFilename) then begin
+        // file found in search dir
+        Result:=RelativeDir+ShortIncFilename;
+        exit;
+      end;
+      if Assigned(OnGetIncludePath) then begin
+        // search with include path of directory
+        IncludePath:=OnGetIncludePath(FullDir);
+        Result:=SearchFileInPath(ShortIncFilename,FullDir,IncludePath,';');
+        if Result<>'' then begin
+          if LeftStr(Result,length(fCurrentDirectory))=fCurrentDirectory then
+            Result:=RightStr(Result,length(Result)-length(fCurrentDirectory));
+          exit;
+        end;
+      end;
+      SearchedDirectories.Add(FullDir);
+    end;
+  finally
+    SearchedDirectories.Free;
+  end;
+  Result:=ShortIncFilename;
+end;
+
 destructor TOutputFilter.Destroy;
 begin
   fFilteredOutput.Free;

lcl/include/control.inc

@@ -1349,6 +1349,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.33  2002/03/08 11:37:42  lazarus
+  MG: outputfilter can now find include files
+
   Revision 1.32  2002/01/01 18:38:36  lazarus
   MG: more wmsize messages :(