paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-07 12:00:56 +01:00
Code Issues Packages Projects Releases Wiki Activity

ide: fix for #14727, added multilingual support for OutputFilter

Browse Source 
git-svn-id: trunk@22060 -
This commit is contained in:
dmitry 2009-10-06 22:31:30 +00:00
parent 9f47216bff
commit ff95847660
3 changed files with 110 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
ide/compileroptions.pp
View File

@ -46,7 +46,7 @@ uses
// IDEIntf
ProjectIntf, MacroIntf, IDEExternToolIntf, SrcEditorIntf,
// IDE
IDEProcs, LazConf, TransferMacros, CompOptsModes;
IDEProcs, IDEMsgIntf, LazConf, TransferMacros, CompOptsModes;
type
@ -486,6 +486,7 @@ type
fHidden : TStringList;
fUsedMsgFile : string;
fUpdating : Integer;
FErrorNames : array [TFPCErrorType] of string;
procedure ClearHash;
procedure AddHash(Msg: TCompilerMessageConfig);
@ -500,10 +501,11 @@ type
procedure SetIgnoredArray(const b: array of Boolean); // to store b[MaxMsgIndex], or function fail
function GetCount: Integer;
function GetErrorNames(errtype: TFPCErrorType): string;
public
constructor Create;
destructor Destroy; override;
procedure Clear; virtual;
procedure Clear; virtual;
procedure Assign(Src: TCompilerMessagesList); virtual;
@ -522,6 +524,7 @@ type
property MsgIgnored[i: Integer]: Boolean read GetMsgIgnored write SetMsgIgnored;
property Count: Integer read GetCount;
property UsedMsgFile : string read fUsedMsgFile;
property ErrorNames[errtype: TFPCErrorType]: string read GetErrorNames;
end;
{ TBaseCompilerOptions }
@ -1495,6 +1498,16 @@ begin
UseMsgFile := XMLConfigFile.GetValue(p+'CompilerMessages/UseMsgFile/Value', False);
MsgFileName := XMLConfigFile.GetValue(p+'CompilerMessages/MsgFileName/Value', '');
if UseMsgFile then
with XMLConfigFile do begin
// ErrorNames should be stored, because the Message file is not read (or parsed)
// on project opening. So errors needs to be initialized properly from the CompilerOptions.xml
CompilerMessages.fErrorNames[etHint]:=GetValue(p+'CompilerMessages/ErrorNames/Hint', FPCErrorTypeNames[etHint]);
CompilerMessages.fErrorNames[etNote]:=GetValue(p+'CompilerMessages/ErrorNames/Note', FPCErrorTypeNames[etNote]);
CompilerMessages.fErrorNames[etWarning]:=GetValue(p+'CompilerMessages/ErrorNames/Warning', FPCErrorTypeNames[etWarning]);
CompilerMessages.fErrorNames[etError]:=GetValue(p+'CompilerMessages/ErrorNames/Error', FPCErrorTypeNames[etError]);
CompilerMessages.fErrorNames[etFatal]:=GetValue(p+'CompilerMessages/ErrorNames/Fatal', FPCErrorTypeNames[etFatal]);
end;
{ Other }
@ -1671,6 +1684,12 @@ begin
end;
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/UseMsgFile/Value', UseMsgFile, False);
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/MsgFileName/Value', MsgFileName, '');
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/ErrorNames/Hint', CompilerMessages.ErrorNames[etHint], FPCErrorTypeNames[etHint]);
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/ErrorNames/Note', CompilerMessages.ErrorNames[etNote], FPCErrorTypeNames[etNote]);
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/ErrorNames/Warning', CompilerMessages.ErrorNames[etWarning], FPCErrorTypeNames[etWarning]);
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/ErrorNames/Error', CompilerMessages.ErrorNames[etError], FPCErrorTypeNames[etError]);
XMLConfigFile.SetDeleteValue(p+'CompilerMessages/ErrorNames/Fatal', CompilerMessages.ErrorNames[etFatal], FPCErrorTypeNames[etFatal]);
{ Other }
p:=Path+'Other/';
@ -4298,6 +4317,11 @@ begin
Result := fItems.Count;
end;
function TCompilerMessagesList.GetErrorNames(errtype: TFPCErrorType): string;
begin
Result := FErrorNames[errtype];
end;
constructor TCompilerMessagesList.Create;
begin
inherited Create;
@ -4329,8 +4353,9 @@ end;
procedure TCompilerMessagesList.Assign(Src: TCompilerMessagesList);
var
i : Integer;
m : TCompilerMessageConfig;
i : Integer;
m : TCompilerMessageConfig;
err : TFPCErrorType;
begin
BeginUpdate;
try
@ -4348,6 +4373,7 @@ begin
AddHash(m);
end;
end;
for err := Low(err) to High(err) do FErrorNames[err] := Src.FErrorNames[err];
finally
EndUpdate;
end;
@ -4373,9 +4399,9 @@ function TCompilerMessagesList.LoadMsgFile(const FileName: string; isFileUnicode
err : Integer;
sub : string;
begin
Result := (s <> '') and not(s[1] in ['#',';','%']);
if not Result then Exit;
Result := (s <> '') and not(s[1] in ['#',';','%']);
if not Result then Exit;
p := Pos('=', s);
Result := p > 0;
if not Result then Exit;
@ -4393,7 +4419,7 @@ function TCompilerMessagesList.LoadMsgFile(const FileName: string; isFileUnicode
if not Result then Exit;
inc(p);
i := p;
while (s[p] <> '_') do inc(p);
while (p <= length(s)) and (s[p] <> '_') do inc(p);
msgType := Copy(s, i, p-i);
isMultiLine := msgType = '[';
if isMultiLine then msgType := '';
@ -4417,14 +4443,21 @@ function TCompilerMessagesList.LoadMsgFile(const FileName: string; isFileUnicode
end;
var
temp : TStringList;
isMln : Boolean;
midx : Integer;
mtype : string;
mtext : string;
i : Integer;
lst : Boolean;
b : array of Boolean;
temp : TStringList;
isMln : Boolean;
midx : Integer;
mtype : string;
mtext : string;
i : Integer;
lst : Boolean;
b : array of Boolean;
err : TFPCErrorType;
const
idxFatal = 01012;
idxError = 01013;
idxWarning = 01014;
idxNote = 01015;
idxHint = 01016;
begin
BeginUpdate;
try
@ -4448,13 +4481,31 @@ begin
fHidden.Add(temp[i]);
end;
end else begin
if (length(mtype) = 1) and (UpperCase(mtype)[1] in ['H','N','W'])
then Add(midx, mtype[1], mtext, b[midx])
else fHidden.Add(temp[i]);
if (length(mtype) = 1) and (UpperCase(mtype)[1] in ['H','N','W']) then
Add(midx, mtype[1], mtext, b[midx])
else begin
case midx of
idxFatal: err := etFatal;
idxError: err := etError;
idxWarning: err := etWarning;
idxNote: err := etNote;
idxHint: err := etHint;
else
err := etNone;
end;
if err <> etNone then begin
mtext := Trim(mtext);
if (length(mtext)>1) and (mtext[length(mtext)]=':') then
FErrorNames[err]:=Copy(mtext, 1, length(mtext)-1)
else
FErrorNames[err]:=mtext;
end;
fHidden.Add(temp[i]);
end;
inc(i);
end;
end else
inc(i);
end else
inc(i)
end;
Result := true;
fUsedMsgFile := FileName;
@ -4488,23 +4539,6 @@ begin
end;
end;
const
cmpMsgHint = 'Hint';
cmpMsgNote = 'Note';
cmpMsgWarn = 'Warn';
function GetMsgTypeStr(AMsgChar: Char; const DefValue: string=''): string;
begin
case AMsgChar of
'h','H': Result := cmpMsgHint;
'w','W': Result := cmpMsgWarn;
'n','N': Result := cmpMsgNote;
else
Result := DefValue;
end;
end;
function TCompilerMessagesList.Add(AMsgIndex: Integer;
AMsgChar: Char; const AMsgText: string; AIgnored: Boolean): TCompilerMessageConfig;
var
@ -4572,7 +4606,8 @@ end;
procedure TCompilerMessagesList.SetDefault(KeepIgnored: Boolean);
var
b : array of Boolean;
b : array of Boolean;
err : TFPCErrorType;
begin
if KeepIgnored then begin
SetLength(b, MaxMsgIndex);
@ -4581,6 +4616,9 @@ begin
BeginUpdate;
try
Clear;
for err := low(TFPCErrorType) to High(TFPCErrorType) do
FErrorNames[err]:=FPCErrorTypeNames[err];
Add(03005,'W','Procedure type "$1" ignored');
Add(03011,'W','Relocatable DLL or executable $1 debug info does not work, disabled.');
Add(03012,'W','To allow debugging for win32 code you need to disable relocation with -WN option');

6
ide/main.pp
View File

@ -9589,6 +9589,7 @@ var
NeedBuildAllFlag: Boolean;
UnitOutputDirectory: String;
TargetExeName: String;
err : TFPCErrorType;
begin
if Project1.MainUnitInfo=nil then begin
// this project has not source to compile
@ -9597,7 +9598,7 @@ begin
Result:=PrepareForCompile;
if Result<>mrOk then exit;
if (AReason in [crCompile,crBuild])
and ([pbfDoNotCompileProject,pbfSkipTools]*Flags=[]) then
begin
@ -9745,6 +9746,9 @@ begin
ToolStatus:=itBuilder;
ConnectOutputFilter;
for err := Low(TFPCErrorType) to High(TFPCErrorType) do
with Project1.CompilerOptions.CompilerMessages do
TheOutputFilter.ErrorTypeName[err] := ErrorNames[err];
// compile
Result:=TheCompiler.Compile(Project1,

34
ide/outputfilter.pas
View File

@ -133,6 +133,7 @@ type
FTool: TIDEExternalToolOptions;
DarwinLinkerMultiline: Boolean;
DarwinLinkerLine : String;
FErrorNames : array [TFPCErrorType] of string; {customizable error names}
procedure DoAddFilteredLine(const s: string; OriginalIndex: integer = -1);
procedure DoAddLastLinkerMessages(SkipLastLine: boolean);
procedure DoAddLastAssemblerMessages;
@ -146,6 +147,9 @@ type
procedure OnAsyncReadData(Sender: TObject);
function CreateScanners(ScannerOptions: TStrings): boolean;
procedure ClearScanners;
protected
procedure SetErrorName(errtype: TFPCErrorType; const AValue: String );
function GetErrorName(errtype: TFPCErrorType): string;
public
ErrorExists: boolean;
Aborted: boolean;
@ -193,6 +197,7 @@ type
property Tool: TIDEExternalToolOptions read FTool;
property ScannerCount: integer read GetScannerCount;
property Scanners[Index: integer]: TIDEMsgScanner read GetScanners;
property ErrorTypeName[errType: TFPCErrorType]: string read GetErrorName write SetErrorName;
end;
EOutputFilterError = class(Exception)
@ -222,6 +227,8 @@ begin
end;
procedure TOutputFilter.Clear;
var
err : TFPCErrorType;
begin
fOutput.Clear;
FAsyncDataAvailable:=false;
@ -539,6 +546,8 @@ var i, j, FilenameEndPos: integer;
if CompStr('Fatal: ',s,p)
or CompStr('Panic',s,p)
or CompStr('Error: ',s,p)
or CompStr(FErrorNames[etFatal], s, p)
or CompStr(FErrorNames[etError], s, p)
or CompStr('Closing script ppas.sh',s,p)
then begin
// always show fatal, panic and linker errors
@ -558,7 +567,7 @@ var i, j, FilenameEndPos: integer;
CurrentMessageParts.Values['Stage']:='Linker'
else
CurrentMessageParts.Values['Stage']:='FPC';
CurrentMessageParts.Values['Type']:=FPCErrorTypeNames[fLastErrorType];
CurrentMessageParts.Values['Type']:=FErrorNames[fLastErrorType];
NewLine:=copy(s,p,length(s));
if fLastErrorType in [etPanic,etFatal] then begin
@ -596,7 +605,7 @@ var i, j, FilenameEndPos: integer;
DoAddFilteredLine(copy(s,p,length(s)));
fLastErrorType:=etNote;
CurrentMessageParts.Values['Stage']:='FPC';
CurrentMessageParts.Values['Type']:=FPCErrorTypeNames[fLastErrorType];
CurrentMessageParts.Values['Type']:=FErrorNames[fLastErrorType];
Result:=true;
exit;
end;
@ -858,20 +867,21 @@ begin
// search for ') <ErrorType>: '
if not CheckForChar(s,i,')') then exit;
if not CheckForChar(s,i,' ') then exit;
if (i>=length(s)) or (not (s[i] in ['A'..'Z'])) then exit;
if (i>=length(s)) or (not (s[i] in ['A'..'Z',#128..#255])) then exit; {#128..#255 - utf8 encoded strings}
j:=i+1;
while (j<=length(s)) and (s[j] in ['a'..'z']) do inc(j);
while (j<=length(s)) and (s[j] in ['a'..'z',#128..#255]) do inc(j);
if (j+1>length(s)) or (s[j]<>':') or (s[j+1]<>' ') then exit;
MessageStartPos:=j+2;
MsgTypeName:=copy(s,i,j-i);
for MsgType:=Succ(etNone) to High(TFPCErrorType) do begin
if FPCErrorTypeNames[MsgType]=MsgTypeName then begin
// FPCErrorTypeNames is checked, in case of badly formed message file
if (FErrorNames[MsgType]=MsgTypeName) or (FPCErrorTypeNames[MsgType]=MsgTypeName) then begin
// this is a freepascal compiler message
// -> filter message
fLastErrorType:=MsgType;
fLastMessageType:=omtFPC;
CurrentMessageParts.Values['Stage']:='FPC';
CurrentMessageParts.Values['Type']:=FPCErrorTypeNames[fLastErrorType];
CurrentMessageParts.Values['Type']:=FErrorNames[fLastErrorType];
CurrentMessageParts.Values['Line']:=
copy(s,LineNumberStartPos,LineNumberEndPos-LineNumberStartPos);
CurrentMessageParts.Values['Column']:=
@ -1015,6 +1025,7 @@ end;
function TOutputFilter.IsHintForUnusedUnit(const OutputLine,
MainSrcFile: string): boolean;
//todo: multilingual?
{ recognizes hints of the form
mainprogram.pp(5,35) Hint: Unit UNUSEDUNIT not used in mainprogram
@ -1031,6 +1042,7 @@ begin
end;
function TOutputFilter.IsHintForParameterSenderNotUsed(const OutputLine: string): boolean;
//todo: multilingual?
{ recognizes hints of the form
Unit1.pas(15,28) Hint: Parameter "Sender" not used
@ -1269,6 +1281,16 @@ begin
end;
end;
procedure TOutputFilter.SetErrorName(errType: TFPCErrorType; const AValue: String);
begin
FErrorNames[errType]:=AValue;
end;
function TOutputFilter.GetErrorName(errType: TFPCErrorType): string;
begin
Result:=FErrorNames[errType];
end;
destructor TOutputFilter.Destroy;
begin
ClearScanners;