library webbrowser;

uses
  Classes, ActiveX, OleCtrls, SHDocVw,
  Rubies, uDefUtils, Pythia, WebBrowserHandle;

{$E so}

function ap_cWebBrowser: TValue;
begin
  Result := cWebBrowser;
end;

procedure WebBrowser_setup(obj: TValue; real: TWebBrowser);
begin
  if @real.OnBeforeNavigate2 = nil then real.OnBeforeNavigate2 := Handle.doBeforeNavigate2;
  if @real.OnCommandStateChange = nil then real.OnCommandStateChange := Handle.doCommandStateChange;
  if @real.OnDocumentComplete = nil then real.OnDocumentComplete := Handle.doDocumentComplete;
  if @real.OnDownloadBegin = nil then real.OnDownloadBegin := Handle.NotifyOnDownloadBegin;
  if @real.OnDownloadComplete = nil then real.OnDownloadComplete := Handle.NotifyOnDownloadComplete;
  if @real.OnNavigateComplete2 = nil then real.OnNavigateComplete2 := Handle.doNavigateComplete2;
  if @real.OnNewWindow2 = nil then real.OnNewWindow2 := Handle.doNewWindow2;
  if @real.OnProgressChange = nil then real.OnProgressChange := Handle.doProgressChange;
  if @real.OnTitleChange = nil then real.OnTitleChange := Handle.doTitleChange;
  if @real.OnVisible = nil then real.OnVisible := Handle.doVisible;
end;

function WebBrowser_alloc(This: TValue; real: TWebBrowser): TValue;
begin
  Result := ChildAlloc(This, real);
  WebBrowser_setup(Result, real);
end;

function ap_iWebBrowser(real: TWebBrowser; owner: Tvalue): Tvalue;
begin
  result := WebBrowser_alloc(cWebBrowser, real);
  ap_owner(result, owner);
end;

function ap_iWebBrowser_v(var AControl; owner: Tvalue): TValue;
begin
  Result := ap_iWebBrowser(TWebBrowser(AControl), owner);
end;

