unit PhiMainUnit;

interface

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils, Classes,
{$IFDEF VCL}
  Controls, Forms, Menus,
{$ELSE}
  QControls, QForms, QMenus,
{$ENDIF}
  PhiForm,
  Rubies,
  uStrUtils, uDefUtils, PhiHandle,// uVariant,
  version,
  uDebug, uHandle, uIntern, uAlloc, uProp, uConv, uIndexer,
  uPhi, uError, uIO, uPropInfo, uTypeInfo, uMarshal, uFunc, uThread,
  uAction, uActionList,
{$IFDEF VCL}
  uHeapStatus, uCreateParams,
{$ENDIF}
  uShiftState, uOwnerDrawState, uCopyMode,
  uFontCharset, uModalResult, uColor, uCursor,
//  uRecord,
  uPoint, uSize, uRect, uSizeConstraints, uDateTime, uByteArray,
{$IFDEF MSWINDOWS}
  uWin, uSys, uVirtualKeyCode, uSearchRec,
{$ENDIF}
  uStream, uStrings, uScreen, uClipboard, uPrinter,
  uGraphic, uIcon, uFont,
{$IFDEF VCL}
  uTextAttributes,
{$ENDIF}
  uBrush, uPen,
  uDragObject, uCanvas, uBitmap, uControlScrollBar,
{$IFDEF VCL}
  uMetaFile,
{$ENDIF}
  uPicture, uApplication, uDataModule,
  uAnyComponent,
  uPersistent, uCollection, uComponent, uControl, uForm,
  uFrame,
  uMenuItem, uMenu,
  uLabel, uButton, uEdit, uMemo,
  uCheckBox, uRadioButton, uListBox,
  uComboBox, uScrollBar, uGroupBox, uRadioGroup, uPanel,
  uBitBtn, uSpeedButton, uMaskEdit, uGrid, uImage, uShape, uBevel,
  uScrollBox, uSplitter,
{$IFDEF VCL}
  uStaticText,
{$ENDIF}
  uTabControl, uPageControl, uTabSheet, uProgressBar, uTrackBar,
{$IFDEF VCL}
  uRichEdit, uUpDown,
{$ENDIF}
  uTreeNode, uTreeView,
  uListItem, uListColumn, uListView,
  uStatusBar, uTimer, uPaintBox,
{$IFDEF VCL}
  uPageScroller,
{$ENDIF}
{$IFDEF VCL}
  uAnimate,
  uLabeledEdit,
  uBoundLabel,
{$ENDIF}
  uCheckListBox,
  uControlBar,
  uValueListEditor,
  uColorBox,
  uHeaderControl,
  uComboBoxEx,
  uCoolBar,
  uHotKey,
  uDdeClientConv,
  uDdeClientItem,
  uDdeServerConv,
  uDdeServerItem,
  uActionToolBar,
  uActionMainMenuBar,
  uCustomizeDlg,
  uActionManager,
  uApplicationEvents,
  uToolBar;

procedure PhiTerminate;
procedure PhiAliveTest;
function PhiAlive: Boolean;
procedure PhiBackTrace;
procedure PhiFail;
function PhiCallProtect(data: Tvalue): Tvalue;
function PhiExport(S: string): Tvalue;
procedure PhiSetStdoutProc(proc: TGetStrProc);
procedure PhiSetGetsFunc(func: TRetStrFunc);
procedure PhiSetGetcFunc(func: TRetChrFunc);
procedure PhiSetInitProc(proc: TProcedure);
procedure PhiLoadProtect(name: PChar; done: TNotifyEvent);
procedure PhiStart;
procedure Init_phi; cdecl;

implementation

var
  InTerminate: Boolean = False;
  InAliveTest: Boolean = False;
  init_proc: TProcedure;

procedure PrintObjectList;
var
  i: Integer;
begin
  if @Stdout = nil then Exit;
  Stdout(PChar(Format('obj: %d'+NL, [PhiObjectList.Count])));
  for i := 0 to PhiObjectList.Count-1 do
    Stdout(PChar(string(PhiObjectList[i].ClassName)+NL));
end;

procedure FormsClose;
var
  i: Integer;
  real: TForm;
  CloseEvent: TCloseEvent;
  CloseQueryEvent: TCloseQueryEvent;
