MG: added outputfilter

git-svn-id: trunk@617 -

.gitattributes

@@ -135,6 +135,7 @@ ide/macropromptdlg.pas svneol=native#text/pascal
 ide/main.pp svneol=native#text/pascal
 ide/msgview.pp svneol=native#text/pascal
 ide/newprojectdlg.pp svneol=native#text/pascal
+ide/outputfilter.pas svneol=native#text/pascal
 ide/project.pp svneol=native#text/pascal
 ide/projectdefs.pas svneol=native#text/pascal
 ide/projectopts.lrs svneol=native#text/pascal

ide/compiler.pp

@@ -1,10 +1,10 @@
 {  $Id$  }
 {
  /***************************************************************************
-                        compiler.pp  -  Main application unit
+                        compiler.pp  -  Lazarus IDE unit
                         -------------------------------------
                    TCompiler is responsible for configuration and running
-                   the PPC386 compiler.
+                   the Free Pascal Compiler.
 
 
                    Initial Revision  : Sun Mar 28 23:15:32 CST 1999
@@ -21,7 +21,7 @@
  *                                                                         *
  ***************************************************************************/
 }
-unit compiler;
+unit Compiler;
 
 {$mode objfpc}
 {$H+}
@@ -30,58 +30,31 @@ interface
 
 uses
   Classes, SysUtils, Forms, Controls, CompilerOptions, Project, Process,
-  IDEProcs;
+  IDEProcs, OutputFilter;
 
 type
-  TOnOutputString = procedure (const Value: String) of Object;
-  TErrorType = (etNone, etHint, etWarning, etError, etFatal);
   TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean)
       of object;
   
   TCompiler = class(TObject)
   private
-    FOnOutputString : TOnOutputString;
-    FOutputList : TStringList;
     FOnCmdLineCreate : TOnCmdLineCreate;
-    function IsHintForUnusedProjectUnit(const OutputLine, 
+    FOutputFilter: TOutputFilter;
-       ProgramSrcFile: string): boolean;
   public
     constructor Create;
     destructor Destroy; override;
     function Compile(AProject: TProject; BuildAll: boolean;
-       const DefaultFilename: string): TModalResult;
+      const DefaultFilename: string): TModalResult;
-    function GetSourcePosition(const Line: string; var Filename:string;
-       var CaretXY: TPoint; var MsgType: TErrorType): boolean;
-    property OnOutputString : TOnOutputString
-       read FOnOutputString write FOnOutputString;
-    property OutputList : TStringList read FOutputList;
     property OnCommandLineCreate: TOnCmdLineCreate
-       read FOnCmdLineCreate write FOnCmdLineCreate;
+      read FOnCmdLineCreate write FOnCmdLineCreate;
+    property OutputFilter: TOutputFilter
+      read FOutputFilter write FOutputFilter;
   end;
 
-const
-  ErrorTypeNames : array[TErrorType] of string = (
-      'None','Hint','Warning','Error','Fatal'
-    );
-
-var
-  Compiler1 : TCompiler;
-
-function ErrorTypeNameToType(const Name:string): TErrorType;
-
 
 implementation
 
 
-function ErrorTypeNameToType(const Name:string): TErrorType;
-var LowName: string;
-begin
-  LowName:=lowercase(Name);
-  for Result:=Low(TErrorType) to High(TErrorType) do
-    if lowercase(ErrorTypeNames[Result])=LowName then exit;
-  Result:=etNone;
-end;
-
 { TCompiler }
 
 {------------------------------------------------------------------------------}
@@ -90,7 +63,6 @@ end;
 constructor TCompiler.Create;
 begin
   inherited Create;
-  FOutputList := TStringList.Create;
 end;
 
 {------------------------------------------------------------------------------}
@@ -98,7 +70,6 @@ end;
 {------------------------------------------------------------------------------}
 destructor TCompiler.Destroy;
 begin
-  FOutputList.Free;
   inherited Destroy;
 end;
 
@@ -111,56 +82,14 @@ const
   BufSize = 1024;
 var
   CmdLine : String;
-  I, Count, LineStart : longint;
+  Abort : Boolean;
-  OutputLine, Buf : String;
-  WriteMessage, ABort : Boolean;
   OldCurDir, ProjectDir, ProjectFilename: string;
   TheProcess : TProcess;
