MG: external tool output parsing for fpc and make messages

git-svn-id: trunk@618 -

components/codetools/allcodetoolunits.pp

@@ -28,6 +28,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.6  2002/01/23 22:12:54  lazarus
+  MG: external tool output parsing for fpc and make messages
+
   Revision 1.5  2001/12/15 22:57:19  lazarus
   MG: added find declaration (not useful yet)
 

ide/exttooldialog.pas

@@ -31,35 +31,46 @@ uses
   {$ENDIF}
   Classes, SysUtils, LCLLinux, Controls, Forms, Buttons, StdCtrls, ComCtrls, 
   Dialogs, ExtCtrls, LResources, XMLCfg, ExtToolEditDlg, Process, KeyMapping,
-  TransferMacros, IDEProcs;
+  TransferMacros, IDEProcs, OutputFilter;
 
 const
   MaxExtTools = ecExtToolLast-ecExtToolFirst+1;
 
 type
+  TOnNeedsOutputFilter = procedure(var OutputFilter: TOutputFilter;
+                           var Abort: boolean) of object;
+
   {
     the storage object for all external tools
   }
   TExternalToolList = class(TList)
   private
+    fOnNeedsOutputFilter: TOnNeedsOutputFilter;
+    fRunningTools: TList; // list of TProcess
     function GetToolOpts(Index: integer): TExternalToolOptions;
     procedure SetToolOpts(Index: integer; NewTool: TExternalToolOptions);
+    procedure AddRunningTool(TheProcess: TProcess; ExecuteProcess: boolean);
   public
     procedure Add(NewTool: TExternalToolOptions);
     procedure Assign(Source: TExternalToolList);
-    constructor Create; 
+    procedure Clear; override;
+    constructor Create;
     procedure Delete(Index: integer); 
     destructor Destroy; override;
-    procedure Clear; override;
+    procedure FreeStoppedProcesses;
     procedure Insert(Index: integer; NewTool: TExternalToolOptions);
     function Load(XMLConfig: TXMLConfig; const Path: string): TModalResult;
     procedure LoadShortCuts(KeyCommandRelationList: TKeyCommandRelationList);
+    function Run(ExtTool: TExternalToolOptions;
+      Macros: TTransferMacroList): TModalResult;
     function Run(Index: integer; Macros: TTransferMacroList): TModalResult;
     function Save(XMLConfig: TXMLConfig; const Path: string): TModalResult;
     procedure SaveShortCuts(KeyCommandRelationList: TKeyCommandRelationList);
     
     property Items[Index: integer]: TExternalToolOptions