begin
  i := 0;
  while True do
  begin
    i := PhiObjectList.FindInstanceOf(TForm, False, i);
    if i = -1 then Break;
    real := TForm(PhiObjectList[i]);
    CloseEvent := real.OnClose;
    CloseQueryEvent := real.OnCloseQuery;
    real.OnClose := nil;
    real.OnCloseQuery := nil;
    real.Close;
    real.OnCloseQuery := CloseQueryEvent;
    real.OnClose := CloseEvent;
    RemoveParentAttr(real);
    ClearEvents(real);
    Inc(i);
  end;
end;

procedure PhiTerminate;
begin
  if InTerminate then Exit;
  InTerminate := True;
  alive_p := False;
  Handle.DoneThread(Application);
  FormsClose;
//  rb_gc;  // ruby_finalize;
  if debug_p then PrintObjectList;
//  if Screen.FormCount = 0 then Application.Terminate;
  InTerminate := False;
end;

function Phi_terminate: Tvalue; cdecl;
begin
  PhiTerminate;
  result := Qnil;
end;

procedure PhiAliveTest;
var
  shown: Boolean;
  i: Integer;
begin
  if InAliveTest or not mainloop_p then Exit;
  InAliveTest := True;
  shown := False;
  try
    i := 0;
    while not shown do
    begin
      i := PhiObjectList.FindInstanceOf(TForm, False, i);
      if i = -1 then Break;
      shown := shown or TForm(PhiObjectlist[i]).Visible;
      Inc(i);
    end;
  finally
    if not shown then PhiTerminate;
    InAliveTest := False;
  end;
end;

function PhiAlive: Boolean;
begin
  result := alive_p;
end;

function Phi_alive_p: Tvalue; cdecl;
begin
  result := ap_bool(alive_p);
end;

procedure PhiBackTrace;
var
  ary: Tvalue;
  str: Tvalue;
  ptr: PChar;

  procedure ErrorInfo(info: Tvalue);
  var
    ary, str: Tvalue;

    procedure Error;
    begin
      Stdout('fail to parse error info: ');
      rb_p(info);
    end;

    function IsType(v: Tvalue; t: Integer): Boolean;
    begin
      Result := RTYPE(v) = t;
      if not Result then Error;
    end;

  begin
    ary := rb_str_split(info, ':');
    str := rb_ary_shift(ary);
    if not IsType(str, T_STRING) then Exit;
    ErrorFile := ap_str_ptr(str);
    str := rb_ary_shift(ary);
    if not IsType(str, T_STRING) then Exit;
    if Length(ErrorFile) = 1 then
    begin
      ErrorFile := ErrorFile + ':' + ap_str_ptr(str);
      str := rb_ary_shift(ary);
    end;
    if RTYPE(str) <> T_STRING then Exit;
    try
      ErrorLine := StrToInt(ap_str_ptr(str));
    except
      on E: EConvertError do Error;
    end;
  end;

begin
  if (@Stdout = nil)
  then Exit;

  if (ap_errinfo = Qnil)
  or (rb_obj_is_kind_of(ap_errinfo, ap_eSystemExit) <> 0)
  or (rb_obj_is_kind_of(ap_errinfo, ap_eDelphiAbort) <> 0)
  then Exit;

  ErrorLine := 0; // ErrorLine = -1 if no error

  ary := rb_funcall2(ap_errinfo, rb_intern('backtrace'), 0, nil);
  str := rb_str_to_str(ap_errinfo);
  ptr := ap_str_ptr(str);
  Stdout(ptr);
  Stdout(' ');
  Stdout('('+dl_class_name_of(ap_errinfo)+')');
  Stdout(NL);

  str := rb_ary_shift(ary);
  ErrorInfo(str);

  rb_ary_pop(ary);

  while str <> Qnil do
  begin
    Stdout('  ');
    Stdout(ap_str_ptr(str));
    Stdout(NL);
    str := rb_ary_shift(ary);
  end;

  ap_set_errinfo(Qnil);
end;

procedure PhiFail;
begin
  PhiBackTrace;
  PhiTerminate;
end;

function ap_protect(proc: TGetValFunc; data: Tvalue; var state: Integer): Tvalue; cdecl;
begin
  result := rb_protect(proc, data, state);
end;

function PhiEventCall(id: Tid; args: Tvalue): Tvalue;
var
  hash, key, obj, recv: Tvalue;
