You've already forked lazarus-ccr
* Added ability to specify in type-mappings if var,constref etc should be uesed
* Added ability to force passing a variable in a parameter instead of function result * Removed ctypes-mapping, this in not necessary anymore git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2355 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -38,25 +38,10 @@ uses
|
|||||||
Classes, SysUtils, strutils,
|
Classes, SysUtils, strutils,
|
||||||
idlParser;
|
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
|
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;
|
function HasDoubleIdentifier(const AnIDL: TIDL; AValue: string): boolean;
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
@ -98,7 +83,142 @@ begin
|
|||||||
end;
|
end;
|
||||||
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
|
var
|
||||||
i,l,m: integer;
|
i,l,m: integer;
|
||||||
@ -110,6 +230,8 @@ var
|
|||||||
ml: boolean;
|
ml: boolean;
|
||||||
AParamName: string;
|
AParamName: string;
|
||||||
PasType: string;
|
PasType: string;
|
||||||
|
FuncRet: string;
|
||||||
|
IsFunc: boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
PascalCode.add('type');
|
PascalCode.add('type');
|
||||||
@ -135,9 +257,18 @@ begin
|
|||||||
if anIDLMember.MemberType=mtFunc then
|
if anIDLMember.MemberType=mtFunc then
|
||||||
begin
|
begin
|
||||||
if anIDLMember.ReturnType = 'void' then
|
if anIDLMember.ReturnType = 'void' then
|
||||||
s := s + ' procedure '
|
begin
|
||||||
|
IsFunc:=false;
|
||||||
|
FuncRet:='';
|
||||||
|
end
|
||||||
else
|
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) + '(';
|
s := s + IdentifierNameToPascalName(anIDLMember.MemberName) + '(';
|
||||||
for m := 0 to anIDLMember.Params.Count-1 do
|
for m := 0 to anIDLMember.Params.Count-1 do
|
||||||
begin
|
begin
|
||||||
@ -152,30 +283,39 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
if m > 0 then s := s + '; ';
|
if m > 0 then s := s + '; ';
|
||||||
if anIDLMemberParameter.ParamInOutType=piOut then
|
|
||||||
s := s + 'out '
|
s := s + GetIdentifierDeclaration(AParamName, AnIDLMemberParameter, TypeConvList);
|
||||||
else if anIDLMemberParameter.ParamInOutType=piInOut then
|
end;
|
||||||
s := s + 'var ';
|
if not IsFunc and (FuncRet<>'') then
|
||||||
s := s + AParamName +': ' + CTypeToPascalType(anIDLMemberParameter.ParamType,anIDLMemberParameter.ParamTypeUnsigned,TypeConvList,CTypesList);
|
begin
|
||||||
|
// Pass the function result as a parameter
|
||||||
|
if anIDLMember.Params.Count>0 then
|
||||||
|
s := s + ';';
|
||||||
|
s := s + FuncRet;
|
||||||
end;
|
end;
|
||||||
s := s + ')';
|
s := s + ')';
|
||||||
if anIDLMember.ReturnType <> 'void' then
|
if IsFunc then
|
||||||
s := s + ' : '+ CTypeToPascalType(anIDLMember.ReturnType,anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList);
|
s := s + ' : '+ PasType;
|
||||||
s := s + '; safecall;'+ LineEnding
|
s := s + '; safecall;'+ LineEnding
|
||||||
end
|
end
|
||||||
else if anIDLMember.MemberType=mtAttribute then
|
else if anIDLMember.MemberType=mtAttribute then
|
||||||
begin
|
begin
|
||||||
PasType:= CTypeToPascalType(anIDLMember.ReturnType, anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList);
|
IsFunc := IsReturnTypeFunction(anIDLMember, TypeConvList, FuncRet, PasType);
|
||||||
s := s + ' function Get' +anIDLMember.MemberName + '(): ' + PasType + '; safecall;' + LineEnding;
|
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
|
if not anIDLMember.MemberReadonly then
|
||||||
s := s + ' procedure Set' +anIDLMember.MemberName + '(a'+anIDLMember.MemberName+': '+ PasType+'); safecall;' + LineEnding;
|
s := s + ' procedure Set' +anIDLMember.MemberName + '(a'+anIDLMember.MemberName+': '+ PasType+'); safecall;' + LineEnding;
|
||||||
|
|
||||||
|
if IsFunc then
|
||||||
|
begin
|
||||||
s := s + ' property ' +IdentifierNameToPascalName(anIDLMember.MemberName)+ ' : '+PasType+
|
s := s + ' property ' +IdentifierNameToPascalName(anIDLMember.MemberName)+ ' : '+PasType+
|
||||||
' read Get' +anIDLMember.MemberName;
|
' read Get' +anIDLMember.MemberName;
|
||||||
if not anIDLMember.MemberReadonly then
|
if not anIDLMember.MemberReadonly then
|
||||||
s := s + ' write Set' +anIDLMember.MemberName;
|
s := s + ' write Set' +anIDLMember.MemberName;
|
||||||
s := s + ';' +LineEnding;
|
s := s + ';' +LineEnding;
|
||||||
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
Consts:=Consts + ' ' + anIDL.InterfaceName +'_'+ anIDLMember.MemberName + '=' + CValueToPascalValue(anIDLMember.ConstValue) + ';'+LineEnding;
|
Consts:=Consts + ' ' + anIDL.InterfaceName +'_'+ anIDLMember.MemberName + '=' + CValueToPascalValue(anIDLMember.ConstValue) + ';'+LineEnding;
|
||||||
|
@ -24,7 +24,7 @@ type
|
|||||||
|
|
||||||
{ TIDLToPascal }
|
{ 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
|
var
|
||||||
AnIDLList: TIDLList;
|
AnIDLList: TIDLList;
|
||||||
AnInput: TStrings;
|
AnInput: TStrings;
|
||||||
@ -35,7 +35,7 @@ begin
|
|||||||
AnIDLList := TIDLList.create;
|
AnIDLList := TIDLList.create;
|
||||||
try
|
try
|
||||||
ParseFile(AnIDLList, AnInput);
|
ParseFile(AnIDLList, AnInput);
|
||||||
GeneratePascalSource(AnIDLList,AnOutput,TypeConvList, CTypesList, AlwaysAddPrefixToParam, ForwardOutput);
|
GeneratePascalSource(AnIDLList,AnOutput,TypeConvList, AlwaysAddPrefixToParam, ForwardOutput);
|
||||||
finally
|
finally
|
||||||
AnIDLList.Free;
|
AnIDLList.Free;
|
||||||
end;
|
end;
|
||||||
@ -52,16 +52,15 @@ var
|
|||||||
output, forwardoutput: TStringList;
|
output, forwardoutput: TStringList;
|
||||||
OutputToFile: boolean;
|
OutputToFile: boolean;
|
||||||
OutputFilename: string;
|
OutputFilename: string;
|
||||||
CTypes, TypeMapList: TStrings;
|
TypeMapList: TStrings;
|
||||||
AlwaysAddPrefixToParam: boolean;
|
AlwaysAddPrefixToParam: boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
filenames := TStringList.Create;
|
filenames := TStringList.Create;
|
||||||
CTypes := TStringList.Create;
|
|
||||||
TypeMapList := TStringList.Create;
|
TypeMapList := TStringList.Create;
|
||||||
try
|
try
|
||||||
// quick check parameters
|
// quick check parameters
|
||||||
ErrorMsg:=CheckOptions('hpo::c:m:f:',nil,nil,filenames);
|
ErrorMsg:=CheckOptions('hpo::m:f:',nil,nil,filenames);
|
||||||
if ErrorMsg<>'' then
|
if ErrorMsg<>'' then
|
||||||
begin
|
begin
|
||||||
ShowException(Exception.Create(ErrorMsg));
|
ShowException(Exception.Create(ErrorMsg));
|
||||||
@ -77,11 +76,6 @@ begin
|
|||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if HasOption('c') then
|
|
||||||
begin
|
|
||||||
CTypes.LoadFromFile(GetOptionValue('c'));
|
|
||||||
end;
|
|
||||||
|
|
||||||
if HasOption('m') then
|
if HasOption('m') then
|
||||||
begin
|
begin
|
||||||
TypeMapList.LoadFromFile(GetOptionValue('m'));
|
TypeMapList.LoadFromFile(GetOptionValue('m'));
|
||||||
@ -109,7 +103,7 @@ begin
|
|||||||
if OutputToFile and (OutputFilename='') then
|
if OutputToFile and (OutputFilename='') then
|
||||||
Output.Clear;
|
Output.Clear;
|
||||||
|
|
||||||
HandleIDLFile(filenames.Strings[i], output, forwardoutput, TypeMapList, CTypes, AlwaysAddPrefixToParam);
|
HandleIDLFile(filenames.Strings[i], output, forwardoutput, TypeMapList, AlwaysAddPrefixToParam);
|
||||||
|
|
||||||
if OutputToFile and (OutputFilename='') then
|
if OutputToFile and (OutputFilename='') then
|
||||||
output.SaveToFile(LowerCase(ExtractFileName(ChangeFileExt(filenames.Strings[i],'.inc'))));
|
output.SaveToFile(LowerCase(ExtractFileName(ChangeFileExt(filenames.Strings[i],'.inc'))));
|
||||||
@ -134,11 +128,9 @@ begin
|
|||||||
|
|
||||||
finally
|
finally
|
||||||
filenames.Free;
|
filenames.Free;
|
||||||
CTypes.Free;
|
|
||||||
TypeMapList.Free;
|
TypeMapList.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
// stop program loop
|
// stop program loop
|
||||||
Terminate;
|
Terminate;
|
||||||
end;
|
end;
|
||||||
@ -166,8 +158,6 @@ begin
|
|||||||
writeln(' directory with the same filenames name as the input files but with');
|
writeln(' directory with the same filenames name as the input files but with');
|
||||||
writeln(' the ''.inc'' extension');
|
writeln(' the ''.inc'' extension');
|
||||||
writeln(' -o filename Write the output to one file called ''filename''');
|
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(' -m filename Read ''filename'' for a list of mappings between idl-type names');
|
||||||
writeln(' and their Pascal counterpart');
|
writeln(' and their Pascal counterpart');
|
||||||
writeln(' -f filename Place all forward declarations into one file called ''filename''');
|
writeln(' -f filename Place all forward declarations into one file called ''filename''');
|
||||||
|
Reference in New Issue
Block a user