-           read GetToolOpts write SetToolOpts; default;
+      read GetToolOpts write SetToolOpts; default;
+    property OnNeedsOutputFilter: TOnNeedsOutputFilter
+      read fOnNeedsOutputFilter write fOnNeedsOutputFilter;
   end;
   
   {
@@ -170,6 +181,8 @@ end;
 
 destructor TExternalToolList.Destroy;
 begin
+  if fRunningTools<>nil then
+    fRunningTools.Free;
   inherited Destroy;
 end;
 
@@ -221,14 +234,26 @@ end;
 
 function TExternalToolList.Run(Index: integer;
   Macros: TTransferMacroList): TModalResult;
-var WorkingDir, Filename, Params, CmdLine: string;
-  TheProcess: TProcess;
 begin
   Result:=mrCancel;
   if (Index<0) or (Index>=Count) then exit;
-  Filename:=Items[Index].Filename;
-  WorkingDir:=Items[Index].WorkingDirectory;
-  Params:=Items[Index].CmdLineParams;
+  Run(Items[Index],Macros);
+end;
+
+function TExternalToolList.Run(ExtTool: TExternalToolOptions;
+  Macros: TTransferMacroList): TModalResult;
+var WorkingDir, Filename, Params, CmdLine, Title: string;
+  TheProcess: TProcess;
+  TheOutputFilter: TOutputFilter;
+  Abort: boolean;
+begin
+  Result:=mrCancel;
+  if ExtTool=nil then exit;
+  Filename:=ExtTool.Filename;
+  WorkingDir:=ExtTool.WorkingDirectory;
+  Params:=ExtTool.CmdLineParams;
+  Title:=ExtTool.Title;
+  if Title='' then Title:=Filename;
   if Macros.SubstituteStr(Filename) 
   and Macros.SubstituteStr(WorkingDir)
   and Macros.SubstituteStr(Params) then begin
@@ -243,12 +268,45 @@ writeln('[TExternalToolList.Run] ',CmdLine);
       TheProcess.Options:= [poUsePipes, poNoConsole];
       TheProcess.ShowWindow := swoNone;
       TheProcess.CurrentDirectory := WorkingDir;
-      TheProcess.Execute;
+      if (ExtTool.NeedsOutputFilter)
+      and Assigned(OnNeedsOutputFilter) then begin
+        Abort:=false;
+        OnNeedsOutputFilter(TheOutputFilter,Abort);
+        if Abort then begin
+          Result:=mrAbort;
+          exit;
+        end;
+      end else
+        TheOutputFilter:=nil;
+      if (TheOutputFilter<>nil) then begin
+        TheOutputFilter.PrgSourceFilename:='';
+        TheOutputFilter.Options:=[ofoExceptionOnError,ofoMakeFilenamesAbsolute];
+        if ExtTool.ScanOutputForFPCMessages then
+          TheOutputFilter.Options:=TheOutputFilter.Options
+                                   +[ofoSearchForFPCMessages];
+        if ExtTool.ScanOutputForMakeMessages then
+          TheOutputFilter.Options:=TheOutputFilter.Options
+                                   +[ofoSearchForMakeMessages];
+        try
+          if TheOutputFilter.IsParsing then begin
+            TheOutputFilter.Execute(TheProcess);
+            TheOutputFilter.ReadLine('"'+Title+'" successfully runned :)',true);
+          end else
+            TheProcess.Execute;
+        finally
+          TheProcess.WaitOnExit;
+          TheProcess.Free;
+        end;
+      end else begin
+        AddRunningTool(TheProcess,true);
+      end;
     except
+      on e: EOutputFilterError do begin
+        raise;
+      end;
       on e: Exception do
         MessageDlg('Failed to run tool',
-          'Unable to run the tool "'+Items[Index].Title+'":'#13
-          +e.Message,mtError,[mbOk],0);
+          'Unable to run the tool "'+Title+'":'#13+e.Message,mtError,[mbOk],0);
     end;
   end;
   Result:=mrOk;
@@ -283,6 +341,42 @@ begin
   end;
 end;
 
+procedure TExternalToolList.AddRunningTool(TheProcess: TProcess;
+  ExecuteProcess: boolean);
+begin
+  if fRunningTools=nil then fRunningTools:=TList.Create;
+  fRunningTools.Add(TheProcess);
+  if ExecuteProcess then
+    TheProcess.Execute;
+end;
+
+procedure TExternalToolList.FreeStoppedProcesses;
+var i: integer;
+  TheProcess: TProcess;
+begin
+  if fRunningTools=nil then exit;
+  i:=fRunningTools.Count-1;
+  while i>=0 do begin
+    try
+      TheProcess:=TProcess(fRunningTools[i]);
+      if not TheProcess.Running then begin
+        try
+          TheProcess.WaitOnExit;
+          TheProcess.Free;
+        finally
+          fRunningTools.Delete(i);
+        end;
+      end;
+    except
+      on E: Exception do begin
+        writeln('Error freeing stopped process: ',E.Message);
+      end;
+    end;
+    dec(i);
+  end;
+end;
+
+
 { TExternalToolDialog }
 
 constructor TExternalToolDialog.Create(AnOwner: TComponent);

ide/exttooleditdlg.pas

@@ -60,6 +60,7 @@ type
     constructor Create;
     destructor Destroy; override;
     procedure Clear;
+    function NeedsOutputFilter: boolean;
     function Load(XMLConfig: TXMLConfig; const Path: string): TModalResult;
     function Save(XMLConfig: TXMLConfig; const Path: string): TModalResult;
     function ShortDescription: string;
@@ -168,6 +169,8 @@ begin
     fWorkingDirectory:=Source.fWorkingDirectory;
     fKey:=Source.fKey;
     fShift:=Source.fShift;
+    fScanOutputForFPCMessages:=Source.fScanOutputForFPCMessages;
+    fScanOutputForMakeMessages:=Source.fScanOutputForMakeMessages;
   end;
 end;
 
@@ -219,9 +222,9 @@ begin
   XMLConfig.SetValue(Path+'Filename/Value',fFilename);
   XMLConfig.SetValue(Path+'CmdLineParams/Value',fCmdLineParams);
   XMLConfig.SetValue(Path+'WorkingDirectory/Value',fWorkingDirectory);
-  XMLConfig.GetValue(
+  XMLConfig.SetValue(
                Path+'ScanOutputForFPCMessages/Value',fScanOutputForFPCMessages);
-  XMLConfig.GetValue(
+  XMLConfig.SetValue(
              Path+'ScanOutputForMakeMessages/Value',fScanOutputForMakeMessages);
   // key and shift are saved with the keymapping in the editoroptions
   Result:=mrOk;
@@ -232,6 +235,11 @@ begin
   Result:=Title;
 end;
 
+function TExternalToolOptions.NeedsOutputFilter: boolean;
+begin
+  Result:=ScanOutputForFPCMessages or ScanOutputForMakeMessages;
+end;
+
 
 { TExternalToolOptionDlg }
 

ide/main.pp

@@ -33,7 +33,7 @@ uses
   MemCheck,
 {$ENDIF}
   Classes, LclLinux, Compiler, StdCtrls, Forms, Buttons, Menus, ComCtrls, Spin,
-  Project, Sysutils, FileCtrl, Controls, Graphics, ExtCtrls, Dialogs, LazConf,
+  Project, SysUtils, FileCtrl, Controls, Graphics, ExtCtrls, Dialogs, LazConf,
   CompReg, CodeToolManager, CodeCache, DefineTemplates, MsgView, NewProjectDlg,
   IDEComp, AbstractFormEditor, FormEditor, CustomFormEditor, ObjectInspector,
   PropEdits, ControlSelection, UnitEditor, CompilerOptions, EditorOptions,
@@ -275,21 +275,25 @@ type
                                     var Abort: boolean);
     procedure OnAfterCodeToolBossApplyChanges(Manager: TCodeToolManager);
     
-    // Debugger Events
+    // Debugger events
     procedure OnDebuggerChangeState(Sender: TObject);
     procedure OnDebuggerCurrentLine(Sender: TObject; 
        const ALocation: TDBGLocationRec);
     Procedure OnDebuggerWatchChanged(Sender : TObject);
     
-    // MessagesView Events
+    // MessagesView events
     procedure MessagesViewSelectionChanged(sender : TObject);
-    
-    //Hint Timer
+
+    // Hint Timer events
     Procedure HintTimer1Timer(Sender : TObject);
     
-    //Watch Dialog
+    // Watch Dialog events
     Procedure OnWatchAdded(Sender : TObject; AnExpression : String);
     
+    // External Tools events
+    procedure OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
+                      var Abort: boolean);
+    
   private
     FHintSender : TObject;
     FCodeLastActivated : Boolean; //used for toggling between code and forms
@@ -4200,8 +4204,21 @@ end;
 //-----------------------------------------------------------------------------
 
 function TMainIDE.DoRunExternalTool(Index: integer): TModalResult;
+var OldToolStatus: TIDEToolStatus;
 begin
-  Result:=EnvironmentOptions.ExternalTools.Run(Index,MacroList);
+  OldToolStatus:=ToolStatus;
+  try
+    EnvironmentOptions.ExternalTools.OnNeedsOutputFilter:=
+      @OnExtToolNeedsOutputFilter;
+    Result:=EnvironmentOptions.ExternalTools.Run(Index,MacroList);
+  except
+    on e: EOutputFilterError do begin
+      DoJumpToCompilerMessage(-1,true);
+      Result:=mrCancel;
+    end;
+  end;
+  if (OldToolStatus=itNone) and (ToolStatus=itBuilder) then
+    ToolStatus:=itNone;
 end;
 
 function TMainIDE.DoCheckSyntax: TModalResult;
@@ -4713,10 +4730,15 @@ begin
         end;
       end;
     end else begin
-      MessageDlg('Unable to find file "'+Filename+'".'
-         +' Check search path in'
-         +' Project->Compiler Options...->Search Paths->Other Unit Files',
-         mtInformation,[mbOk],0);
+      if FilenameIsAbsolute(Filename) then begin
+        MessageDlg('Unable to find file "'+Filename+'".',
+           mtInformation,[mbOk],0)
+      end else begin
+        MessageDlg('Unable to find file "'+Filename+'".'#13
+           +'Check search path in'#13
+           +'Run->Compiler Options...->Search Paths->Other Unit Files',
+           mtInformation,[mbOk],0);
+      end;
     end;
   end;
 end;
@@ -5606,6 +5628,26 @@ begin
   Breakpoints_Dlg.DeleteBreakPoint(TSourceNotebook(sender).GetActiveSe.FileName,Line);
 end;
 
+procedure TMainIDE.OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
+  var Abort: boolean);
+var ActiveSrcEdit: TSourceEditor;
+begin
+  OutputFilter:=TheOutputFilter;
+  OutputFilter.Project:=Project;
+  if ToolStatus<>itNone then begin
+    Abort:=true;
+    exit;
+  end;
+  ActiveSrcEdit:=SourceNotebook.GetActiveSE;
+  if ActiveSrcEdit<>nil then ActiveSrcEdit.ErrorLine:=-1;
+
+  ToolStatus:=itBuilder;
+  MessagesView.Clear;
+  DoArrangeSourceEditorAndMessageView;
+
+  TheOutputFilter.OnOutputString:=@MessagesView.Add;
+end;
+
 //-----------------------------------------------------------------------------
 
 initialization