-
-  procedure ProcessOutputLine;
-  begin
-writeln('[TCompiler.Compile] Output="',OutputLine,'"');
-    FOutputList.Add(OutputLine);
-
-    //determine what type of message it is
-    if (pos(') Hint:',OutputLine) <> 0) then begin
-      WriteMessage := AProject.CompilerOptions.ShowHints
-                   or AProject.CompilerOptions.ShowAll;
-      if (not AProject.CompilerOptions.ShowAll) 
-      and (not AProject.CompilerOptions.ShowHintsForUnusedProjectUnits)
-      and (IsHintForUnusedProjectUnit(OutputLine,ProjectFilename)) then
-        WriteMessage:=false;
-    end else if (pos(') Note:',OutputLine) <> 0) then
-      WriteMessage := AProject.CompilerOptions.ShowNotes
-                   or AProject.CompilerOptions.ShowAll
-    else if (pos(') Error:',OutputLine) <> 0) then begin
-      WriteMessage := AProject.CompilerOptions.ShowErrors
-                   or AProject.CompilerOptions.ShowAll;
-      Result:=mrCancel;
-    end else if (pos(') Warning:',OutputLine) <> 0) then
-      WriteMessage := AProject.CompilerOptions.ShowWarn
-                   or AProject.CompilerOptions.ShowAll
-    else if (copy(OutputLine,1,5)='Panic') or (pos(') Fatal:',OutputLine) <> 0) or (pos('Fatal: ',OutputLine) <> 0)
-    then begin
-      Result:=mrCancel;
-      WriteMessage := true;
-    end else if OutputLine='Closing script ppas.sh' then begin
-      WriteMessage:=true;
-    end;
-    if (WriteMessage) and Assigned(OnOutputString) then
-      OnOutputString(OutputLine);
-    WriteMessage := false;
-
-    Application.ProcessMessages;
-    OutputLine:='';
-  end;
-
-// TCompiler.Compile
 begin
   Result:=mrCancel;
   if AProject.MainUnit<0 then exit;
   OldCurDir:=GetCurrentDir;
-  if Aproject.IsVirtual then
+  if AProject.IsVirtual then
     ProjectFilename:=DefaultFilename
   else
     ProjectFilename:=AProject.Units[AProject.MainUnit].Filename;
@@ -168,8 +97,6 @@ begin
   ProjectDir:=ExtractFilePath(ProjectFilename);
   if not SetCurrentDir(ProjectDir) then exit;
   try
-    FOutputList.Clear;
-    SetLength(Buf,BufSize);
     CmdLine := AProject.CompilerOptions.CompilerPath;
     
     if Assigned(FOnCmdLineCreate) then begin
@@ -184,16 +111,12 @@ begin
       CheckIfFileIsExecutable(CmdLine);
     except
       on E: Exception do begin
-        OutputLine:='Error: invalid compiler: '+E.Message;
+        if OutputFilter<>nil then
-        writeln(OutputLine);
+          OutputFilter.ReadLine('Error: invalid compiler: '+E.Message,true);
-        if Assigned(OnOutputString) then
-          OnOutputString(OutputLine);
         if CmdLine='' then begin
-          OutputLine:='Hint: you can set the compiler path in '
+          if OutputFilter<>nil then
-             +'Environment->General Options->Files->Compiler Path';
+            OutputFilter.ReadLine('Hint: you can set the compiler path in '
-          writeln(OutputLine);
+             +'Environment->General Options->Files->Compiler Path',true);
-          if Assigned(OnOutputString) then
-            OnOutputString(OutputLine);
         end;
         exit;
       end;
@@ -214,7 +137,6 @@ begin
     Writeln('[TCompiler.Compile] CmdLine="',CmdLine,'"');
 
     try
-      
       TheProcess := TProcess.Create(nil);
       TheProcess.CommandLine := CmdLine;
       TheProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];
@@ -222,41 +144,28 @@ begin
       Result:=mrOk;
       try
         TheProcess.CurrentDirectory:=ProjectDir;
