Browse Source

rtl: added TCustomAttribute

mattias 6 years ago
parent
commit
dcb5c10cac
2 changed files with 48 additions and 0 deletions
  1. 6 0
      packages/rtl/system.pas
  2. 42 0
      packages/rtl/typinfo.pas

+ 6 - 0
packages/rtl/system.pas

@@ -134,6 +134,12 @@ type
     function ToString: String; virtual;
   end;
 
+  { TCustomAttribute - base class of all user defined attributes. }
+
+  TCustomAttribute = class
+  end;
+  TCustomAttributeArray = array of TCustomAttribute;
+
 const
   { IInterface }
   S_OK          = 0;

+ 42 - 0
packages/rtl/typinfo.pas

@@ -68,12 +68,15 @@ const
   tkProperties = tkAny-tkMethods-[tkUnknown];
 
 type
+  TTypeInfoAttributes = type TJSValueDynArray;
+
   { TTypeInfo }
 
   TTypeInfo = class external name 'rtl.tTypeInfo'
   public
     Name: String external name 'name';
     Kind: TTypeKind external name 'kind';
+    Attributes: TTypeInfoAttributes external name 'attr'; // can be undefined
   end;
   TTypeInfoClassOf = class of TTypeInfo;
 
@@ -222,6 +225,7 @@ type
   public
     Name: String external name 'name';
     Kind: TTypeMemberKind external name 'kind';
+    Attributes: TTypeInfoAttributes external name 'attr'; // can be undefined
   end;
   TTypeMemberDynArray = array of TTypeMember;
 
@@ -362,6 +366,8 @@ function GetInterfaceMembers(aTIInterface: TTypeInfoInterface): TTypeMemberDynAr
 function GetInterfaceMember(aTIInterface: TTypeInfoInterface; const aName: String): TTypeMember;
 function GetInterfaceMethods(aTIInterface: TTypeInfoInterface): TTypeMemberMethodDynArray;
 
+function GetRTTIAttributes(const Attributes: TTypeInfoAttributes): TCustomAttributeArray;
+
 function GetPropInfos(aTIStruct: TTypeInfoStruct): TTypeMemberPropertyDynArray;
 function GetPropList(aTIStruct: TTypeInfoStruct; TypeKinds: TTypeKinds; Sorted: boolean = true): TTypeMemberPropertyDynArray;
 function GetPropList(aTIStruct: TTypeInfoStruct): TTypeMemberPropertyDynArray;
@@ -623,6 +629,42 @@ begin
   end;
 end;
 
+type
+  TCreatorAttribute = class external name 'attr'
+    class function Create(const ProcName: string): TCustomAttribute; overload; external name '$create';
+    class function Create(const ProcName: string; Params: jsvalue): TCustomAttribute; overload; external name '$create';
+  end;
+  TCreatorAttributeClass = class of TCreatorAttribute;
+
+function GetRTTIAttributes(const Attributes: TTypeInfoAttributes
+  ): TCustomAttributeArray;
+var
+  i, len: Integer;
+  AttrClass: TCreatorAttributeClass;
+  ProcName: String;
+  Attr: TCustomAttribute;
+begin
+  Result:=nil;
+  if Attributes=Undefined then exit;
+  i:=0;
+  len:=length(Attributes);
+  while i<len do
+    begin
+    AttrClass:=TCreatorAttributeClass(Attributes[i]);
+    inc(i);
+    ProcName:=String(Attributes[i]);
+    inc(i);
+    if (i<len) and isArray(Attributes[i]) then
+      begin
+      Attr:=AttrClass.Create(ProcName,Attributes[i]);
+      inc(i);
+      end
+    else
+      Attr:=AttrClass.Create(ProcName);
+    Insert(Attr,Result,length(Result));
+    end;
+end;
+
 function GetPropInfos(aTIStruct: TTypeInfoStruct): TTypeMemberPropertyDynArray;
 var
   C: TTypeInfoStruct;