@@ -5622,6 +5664,9 @@ end.
 =======
 
   $Log$
+  Revision 1.205  2002/01/23 22:12:54  lazarus
+  MG: external tool output parsing for fpc and make messages
+
   Revision 1.204  2002/01/23 20:07:20  lazarus
   MG: added outputfilter
 
@@ -5668,6 +5713,9 @@ end.
 
 <<<<<<< main.pp
   $Log$
+  Revision 1.205  2002/01/23 22:12:54  lazarus
+  MG: external tool output parsing for fpc and make messages
+
   Revision 1.204  2002/01/23 20:07:20  lazarus
   MG: added outputfilter
 

ide/outputfilter.pas

@@ -31,8 +31,12 @@ uses
 type
   TOnOutputString = procedure (const Value: String) of Object;
   
-  TOuputFilterOption = (ofoSearchForFPCMessages, ofoSearchForMakeMessages,
-        ofoExceptionOnError);
+  TOuputFilterOption = (
+        ofoSearchForFPCMessages, // scan for freepascal compiler messages
+        ofoSearchForMakeMessages,// scan for make/gmake messages
+        ofoExceptionOnError,     // raise exception on panic, fatal errors
+        ofoMakeFilenamesAbsolute // convert relative filenames to absolute ones
+        );
   TOuputFilterOptions = set of TOuputFilterOption;
   
   TOutputMessageType = (omtNone, omtFPC, omtLinker, omtMake);