begin
  result := Qnil;
  try
    hash := rb_iv_get(ap_ary_ptr(args)^, '@events');
    if RTYPE(hash) = T_HASH then
    begin
      key := ID2SYM(id);
      obj := rb_hash_aref(hash, key);
      if obj <> ap_hash_ifnone(hash) then
        result := rb_apply(obj, id_call, args);
    end;
    if result = Qnil then
    begin
      recv := rb_ary_shift(args);
      if RTEST(recv) then
        result := rb_apply(recv, id, args);
    end;
  except
    on E: EAbort do
      ap_raise(ap_eDelphiAbort, E.message);
    on E: Exception do
      ap_raise(ap_eDelphiError, E.message);
  end;
end;

function PhiCall(data: Tvalue): Tvalue; cdecl;
var
  id: Tvalue;
begin
  id := rb_ary_shift(data);
  result := PhiEventCall(id, data);
end;

function PhiCallProtect(data: Tvalue): Tvalue;
var
  state: Integer;
begin
  result := ap_protect(PhiCall, data, state);
  if state <> 0 then
    if (rb_obj_is_kind_of(ap_errinfo, ap_eDelphiAbort) <> 0)
    then Abort
    else rb_ary_push(vPhiErrors, ap_errinfo);
end;

procedure PhiLoadChildren(real: TComponent);
var
  i: Integer;
  func: TAllocFunc;
  name: string;
  This: Tvalue;
  obj: Tvalue;
  AComponent: TComponent;
begin
  This := real.tag;

  for i := 0 to real.ComponentCount-1 do
  begin
    AComponent := real.Components[i];
    if AComponent is TControl then Continue;
    name := trimPhiUnder(AComponent.ClassName);
    func := GetAllocFunc(name);
    if @func = nil then Continue;
    obj := func(AComponent, This);

    if AComponent.name = '' then
       AComponent.name := LowerCase1(chopHead(AComponent.ClassName)) + IntToStr(i);
    name := LowerCase1(AComponent.name);
    rb_iv_set(This, PChar('@'+name), obj);
    rb_define_attr(rb_singleton_class(This), PChar(name), 1, 0);

    rb_iv_set(obj, PChar('@parent'), This);

    PhiLoadChildren(AComponent);
  end;
end;

procedure PhiLoadControls(real: TWinControl);
var
  i: Integer;
  func: TAllocFunc;
  name: string;
  This: Tvalue;
  obj: Tvalue;
  AControl: TControl;
begin
  This := real.tag;

  for i := 0 to real.ControlCount-1 do
  begin
    AControl := real.Controls[i];
    name := trimPhiUnder(AControl.ClassName);
    func := GetAllocFunc(name);
    if @func = nil then Continue;
    obj := func(AControl, This);

    if AControl.name = '' then
       AControl.name := LowerCase1(chopHead(AControl.ClassName)) + IntToStr(i);
    name := LowerCase1(AControl.name);
    rb_iv_set(This, PChar('@'+name), obj);
    rb_define_attr(rb_singleton_class(This), PChar(name), 1, 0);

    rb_iv_set(obj, PChar('@parent'), This);

    if AControl is TWinControl then
      PhiLoadControls(TWinControl(AControl));
  end;
end;

procedure DefineMenuItem(real: TMenuItem);
var
  i: Integer;
  name: string;
  This: Tvalue;
  obj: Tvalue;
  item: TMenuItem;
begin
  This := real.tag;
  if real.name = '' then
  try
    name := real.ClassName;
    if real.ComponentIndex = -1 then
       real.name := LowerCase1(chopHead(name))
    else
       real.name := LowerCase1(chopHead(name))
       + IntToStr(real.ComponentIndex);
  except
    on E: Exception do
      ap_raise(ap_eDelphiError, E.message);
  end;

  for i := 0 to real.Count-1 do
  begin
    item := real[i];
    obj := ap_iMenuItem(item, This);

    name := LowerCase1(item.name);
    if name = '' then
    begin
      name := LowerCase1(chopHead(item.ClassName)) + IntToStr(i);
      item.name := name;
    end;
    rb_iv_set(This, PChar('@'+name), obj);
    rb_define_attr(rb_singleton_class(This), PChar(name), 1, 0);

    DefineMenuItem(item);
  end;
end;

procedure DefineMenus(AForm: TForm);
begin
  with AForm do
  begin
    if Menu = nil then Exit;
    rb_iv_set(Tag, '@menu', ap_iMainMenu(AForm.Menu, AForm.Tag));
    DefineMenuItem(Menu.Items);
  end;
end;

procedure FormSetParams(AForm: TForm);
begin
  DefineMenus(AForm);
  FormSetName(AForm, AForm.name);
end;

