unit uPropInfo;

interface

uses Classes, TypInfo, Rubies;

var
  cPropInfo: Tvalue;

procedure PropInfo_setup(This: Tvalue; real: PPropInfo); cdecl;
function PropInfo_new(This, v, prop: Tvalue): Tvalue; cdecl;
procedure Init_PropInfo;

implementation

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils,
  uStrUtils, uDefUtils,
  uHandle, uPhi, uError, uDebug, uIO, uConv,
  uTypeInfo;

procedure PropInfo_setup(This: Tvalue; real: PPropInfo); cdecl;
var
  ATypeInfo: PTypeInfo;
  vTypeInfo: Tvalue;
begin
  rb_iv_set(This, '@reader', ap_bool(real.GetProc <> nil));
  rb_iv_set(This, '@writer', ap_bool(real.SetProc <> nil));
  rb_iv_set(This, '@name', rb_str_new2(PChar(string(real^.Name))));

  ATypeInfo := real^.PropType^;
  vTypeInfo := rb_data_object_alloc(cTypeInfo, ATypeInfo, nil, nil);
  rb_iv_set(This, '@type_info', vTypeInfo);

  TypeInfo_setup_internal(vTypeInfo, ATypeInfo);
  TypeInfo_setup_TypeData(vTypeInfo, ATypeInfo);
end;

function PropInfo_new(This, v, prop: Tvalue): Tvalue; cdecl;
var
  obj: TObject;
  real: PPropInfo;
begin
  ap_data_get_object(v, TObject, obj);
  real := GetPropInfo(obj, trimUnder(dl_caption(prop)));
  if real = nil then
    result := Qnil
  else
  begin
    result := rb_data_object_alloc(cPropInfo, real, nil, nil);
    PropInfo_setup(result, real);
    rb_iv_set(result, '@object', v);
  end;
end;

procedure Init_PropInfo;
begin
  cPropInfo := rb_define_class_under(mPhi, 'PropInfo', ap_cObject);
  rb_define_singleton_method(cPropInfo, 'new', @PropInfo_new, 2);
  rb_define_attr(cPropInfo, 'reader', 1, 0);
  rb_define_attr(cPropInfo, 'writer', 1, 0);
  rb_define_attr(cPropInfo, 'name', 1, 0);
  rb_define_attr(cPropInfo, 'type_info', 1, 0);
  rb_define_attr(cPropInfo, 'object', 1, 0);
end;

end.