function WebBrowser_new(argc: Integer; argv: Pointer; This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
begin
  real := TWebBrowser.Create(nil);
  Result := CompoAlloc(This, real);
  CompoSetup(argc, argv, real);
  WebBrowser_setup(Result, real);
  ap_obj_call_init(Result, argc, argv);
end;

function WebBrowser_event_handle(This, name: Tvalue): Tvalue; cdecl;
begin
  EventHandle(This, name, [PhiGetHandle, Handle]);
  result := Qnil;
end;

function WebBrowser_navigate(argc: Integer; argv: Tvalue_array; This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
  flags, trgetframe, postdata, headers: OleVariant;
begin
  real := ap_data_get_struct(This);
  case argc of
  0:
    ap_raise(ap_eArgError, sToo_few_args);
  1:
    real.Navigate(dl_String(argv[0]));
  2:
    begin
      flags := dl_Variant(argv[1]);
      real.Navigate(dl_String(argv[0]), flags);
    end;
  3:
    begin
      flags := dl_Variant(argv[1]);
      trgetframe := dl_Variant(argv[2]);
      real.Navigate(dl_String(argv[0]), flags, trgetframe);
    end;
  4:
    begin
      flags := dl_Variant(argv[1]);
      trgetframe := dl_Variant(argv[2]);
      postdata := dl_Variant(argv[3]);
      real.Navigate(dl_String(argv[0]), flags, trgetframe, postdata);
    end;
  5:
    begin
      flags := dl_Variant(argv[1]);
      trgetframe := dl_Variant(argv[2]);
      postdata := dl_Variant(argv[3]);
      headers := dl_Variant(argv[4]);
      real.Navigate(dl_String(argv[0]), flags, trgetframe, postdata, headers);
    end;
  else
    ap_raise(ap_eArgError, sToo_many_args);
  end;
  Result := This;
end;

function WebBrowser_navigate2(argc: Integer; argv: Tvalue_array; This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
  url, flags, trgetframe, postdata, headers: OleVariant;
begin
  real := ap_data_get_struct(This);
  case argc of
  0:
    ap_raise(ap_eArgError, sToo_few_args);
  1:
    begin
      url := dl_Variant(argv[0]);
      real.Navigate(url);
    end;
  2:
    begin
      url := dl_Variant(argv[0]);
      flags := dl_Variant(argv[1]);
      real.Navigate(url, flags);
    end;
  3:
    begin
      url := dl_Variant(argv[0]);
      flags := dl_Variant(argv[1]);
      trgetframe := dl_Variant(argv[2]);
      real.Navigate(url, flags, trgetframe);
    end;
  4:
    begin
      url := dl_Variant(argv[0]);
      flags := dl_Variant(argv[1]);
      trgetframe := dl_Variant(argv[2]);
      postdata := dl_Variant(argv[3]);
      real.Navigate(url, flags, trgetframe, postdata);
    end;
  5:
    begin
      url := dl_Variant(argv[0]);
      flags := dl_Variant(argv[1]);
      trgetframe := dl_Variant(argv[2]);
      postdata := dl_Variant(argv[3]);
      headers := dl_Variant(argv[4]);
      real.Navigate(url, flags, trgetframe, postdata, headers);
    end;
  else
    ap_raise(ap_eArgError, sToo_many_args);
  end;
  Result := This;
end;

function WebBrowser_go_home(This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  real.GoHome;
  Result := This;
end;

function WebBrowser_go_forward(This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  real.GoForward;
  Result := This;
end;

function WebBrowser_go_back(This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  real.GoBack;
  Result := This;
end;

function WebBrowser_go_search(This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  real.GoSearch;
  Result := This;
end;

function WebBrowser_refresh(This: TValue): TValue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  real.Refresh;
  Result := This;
end;

function WebBrowser_refresh2(argc: Integer; argv: Pointer; This: TValue): TValue; cdecl;
var
  args: array of TValue;
  real: TWebBrowser;
  level: OleVariant;
begin
  real := ap_data_get_struct(This);
  case argc of
  0:
    real.Refresh2;
  1:
    begin
      SetLength(args, argc);
      args := argv;
      level := dl_Variant(args[0]);
      real.Refresh2(level);
    end;
  else
    ap_raise(ap_eArgError, sToo_few_args);
  end;
  Result := This;
end;

function WebBrowser_set_method(This, v: Tvalue): Tvalue; cdecl;
var
  hash, key: Tvalue;
  name: string;
  id: Tid;
begin
  hash := rb_iv_get(This, '@events');
  name := LowerCase1(rb_id2name(rb_frame_last_func));
  SetLength(name, Length(name)-1); // chop!
  id := rb_intern(PChar(name));
  key := ID2SYM(id);
  rb_hash_aset(hash, key, v);
  result := v;
end;

function WebBrowser_set_on_before_navigate(This, v: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  result := WebBrowser_set_method(This, v);
  real := ap_data_get_struct(This);
  if @real.OnBeforeNavigate2 = nil then
      real.OnBeforeNavigate2 := Handle.doBeforeNavigate2;
end;

function WebBrowser_set_on_navigate_complete(This, v: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  result := WebBrowser_set_method(This, v);
  real := ap_data_get_struct(This);
  if @real.OnNavigateComplete2 = nil then
      real.OnNavigateComplete2 := Handle.doNavigateComplete2;
end;

function WebBrowser_get_busy(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.Busy);
end;

function WebBrowser_get_full_name(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.FullName);
end;

function WebBrowser_get_location_name(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.LocationName);
end;

function WebBrowser_get_location_url(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.LocationUrl);
end;

function WebBrowser_get_name(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.Name);
end;

function WebBrowser_get_path(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.Path);
end;

function WebBrowser_get_ready_state(This: Tvalue): Tvalue; cdecl;
var
  real: TWebBrowser;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.ReadyState);
end;

procedure Init_webbrowser;
begin
  PhiStart;

  rb_define_const(ap_mPhi, 'CSC_UPDATECOMMANDS', rb_uint2inum(CSC_UPDATECOMMANDS));
  rb_define_const(ap_mPhi, 'CSC_NAVIGATEFORWARD', INT2FIX(CSC_NAVIGATEFORWARD));
  rb_define_const(ap_mPhi, 'CSC_NAVIGATEBACK', INT2FIX(CSC_NAVIGATEBACK));

  rb_define_const(ap_mPhi, 'READYSTATE_UNINITIALIZED', INT2FIX(0));
  rb_define_const(ap_mPhi, 'READYSTATE_LOADING', INT2FIX(1));
  rb_define_const(ap_mPhi, 'READYSTATE_LOADED', INT2FIX(2));
  rb_define_const(ap_mPhi, 'READYSTATE_INTERACTIVE', INT2FIX(3));
  rb_define_const(ap_mPhi, 'READYSTATE_COMPLETE', INT2FIX(4));

  cWebBrowser := DefinePersistentClass(ap_mPhi, TWebBrowser, ap_cWinControl, ap_iWebBrowser_v);
  DefineSingletonMethod(cWebBrowser, 'new', WebBrowser_new);
  rb_define_method(cWebBrowser, 'event_handle', @WebBrowser_event_handle, 1);

  rb_define_method(cWebBrowser, 'navigate', @WebBrowser_navigate, -1);
  rb_define_method(cWebBrowser, 'navigate2', @WebBrowser_navigate2, -1);
  rb_define_method(cWebBrowser, 'go_home', @WebBrowser_go_home, 0);
  rb_define_method(cWebBrowser, 'go_forward', @WebBrowser_go_forward, 0);
  rb_define_method(cWebBrowser, 'go_back', @WebBrowser_go_back, 0);
  rb_define_method(cWebBrowser, 'go_search', @WebBrowser_go_search, 0);
  rb_define_method(cWebBrowser, 'refresh', @WebBrowser_refresh, 0);
  rb_define_method(cWebBrowser, 'refresh2', @WebBrowser_refresh2, -1);

  DefineAttrGet(cWebBrowser, 'busy?', WebBrowser_get_busy);
  DefineAttrGet(cWebBrowser, 'full_name', WebBrowser_get_full_name);
  DefineAttrGet(cWebBrowser, 'location_name', WebBrowser_get_location_name);
  DefineAttrGet(cWebBrowser, 'location_url', WebBrowser_get_location_url);
  DefineAttrGet(cWebBrowser, 'name', WebBrowser_get_name);
  DefineAttrGet(cWebBrowser, 'path', WebBrowser_get_path);
  DefineAttrGet(cWebBrowser, 'ready_state', WebBrowser_get_ready_state);

  DefineAttrSet(cWebBrowser, 'on_before_navigate', WebBrowser_set_on_before_navigate);
  rb_define_method(cWebBrowser, 'on_before_navigate', @retval, -1);
  DefineAttrSet(cWebBrowser, 'on_navigate_complete', WebBrowser_set_on_navigate_complete);
  rb_define_method(cWebBrowser, 'on_navigate_complete', @retval, -1);
end;

exports
  ap_cWebBrowser,
  WebBrowser_alloc,
  Init_WebBrowser;

var
  SaveExit: Pointer;

procedure LibExit;
begin
  CoUninitialize;
  ExitProc := SaveExit;
end;

begin
  SaveExit := ExitProc;
  ExitProc := @LibExit;
  CoInitialize(nil);
end.

