diff --git a/applications/idlparser/idlgenpascal.pas b/applications/idlparser/idlgenpascal.pas new file mode 100644 index 000000000..98134f9d4 --- /dev/null +++ b/applications/idlparser/idlgenpascal.pas @@ -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. + diff --git a/applications/idlparser/idlparser.pas b/applications/idlparser/idlparser.pas new file mode 100644 index 000000000..e3288c002 --- /dev/null +++ b/applications/idlparser/idlparser.pas @@ -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. + diff --git a/applications/idlparser/idltopascal_gui.ico b/applications/idlparser/idltopascal_gui.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/applications/idlparser/idltopascal_gui.ico differ diff --git a/applications/idlparser/idltopascal_gui.lpi b/applications/idlparser/idltopascal_gui.lpi new file mode 100644 index 000000000..4cf688ac2 --- /dev/null +++ b/applications/idlparser/idltopascal_gui.lpi @@ -0,0 +1,105 @@ + + + + + + + + + <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> diff --git a/applications/idlparser/idltopascal_gui.lpr b/applications/idlparser/idltopascal_gui.lpr new file mode 100644 index 000000000..707e92613 --- /dev/null +++ b/applications/idlparser/idltopascal_gui.lpr @@ -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. + diff --git a/applications/idlparser/main.lfm b/applications/idlparser/main.lfm new file mode 100644 index 000000000..9ef546a59 --- /dev/null +++ b/applications/idlparser/main.lfm @@ -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 diff --git a/applications/idlparser/main.pas b/applications/idlparser/main.pas new file mode 100644 index 000000000..a2ae7df6d --- /dev/null +++ b/applications/idlparser/main.pas @@ -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. + diff --git a/applications/idlparser/pascaltypesettings.lfm b/applications/idlparser/pascaltypesettings.lfm new file mode 100644 index 000000000..a2f2fe580 --- /dev/null +++ b/applications/idlparser/pascaltypesettings.lfm @@ -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 diff --git a/applications/idlparser/pascaltypesettings.pas b/applications/idlparser/pascaltypesettings.pas new file mode 100644 index 000000000..49d1a0ecf --- /dev/null +++ b/applications/idlparser/pascaltypesettings.pas @@ -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. + diff --git a/applications/idlparser/readme.txt b/applications/idlparser/readme.txt new file mode 100644 index 000000000..e486d56ad --- /dev/null +++ b/applications/idlparser/readme.txt @@ -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