* Added initial version of idlparser

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2337 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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.
+

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.
+

applications/idlparser/idltopascal_gui.lpi

@@ -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>

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.
+

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

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.
+

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

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.
+

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