diff --git a/.gitattributes b/.gitattributes index 9575c9c4b2..3b82e2251b 100644 --- a/.gitattributes +++ b/.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 diff --git a/ide/compiler.pp b/ide/compiler.pp index b1acdba34c..5c8a68b062 100644 --- a/ide/compiler.pp +++ b/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, - ProgramSrcFile: string): boolean; + FOutputFilter: TOutputFilter; public constructor Create; destructor Destroy; override; function Compile(AProject: TProject; BuildAll: boolean; - 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; + const DefaultFilename: string): TModalResult; 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; - OutputLine, Buf : String; - WriteMessage, ABort : Boolean; + 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; - writeln(OutputLine); - if Assigned(OnOutputString) then - OnOutputString(OutputLine); + if OutputFilter<>nil then + OutputFilter.ReadLine('Error: invalid compiler: '+E.Message,true); if CmdLine='' then begin - OutputLine:='Hint: you can set the compiler path in ' - +'Environment->General Options->Files->Compiler Path'; - writeln(OutputLine); - if Assigned(OnOutputString) then - OnOutputString(OutputLine); + if OutputFilter<>nil then + OutputFilter.ReadLine('Hint: you can set the compiler path in ' + +'Environment->General Options->Files->Compiler Path',true); 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; - - OutputLine:=''; - repeat - if TheProcess.Output<>nil then - Count:=TheProcess.Output.Read(Buf[1],length(Buf)) - else - Count:=0; - 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 (iBuf[i+1]) - then - inc(i); - LineStart:=i+1; - end; - inc(i); - end; - OutputLine:=copy(Buf,LineStart,Count-LineStart+1); - until Count=0; - TheProcess.WaitOnExit; + + if OutputFilter<>nil then begin + OutputFilter.PrgSourceFilename:=ProjectFilename; + OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError]; + OutputFilter.Project:=AProject; + OutputFilter.Execute(TheProcess); + end else begin + TheProcess.Execute; + end; 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 Assigned(OnOutputString) then - OnOutputString(E.Message); + if OutputFilter<>nil then + OutputFilter.ReadLine(E.Message,true); 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 -(123,45) : -(456) : in line (123) -Fatal: -} -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: (123,45) : - // 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 - // (456) : 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 diff --git a/ide/exttooleditdlg.pas b/ide/exttooleditdlg.pas index 1228819acf..07e9e877ac 100644 --- a/ide/exttooleditdlg.pas +++ b/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 - read fWorkingDirectory write fWorkingDirectory; + property Filename: string read fFilename write fFilename; 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); - // key and shift will be saved with the keymapping in the editoroptions + Path+'WorkingDirectory/Value',fWorkingDirectory); + 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); - with MacrosInsert do begin - Name:='MacrosInsert'; + MacrosInsertButton:=TButton.Create(Self); + with MacrosInsertButton do begin + 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. diff --git a/ide/main.pp b/ide/main.pp index e03d1c17b2..47af472d7f 100644 --- a/ide/main.pp +++ b/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; - with Compiler1 do begin + TheCompiler := TCompiler.Create; + 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; - Result:=Compiler1.Compile(Project,BuildAll,DefaultFilename); + TheOutputFilter.OnOutputString:=@MessagesView.Add; + 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 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 diff --git a/ide/outputfilter.pas b/ide/outputfilter.pas new file mode 100644 index 0000000000..029ae7aa5f --- /dev/null +++ b/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 (iBuf[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 + Assembling + Fatal: + (123,45) : + (123) : + (456) : 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: ' + 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 +(123,45) : +(123) : +(456) : in line (123) +Fatal: +} +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: (123,45) : + // 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 + // (456) : 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. + +