function PhiLoadForm(AForm: TForm): Tvalue;
var
  obj: Tvalue;
begin
  obj := AnyForm_alloc(AForm);
  PhiLoadChildren(AForm);
  PhiLoadControls(AForm);
  FormSetParams(AForm);
  result := obj;
end;

function PhiLoadComponent(Component: TComponent): Tvalue;
var
  name: string;
  func: TAllocFunc;
begin
  name := trimPhiUnder(Component.ClassName);
  func := GetAllocFunc(name);
  if @func = nil then
    if Component is TForm then
      func := @ap_iForm_v
    else
    begin
      result := Qnil;
      Exit;
    end;
  result := func(Component, Qnil);
  PhiLoadChildren(Component);
  if Component is TWinControl then
    PhiLoadControls(TWinControl(Component));
  if Component is TForm then
    FormSetParams(TForm(Component));
  if Component.name = '' then
  try
    if Component.ComponentIndex = -1 then
       Component.name := LowerCase1(chopHead(name))
    else
       Component.name := LowerCase1(chopHead(name))
       + IntToStr(Component.ComponentIndex);
  except
    on E: Exception do
      ap_raise(ap_eDelphiError, E.message);
  end;
end;

function Stream_read_component(This: Tvalue): Tvalue; cdecl;
var
  real: TStream;
  Component: TComponent;
begin
  result := Qnil;
  real := ap_data_get_struct(This);
  try
    Component := real.ReadComponent(nil);
    result := PhiLoadComponent(Component);
  except
    on E: Exception do
      ap_raise(ap_eIOError, E.message);
  end;
end;

function Component_load(This, str: Tvalue): Tvalue; cdecl;
var
  Component: TComponent;
begin
  Component := StringToComponent(dl_String(str));
  result := PhiLoadComponent(Component);
end;

function Component_marshal_load(This, str: Tvalue): Tvalue; cdecl;
begin
  result := Component_load(This, str);
end;

function PhiExportFunc(top_module: Tvalue): Tvalue; cdecl;
var
  i: Integer;
  AForm: TForm;
  obj: Tvalue;
  name: string;
begin
  for i := 0 to Screen.FormCount-1 do
  begin
    AForm := Screen.Forms[i];
    name := chopHead(AForm.ClassName);
    if AForm.name = '' then
       AForm.name := name;
    obj := PhiLoadForm(AForm);
    rb_define_const(top_module, PChar(UpperCase1(name)), obj);
  end;
  result := Qnil;
end;

function PhiExport(S: string): Tvalue;
var
  module: Tvalue;
  state: Integer;
begin
  if Length(S) = 0 then begin result := Qnil; Exit end;
  module := rb_define_module(PChar(S));
  ap_protect(PhiExportFunc, module, state);
  if state <> 0 then PhiFail;
  result := module;
end;

function Phi_export(This, str: Tvalue): Tvalue; cdecl;
begin
  result := PhiExport(dl_caption(str));
end;

procedure PhiSetStdoutProc(proc: TGetStrProc);
begin
  Stdout := proc;
end;

procedure PhiSetGetsFunc(func: TRetStrFunc);
begin
  gets := func;
end;

procedure PhiSetGetcFunc(func: TRetChrFunc);
begin
  getc := func;
end;

procedure PhiSetInitProc(proc: TProcedure);
begin
  init_proc := proc;
end;

function Phi_alive_test: Tvalue; cdecl;
var
  shown: Boolean;
  i: Integer;
begin
  result := QTrue;
  if InAliveTest then Exit;
  InAliveTest := True;
  shown := False;
  try
    i := 0;
    while not shown do
    begin
      i := PhiObjectList.FindInstanceOf(TForm, False, i);
      if i = -1 then Break;
      shown := shown or TForm(PhiObjectlist[i]).Visible;
      Inc(i);
    end;
    result := ap_bool(shown);
  finally
    InAliveTest := False;
  end;
end;

function Phi_mainloop(This: Tvalue): Tvalue; cdecl;
var
  errinfo: Tvalue;
begin
  if mainloop_p then
    ap_raise(ap_eStandardError, 'duplicate mainloop'); //avoid nesting.
  mainloop_p := True;
  PhiAliveTest;
  try
    result := This;
    while PhiAlive do
    begin
      Application.HandleMessage;
      errinfo := rb_ary_shift(vPhiErrors);
      if RTEST(errinfo) then
        rb_exc_raise(errinfo); //reraise.
    end;
    alive_p := True; //reset. allow recall mainloop.
  finally
    mainloop_p := False;
  end