-        TheProcess.Execute;
+        
-        Application.ProcessMessages;
+        if OutputFilter<>nil then begin
-
+          OutputFilter.PrgSourceFilename:=ProjectFilename;
-        OutputLine:='';
+          OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError];
-        repeat
+          OutputFilter.Project:=AProject;
-          if TheProcess.Output<>nil then
+          OutputFilter.Execute(TheProcess);
-            Count:=TheProcess.Output.Read(Buf[1],length(Buf))
+        end else begin
-          else
+          TheProcess.Execute;
-            Count:=0;         
+        end;
-          WriteMessage := False;
-          LineStart:=1;
-          i:=1;
-          while i<=Count do begin
-            if Buf[i] in [#10,#13] then begin
-              OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
-              ProcessOutputLine;
-              if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
-              then
-                inc(i);
-              LineStart:=i+1;
-            end;
-            inc(i);
-          end;
-          OutputLine:=copy(Buf,LineStart,Count-LineStart+1);
-        until Count=0;
-        TheProcess.WaitOnExit;
       finally
+        TheProcess.WaitOnExit;
         TheProcess.Free;
       end;
     except
+      on e: EOutputFilterError do begin
+        Result:=mrCancel;
+        exit;
+      end;
       on e: Exception do begin
         writeln('[TCompiler.Compile] exception "',E.Message,'"');
-        FOutputList.Add(E.Message);
+        if OutputFilter<>nil then
-        if Assigned(OnOutputString) then
+          OutputFilter.ReadLine(E.Message,true);
-          OnOutputString(E.Message);
         Result:=mrCancel;
         exit;
       end;
@@ -267,95 +176,14 @@ begin
   writeln('[TCompiler.Compile] end');
 end;
 
-{--------------------------------------------------------------------------
-            TCompiler IsHintForUnusedProjectUnit
----------------------------------------------------------------------------}
-function TCompiler.IsHintForUnusedProjectUnit(const OutputLine, 
-  ProgramSrcFile: string): boolean;
-{ recognizes hints of the form
-
-  mainprogram.pp(5,35) Hint: Unit UNUSEDUNIT not used in mainprogram
-}
-var Filename: string;
-begin
-  Result:=false;
-  Filename:=ExtractFilename(ProgramSrcFile);
-  if CompareFilenames(Filename,copy(OutputLine,1,length(Filename)))<>0 then
-    exit;
-  if (pos(') Hint: Unit ',OutputLine)<>0)
-  and (pos(' not used in ',OutputLine)<>0) then
-    Result:=true;
-end;
-
-{--------------------------------------------------------------------------
-            TCompiler GetSourcePosition
----------------------------------------------------------------------------}
-function TCompiler.GetSourcePosition(const Line: string; var Filename:string;
-  var CaretXY: TPoint; var MsgType: TErrorType): boolean;
-{ This assumes the line has one of the following formats
-<filename>(123,45) <ErrorType>: <some text>
-<filename>(456) <ErrorType>: <some text> in line (123)
-Fatal: <some text>
-}
-var StartPos, EndPos: integer;
-begin
-  Result:=false;
-  if copy(Line,1,7)='Fatal: ' then begin
-    Result:=true;
-    Filename:='';
-    MsgType:=etFatal;
-    exit;
-  end;
-  StartPos:=1;
-  // find filename
-  EndPos:=StartPos;
-  while (EndPos<=length(Line)) and (Line[EndPos]<>'(') do inc(EndPos);
-  if EndPos>length(Line) then exit;
-  FileName:=copy(Line,StartPos,EndPos-StartPos);
-  // read linenumber
-  StartPos:=EndPos+1;
-  EndPos:=StartPos;
-  while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
-  if EndPos>length(Line) then exit;
-  CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
-  if Line[EndPos]=',' then begin
-    // format: <filename>(123,45) <ErrorType>: <some text>
-    // read column
-    StartPos:=EndPos+1;
-    EndPos:=StartPos;
-    while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
-    if EndPos>length(Line) then exit;
-    CaretXY.X:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
-    // read error type
-    StartPos:=EndPos+2;
-    while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
-    if EndPos>length(Line) then exit;
-    MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
-    Result:=true;
-  end else if Line[EndPos]=')' then begin
-    // <filename>(456) <ErrorType>: <some text> in line (123)
-    // read error type
-    StartPos:=EndPos+2;
-    while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
-    if EndPos>length(Line) then exit;
-    MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
-    // read second linenumber (more useful)
-    while (EndPos<=length(Line)) and (Line[EndPos]<>'(') do inc(EndPos);
-    if EndPos>length(Line) then exit;
-    StartPos:=EndPos+1;
-    EndPos:=StartPos;
-    while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
-    if EndPos>length(Line) then exit;
-    CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
-    Result:=true;
-  end;
-end;
-
 
 end.
 
 {
   $Log$
+  Revision 1.28  2002/01/23 20:07:20  lazarus
+  MG: added outputfilter
+
   Revision 1.27  2002/01/15 08:49:56  lazarus
   MG: fixed zombie compilers
 

ide/exttooleditdlg.pas

@@ -47,12 +47,14 @@ type
   }
   TExternalToolOptions = class
   private
-    fTitle: string;
-    fFilename: string;
     fCmdLineParams: string;
-    fWorkingDirectory: string;
+    fFilename: string;
     fKey: word;
+    fScanOutputForFPCMessages: boolean;
+    fScanOutputForMakeMessages: boolean;
     fShift: TShiftState;
+    fTitle: string;
+    fWorkingDirectory: string;
   public
     procedure Assign(Source: TExternalToolOptions);
     constructor Create;
@@ -62,13 +64,17 @@ type
     function Save(XMLConfig: TXMLConfig; const Path: string): TModalResult;
     function ShortDescription: string;
     
-    property Title: string read fTitle write fTitle;
-    property Filename: string read fFilename write fFilename;
     property CmdLineParams: string read fCmdLineParams write fCmdLineParams;
-    property WorkingDirectory: string
+    property Filename: string read fFilename write fFilename;
-           read fWorkingDirectory write fWorkingDirectory;
     property Key: word read fKey write fKey;
+    property Title: string read fTitle write fTitle;
+    property ScanOutputForFPCMessages: boolean
+      read fScanOutputForFPCMessages write fScanOutputForFPCMessages;
+    property ScanOutputForMakeMessages: boolean
+      read fScanOutputForMakeMessages write fScanOutputForMakeMessages;
     property Shift: TShiftState read fShift write fShift;
+    property WorkingDirectory: string
+      read fWorkingDirectory write fWorkingDirectory;
   end;
 
   {
@@ -83,6 +89,9 @@ type
     ParametersEdit: TEdit;
     WorkingDirLabel: TLabel;
     WorkingDirEdit: TEdit;
+    OptionsGroupBox: TGroupBox;
+    OptionScanOutputForFPCMessagesCheckBox: TCheckBox;
+    OptionScanOutputForMakeMessagesCheckBox: TCheckBox;
     KeyGroupBox: TGroupBox;
     KeyCtrlCheckBox: TCheckBox;
     KeyAltCheckBox: TCheckBox;
@@ -91,14 +100,15 @@ type
     KeyGrabButton: TButton;
     MacrosGroupbox: TGroupbox;
     MacrosListbox: TListbox;
-    MacrosInsert: TButton;
+    MacrosInsertButton: TButton;
     OkButton: TButton;
     CancelButton: TButton;
     procedure CancelButtonClick(Sender: TObject);
     procedure OkButtonClick(Sender: TObject);
     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift:TShiftState);
     procedure KeyGrabButtonClick(Sender: TObject);
-    procedure MacrosInsertClick(Sender: TObject);
+    procedure MacrosInsertButtonClick(Sender: TObject);
+    procedure MacrosListboxClick(Sender: TObject);
   private
     fOptions: TExternalToolOptions; 
     fTransferMacros: TTransferMacroList;
@@ -180,6 +190,8 @@ begin
   fWorkingDirectory:='';
   fKey:=VK_UNKNOWN;
   fShift:=[];
+  fScanOutputForFPCMessages:=false;
+  fScanOutputForMakeMessages:=false;
 end;
 
 function TExternalToolOptions.Load(XMLConfig: TXMLConfig;
@@ -190,8 +202,12 @@ begin
   fFilename:=XMLConfig.GetValue(Path+'Filename/Value',fFilename);
   fCmdLineParams:=XMLConfig.GetValue(Path+'CmdLineParams/Value',fCmdLineParams);
   fWorkingDirectory:=XMLConfig.GetValue(
-                                    Path+'WorkingDirectory/Value',fWorkingDirectory);
+                               Path+'WorkingDirectory/Value',fWorkingDirectory);
-  // key and shift will be saved with the keymapping in the editoroptions
+  fScanOutputForFPCMessages:=XMLConfig.GetValue(
+               Path+'ScanOutputForFPCMessages/Value',fScanOutputForFPCMessages);
+  fScanOutputForMakeMessages:=XMLConfig.GetValue(
+             Path+'ScanOutputForMakeMessages/Value',fScanOutputForMakeMessages);
+  // key and shift are saved with the keymapping in the editoroptions
   Result:=mrOk;
 end;
 
@@ -203,6 +219,11 @@ begin
   XMLConfig.SetValue(Path+'Filename/Value',fFilename);
   XMLConfig.SetValue(Path+'CmdLineParams/Value',fCmdLineParams);
   XMLConfig.SetValue(Path+'WorkingDirectory/Value',fWorkingDirectory);
+  XMLConfig.GetValue(
+               Path+'ScanOutputForFPCMessages/Value',fScanOutputForFPCMessages);
+  XMLConfig.GetValue(
+             Path+'ScanOutputForMakeMessages/Value',fScanOutputForMakeMessages);
+  // key and shift are saved with the keymapping in the editoroptions
   Result:=mrOk;
 end;
 
@@ -305,16 +326,47 @@ begin
       Visible:=true; 
     end;
     
+    OptionsGroupBox:=TGroupBox.Create(Self);
+    with OptionsGroupBox do begin
+      Name:='OptionsGroupBox';
+      Parent:=Self;
+      Caption:='Options:';
+      Left:=5;
+      Top:=WorkingDirLabel.Top+WorkingDirLabel.Height+12;
+      Width:=Self.ClientWidth-Left-Left;
+      Height:=66;
+      Visible:=true; 
+    end;
+    
+    OptionScanOutputForFPCMessagesCheckBox:=TCheckBox.Create(Self);
+    with OptionScanOutputForFPCMessagesCheckBox do begin
+      Name:='OptionScanOutputForFPCMessagesCheckBox';
+      Parent:=OptionsGroupBox;
+      SetBounds(5,2,400,20);
+      Caption:='Scan output for Free Pascal Compiler messages';
+      Visible:=true;
+    end;
+
+    OptionScanOutputForMakeMessagesCheckBox:=TCheckBox.Create(Self);
+    with OptionScanOutputForMakeMessagesCheckBox do begin
+      Name:='OptionScanOutputForMakeMessagesCheckBox';
+      Parent:=OptionsGroupBox;
+      SetBounds(5,OptionScanOutputForFPCMessagesCheckBox.Top
+                +OptionScanOutputForFPCMessagesCheckBox.Height+4,400,20);
+      Caption:='Scan output for make messages';
+      Visible:=true;
+    end;
+
     KeyGroupBox:=TGroupBox.Create(Self);
     with KeyGroupBox do begin
       Name:='KeyGroupBox';
       Parent:=Self;
       Caption:='Key';
       Left:=5;
-      Top:=WorkingDirLabel.Top+WorkingDirLabel.Height+12;
+      Top:=OptionsGroupBox.Top+OptionsGroupBox.Height+12;
       Width:=Self.ClientWidth-Left-Left;
       Height:=50;
-      Visible:=true; 
+      Visible:=true;
     end;
 
     KeyCtrlCheckBox:=TCheckBox.Create(Self);
@@ -403,16 +455,18 @@ begin
       Parent:=MacrosGroupbox;
       SetBounds(5,5,MacrosGroupbox.ClientWidth-120,
                    MacrosGroupbox.ClientHeight-30);
+      OnClick:=@MacrosListboxClick;
       Visible:=true; 
     end;
     
-    MacrosInsert:=TButton.Create(Self);
+    MacrosInsertButton:=TButton.Create(Self);
-    with MacrosInsert do begin
+    with MacrosInsertButton do begin
-      Name:='MacrosInsert';
+      Name:='MacrosInsertButton';
       Parent:=MacrosGroupbox;
       SetBounds(MacrosGroupbox.ClientWidth-90,5,70,25);
       Caption:='Insert';
-      OnClick:=@MacrosInsertClick;
+      OnClick:=@MacrosInsertButtonClick;
+      Enabled:=false;
       Visible:=true; 
     end;
     
@@ -458,6 +512,10 @@ begin
     if KeyAltCheckBox.Checked then include(fOptions.fShift,ssAlt);
     if KeyShiftCheckBox.Checked then include(fOptions.fShift,ssShift);
   end;
+  fOptions.ScanOutputForFPCMessages:=
+    OptionScanOutputForFPCMessagesCheckBox.Checked;
+  fOptions.ScanOutputForMakeMessages:=
+    OptionScanOutputForMakeMessagesCheckBox.Checked;
 end;
 
 procedure TExternalToolOptionDlg.LoadFromOptions;
@@ -470,6 +528,10 @@ begin
   KeyCtrlCheckBox.Checked:=(ssCtrl in fOptions.Shift);
   KeyShiftCheckBox.Checked:=(ssShift in fOptions.Shift);
   KeyAltCheckBox.Checked:=(ssAlt in fOptions.Shift);
+  OptionScanOutputForFPCMessagesCheckBox.Checked:=
+    fOptions.ScanOutputForFPCMessages;
+  OptionScanOutputForMakeMessagesCheckBox.Checked:=
+    fOptions.ScanOutputForMakeMessages;
 end;
 
 procedure TExternalToolOptionDlg.OkButtonClick(Sender: TObject);
@@ -594,7 +656,7 @@ begin
   end;
 end;
 
-procedure TExternalToolOptionDlg.MacrosInsertClick(Sender: TObject);
+procedure TExternalToolOptionDlg.MacrosInsertButtonClick(Sender: TObject);
 var i: integer;
   s: string;
 begin
@@ -607,4 +669,9 @@ begin
   ParametersEdit.Text:=ParametersEdit.Text+s;
 end;
 
+procedure TExternalToolOptionDlg.MacrosListboxClick(Sender: TObject);
+begin
+  MacrosInsertButton.Enabled:=(MacrosListbox.ItemIndex>=0);
+end;
+
 end.

ide/main.pp

@@ -39,7 +39,7 @@ uses
   PropEdits, ControlSelection, UnitEditor, CompilerOptions, EditorOptions,
   EnvironmentOpts, TransferMacros, KeyMapping, ProjectOpts, IDEProcs, Process,
   UnitInfoDlg, Debugger, DBGWatch, RunParamsOpts, ExtToolDialog, MacroPromptDlg,
-  LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg,ColumnDlg;
+  LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter;
 
 const
   Version_String = '0.8.2 alpha';
@@ -300,6 +300,8 @@ type
     FMessagesViewBoundsRectValid: boolean;
     FOpenEditorsOnCodeToolChange: boolean;
     TheDebugger: TDebugger;
+    TheCompiler: TCompiler;
+    TheOutputFilter: TOutputFilter;
 
     Function CreateSeperator : TMenuItem;
     Procedure SetDefaultsForForm(aForm : TCustomForm);
@@ -618,10 +620,14 @@ begin
   ComponentNotebook.OnPageChanged := @ControlClick;
   ComponentNotebook.Show;
 
+  // output filter
+  TheOutputFilter:=TOutputFilter.Create;
+
   // compiler interface
-  Compiler1 := TCompiler.Create;
+  TheCompiler := TCompiler.Create;
-  with Compiler1 do begin
+  with TheCompiler do begin
     OnCommandLineCreate:=@OnCmdLineCreate;
+    OutputFilter:=TheOutputFilter;
   end;
 
   HintTimer1 := TTimer.Create(self);
@@ -797,7 +803,8 @@ CheckHeap(IntToStr(GetMem_Cnt));
   FormEditor1.Free;
   FormEditor1:=nil;
   PropertyEditorHook1.Free;
-  Compiler1.Free;
+  TheCompiler.Free;
+  TheOutputFilter.Free;
   MacroList.Free;
   EditorOpts.Free;
   EditorOpts:=nil;
@@ -3927,8 +3934,8 @@ begin
     MessagesView.Clear;
     DoArrangeSourceEditorAndMessageView;
    
-    Compiler1.OnOutputString:=@MessagesView.Add;
+    TheOutputFilter.OnOutputString:=@MessagesView.Add;
-    Result:=Compiler1.Compile(Project,BuildAll,DefaultFilename);
+    Result:=TheCompiler.Compile(Project,BuildAll,DefaultFilename);
     if Result=mrOk then begin
       MessagesView.MessageView.Items.Add(
         'Project "'+Project.Title+'" successfully built. :)');
@@ -4667,16 +4674,18 @@ begin
     // search relevant message (first error, first fatal)
     Index:=0;
     while (Index<MaxMessages) do begin
-      if (Compiler1.GetSourcePosition(MessagesView.MessageView.Items[Index],
+      if (TheOutputFilter.GetSourcePosition(
-        Filename,CaretXY,MsgType)) then begin
+        MessagesView.MessageView.Items[Index],
-        if MsgType in [etError,etFatal] then break;
+        Filename,CaretXY,MsgType)) then
+      begin
+        if MsgType in [etError,etFatal,etPanic] then break;
       end;
       inc(Index);
     end;
     if Index>=MaxMessages then exit;
     MessagesView.MessageView.ItemIndex:=Index;
   end;
-  if Compiler1.GetSourcePosition(MessagesView.MessageView.Items[Index],
+  if TheOutputFilter.GetSourcePosition(MessagesView.MessageView.Items[Index],
         Filename,CaretXY,MsgType) then begin
     SearchedFilename:=SearchFile(Filename);
     if SearchedFilename<>'' then begin
@@ -5613,6 +5622,9 @@ end.
 =======
 
   $Log$
+  Revision 1.204  2002/01/23 20:07:20  lazarus
+  MG: added outputfilter
+
   Revision 1.203  2002/01/21 14:17:44  lazarus
   MG: added find-block-start and renamed find-block-other-end
 
@@ -5656,6 +5668,9 @@ end.
 
 <<<<<<< main.pp
   $Log$
+  Revision 1.204  2002/01/23 20:07:20  lazarus
+  MG: added outputfilter
+
   Revision 1.203  2002/01/21 14:17:44  lazarus
   MG: added find-block-start and renamed find-block-other-end
 

ide/outputfilter.pas

@@ -0,0 +1,372 @@
+{  $Id$  }
+{
+ /***************************************************************************
+                        outputfilter.pas  -  Lazarus IDE unit
+                        -------------------------------------
+                   TOutputFilter is responsible for parsing output of external
+                   tools and to filter important messages.
+
+ ***************************************************************************/
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+}
+unit OutputFilter;
+
+{$mode objfpc}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, CompilerOptions, Project, Process,
+  IDEProcs;
+
+type
+  TOnOutputString = procedure (const Value: String) of Object;
+  
+  TOuputFilterOption = (ofoSearchForFPCMessages, ofoSearchForMakeMessages,
+        ofoExceptionOnError);
+  TOuputFilterOptions = set of TOuputFilterOption;
+  
+  TOutputMessageType = (omtNone, omtFPC, omtLinker, omtMake);
+
+  TErrorType = (etNone, etHint, etNote, etWarning, etError, etFatal, etPanic);
+
+  TOutputFilter = class
+  private
+    fFilteredOutput: TStringList;
+    fLastErrorType: TErrorType;
+    fLastMessageType: TOutputMessageType;
+    fOnOutputString: TOnOutputString;
+    fOptions: TOuputFilterOptions;
+    fProject: TProject;
+    fPrgSourceFilename: string;
+    procedure DoAddFilteredLine(const s: string);
+  public
+    procedure Execute(TheProcess: TProcess);
+    function GetSourcePosition(const Line: string; var Filename:string;
+      var CaretXY: TPoint; var MsgType: TErrorType): boolean;
+    procedure Clear;
+    constructor Create;
+    destructor Destroy; override;
+    function IsHintForUnusedProjectUnit(const OutputLine,
+      ProgramSrcFile: string): boolean;
+    procedure ReadLine(const s: string; DontFilterLine: boolean);
+    function ReadFPCompilerLine(const s: string): boolean;
+    property FilteredLines: TStringList read fFilteredOutput;
+    property LastErrorType: TErrorType;
+    property LastMessageType: TOutputMessageType read fLastMessageType;
+    property PrgSourceFilename: string
+      read fPrgSourceFilename write fPrgSourceFilename;
+    property OnOutputString: TOnOutputString
+      read fOnOutputString write fOnOutputString;
+    property Options: TOuputFilterOptions read fOptions write fOptions;
+    property Project: TProject read fProject write fProject;
+  end;
+  
+  EOutputFilterError = class(Exception)
+  end;
+
+const
+  ErrorTypeNames : array[TErrorType] of string = (
+      'None','Hint','Note','Warning','Error','Fatal','Panic'
+    );
+
+function ErrorTypeNameToType(const Name:string): TErrorType;
+
+
+implementation
+
+
+function ErrorTypeNameToType(const Name:string): TErrorType;
+begin
+  for Result:=Succ(etNone) to High(TErrorType) do
+    if AnsiCompareText(ErrorTypeNames[Result],Name)=0 then exit;
+  Result:=etNone;
+end;
+
+
+{ TOutputFilter }
+
+constructor TOutputFilter.Create;
+begin
+  inherited Create;
+  fFilteredOutput:=TStringList.Create;
+  Clear;
+end;
+
+procedure TOutputFilter.Clear;
+begin
+  fFilteredOutput.Clear;
+end;
+
+procedure TOutputFilter.Execute(TheProcess: TProcess);
+const
+  BufSize = 1024;
+var
+  i, Count, LineStart : longint;
+  OutputLine, Buf : String;
+begin
+  TheProcess.Execute;
+  SetLength(Buf,BufSize);
+  Application.ProcessMessages;
+
+  fFilteredOutput.Clear;
+  OutputLine:='';
+  repeat
+    if TheProcess.Output<>nil then
+      Count:=TheProcess.Output.Read(Buf[1],length(Buf))
+    else
+      Count:=0;
+    LineStart:=1;
+    i:=1;
+    while i<=Count do begin
+      if Buf[i] in [#10,#13] then begin
+        OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
+        ReadLine(OutputLine,false);
+        OutputLine:='';
+        if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
+        then
+          inc(i);
+        LineStart:=i+1;
+      end;
+      inc(i);
+    end;
+    OutputLine:=copy(Buf,LineStart,Count-LineStart+1);
+  until Count=0;
+  TheProcess.WaitOnExit;
+end;
+
+procedure TOutputFilter.ReadLine(const s: string; DontFilterLine: boolean);
+begin
+  writeln('TOutputFilter: "',s,'"');
+  fLastMessageType:=omtNone;
+  fLastErrorType:=etNone;
+  if DontFilterLine then begin
+    DoAddFilteredLine(s);
+  end else if (ofoSearchForFPCMessages in Options) and (ReadFPCompilerLine(s))
+  then begin
+    exit;
+  end;
+end;
+
+function TOutputFilter.ReadFPCompilerLine(const s: string): boolean;
+{ returns true, if it is a compiler message
+   Examples for freepascal compiler messages:
+     Compiling <filename>
+     Assembling <filename>
+     Fatal: <some text>
+     <filename>(123,45) <ErrorType>: <some text>
+     <filename>(123) <ErrorType>: <some text>
+     <filename>(456) <ErrorType>: <some text> in line (123)
+}
+var i, j: integer;
+  MsgTypeName: string;
+  MsgType: TErrorType;
+  SkipMessage: boolean;
+begin
+  Result:=false;
+  if ('Compiling '=copy(s,1,length('Compiling ')))
+  or ('Assembling '=copy(s,1,length('Assembling ')))
+  then begin
+    fLastMessageType:=omtFPC;
+    fLastErrorType:=etNone;
+    Result:=true;
+    exit;
+  end;
+  if ('Fatal: '=copy(s,1,length('Fatal: ')))
+  or ('Panic'=copy(s,1,length('Panic')))
+  or ('Closing script ppas.sh'=s)
+  then begin
+    // always show fatal, panic and linker errors
+    fLastMessageType:=omtFPC;
+    if ('Panic'=copy(s,1,length('Panic'))) then
+      fLastErrorType:=etPanic
+    else if ('Fatal: '=copy(s,1,length('Fatal: '))) then
+      fLastErrorType:=etFatal
+    else if ('Closing script ppas.sh'=s) then begin
+      fLastMessageType:=omtLinker;
+      fLastErrorType:=etFatal;
+    end;
+    fFilteredOutput.Add(s);
+    if (ofoExceptionOnError in Options) then
+      raise EOutputFilterError.Create(s);
+    Result:=true;
+    exit;
+  end;
+  // search for round bracket open
+  i:=1;
+  while (i<=length(s)) and (s[i]<>'(') do inc(i);
+  inc(i);
+  // search for number
+  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)) and (s[i]=',') and (s[i+1] in ['0'..'9']) then begin
+    // skip second number
+    inc(i);
+    while (i<=length(s)) and (s[i] in ['0'..'9']) do inc(i);
+  end;
+  // search for ') <ErrorType>: '
+  inc(i,2);
+  if (i>=length(s)) or (s[i-2]<>')') or (S[i-1]<>' ')
+  or (not (s[i] in ['A'..'Z'])) then exit;
+  j:=i+1;
+  while (j<=length(s)) and (s[j] in ['a'..'z']) do inc(j);
+  if (j+1>length(s)) or (s[j]<>':') or (s[j+1]<>' ') then exit;
+  MsgTypeName:=copy(s,i,j-i);
+  for MsgType:=Succ(etNone) to High(TErrorType) do begin
+    if ErrorTypeNames[MsgType]=MsgTypeName then begin
+      // this is a freepascal compiler message
+      // -> 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;
+
+      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;
+      if not SkipMessage then
+        DoAddFilteredLine(s);
+      if (ofoExceptionOnError in Options) and (MsgType in [etPanic, etFatal])
+      then
+        raise EOutputFilterError.Create(s);
+      Result:=true;
+      exit;
+    end;
+  end;
+end;
+
+function TOutputFilter.GetSourcePosition(const Line: string; var Filename:string;
+  var CaretXY: TPoint; var MsgType: TErrorType): boolean;
+{ This assumes the line has one of the following formats
+<filename>(123,45) <ErrorType>: <some text>
+<filename>(123) <ErrorType>: <some text>
+<filename>(456) <ErrorType>: <some text> in line (123)
+Fatal: <some text>
+}
+var StartPos, EndPos: integer;
+begin
+  Result:=false;
+  if copy(Line,1,7)='Fatal: ' then begin
+    Result:=true;
+    Filename:='';
+    MsgType:=etFatal;
+    exit;
+  end;
+  StartPos:=1;
+  // find filename
+  EndPos:=StartPos;
+  while (EndPos<=length(Line)) and (Line[EndPos]<>'(') do inc(EndPos);
+  if EndPos>length(Line) then exit;
+  FileName:=copy(Line,StartPos,EndPos-StartPos);
+  // read linenumber
+  StartPos:=EndPos+1;
+  EndPos:=StartPos;
+  while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
+  if EndPos>length(Line) then exit;
+  CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
+  if Line[EndPos]=',' then begin
+    // format: <filename>(123,45) <ErrorType>: <some text>
+    // read column
+    StartPos:=EndPos+1;
+    EndPos:=StartPos;
+    while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
+    if EndPos>length(Line) then exit;
+    CaretXY.X:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
+    // read error type
+    StartPos:=EndPos+2;
+    while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
+    if EndPos>length(Line) then exit;
+    MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
+    Result:=true;
+  end else if Line[EndPos]=')' then begin
+    // <filename>(456) <ErrorType>: <some text> in line (123)
+    // read error type
+    StartPos:=EndPos+2;
+    while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
+    if EndPos>length(Line) then exit;
+    MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
+    // read second linenumber (more useful)
+    while (EndPos<=length(Line)) and (Line[EndPos]<>'(') do inc(EndPos);
+    if EndPos>length(Line) then exit;
+    StartPos:=EndPos+1;
+    EndPos:=StartPos;
+    while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
+    if EndPos>length(Line) then exit;
+    CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
+    Result:=true;
+  end;
+end;
+
+function TOutputFilter.IsHintForUnusedProjectUnit(const OutputLine,
+  ProgramSrcFile: string): boolean;
+{ recognizes hints of the form
+
+  mainprogram.pp(5,35) Hint: Unit UNUSEDUNIT not used in mainprogram
+}
+var Filename: string;
+begin
+  Result:=false;
+  Filename:=ExtractFilename(ProgramSrcFile);
+  if CompareFilenames(Filename,copy(OutputLine,1,length(Filename)))<>0 then
+    exit;
+  if (pos(') Hint: Unit ',OutputLine)<>0)
+  and (pos(' not used in ',OutputLine)<>0) then
+    Result:=true;
+end;
+
+procedure TOutputFilter.DoAddFilteredLine(const s: string);
+begin
+  fFilteredOutput.Add(s);
+  if Assigned(OnOutputString) then
+    OnOutputString(s);
+end;
+
+destructor TOutputFilter.Destroy;
+begin
+  fFilteredOutput.Free;
+  inherited Destroy;
+end;
+
+
+end.
+
+