paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-03 05:57:15 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: example to parse fpc msg files

Browse Source 
git-svn-id: trunk@35142 -
This commit is contained in:
mattias 2012-02-05 08:58:57 +00:00
parent 02e00c3bc2
commit 8c47e403f7
4 changed files with 155 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -464,6 +464,8 @@ components/codetools/examples/listinterfaceclasses.lpi svneol=native#text/plain
components/codetools/examples/listinterfaceclasses.pas svneol=native#text/plain
components/codetools/examples/methodjumping.lpi svneol=native#text/plain
components/codetools/examples/methodjumping.pas svneol=native#text/plain
components/codetools/examples/parsefpcmsg.lpi svneol=native#text/plain
components/codetools/examples/parsefpcmsg.pas svneol=native#text/plain
components/codetools/examples/ppudependencies.lpi svneol=native#text/plain
components/codetools/examples/ppudependencies.lpr svneol=native#text/plain
components/codetools/examples/proctomethod.lpi svneol=native#text/plain

12
components/codetools/codetoolsfpcmsgs.pas
View File

@ -59,6 +59,7 @@ type
Comment: string; // multi line
Index: integer; // index in list
function GetName(WithID: boolean = true): string;
end;
{ TFPCMsgFile }
@ -215,6 +216,17 @@ begin
end;
end;
{ TFPCMsgItem }
function TFPCMsgItem.GetName(WithID: boolean): string;
begin
Result:=Part+'_';
if Typ<>'' then Result:=Result+Typ+'_';
Result:=Result+TxtIdentifier;
if WithID then
Result:=Result+'='+IntToStr(ID);
end;
{ TFPCMsgFile }
function TFPCMsgFile.GetItems(Index: integer): TFPCMsgItem;

71
components/codetools/examples/parsefpcmsg.lpi Normal file
View File

@ -0,0 +1,71 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="parsefpcmsg"/>
<UseAppBundle Value="False"/>
</General>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="CodeTools"/>
</Item1>
</RequiredPackages>
<Units Count="5">
<Unit0>
<Filename Value="parsefpcmsg.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parsefpcmsg"/>
</Unit0>
<Unit1>
<Filename Value="scanexamples/brokenfilenames.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BrokenFilenames"/>
</Unit1>
<Unit2>
<Filename Value="scanexamples/brokenincfiles.inc"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="scanexamples/empty.inc"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="scanexamples/indentation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Indentation"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

70
components/codetools/examples/parsefpcmsg.pas Normal file
View File

@ -0,0 +1,70 @@
{
***************************************************************************
* *
* This source 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. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Demo for parsing fpc compiler/msg/error*.msg files.
}
program parsefpcmsg;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, FileProcs,
CodeToolManager, CodeCache, CodeToolsFPCMsgs;
var
Code: TCodeBuffer;
Filename: String;
MsgFile: TFPCMsgFile;
i: Integer;
Found: TFPCMsgItem;
Item: TFPCMsgItem;
begin
if Paramcount<>1 then begin
writeln('Usage: '+ParamStr(0)+' fpc_file_errore.msg');
writeln(ParamCount);
Halt;
end;
Filename:=TrimAndExpandFilename(ParamStrUTF8(1));
// load the file
Code:=CodeToolBoss.LoadFile(Filename,false,false);
if Code=nil then
raise Exception.Create('unable to read '+Filename);
MsgFile:=TFPCMsgFile.Create;
MsgFile.LoadFromText(Code.Source);
for i:=0 to MsgFile.Count-1 do begin
Item:=MsgFile[i];
Found:=MsgFile.FindWithMessage(Item.Msg);
if Found=nil then begin
writeln('TForm1.FormCreate message does not fit itself: i=',i,
' MsgFile[i]=',Item.GetName,'="',Item.Msg,'"');
end else if Found<>Item then begin
writeln('TForm1.FormCreate message pattern is ambiguous: i=',i,
' MsgFile[i]=',Item.GetName,'="',Item.Msg,'"',
' Other=',Found.GetName,'="',Found.Msg,'"');
end;
end;
MsgFile.Free;
end.