@@ -41,9 +45,11 @@ type
 
   TOutputFilter = class
   private
+    fCurrentDirectory: string;
     fFilteredOutput: TStringList;
     fLastErrorType: TErrorType;
     fLastMessageType: TOutputMessageType;
+    fMakeDirHistory: TStringList;
     fOnOutputString: TOnOutputString;
     fOptions: TOuputFilterOptions;
     fProject: TProject;
@@ -58,10 +64,13 @@ type
     destructor Destroy; override;
     function IsHintForUnusedProjectUnit(const OutputLine,
       ProgramSrcFile: string): boolean;
+    function IsParsing: boolean;
     procedure ReadLine(const s: string; DontFilterLine: boolean);
     function ReadFPCompilerLine(const s: string): boolean;
+    function ReadMakeLine(const s: string): boolean;
+    property CurrentDirectory: string read fCurrentDirectory;
     property FilteredLines: TStringList read fFilteredOutput;
-    property LastErrorType: TErrorType;
+    property LastErrorType: TErrorType read fLastErrorType;
     property LastMessageType: TOutputMessageType read fLastMessageType;
     property PrgSourceFilename: string
       read fPrgSourceFilename write fPrgSourceFilename;
@@ -115,6 +124,12 @@ var
   OutputLine, Buf : String;
 begin
   TheProcess.Execute;
