* Added initial version of idlparser

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2337 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
loesje_
2012-03-14 15:06:44 +00:00
parent f78231c2d7
commit 9c3f8d1bfb
10 changed files with 1378 additions and 0 deletions

View File

@ -0,0 +1,181 @@
unit idlGenPascal;
{ Unit which generates a pascal source file from a TIDLList struct.
Copyright (C) 2012 Joost van der Sluis/CNOC joost@cnoc.nl
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program 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 Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, idlParser;
procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean);
implementation
function CTypeToPascalType(AValue: string; unsigned: boolean; TypeConvList, CTypesList: TStrings): string;
begin
if TypeConvList.Values[AValue]<>'' then
result := TypeConvList.Values[AValue]
else if CTypesList.IndexOf(AValue) > -1 then
begin
result := 'c';
if unsigned then result := Result + 'u';
result := result+AValue;
end
else
result := AValue;
end;
function HasDoubleIdentifier(const AnIDL: TIDL; AValue: string): boolean;
var
i: Integer;
begin
result := false;
for i := 0 to AnIDL.members.Count-1 do
if sametext((AnIDL.members.Items[i] as TIDLMember).MemberName, AValue) then
begin
result := true;
break;
end;
end;
function CValueToPascalValue(AValue: string) : string;
begin
if copy(AValue,1,2)='0x' then
result := '$'+copy(AValue,3,16)
else
result := AValue;
end;
procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean);
var
i,l,m: integer;
anIDL: TIDL;
anIDLMember: TIDLMember;
anIDLMemberParameter: TIDLMemberParameter;
s: string;
Consts: string;
ml: boolean;
AParamName: string;
PasType: string;
begin
PascalCode.add('type');
for i := 0 to AnIdlList.Count-1 do
begin
ml := False;
consts := '';
anIDL := TIDL(AnIdlList.Items[i]);
s := ' ' + anIDL.InterfaceName + ' = interface';
if anIDL.InterfaceType<>'' then
s := s + '(' + anIDL.InterfaceType + ')';
if anIDL.UUID<>'' then
begin
s := s + LineEnding + ' [''{' + AnIDL.uuid + '}'']' + LineEnding;
ml := true;
end;
if anIDL.members.Count>0 then
begin
ml := true;
for l := 0 to anIDL.members.Count-1 do
begin
anIDLMember := TIDLMember(anIDL.members.Items[l]);
if anIDLMember.MemberType=mtFunc then
begin
if anIDLMember.ReturnType = 'void' then
s := s + ' procedure '
else
s := s + ' function ';
s := s + anIDLMember.MemberName + '(';
for m := 0 to anIDLMember.Params.Count-1 do
begin
anIDLMemberParameter := (anIDLMember.Params.Items[m]) as TIDLMemberParameter;
AParamName := anIDLMemberParameter.ParamName;
if AlwaysAddPrefixToParam or HasDoubleIdentifier(anIDL,AParamName) then // It could be that the name is used in a inherited class
begin
if AParamName[1] in ['a','e','o','u','i'] then
AParamName := 'An'+AParamName
else
AParamName := 'A'+AParamName;
end;
if m > 0 then s := s + '; ';
if anIDLMemberParameter.ParamInOutType=piOut then
s := s + 'out ';
s := s + AParamName +': ' + CTypeToPascalType(anIDLMemberParameter.ParamType,anIDLMemberParameter.ParamTypeUnsigned,TypeConvList,CTypesList);
end;
s := s + ')';
if anIDLMember.ReturnType <> 'void' then
s := s + ' : '+ CTypeToPascalType(anIDLMember.ReturnType,anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList);
s := s + '; safecall;'+ LineEnding
end
else if anIDLMember.MemberType=mtAttribute then
begin
PasType:= CTypeToPascalType(anIDLMember.ReturnType, anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList);
s := s + ' function Get' +anIDLMember.MemberName + '(): ' + PasType + '; safecall;' + LineEnding;
if not anIDLMember.MemberReadonly then
s := s + ' procedure Set' +anIDLMember.MemberName + '(a'+anIDLMember.MemberName+': '+ PasType+'); safecall;' + LineEnding;
s := s + ' property ' +anIDLMember.MemberName+ ' : '+PasType+
' read Get' +anIDLMember.MemberName;
if not anIDLMember.MemberReadonly then
s := s + ' write Set' +anIDLMember.MemberName;
s := s + ';' +LineEnding;
end
else
Consts:=Consts + ' ' + anIDL.InterfaceName +'_'+ anIDLMember.MemberName + '=' + CValueToPascalValue(anIDLMember.ConstValue) + ';'+LineEnding;
end;
end;
if ml then
s := LineEnding + s + LineEnding+' end;' + LineEnding
else
s := s + ';';
PascalCode.Add(s);
if consts<>'' then
begin
PascalCode.Add('const');
PascalCode.Add(Consts);
end;
end;
end;
end.

