You've already forked lazarus-ccr
* 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:
181
applications/idlparser/idlgenpascal.pas
Normal file
181
applications/idlparser/idlgenpascal.pas
Normal 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.
|
||||||
|
|
512
applications/idlparser/idlparser.pas
Normal file
512
applications/idlparser/idlparser.pas
Normal 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.
|
||||||
|
|
BIN
applications/idlparser/idltopascal_gui.ico
Normal file
BIN
applications/idlparser/idltopascal_gui.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
105
applications/idlparser/idltopascal_gui.lpi
Normal file
105
applications/idlparser/idltopascal_gui.lpi
Normal 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>
|
23
applications/idlparser/idltopascal_gui.lpr
Normal file
23
applications/idlparser/idltopascal_gui.lpr
Normal 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.
|
||||||
|
|
121
applications/idlparser/main.lfm
Normal file
121
applications/idlparser/main.lfm
Normal 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
|
119
applications/idlparser/main.pas
Normal file
119
applications/idlparser/main.pas
Normal 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.
|
||||||
|
|
190
applications/idlparser/pascaltypesettings.lfm
Normal file
190
applications/idlparser/pascaltypesettings.lfm
Normal 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
|
106
applications/idlparser/pascaltypesettings.pas
Normal file
106
applications/idlparser/pascaltypesettings.pas
Normal 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.
|
||||||
|
|
21
applications/idlparser/readme.txt
Normal file
21
applications/idlparser/readme.txt
Normal 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
|
Reference in New Issue
Block a user