paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 14:20:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added outputfilter

Browse Source 
git-svn-id: trunk@617 -
This commit is contained in:
lazarus 2002-01-23 20:07:21 +00:00
parent 3a23d2cd21
commit 8bc31599df
5 changed files with 518 additions and 235 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

242
ide/compiler.pp
View File

@ -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 (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;
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
<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

103
ide/exttooleditdlg.pas
View File

@ -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.

35
ide/main.pp
View File

@ -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) do begin
if (Compiler1.GetSourcePosition(MessagesView.MessageView.Items[Index],
Filename,CaretXY,MsgType)) then begin
if MsgType in [etError,etFatal] then break;
if (TheOutputFilter.GetSourcePosition(
MessagesView.MessageView.Items[Index],
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

372
ide/outputfilter.pas Normal file
View File

@ -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.