paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 21:20:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: added CreateExprListFromMethodTypeData for Instance+PropName

Browse Source 
git-svn-id: trunk@40121 -
This commit is contained in:
mattias 2013-02-02 15:28:32 +00:00
parent 632d1dc771
commit 1b4524ada4
1 changed files with 39 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
components/codetools/eventcodetool.pas
View File

@ -116,10 +116,13 @@ type
const PropName: string; out TypeContext: TFindContext;
ExceptionOnNotFound: boolean): boolean;
function CreateExprListFromInstanceProperty(Instance: TPersistent;
const PropName: string): TExprTypeList;
const PropName: string; UseRTTI: boolean = false): TExprTypeList;
function CreateExprListFromMethodTypeData(TypeData: PTypeData;
Params: TFindDeclarationParams; out List: TExprTypeList): boolean;
function CreateExprListFromMethodTypeData(Instance: TPersistent;
const PropName: string;
Params: TFindDeclarationParams; out List: TExprTypeList): boolean;
function FindPublishedMethodNodeInClass(ClassNode: TCodeTreeNode;
const AMethodName: string;
ExceptionOnNotFound: boolean): TFindContext;
@ -1147,20 +1150,27 @@ begin
end;
function TEventsCodeTool.CreateExprListFromInstanceProperty(
Instance: TPersistent; const PropName: string): TExprTypeList;
Instance: TPersistent; const PropName: string; UseRTTI: boolean
): TExprTypeList;
var
Params: TFindDeclarationParams;
TypeContext: TFindContext;
begin
Result:=nil;
if not FindTypeOfInstanceProperty(Instance,PropName,TypeContext,true) then exit;
if TypeContext.Node.Desc<>ctnProcedureType then begin
debugln(['TEventsCodeTool.CreateExprListFromPropertyInfo property '+DbgSName(Instance)+'.'+PropName+' is not method: ',TypeContext.Node.DescAsString]);
exit;
end;
Params:=TFindDeclarationParams.Create;
try
Result:=TypeContext.Tool.CreateParamExprListFromProcNode(TypeContext.Node,Params);
if UseRTTI then begin
if not CreateExprListFromMethodTypeData(Instance,PropName,Params,Result)
then
exit;
end else begin
if not FindTypeOfInstanceProperty(Instance,PropName,TypeContext,true) then exit;
if TypeContext.Node.Desc<>ctnProcedureType then begin
debugln(['TEventsCodeTool.CreateExprListFromPropertyInfo property '+DbgSName(Instance)+'.'+PropName+' is not method: ',TypeContext.Node.DescAsString]);
exit;
end;
Result:=TypeContext.Tool.CreateParamExprListFromProcNode(TypeContext.Node,Params);
end;
finally
Params.Free;
end;
@ -1252,6 +1262,27 @@ begin
Result:=true;
end;
function TEventsCodeTool.CreateExprListFromMethodTypeData(
Instance: TPersistent; const PropName: string;
Params: TFindDeclarationParams; out List: TExprTypeList): boolean;
var
PropInfo: PPropInfo;
TypeData: PTypeData;
begin
Result:=false;
PropInfo:=GetPropInfo(Instance,PropName);
if PropInfo=nil then begin
debugln(['TEventsCodeTool.CreateExprListFromMethodTypeData property not found: ',DbgSName(Instance),' property=',PropName]);
exit;
end;
if PropInfo^.PropType^.Kind<>tkMethod then begin
debugln(['TEventsCodeTool.CreateExprListFromMethodTypeData property is not a method: ',DbgSName(Instance),' property=',PropName]);
exit;
end;
TypeData:=GetTypeData(PropInfo^.PropType);
Result:=CreateExprListFromMethodTypeData(TypeData,Params,List);
end;
function TEventsCodeTool.CollectPublishedMethods(
Params: TFindDeclarationParams; const FoundContext: TFindContext
): TIdentifierFoundResult;