View File

@ -0,0 +1,512 @@
unit idlParser;
{ Unit which parses idl (interface description language) files into a TIDLList
struct.
Copyright (C) 2012 Joost van der Sluis/CNOC joost@cnoc.nl
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program 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 Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,contnrs;
type
TMemberType=(mtFunc,mtAttribute,mtConst);
TParamInOutType=(piOut,piIn);
{ TIDLMemberParameter }
TIDLMemberParameter = class
private
FParamInOutType: TParamInOutType;
FParamName: string;
FParamType: string;
FParamTypeUnsigned: boolean;
public
property ParamType : string read FParamType write FParamType;
property ParamTypeUnsigned: boolean read FParamTypeUnsigned write FParamTypeUnsigned;
property ParamName: string read FParamName write FParamName;
property ParamInOutType: TParamInOutType read FParamInOutType write FParamInOutType;
end;
TIDLMemberParameterList = class(TObjectList);
{ TIDLMember }
TIDLMember = class
private
FMemberName: string;
FMemberReadonly: boolean;
FMemberType: TMemberType;
FParams: TIDLMemberParameterList;
FReturnType: string;
FConstValue: string;
FReturnTypeUnsigned: boolean;
public
constructor Create; virtual;
destructor Destroy; override;
property MemberType : TMemberType read FMemberType write FMemberType;
property ReturnType : string read FReturnType write FReturnType;
property ReturnTypeUnsigned: boolean read FReturnTypeUnsigned write FReturnTypeUnsigned;
property MemberName: string read FMemberName write FMemberName;
property MemberReadonly: boolean read FMemberReadonly write FMemberReadonly;
property Params: TIDLMemberParameterList read FParams;
property ConstValue: string read FConstValue write FConstValue;
end;
TIDLMemberList = class(TObjectList);
TIDL = class
private
FInterfaceName: string;
FInterfaceType: string;
Fmembers: TIDLMemberList;
FUUID: string;
public
constructor Create; virtual;
destructor Destroy; override;
property InterfaceName: string read FInterfaceName write FInterfaceName;
property InterfaceType: string read FInterfaceType write FInterfaceType;
property UUID: string read FUUID write FUUID;
property members: TIDLMemberList read Fmembers;
end;
TIDLList = class(TObjectList);
procedure ParseFile(const AnIdlList: TIDLList; const IDLtext: tstrings);
implementation
const
idlInterface = 'interface';
idlUUID = 'uuid';
idlattribute = 'attribute';
idlconst = 'const';
idlreadonly = 'readonly';
idlInterfaceEnd = ';';
idlUnsigned = 'unsigned';
idlMemberEnd = ';';
idlInterfaceTypeSeparator = ':';
idlInterfaceBlockStart = '{';
idlInterfaceBlockEnd = '}';
idlStartMultiLineComment = '/*';
idlEndMultiLineComment = '*/';
idlStartExtension = '%{';
idlEndExtension = '%}';
idlStartSingleLineComment = '//';
idlEndSingleLineComment = #10;
idlStartIDLAttributesBlock = '[';
idlEndIDLAttributesBlock = ']';
idlStartUUID = '(';
idlEndUUID = ')';
idlSeparateFuncParams = ',';
idlStartFuncParams = '(';
idlEndFuncParams = ')';
idlParamIn = 'in';
idlParamOut = 'out';
idlConstAssign = '=';
procedure ParseFile(const AnIdlList: TIDLList; const IDLtext: tstrings);
type TParseState = (psBegin,
psMultiLineComment,
psSingleLineComment,
psInterface,
psInterfaceType,
psInterfaceBlock,
psInterfaceBlockFuncName,
psInterfaceBlockFuncParams,
psInterfaceBlockFuncParamName,
psInterfaceAfterFuncParams,
psParamAttributeBlock,
psConstValue,
psIDLAttributes,
psSearchUUID,
psUUID,
psExtension,
psWord);
var
PriorState: TParseState;
ParseState: TParseState;
LineNr: integer;
IDLString: string;
pCurrent: pchar;
AWord: string;
pWordStart: pchar;
wordchars: set of char;
UUIDAttribute: string;
CurrentIDL: TIDL;
CurrentIDLMember: TIDLMember;
CurrentIDLMemberParam: TIDLMemberParameter;
IsAttribute, IsReadonly: boolean;
IsConst: boolean;
IsParamIn, IsParamOut: boolean;
IsUnsigned: boolean;
function CheckChar(const ACheckForString: string; ASetParseState: TParseState): boolean;
begin
result := false;
if CompareChar(pCurrent^,ACheckForString[1], length(ACheckForString))=0 then
begin
ParseState := ASetParseState;
inc(pcurrent,length(ACheckForString));
result := True;
end;
end;
function CheckChar(const ACheckForString: string; ASetParseState, ASetPriorParseState: TParseState): boolean;
begin
result := CheckChar(ACheckForString, ASetParseState);
if result then
PriorState:=ASetPriorParseState;
end;
function CheckStartWord(ASetParseState, ASetPriorParseState: TParseState; AllowMinus: boolean = false): boolean;
var
c: char;
begin
result := false;
wordchars:=['a'..'z','A'..'Z','0'..'9','_'];
if AllowMinus then include(wordchars,'-');
if pCurrent^ in wordchars then
begin
pWordStart:=pCurrent;
PriorState:=ASetPriorParseState;
ParseState := ASetParseState;
inc(pcurrent);
result := True;
end;
end;
function CheckEndWord(ASetParseState: TParseState): boolean;
var
i: integer;
begin
result := false;
if not (pCurrent^ in wordchars) then
begin
i := pCurrent-pWordStart;
SetLength(AWord,i);
move(pWordStart^,AWord[1],i);
if PriorState = psInterface then
CurrentIDL.InterfaceName:=AWord
else if PriorState = psInterfaceType then
CurrentIDL.InterfaceType:=AWord
else if PriorState = psSearchUUID then
UUIDAttribute:=AWord
else if PriorState = psInterfaceBlockFuncName then
CurrentIDLMember.MemberName:=AWord
else if PriorState = psInterfaceBlockFuncParamName then
CurrentIDLMemberParam.ParamName:=AWord
else if PriorState = psConstValue then
begin
if CurrentIDLMember.ConstValue<>'' then CurrentIDLMember.ConstValue := CurrentIDLMember.ConstValue + ' ';
CurrentIDLMember.ConstValue:=CurrentIDLMember.ConstValue + AWord;
end;
ParseState := ASetParseState;
result := True;
end;
end;
function CheckInterfaceStart: boolean;
begin
result := CheckChar(idlInterface, psInterface);
if result then
begin
CurrentIDL := TIDL.Create;
AnIdlList.Add(CurrentIDL);
CurrentIDL.UUID:=UUIDAttribute;
UUIDAttribute:='';
end;
end;
function CheckFuncStart: boolean;
begin
result := CheckStartWord(psWord, psInterfaceBlockFuncName);
if result then
begin
CurrentIDLMember := TIDLMember.Create;
if Isconst then
CurrentIDLMember.MemberType:=mtConst
else if IsAttribute then
CurrentIDLMember.MemberType:=mtAttribute
else
CurrentIDLMember.MemberType:=mtFunc;
CurrentIDLMember.MemberReadonly:=IsReadonly;
IsAttribute:=false;
IsConst:=false;
IsReadonly:=false;
CurrentIDL.members.Add(CurrentIDLMember);
end;
end;
function CheckParamStart: boolean;
begin
result := CheckStartWord(psWord, psInterfaceBlockFuncParamName);
if result then
begin
CurrentIDLMemberParam := TIDLMemberParameter.Create;
if IsParamIn then
CurrentIDLMemberParam.ParamInOutType:=piIn;
if IsParamOut then
CurrentIDLMemberParam.ParamInOutType:=piOut;
IsParamIn:=false;
IsParamOut:=false;
CurrentIDLMember.Params.Add(CurrentIDLMemberParam);
end;
end;
function CheckAttributeStart: boolean;
begin
result := CheckChar(idlattribute, psInterfaceBlock);
if result then
IsAttribute := True;
end;
function CheckConstStart: boolean;
begin
result := CheckChar(idlconst, psInterfaceBlock);
if result then
IsConst := True;
end;
function CheckUnsigned: boolean;
begin
result := CheckChar(idlUnsigned, ParseState);
if result then
IsUnsigned := True;
end;
function CheckAttributeReadOnly: boolean;
begin
result := CheckChar(idlreadonly, psInterfaceBlock);
if result then
IsReadonly := True;
end;
function CheckParamIn: boolean;
begin
result := CheckChar(idlParamIn, psInterfaceBlockFuncParams);
if result then
IsParamIn := True;
end;
function CheckParamOut: boolean;
begin
result := CheckChar(idlParamOut, psInterfaceBlockFuncParams);
if result then
IsParamOut := True;
end;
begin
LineNr := 0;
ParseState:=psBegin;
IDLString:=IDLtext.Text;
if length(IDLString)=0 then
Exit;
IsAttribute:=false;
IsReadonly:=false;
IsUnsigned:=false;
IsConst:=false;
UUIDAttribute:='';
pCurrent:=@IDLString[1];
while pCurrent^ <> #0 do
begin
case ParseState of
psBegin:
begin
if not (CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlStartExtension,psExtension,ParseState) or
CheckInterfaceStart or
CheckChar(idlStartIDLAttributesBlock,psIDLAttributes,ParseState) or
CheckChar(idlInterface,psInterface)) then
inc(pCurrent);
end;
psMultiLineComment:
begin
if not (CheckChar(idlEndMultiLineComment,PriorState)) then
inc(pCurrent);
end;
psExtension:
begin
if not (CheckChar(idlEndExtension,PriorState)) then
inc(pCurrent);
end;
psSingleLineComment:
begin
if not (CheckChar(idlEndSingleLineComment,PriorState)) then
inc(pCurrent);
end;
psParamAttributeBlock:
begin
if not (CheckChar(idlEndIDLAttributesBlock,PriorState)) then
inc(pCurrent);
end;
psIDLAttributes:
begin
if not (CheckChar(idlEndIDLAttributesBlock,psBegin) or
CheckChar(idlUUID, psSearchUUID)) then
inc(pCurrent);
end;
psSearchUUID:
begin
if not (CheckChar(idlStartUUID,psUUID) or
CheckChar(idlEndUUID, psIDLAttributes)) then
inc(pCurrent);
end;
psUUID:
begin
if not CheckStartWord(psWord,psSearchUUID,true) then
inc(pCurrent);
end;
psInterface, psInterfaceType:
begin
if not (CheckStartWord(psWord,ParseState) or
CheckChar(idlInterfaceBlockStart,psInterfaceBlock,ParseState) or
CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlStartSingleLineComment,psSingleLineComment,ParseState) or
CheckChar(idlStartExtension,psExtension,ParseState) or
CheckChar(idlInterfaceTypeSeparator, psInterfaceType) or
CheckChar(idlInterfaceEnd, psBegin)) then
inc(pCurrent);
end;
psInterfaceBlock:
begin
if not (CheckChar(idlInterfaceBlockEnd,psInterface) or
CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlStartExtension,psExtension,ParseState) or
CheckChar(idlStartSingleLineComment,psSingleLineComment,ParseState) or
CheckChar(idlStartIDLAttributesBlock,psParamAttributeBlock,ParseState) or
CheckAttributeStart or
CheckAttributeReadOnly or
CheckConstStart or
CheckUnsigned or
CheckFuncStart) then
inc(pCurrent)
end;
psInterfaceBlockFuncName:
begin
if CurrentIDLMember.ReturnType = '' then
begin
CurrentIDLMember.ReturnType:=aword;
CurrentIDLMember.ReturnTypeUnsigned := IsUnsigned;
IsUnsigned:=false;
end;
if not (CheckStartWord(psWord, psInterfaceBlockFuncName) or
CheckChar(idlStartFuncParams,psInterfaceBlockFuncParams) or
CheckChar(idlMemberEnd,psInterfaceBlock) or
CheckChar(idlConstAssign,psConstValue) or
CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState)) then
inc(pCurrent)
end;
psInterfaceBlockFuncParams:
begin
if not (CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlStartIDLAttributesBlock,psParamAttributeBlock,ParseState) or
CheckParamIn or
CheckParamOut or
CheckUnsigned or
CheckParamStart or
CheckChar(idlEndFuncParams,psInterfaceAfterFuncParams)) then
inc(pCurrent)
end;
psInterfaceAfterFuncParams:
begin
// voor een definitie als: 'nsIDOMNode setNamedItem(in nsIDOMNode arg) raises(DOMException);'
// negeer in dat geval alles na de parameters
if not (CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlMemberEnd,psInterfaceBlock)) then
inc(pCurrent)
end;
psInterfaceBlockFuncParamName:
begin
if CurrentIDLMemberParam.ParamType = '' then
begin
CurrentIDLMemberParam.ParamType:=aword;
CurrentIDLMemberParam.ParamTypeUnsigned := IsUnsigned;
IsUnsigned:=false;
end;
if not (CheckStartWord(psWord, psInterfaceBlockFuncParamName) or
CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlSeparateFuncParams,psInterfaceBlockFuncParams) or
CheckChar(idlEndFuncParams,psInterfaceAfterFuncParams)) then
inc(pCurrent)
end;
psConstValue:
begin
if not (CheckStartWord(psWord, psConstValue) or
CheckChar(idlStartMultiLineComment,psMultiLineComment,ParseState) or
CheckChar(idlMemberEnd,psInterfaceBlock)) then
inc(pCurrent)
end;
psWord:
begin
if not CheckEndWord(PriorState) then
inc(pCurrent);
end;
end;
end;
end;
{ TIDLMember }
constructor TIDLMember.Create;
begin
FParams := TIDLMemberParameterList.create;
end;
destructor TIDLMember.Destroy;
begin
FParams.Free;
inherited Destroy;
end;
{ TIDL }
constructor TIDL.Create;
begin
Fmembers := TIDLMemberList.create;
end;
destructor TIDL.Destroy;
begin
Fmembers.free;
inherited Destroy;
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,105 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="idltopascal_gui"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<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|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="5">
<Unit0>
<Filename Value="idltopascal_gui.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="idltopascal_gui"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="main"/>
</Unit1>
<Unit2>
<Filename Value="idlparser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="idlParser"/>
</Unit2>
<Unit3>
<Filename Value="idlgenpascal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="idlGenPascal"/>
</Unit3>
<Unit4>
<Filename Value="pascaltypesettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TypeSettings"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="PascaltypeSettings"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="idltopascal_gui"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,23 @@
program IdlToPascal_GUI;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms,
main, idlparser, idlGenPascal, PascaltypeSettings
;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TTypeSettings, TypeSettings);
Application.Run;
end.

