diff --git a/applications/idlparser/idlgenpascal.pas b/applications/idlparser/idlgenpascal.pas index a01618800..4a3af14e8 100644 --- a/applications/idlparser/idlgenpascal.pas +++ b/applications/idlparser/idlgenpascal.pas @@ -38,25 +38,10 @@ uses Classes, SysUtils, strutils, idlParser; -procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil); +procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil); 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 := 'idl'; - 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; @@ -98,7 +83,142 @@ begin end; end; -procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil); +function IsReturnTypeFunction(AnIDLMember: TIDLMember; TypeConvList: TStrings; var AParamStr: string; var AReturnType: string) : boolean; +var + found: boolean; + Isfunction: boolean; + + function Search(const AValue: string): boolean; + var + i,c: integer; + res: string; + begin + result := true; + if AValue='' then + AReturnType := AnIDLMember.ReturnType + else + begin + result := false; + i := TypeConvList.IndexOfName(AValue); + if i > -1 then + begin + result := true; + res := TypeConvList.ValueFromIndex[i]; + c := pos(',',res); + if c>0 then + begin + IsFunction:=false; + AReturnType:= copy(res,1,c-1); + AParamStr := copy(res,c+1,10) + ' result_: ' + AReturnType; + end + else + AReturnType := res; + end; + end; + end; + +begin + found := false; + IsFunction:=true; + AReturnType:=''; + AParamStr:=''; + if AnIDLMember.ReturnTypeUnsigned then + begin + found := Search(AnIDLMember.ReturnType+',unsigned,f'); + if not found then + found := Search(AnIDLMember.ReturnType+',f'); + if not found then + found := Search(AnIDLMember.ReturnType+',unsigned'); + end; + + if not found then + found := Search(AnIDLMember.ReturnType+',f'); + + if not found then + found := Search(AnIDLMember.ReturnType); + + if not found then + found := Search(''); + + result := Isfunction; +end; + +function GetIdentifierDeclaration(AParamName: String; AnIDLMemberParameter: TIDLMemberParameter; TypeConvList: TStrings) : string; +var + s: string; + SearchFor: string; + found: boolean; + defprefix: string; + + function Search(const AValue: string): boolean; + var + i,c: integer; + res: string; + begin + result := true; + if avalue='' then + s := defprefix + AParamName + ': ' +AnIDLMemberParameter.ParamType + else + begin + result := false; + i := TypeConvList.IndexOfName(AValue); + if (i > -1) then + begin + result := true; + res := TypeConvList.ValueFromIndex[i]; + if res = '' then + s := 'out ' + AParamName + else + begin + c := pos(',',res); + if c > 0 then + begin + s := copy(res,c+1,10) + ' ' +AParamName + ': ' + copy(res,1,c-1); + end + else + s := defprefix + AParamName + ': ' +res; + end; + end; + end; + end; + +begin + defprefix := ''; + if anIDLMemberParameter.ParamInOutType=piOut then + begin + SearchFor := AnIDLMemberParameter.ParamType + ',out'; + defprefix:='out '; + end + else if anIDLMemberParameter.ParamInOutType=piInOut then + begin + SearchFor := AnIDLMemberParameter.ParamType + ',inout'; + defprefix:='var '; + end + else if anIDLMemberParameter.ParamInOutType=piIn then + SearchFor := AnIDLMemberParameter.ParamType + ',in'; + + if AnIDLMemberParameter.ParamTypeUnsigned then + begin + Found := search(SearchFor+',unsigned'); + if not Found then + Found := search(AnIDLMemberParameter.ParamType+',unsigned'); + end + else + Found := false; + + if not Found then + Found := search(SearchFor); + + if not found then + Found := search(AnIDLMemberParameter.ParamType); + + if not Found then + search(''); + + result := s; +end; + +procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil); var i,l,m: integer; @@ -110,6 +230,8 @@ var ml: boolean; AParamName: string; PasType: string; + FuncRet: string; + IsFunc: boolean; begin PascalCode.add('type'); @@ -135,9 +257,18 @@ begin if anIDLMember.MemberType=mtFunc then begin if anIDLMember.ReturnType = 'void' then - s := s + ' procedure ' + begin + IsFunc:=false; + FuncRet:=''; + end else - s := s + ' function '; + IsFunc := IsReturnTypeFunction(anIDLMember, TypeConvList, FuncRet, PasType); + + if IsFunc then + s := s + ' function ' + else + s := s + ' procedure '; + s := s + IdentifierNameToPascalName(anIDLMember.MemberName) + '('; for m := 0 to anIDLMember.Params.Count-1 do begin @@ -152,30 +283,39 @@ begin end; if m > 0 then s := s + '; '; - if anIDLMemberParameter.ParamInOutType=piOut then - s := s + 'out ' - else if anIDLMemberParameter.ParamInOutType=piInOut then - s := s + 'var '; - s := s + AParamName +': ' + CTypeToPascalType(anIDLMemberParameter.ParamType,anIDLMemberParameter.ParamTypeUnsigned,TypeConvList,CTypesList); + + s := s + GetIdentifierDeclaration(AParamName, AnIDLMemberParameter, TypeConvList); + end; + if not IsFunc and (FuncRet<>'') then + begin + // Pass the function result as a parameter + if anIDLMember.Params.Count>0 then + s := s + ';'; + s := s + FuncRet; end; s := s + ')'; - if anIDLMember.ReturnType <> 'void' then - s := s + ' : '+ CTypeToPascalType(anIDLMember.ReturnType,anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList); + if IsFunc then + s := s + ' : '+ PasType; 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; + IsFunc := IsReturnTypeFunction(anIDLMember, TypeConvList, FuncRet, PasType); + if IsFunc then + s := s + ' function Get' +anIDLMember.MemberName + '(): ' + PasType + '; safecall;' + LineEnding + else // Pass the function result as a parameter + s := s + ' procedure Get' +anIDLMember.MemberName + '('+FuncRet+'); safecall;' + LineEnding; if not anIDLMember.MemberReadonly then s := s + ' procedure Set' +anIDLMember.MemberName + '(a'+anIDLMember.MemberName+': '+ PasType+'); safecall;' + LineEnding; - s := s + ' property ' +IdentifierNameToPascalName(anIDLMember.MemberName)+ ' : '+PasType+ - ' read Get' +anIDLMember.MemberName; - if not anIDLMember.MemberReadonly then - s := s + ' write Set' +anIDLMember.MemberName; - s := s + ';' +LineEnding; - + if IsFunc then + begin + s := s + ' property ' +IdentifierNameToPascalName(anIDLMember.MemberName)+ ' : '+PasType+ + ' read Get' +anIDLMember.MemberName; + if not anIDLMember.MemberReadonly then + s := s + ' write Set' +anIDLMember.MemberName; + s := s + ';' +LineEnding; + end; end else Consts:=Consts + ' ' + anIDL.InterfaceName +'_'+ anIDLMember.MemberName + '=' + CValueToPascalValue(anIDLMember.ConstValue) + ';'+LineEnding; diff --git a/applications/idlparser/idltopas.pp b/applications/idlparser/idltopas.pp index c70b09b57..c9af35727 100644 --- a/applications/idlparser/idltopas.pp +++ b/applications/idlparser/idltopas.pp @@ -24,7 +24,7 @@ type { TIDLToPascal } -procedure HandleIDLFile(AFilename: string; AnOutput, ForwardOutput: TStrings; TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean); +procedure HandleIDLFile(AFilename: string; AnOutput, ForwardOutput: TStrings; TypeConvList: TStrings; AlwaysAddPrefixToParam: boolean); var AnIDLList: TIDLList; AnInput: TStrings; @@ -35,7 +35,7 @@ begin AnIDLList := TIDLList.create; try ParseFile(AnIDLList, AnInput); - GeneratePascalSource(AnIDLList,AnOutput,TypeConvList, CTypesList, AlwaysAddPrefixToParam, ForwardOutput); + GeneratePascalSource(AnIDLList,AnOutput,TypeConvList, AlwaysAddPrefixToParam, ForwardOutput); finally AnIDLList.Free; end; @@ -52,16 +52,15 @@ var output, forwardoutput: TStringList; OutputToFile: boolean; OutputFilename: string; - CTypes, TypeMapList: TStrings; + TypeMapList: TStrings; AlwaysAddPrefixToParam: boolean; begin filenames := TStringList.Create; - CTypes := TStringList.Create; TypeMapList := TStringList.Create; try // quick check parameters - ErrorMsg:=CheckOptions('hpo::c:m:f:',nil,nil,filenames); + ErrorMsg:=CheckOptions('hpo::m:f:',nil,nil,filenames); if ErrorMsg<>'' then begin ShowException(Exception.Create(ErrorMsg)); @@ -77,11 +76,6 @@ begin Exit; end; - if HasOption('c') then - begin - CTypes.LoadFromFile(GetOptionValue('c')); - end; - if HasOption('m') then begin TypeMapList.LoadFromFile(GetOptionValue('m')); @@ -109,7 +103,7 @@ begin if OutputToFile and (OutputFilename='') then Output.Clear; - HandleIDLFile(filenames.Strings[i], output, forwardoutput, TypeMapList, CTypes, AlwaysAddPrefixToParam); + HandleIDLFile(filenames.Strings[i], output, forwardoutput, TypeMapList, AlwaysAddPrefixToParam); if OutputToFile and (OutputFilename='') then output.SaveToFile(LowerCase(ExtractFileName(ChangeFileExt(filenames.Strings[i],'.inc')))); @@ -134,11 +128,9 @@ begin finally filenames.Free; - CTypes.Free; TypeMapList.Free; end; - // stop program loop Terminate; end; @@ -166,8 +158,6 @@ begin writeln(' directory with the same filenames name as the input files but with'); writeln(' the ''.inc'' extension'); writeln(' -o filename Write the output to one file called ''filename'''); - writeln(' -c filename Read ''filename'' to get a list of typenames that have to be'); - writeln(' prefixed with ''c'' or ''cu'' (as used in the ctypes unit)'); writeln(' -m filename Read ''filename'' for a list of mappings between idl-type names'); writeln(' and their Pascal counterpart'); writeln(' -f filename Place all forward declarations into one file called ''filename''');