+  fCurrentDirectory:=TheProcess.CurrentDirectory;
+  if fCurrentDirectory='' then fCurrentDirectory:=GetCurrentDir;
+  if (fCurrentDirectory<>'')
+  and (fCurrentDirectory[length(fCurrentDirectory)]<>PathDelim) then
+    fCurrentDirectory:=fCurrentDirectory+PathDelim;
+  if fMakeDirHistory<>nil then fMakeDirHistory.Clear;
   SetLength(Buf,BufSize);
   Application.ProcessMessages;
 
@@ -152,6 +167,9 @@ begin
   if DontFilterLine then begin
     DoAddFilteredLine(s);
   end else if (ofoSearchForFPCMessages in Options) and (ReadFPCompilerLine(s))
+  then begin
+    exit;
+  end else if (ofoSearchForMakeMessages in Options) and (ReadMakeLine(s))
   then begin
     exit;
   end;
@@ -167,8 +185,8 @@ function TOutputFilter.ReadFPCompilerLine(const s: string): boolean;
      <filename>(123) <ErrorType>: <some text>
      <filename>(456) <ErrorType>: <some text> in line (123)
 }
-var i, j: integer;
-  MsgTypeName: string;
+var i, j, FilenameEndPos: integer;
+  MsgTypeName, Filename, Msg: string;
   MsgType: TErrorType;
   SkipMessage: boolean;
 begin
@@ -204,6 +222,7 @@ begin
   // search for round bracket open
   i:=1;
   while (i<=length(s)) and (s[i]<>'(') do inc(i);
+  FilenameEndPos:=i-1;
   inc(i);
   // search for number
   if (i>=length(s)) or (not (s[i] in ['0'..'9'])) then exit;
@@ -227,47 +246,56 @@ begin
       // -> filter message
       fLastErrorType:=MsgType;
       SkipMessage:=true;
-      case MsgType of
-      
-      etHint:
-        begin
-          SkipMessage:=not (Project.CompilerOptions.ShowHints
-                            or Project.CompilerOptions.ShowAll);
-          if (not SkipMessage)
-          and (not Project.CompilerOptions.ShowAll)
-          and (not Project.CompilerOptions.ShowHintsForUnusedProjectUnits)
-          and (PrgSourceFilename<>'')
-          and (IsHintForUnusedProjectUnit(s,PrgSourceFilename)) then
-            SkipMessage:=true;
-        end;
-        
-      etNote:
-        begin
-          SkipMessage:=not (Project.CompilerOptions.ShowNotes
-                            or Project.CompilerOptions.ShowAll);
-        end;
+      if Project<>nil then begin
+        case MsgType of
 
-      etError:
-        begin
-          SkipMessage:=not (Project.CompilerOptions.ShowErrors
-                            or Project.CompilerOptions.ShowAll);
-        end;
-        
-      etWarning:
-        begin
-          SkipMessage:=not (Project.CompilerOptions.ShowWarn
-                            or Project.CompilerOptions.ShowAll);
-        end;
+        etHint:
+          begin
+            SkipMessage:=not (Project.CompilerOptions.ShowHints
+                              or Project.CompilerOptions.ShowAll);
+            if (not SkipMessage)
+            and (not Project.CompilerOptions.ShowAll)
+            and (not Project.CompilerOptions.ShowHintsForUnusedProjectUnits)
+            and (PrgSourceFilename<>'')
+            and (IsHintForUnusedProjectUnit(s,PrgSourceFilename)) then
+              SkipMessage:=true;
+          end;
 