View File

@ -0,0 +1,121 @@
object MainForm: TMainForm
Left = 468
Height = 438
Top = 319
Width = 680
Caption = 'IDL to Pascal parser'
ClientHeight = 438
ClientWidth = 680
LCLVersion = '0.9.31'
object memoPascalfile: TMemo
Left = 355
Height = 400
Top = 0
Width = 325
Align = alClient
Lines.Strings = (
''
)
ScrollBars = ssAutoBoth
TabOrder = 0
end
object memoIDLFile: TMemo
Left = 0
Height = 400
Top = 0
Width = 350
Align = alLeft
Lines.Strings = (
''
)
ScrollBars = ssAutoBoth
TabOrder = 1
end
object pBottom: TPanel
Left = 0
Height = 38
Top = 400
Width = 680
Align = alBottom
ClientHeight = 38
ClientWidth = 680
TabOrder = 2
object bConvert: TButton
Left = 80
Height = 32
Top = 3
Width = 100
Align = alLeft
BorderSpacing.Around = 2
Caption = 'IDL to Pascal'
OnClick = bConvertClick
TabOrder = 0
end
object bOpen: TButton
Left = 3
Height = 32
Top = 3
Width = 75
Align = alLeft
BorderSpacing.Around = 2
Caption = 'Open IDL'
OnClick = bOpenClick
TabOrder = 1
end
object bSave: TButton
Left = 182
Height = 32
Top = 3
Width = 139
Align = alLeft
BorderSpacing.Around = 2
Caption = 'Save to include file'
OnClick = bSaveClick
TabOrder = 2
end
object Label1: TLabel
Left = 458
Height = 36
Top = 1
Width = 1
Align = alLeft
Layout = tlCenter
ParentColor = False
end
object cbParamPrefix: TCheckBox
Left = 323
Height = 36
Top = 1
Width = 135
Align = alLeft
Caption = 'Add param prefix'
TabOrder = 3
end
object bSettings: TButton
Left = 608
Height = 32
Top = 3
Width = 69
Align = alRight
BorderSpacing.Around = 2
Caption = 'Settings'
OnClick = bSettingsClick
TabOrder = 4
end
end
object Splitter1: TSplitter
Left = 350
Height = 400
Top = 0
Width = 5
end
object OpenDialog: TOpenDialog
Filter = 'IDL-files|*.idl|All-diles|*'
left = 32
top = 8
end
object SaveDialog: TSaveDialog
left = 120
top = 8
end
end