end;

function Phi_mainloop_p(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Bool(mainloop_p);
end;

procedure ap_load(fname, wrap: Tvalue);
begin
  try
    rb_load(fname, Integer(RTEST(wrap)));
  except
    on E: Exception do
      ap_raise(eDelphiError, PChar(
        Format('%s (%s)', [E.message, E.ClassName])
      ));
  end;
end;

function ap_load_0(fname: Tvalue): Tvalue; cdecl;
begin
  ap_load(fname, 0);
  result := Qtrue;
end;

procedure ap_load_protect(fname: Tvalue; var state: Integer);
begin
  ap_protect(ap_load_0, fname, state);
end;

procedure PhiLoadProtect(name: PChar; done: TNotifyEvent);
var
  state: Integer;
begin
  ErrorFile := '';
  ErrorLine := -1;
  alive_p := True;
  Handle.SetAppDoneThread(done);
  ruby_script(name);
  ap_load_protect(rb_str_new2(name), state);
  if state <> 0 then PhiFail;//PhiBackTrace;
  if debug_p then PrintObjectList;
  PhiTerminate;
end;

procedure PhiStart;
begin
  if ap_mPhi = 0 then ap_loaderror('undefined Phi module');
end;

procedure Init_phi; cdecl;
{$IFNDEF MAKE_PROP}
var
  klass: Tvalue;
{$ENDIF}
begin
//  rb_p(rb_str_new2('enter Init_phi'));
{$IFDEF MAKE_PROFILE}
  OutputProfile('Init_phi begin');
{$ENDIF}
  DefineMethod(ap_cObject, 'initialize', retnil);

  alive_p := True;
  mainloop_p := False;

//  Init_Variant;
  Init_intern;
  Init_phi_module;
  Init_error;
  Init_IO;
  Init_version;
  Init_Indexer;

//  rb_define_module_function(mPhi, 'terminate', @Phi_terminate, 0);
  rb_define_module_function(mPhi, 'alive_test', @Phi_alive_test, 0);
  rb_define_module_function(mPhi, 'alive?', @Phi_alive_p, 0);
  rb_define_module_function(mPhi, 'mainloop', @Phi_mainloop, 0);
  rb_define_module_function(mPhi, 'mainloop?', @Phi_mainloop_p, 0);
  rb_define_module_function(mPhi, 'undef_stdio', @Phi_undef_stdio, 0);
  rb_define_module_function(mPhi, 'export', @Phi_export, 1);

{$IFDEF LINUX}
  rb_define_const(mPhi, 'PLATFORM', ap_String('LINUX'));
{$ENDIF}
{$IFDEF MSWINDOWS}
{$IFDEF WIN32}
  rb_define_const(mPhi, 'PLATFORM', ap_String('WIN32'));
{$ELSE}
  rb_define_const(mPhi, 'PLATFORM', ap_String('WIN16'));
{$ENDIF}
{$ENDIF}
{$IFDEF VCL}
  rb_define_const(mPhi, 'COMPOLIB', ap_String('VCL'));
{$ELSE}
  rb_define_const(mPhi, 'COMPOLIB', ap_String('CLX'));
{$ENDIF}
  rb_define_const(mPhi, 'DELPHIAN_AUTO_NAME', Qfalse);

  Init_Prop;
  Init_PropInfo;
  Init_TypeInfo;

  OutputConstSetType(mPhi, TypeInfo(TAlign));
  OutputConstSetType(mPhi, TypeInfo(TAlignment));
  OutputConstSetType(mPhi, TypeInfo(TAnchorKind));
  OutputConstSetType(mPhi, TypeInfo(TCloseAction));
  OutputConstSetType(mPhi, TypeInfo(TDragMode));
{$IFDEF VCL}
  OutputConstSetType(mPhi, TypeInfo(TImeMode));
{$ENDIF}
  OutputConstSetType(mPhi, TypeInfo(TBorderStyle));
  OutputConstSetType(mPhi, TypeInfo(TScrollBarKind));
  OutputConstSetType(mPhi, TypeInfo(TMouseButton));
{$IFDEF VCL}
  OutputConstSetType(mPhi, TypeInfo(TBevelKind));
{$ENDIF}

  Init_Persistent;
  Init_Collection;
  Init_Component;
  Init_Func;
  Init_Thread;

  Init_Action;
  Init_ActionList;
{$IFDEF VCL}
  Init_HeapStatus;
  Init_CreateParams;
{$ENDIF}
  Init_Color;
  Init_Cursor;
  Init_ShiftState;
  Init_OwnerDrawState;
  Init_CopyMode;
  Init_FontCharset;
  Init_ModalResult;

//  Init_Record;
  Init_Point;
  Init_Size;
  Init_Rect;
  Init_SizeConstraints;
  Init_DateTime;
  Init_ByteArray;

{$IFDEF MSWINDOWS}
  Init_Win;
  Init_Sys;
  Init_VirtualKeyCode;
  Init_SearchRec;
{$ENDIF}

  Init_Stream;
  Init_Strings;
  Init_Screen;
  Init_Clipboard;
  Init_Printer;
  Init_Graphic;
  Init_Icon;
  Init_Font;
{$IFDEF VCL}
  Init_TextAttributes;
{$ENDIF}
  Init_Brush;
  Init_Pen;
  Init_DragObject;

  Init_Canvas;
  Init_Bitmap;
  Init_ControlScrollBar;
{$IFDEF VCL}
  Init_Metafile;
{$ENDIF}
  Init_Picture;

  Init_Application;
  Init_DataModule;
  Init_Control;

  Init_Form;

  Init_Frame;
  Init_MenuItem;
  Init_Menu;
  Init_Label;
  Init_Button;
  Init_Edit;
  Init_Memo;
  Init_CheckBox;
  Init_RadioButton;
  Init_ListBox;
  Init_ComboBox;
  Init_ScrollBar;
  Init_GroupBox;
  Init_RadioGroup;
  Init_Panel;

  Init_BitBtn;
  Init_SpeedButton;
  Init_MaskEdit;
  Init_Grid;
  Init_Image;
  Init_Shape;
  Init_Bevel;
  Init_ScrollBox;
  Init_Splitter;
{$IFDEF VCL}
  Init_StaticText;
{$ENDIF}

  Init_TabControl;
  Init_PageControl;
  Init_TabSheet;
  Init_ProgressBar;
  Init_TrackBar;
{$IFDEF VCL}
  Init_RichEdit;
  Init_UpDown;
{$ENDIF}
  Init_TreeNode;
  Init_TreeView;
  Init_ListItem;
  Init_ListColumn;
  Init_ListView;
  Init_StatusBar;

  Init_Timer;
  Init_PaintBox;
  Init_ToolBar;
{$IFDEF VCL}
  Init_PageScroller;
{$ENDIF}
{$IFDEF VCL}
  Init_Animate;
  Init_LabeledEdit;
  Init_BoundLabel;
{$ENDIF}
  Init_CheckListBox;
  Init_ControlBar;
  Init_ValueListEditor;
  Init_ColorBox;
  Init_HeaderControl;
  Init_ComboBoxEx;
  Init_CoolBar;
  Init_HotKey;
  Init_DdeClientConv;
  Init_DdeClientItem;
  Init_DdeServerConv;
  Init_DdeServerItem;
  Init_ActionToolBar;
  Init_ActionMainMenuBar;
  Init_CustomizeDlg;
  Init_ActionManager;
  Init_ApplicationEvents;

  rb_define_method(cStream, 'read_component', @Stream_read_component, 0);
  rb_define_singleton_method(cComponent, '_load', @Component_load, 1);
  rb_define_method(cComponent, 'marshal_load', @Component_marshal_load, 1);

{$IFNDEF MAKE_PROP}
{$I PhiProp.inc}
{$ENDIF}
(*
  PhiAllocFuncList.CaseSensitive := True;
  PhiAllocFuncList.Sorted := True;
  PhiEventFuncList.CaseSensitive := True;
  PhiEventFuncList.Sorted := True;
*)
  if @init_proc <> nil then init_proc;
{$IFDEF MAKE_PROFILE}
  OutputProfile('Init_phi end');
{$ENDIF}
//  rb_p(rb_str_new2('leave Init_phi'));
end;

procedure InitHandle;
begin
  Handle := TPhiHandle.Create(UOwner);
  Stdout := io_stdout;
  gets := io_gets;
  getc := io_getc;
end;

initialization
  InitHandle;

finalization
  Handle.Free;
(*
var
  SaveExit: Pointer;

procedure LibExit;
begin
  Handle.Free;
  ExitProc := SaveExit;
end;

begin
  SaveExit := ExitProc;
  ExitProc := @LibExit;
  InitHandle;
*)
end.