-      etPanic, etFatal:
+        etNote:
+          begin
+            SkipMessage:=not (Project.CompilerOptions.ShowNotes
+                              or Project.CompilerOptions.ShowAll);
+          end;
+
+        etError:
+          begin
+            SkipMessage:=not (Project.CompilerOptions.ShowErrors
+                              or Project.CompilerOptions.ShowAll);
+          end;
+
+        etWarning:
+          begin
+            SkipMessage:=not (Project.CompilerOptions.ShowWarn
+                              or Project.CompilerOptions.ShowAll);
+          end;
+
+        etPanic, etFatal:
+          SkipMessage:=false;
+
+        end;
+      end else
         SkipMessage:=false;
-
+      Msg:=s;
+      if (ofoMakeFilenamesAbsolute in Options) then begin
+        Filename:=copy(s,1,FilenameEndPos);
+        if not FilenameIsAbsolute(Filename) then
+          Msg:=fCurrentDirectory+Msg;
       end;
       if not SkipMessage then
-        DoAddFilteredLine(s);
+        DoAddFilteredLine(Msg);
       if (ofoExceptionOnError in Options) and (MsgType in [etPanic, etFatal])
       then
-        raise EOutputFilterError.Create(s);
+        raise EOutputFilterError.Create(Msg);
       Result:=true;
       exit;
     end;
@@ -363,9 +391,58 @@ end;
 destructor TOutputFilter.Destroy;
 begin
   fFilteredOutput.Free;
+  fMakeDirHistory.Free;
   inherited Destroy;
 end;
 
+function TOutputFilter.IsParsing: boolean;
+begin
+  Result:=([ofoSearchForFPCMessages,ofoSearchForMakeMessages]*Options)<>[];
+end;
+
+function TOutputFilter.ReadMakeLine(const s: string): boolean;
+{ returns true, if it is a make/gmake message
+   Examples for make messages:
+     make[1]: Entering directory `<filename>'
+     make[1]: Leaving directory `<filename>'
+}
+var i: integer;
+begin
+  Result:=false;
+  i:=length('make[');
+  if copy(s,1,i)<>'make[' then exit;
+  inc(i);
+  if (i>length(s)) or (not (s[i] in ['0'..'9'])) then exit;
+  while (i<=length(s)) and (s[i] in ['0'..'9']) do inc(i);
+  if (i>length(s)) or (s[i]<>']') then exit;
+  if copy(s,i,length(']: Leaving directory `'))=']: Leaving directory `' then
+  begin
+    if (fMakeDirHistory<>nil) and (fMakeDirHistory.Count>0) then begin
+      fCurrentDirectory:=fMakeDirHistory[fMakeDirHistory.Count-1];
+      fMakeDirHistory.Delete(fMakeDirHistory.Count-1);
+      Result:=true;
+      exit;
+    end else begin
+      // leaving what directory???
+      fCurrentDirectory:='';
+    end;
+  end;
+  if copy(s,i,length(']: Entering directory `'))=']: Entering directory `' then
+  begin
+    inc(i,length(']: Entering directory `'));
+    if (fCurrentDirectory<>'') then begin
+      if (fMakeDirHistory=nil) then fMakeDirHistory:=TStringList.Create;
+      fMakeDirHistory.Add(fCurrentDirectory);
+    end;
+    fCurrentDirectory:=copy(s,i,length(s)-i);
+    if (fCurrentDirectory<>'')
+    and (fCurrentDirectory[length(fCurrentDirectory)]<>PathDelim) then
+      fCurrentDirectory:=fCurrentDirectory+PathDelim;
+    Result:=true;
+    exit;
+  end;
+end;
+
 
 end.