View File

@ -0,0 +1,119 @@
unit main;
{$mode objfpc}{$H+}
{ Main form for application to convert IDL to Pascal sourcefiles
Copyright (C) 20120 Joost van der Sluis/CNOC joost@cnoc.nl
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program 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 Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Grids, ValEdit, contnrs, idlparser, idlGenPascal;
type
{ TMainForm }
TMainForm = class(TForm)
bOpen: TButton;
bConvert: TButton;
bSave: TButton;
bSettings: TButton;
cbParamPrefix: TCheckBox;
Label1: TLabel;
memoPascalfile: TMemo;
memoIDLFile: TMemo;
OpenDialog: TOpenDialog;
pBottom: TPanel;
SaveDialog: TSaveDialog;
Splitter1: TSplitter;
procedure bOpenClick(Sender: TObject);
procedure bConvertClick(Sender: TObject);
procedure bSaveClick(Sender: TObject);
procedure bSettingsClick(Sender: TObject);
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
PascaltypeSettings;
{ TMainForm }
procedure TMainForm.bOpenClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
memoIDLFile.Lines.LoadFromFile(OpenDialog.FileName);
label1.Caption:=OpenDialog.FileName;
end;
end;
procedure TMainForm.bConvertClick(Sender: TObject);
var
IDLList: TIDLList;
begin
memoPascalfile.lines.clear;
IDLList := TIDLList.create;
try
IDLList.OwnsObjects:=true;
ParseFile(IDLList, memoIDLFile.Lines);
GeneratePascalSource(IDLList,memoPascalfile.Lines,TypeSettings.ValueListEditor1.Strings,TypeSettings.cTypes.Lines, cbParamPrefix.Checked);
finally
IDLList.Free;
end;
end;
procedure TMainForm.bSaveClick(Sender: TObject);
begin
SaveDialog.FileName:=ChangeFileExt(LowerCase(ExtractFileName(Label1.Caption)),'.inc');
if SaveDialog.Execute then
memoPascalfile.Lines.SaveToFile(SaveDialog.FileName);
end;
procedure TMainForm.bSettingsClick(Sender: TObject);
begin
TypeSettings.Show;
end;
end.

View File

@ -0,0 +1,190 @@
object TypeSettings: TTypeSettings
Left = 901
Height = 277
Top = 640
Width = 498
Caption = 'IDL to Pascal type translation settings'
ClientHeight = 277
ClientWidth = 498
LCLVersion = '0.9.31'
object pLeft: TPanel
Left = 0
Height = 277
Top = 0
Width = 240
Align = alLeft
BevelOuter = bvNone
ClientHeight = 277
ClientWidth = 240
TabOrder = 0
object ValueListEditor1: TValueListEditor
Left = 0
Height = 225
Top = 22
Width = 240
Align = alClient
AutoFillColumns = True
FixedCols = 0
FixedRows = 0
RowCount = 3
TabOrder = 0
Strings.Strings = (
'--=see lazarus bug 21480 '
'wstring=PWideChar'
'boolean=longbool'
''
)
TitleCaptions.Strings = (
'IDL-Type'
'Pascal-Type'
)
ColWidths = (
119
119
)
Cells = (
6
0
0
'IDL-Type'
0
1
'wstring'
0
2
'boolean'
1
0
'Pascal-Type'
1
1
'PWideChar'
1
2
'longbool'
)
end
object Label2: TLabel
Left = 0
Height = 22
Top = 0
Width = 240
Align = alTop
Caption = 'Map IDL-types to Pascal-types'
ParentColor = False
end
object pMapBottom: TPanel
Left = 0
Height = 30
Top = 247
Width = 240
Align = alBottom
BevelOuter = bvNone
ClientHeight = 30
ClientWidth = 240
TabOrder = 1
object bSaveMap: TButton
Left = 138
Height = 26
Top = 2
Width = 100
Align = alRight
BorderSpacing.Around = 2
Caption = 'Save to file'
OnClick = bSaveMapClick
TabOrder = 0
end
object bLoadMap: TButton
Left = 2
Height = 26
Top = 2
Width = 100
Align = alLeft
BorderSpacing.Around = 2
Caption = 'Load from file'
OnClick = bLoadMapClick
TabOrder = 1
end
end
end
object Splitter1: TSplitter
Left = 240
Height = 277
Top = 0
Width = 5
end
object pRight: TPanel
Left = 245
Height = 277
Top = 0
Width = 253
Align = alClient
BevelOuter = bvNone
ClientHeight = 277
ClientWidth = 253
TabOrder = 2
object cTypes: TMemo
Left = 0
Height = 225
Top = 22
Width = 253
Align = alClient
Lines.Strings = (
'long'
'short'
'float'
)
TabOrder = 0
end
object Label3: TLabel
Left = 0
Height = 22
Top = 0
Width = 253
Align = alTop
Caption = 'List of c-types'
ParentColor = False
end
object pCListBottom: TPanel
Left = 0
Height = 30
Top = 247
Width = 253
Align = alBottom
BevelOuter = bvNone
ClientHeight = 30
ClientWidth = 253
TabOrder = 1
object bSaveClist: TButton
Left = 151
Height = 26
Top = 2
Width = 100
Align = alRight
BorderSpacing.Around = 2
Caption = 'Save to file'
OnClick = bSaveClistClick
TabOrder = 0
end
object bLoadCList: TButton
Left = 2
Height = 26
Top = 2
Width = 100
Align = alLeft
BorderSpacing.Around = 2
Caption = 'Load from file'
OnClick = bLoadCListClick
TabOrder = 1
end
end
end
object OpenDialog: TOpenDialog
left = 54
top = 153
end
object SaveDialog: TSaveDialog
left = 152
top = 152
end
end

View File

@ -0,0 +1,106 @@
unit PascaltypeSettings;
{ Settings for converting IDL-types to Pascal types
Copyright (C) 20120 Joost van der Sluis/CNOC joost@cnoc.nl
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program 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 Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ValEdit;
type
{ TTypeSettings }
TTypeSettings = class(TForm)
bLoadCList: TButton;
bSaveMap: TButton;
bLoadMap: TButton;
bSaveClist: TButton;
cTypes: TMemo;
Label2: TLabel;
Label3: TLabel;
OpenDialog: TOpenDialog;
pMapBottom: TPanel;
pCListBottom: TPanel;
pRight: TPanel;
pLeft: TPanel;
SaveDialog: TSaveDialog;
Splitter1: TSplitter;
ValueListEditor1: TValueListEditor;
procedure bLoadCListClick(Sender: TObject);
procedure bLoadMapClick(Sender: TObject);
procedure bSaveClistClick(Sender: TObject);
procedure bSaveMapClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
TypeSettings: TTypeSettings;
implementation
{$R *.lfm}
{ TTypeSettings }
procedure TTypeSettings.bLoadMapClick(Sender: TObject);
begin
if OpenDialog.Execute then
ValueListEditor1.LoadFromFile(OpenDialog.FileName);
end;
procedure TTypeSettings.bSaveClistClick(Sender: TObject);
begin
if SaveDialog.Execute then
cTypes.Lines.SaveToFile(SaveDialog.FileName);
end;
procedure TTypeSettings.bLoadCListClick(Sender: TObject);
begin
if OpenDialog.Execute then
cTypes.Lines.LoadFromFile(OpenDialog.FileName);
end;
procedure TTypeSettings.bSaveMapClick(Sender: TObject);
begin
if SaveDialog.Execute then
ValueListEditor1.SaveToFile(SaveDialog.FileName);
end;
end.

View File

@ -0,0 +1,21 @@
This program is a simple IDL-parser that is used to generate header-include
files for the Gecko-SDK.
This application is able to parse the .idl files from the Gecko-SDK project.
It could be that it can be used or extended to parse idl-files from other
projects, but I never tested that.
The generated Pascal-sources are as close as possible to the original idl
files. C-types are converted to their corresponding types in fpc's ctypes
unit.
It is possible to map some types from their idl to Pascal name. You can also
specify which types have to be converted to their ctypes-unit equivalent.
All files are licensed by the modified LGPL, as used in the Lazarus LCL.
I hope this is useful for someone,
Joost van der Sluis, CNOC
March 14, 2012