(*
    GTK-Kylix Library: GTKForms - Basic windows (TGTKForm, TGTKDialog), TGTKApplication, TGDKScreen  
    Version 0.6.28  (last updated 2008-10-12)
    Copyright (C) 2007 Tomas Bzatek <tbzatek@users.sourceforge.net>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the 
    Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
    Boston, MA  02111-1307  USA.

*)

unit GTKForms;

interface

uses gtk2, gdk2, glib2, Classes, SysUtils, GTKControls, GTKConsts;


type    //  Some basic types
  PCharArray = array[0..0] of PChar;

  __pthread_t = {$ifdef cpu64}QWord{$else}DWord{$endif};

  TCustomGTKForm = class;

(****************************************** TGDKSCREEN **************************************************************************)
  TGDKScreen = class(TComponent)
  private
    FForms: TList;
    FActiveForm: TCustomGTKForm;
    procedure AddForm(AForm: TCustomGTKForm);
    function GetForm(Index: Integer): TCustomGTKForm;
    function GetFormCount: Integer;
    procedure RemoveForm(AForm: TCustomGTKForm);
    function GetHeight: Integer;
    function GetWidth: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ActiveForm: TCustomGTKForm read FActiveForm;
    property FormCount: Integer read GetFormCount;
    property Forms[Index: Integer]: TCustomGTKForm read GetForm;
    property Height: Integer read GetHeight;
    property Width: Integer read GetWidth;
  end;

(****************************************** TGTKFORM ****************************************************************************)
  TCloseAction = (caNone, caHide, caFree, caMinimize);
  TCloseEvent = procedure(Sender: TObject; var Action: TCloseAction) of object;
  TCloseQueryEvent = procedure(Sender: TObject; var CanClose: Boolean) of object;
  TWindowPosition = (wpNone, wpCenter, wpMouse, wpCenterAlways, wpCenterOnParent);
  TGDKWindowState = (wsNormal, wsState1, wsMinimized, wsState2, wsMaximized);
  TGDKWindowTypeHint = (whNormal, whDialog, whToolbar, whSplashScreen, whUtility, whDock, whDesktop);

  TCustomGTKForm = class(TGTKBin)
    procedure FormCreate(Sender: TObject); dynamic;
  private
    FOnClose: TCloseEvent;
    FOnCloseQuery: TCloseQueryEvent;
    FOnResize: TNotifyEvent;
    FOnShow: TNotifyEvent;
    FCaption: string;
    FOnDestroy: TNotifyEvent;
    function GetWindowPosition: TWindowPosition;
    function GetResizeable: boolean;
    function GetWindowTypeHint: TGDKWindowTypeHint;
    function GetWindowState: TGDKWindowState;
    function GetLeft: integer;
    function GetTop: integer;
    function GetWidth: integer;
    function GetHeight: integer;
    procedure SetVisible(Value: Boolean);
    procedure SetCaption(Value: string);
    procedure SetWindowPosition(Value: TWindowPosition);
    procedure SetResizeable(Value: Boolean);
    procedure SetWindowTypeHint(Value: TGDKWindowTypeHint);
    procedure SetLeft(Value: integer);
    procedure SetTop(Value: integer);
    procedure SetWidth(Value: integer);
    procedure SetHeight(Value: integer);
    procedure SetDefault(Value: TGTKControl);
  protected
    procedure DoClose(var Action: TCloseAction); dynamic;
    property Visible write SetVisible default False;
    property OnClose: TCloseEvent read FOnClose write FOnClose;
    property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property Caption: string read FCaption write SetCaption;
    property WindowPosition: TWindowPosition read GetWindowPosition write SetWindowPosition;
    property Resizeable: boolean read GetResizeable write SetResizeable;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property WindowTypeHint: TGDKWindowTypeHint read GetWindowTypeHint write SetWindowTypeHint;
    property WindowState: TGDKWindowState read GetWindowState;
    property Left: integer read GetLeft write SetLeft;
    property Top: integer read GetTop write SetTop;
    property Width: integer read GetWidth write SetWidth;
    property Height: integer read GetHeight write SetHeight;
    property Default: TGTKControl write SetDefault;
  public
    FAccelGroup: PGtkAccelGroup;
    Tooltips: TGTKTooltips;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Release;
    function Close: boolean;
    procedure ShowModal; virtual;
    function CloseQuery: Boolean; virtual;
    procedure SetDefaultSize(DefaultWidth, DefaultHeight: integer);
    procedure SetTransientFor(Parent: TCustomGTKForm);
    procedure Maximize;
    procedure Unmaximize;
    procedure Minimize;
    procedure Unminimize;
    procedure Stick;
    procedure Unstick;
    procedure WindowMove(ALeft, ATop: integer);
    procedure Resize(AWidth, AHeight: integer);
  end;

  TGTKForm = class(TCustomGTKForm)
  public
    constructor Create(AOwner: TComponent); override;
    procedure Show; virtual;
    procedure Hide;
  end;

(****************************************** TGTKDIALOG **************************************************************************)
  TMessageButton = (mbYes, mbNo, mbOK, mbCancel, mbApply, mbClose, mbHelp, mbPrint, mbQuit, mbStop, mbBack, mbForward, mbNone);
  TMessageButtons = set of TMessageButton;
  TGTKDialogResponseEvent = procedure(Sender: TObject; const ResponseID: integer) of object;

  TGTKDialog = class(TCustomGTKForm)
  private
    FButtons: TMessageButtons;
    FOnResponse: TGTKDialogResponseEvent;
    function GetShowSeparator: boolean;
    procedure SetButtons(Value: TMessageButtons);
    procedure SetShowSeparator(Value: boolean);
    procedure SetModalResult(Value: TMessageButton);
    procedure SetDefaultButton(Value: TMessageButton);
    procedure SetParentForm(Value: TCustomGTKForm);
  public
    ClientArea: TGTKVBox;
    ActionArea: TGTKHBox;
    constructor Create(AOwner: TComponent); override;
    function Run: TMessageButton;
    procedure AddButton(ButtonCaption: string; ButtonID: integer);
    procedure SetResponseSensitive(ButtonID: integer; Sensitive: boolean);
  published
    property Buttons: TMessageButtons read FButtons write SetButtons default [];
    property ShowSeparator: boolean read GetShowSeparator write SetShowSeparator;
    property ModalResult: TMessageButton write SetModalResult;
    property DefaultButton: TMessageButton write SetDefaultButton;
    property Caption;
    property OnResponse: TGTKDialogResponseEvent read FOnResponse write FOnResponse;
    property ParentForm: TCustomGTKForm write SetParentForm;
  end;

(****************************************** TGTKAPPLICATION *********************************************************************)
  TMessageStyle = (mbError, mbInfo, mbQuestion, mbWarning);

  TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;

  TGTKApplication = class(TComponent)
  private
    FTerminated: Boolean;
    FOnException: TExceptionEvent;
    FMainForm: TCustomGTKForm;
    FMainFormSet, FGTK205Up, FGTK220Up, FGTK240Up, FGTK260Up, FGTK280Up: Boolean;
    FThreadID: __pthread_t;
    procedure Quit;
  protected
    procedure CreateHandle;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ControlDestroyed(Control: TGTKControl);
    procedure CreateForm(InstanceClass: TComponentClass; var Reference);
    procedure HandleException(Sender: TObject);
    procedure HandleMessage;
    procedure HookSynchronizeWakeup;
    procedure Initialize;
    function MessageBox(const Text: string; Buttons: TMessageButtons = [mbOK]; Style: TMessageStyle = mbInfo;
                        Default: TMessageButton = mbNone; Escape: TMessageButton = mbNone): TMessageButton; overload;
    function MessageBox(ParentWindow: PGtkWindow; const Text: string; Buttons: TMessageButtons = [mbOK]; Style: TMessageStyle = mbInfo;
                        Default: TMessageButton = mbNone; Escape: TMessageButton = mbNone): TMessageButton; overload;
    procedure ProcessMessages;
    procedure Run;
    procedure ShowException(E: Exception);
    procedure Terminate;
    procedure UnhookSynchronizeWakeup;
    property MainForm: TCustomGTKForm read FMainForm;
    property Terminated: Boolean read FTerminated;
    property OnException: TExceptionEvent read FOnException write FOnException;
  published
    property GTKVersion_2_0_5_Up: boolean read FGTK205Up;
    property GTKVersion_2_2_0_Up: boolean read FGTK220Up;
    property GTKVersion_2_4_0_Up: boolean read FGTK240Up;
    property GTKVersion_2_6_0_Up: boolean read FGTK260Up;
    property GTKVersion_2_8_0_Up: boolean read FGTK280Up;
    property ThreadID: __pthread_t read FThreadID;
  end;


{ Global objects }

var Application: TGTKApplication;
    Screen: TGDKScreen;
    Argc: Integer;
    Argv: PPChar;

function GetParentForm(Control: TGTKControl): TCustomGTKForm;
   
    
(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
implementation

uses GTKUtils;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGDKScreen.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FForms := TList.Create;
  FActiveForm := nil;
end;

destructor TGDKScreen.Destroy;
begin
  FForms.Free;
  inherited Destroy;
end;

procedure TGDKScreen.AddForm(AForm: TCustomGTKForm);
begin
  FForms.Add(AForm);
end;

function TGDKScreen.GetForm(Index: Integer): TCustomGTKForm;
begin
  Result := FForms[Index];
end;

function TGDKScreen.GetFormCount: Integer;
begin
  Result := FForms.Count;
end;

procedure TGDKScreen.RemoveForm(AForm: TCustomGTKForm);
begin
  FForms.Remove(AForm);
end;

function TGDKScreen.GetHeight: Integer;
begin
  Result := gdk_screen_height;
end;

function TGDKScreen.GetWidth: Integer;
begin
  Result := gdk_screen_width;
end;


(********************************************************************************************************************************)
(********************************************************************************************************************************)
function TCustomGTKForm_delete_event(widget: PGtkWidget; event: PGdkEvent; user_data: gpointer): gboolean; cdecl;
begin
  Result := not TCustomGTKForm(user_data).Close;
end;

procedure TCustomGTKForm_show(anobject : PGtkObject; user_data: pgpointer); cdecl;
begin
  if Assigned(TCustomGTKForm(user_data).FOnShow) then TCustomGTKForm(user_data).FOnShow(TCustomGTKForm(user_data));
end;

procedure TCustomGTKForm_size_allocate(widget : PGtkWidget; allocation : PGtkAllocation; user_data : gpointer); cdecl;
begin
  if Assigned(TCustomGTKForm(user_data).FOnResize) then TCustomGTKForm(user_data).FOnResize(TCustomGTKForm(user_data));
end;

constructor TCustomGTKForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Tooltips := TGTKTooltips.Create(Self);
  FOnClose := nil;
  FOnCloseQuery := nil;
  FOnDestroy := nil;
  FCaption := '';
  FAccelGroup := gtk_accel_group_new;
  Screen.AddForm(Self);
end;

destructor TCustomGTKForm.Destroy;
begin
  try
    Screen.RemoveForm(Self);
    if Assigned(FOnDestroy) then FOnDestroy(Self);
  except
  end;
  Tooltips.Free;
  if not Application.Terminated then gtk_widget_destroy(FWidget);
  inherited Destroy;
end;

procedure TCustomGTKForm.SetVisible(Value: Boolean);
begin
  inherited Visible := Value;
end;

function TCustomGTKForm.Close: boolean;
var CloseAction: TCloseAction;
begin
  CloseAction := caFree;
  if CloseQuery then begin
    DoClose(CloseAction);
    if CloseAction <> caNone then
      if Application.MainForm = Self
        then Application.Terminate
        else if CloseAction = caHide then
          Hide
{        else if CloseAction = caMinimize then
          WindowState := wsMinimized }
        else
          Release;
    end else CloseAction := caNone;
  Result := CloseAction = caFree;
end;

function TCustomGTKForm.CloseQuery: Boolean;
begin
  Result := True;
  if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Result);
end;

procedure TCustomGTKForm.DoClose(var Action: TCloseAction);
begin
  if Assigned(FOnClose) then FOnClose(Self, Action);
end;

procedure TCustomGTKForm.Release;
begin
//  SetParent(nil);
//  if Assigned(FWidget) and GTK_IS_WIDGET(FWidget) then gtk_widget_destroy(PGtkWidget(FWidget));
end;

procedure TCustomGTKForm.FormCreate(Sender: TObject);
begin
  //  Dummy procedure, override it in ordinary instance if needed
end;

procedure TCustomGTKForm.SetCaption(Value: string);
begin
  FCaption := Value;
  gtk_window_set_title(PGtkWindow(FWidget), PChar(Value));
end;

function TCustomGTKForm.GetWindowPosition: TWindowPosition;
begin
  Result := TWindowPosition(position(PGtkWindow(FWidget)^));
end;

procedure TCustomGTKForm.SetWindowPosition(Value: TWindowPosition);
begin
  gtk_window_set_position(PGtkWindow(FWidget), TGtkWindowPosition(Value));
end;

function TCustomGTKForm.GetResizeable: boolean;
begin
  Result := gtk_window_get_resizable(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.SetResizeable(Value: Boolean);
begin
  gtk_window_set_resizable(PGtkWindow(FWidget), Value);
end;

procedure TCustomGTKForm.SetDefaultSize(DefaultWidth, DefaultHeight: integer);
begin
  gtk_window_set_default_size(PGtkWindow(FWidget), DefaultWidth, DefaultHeight);
end;

procedure TCustomGTKForm.SetTransientFor(Parent: TCustomGTKForm);
begin
  if Assigned(Parent) and Assigned(Parent.FWidget) then
    gtk_window_set_transient_for(PGtkWindow(FWidget), PGtkWindow(Parent.FWidget));
end;

procedure TCustomGTKForm.ShowModal;
begin
  gtk_window_set_modal(PGtkWindow(FWidget), True);
  if Assigned(Parent) and (Parent is TCustomGTKForm) then gtk_window_set_transient_for(PGtkWindow(FWidget), PGtkWindow(Parent.FWidget));
  SetVisible(True);
end;

function TCustomGTKForm.GetWindowTypeHint: TGDKWindowTypeHint;
begin
  Result := TGDKWindowTypeHint(gtk_window_get_type_hint(PGtkWindow(FWidget)));
end;

procedure TCustomGTKForm.SetWindowTypeHint(Value: TGDKWindowTypeHint);
begin
  gtk_window_set_type_hint(PGtkWindow(FWidget), gdk2.TGdkWindowTypeHint(Value));
end;

function TCustomGTKForm.GetWindowState: TGDKWindowState;
begin
  Result := TGDKWindowState(gdk_window_get_state(PGdkWindow(FWidget^.window)));
end;

procedure TCustomGTKForm.Maximize;
begin
  gtk_window_maximize(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.Unmaximize;
begin
  gtk_window_unmaximize(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.Minimize;
begin
  gtk_window_iconify(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.Unminimize;
begin
  gtk_window_deiconify(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.Stick;
begin
  gtk_window_stick(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.Unstick;
begin
  gtk_window_unstick(PGtkWindow(FWidget));
end;

procedure TCustomGTKForm.WindowMove(ALeft, ATop: integer);
begin
  gtk_window_move(PGtkWindow(FWidget), ALeft, ATop);
end;

function TCustomGTKForm.GetLeft: integer;
var PosLeft, PosTop: integer;
begin
  gtk_window_get_position(PGtkWindow(FWidget), @PosLeft, @PosTop);
  Result := PosLeft;
end;

function TCustomGTKForm.GetTop: integer;
var PosLeft, PosTop: integer;
begin
  gtk_window_get_position(PGtkWindow(FWidget), @PosLeft, @PosTop);
  Result := PosTop;
end;

function TCustomGTKForm.GetWidth: integer;
var AWidth, AHeight: integer;
begin
  gtk_window_get_size(PGtkWindow(FWidget), @AWidth, @AHeight);
  Result := AWidth;
end;

function TCustomGTKForm.GetHeight: integer;
var AWidth, AHeight: integer;
begin
  gtk_window_get_size(PGtkWindow(FWidget), @AWidth, @AHeight);
  Result := AHeight;
end;

procedure TCustomGTKForm.SetLeft(Value: integer);
begin
  gtk_window_move(PGtkWindow(FWidget), Value, GetTop);
end;

procedure TCustomGTKForm.SetTop(Value: integer);
begin
  gtk_window_move(PGtkWindow(FWidget), GetLeft, Value);
end;

procedure TCustomGTKForm.SetWidth(Value: integer);
begin
  gtk_window_resize(PGtkWindow(FWidget), Value, GetHeight);
end;

procedure TCustomGTKForm.SetHeight(Value: integer);
begin
  gtk_window_resize(PGtkWindow(FWidget), GetWidth, Value);
end;

procedure TCustomGTKForm.Resize(AWidth, AHeight: integer);
begin
  gtk_window_resize(PGtkWindow(FWidget), AWidth, AHeight);
end;

procedure TCustomGTKForm.SetDefault(Value: TGTKControl);
begin
  gtk_window_set_default(PGtkWindow(FWidget), Value.FWidget);
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKApplication.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMainForm := nil;
  FMainFormSet := False;
  if not Assigned(Classes.ApplicationHandleException) then
    Classes.ApplicationHandleException := HandleException;
  if not Assigned(Classes.ApplicationShowException) then
    Classes.ApplicationShowException := ShowException;
  CreateHandle;
  HookSynchronizeWakeup;
  FThreadID := 0;
end;

procedure my_g_thread_init(vtable:Pointer);cdecl;external 'libgthread-2.0.so' name 'g_thread_init';

procedure TGTKApplication.CreateHandle;
var
  I: Integer;
  Temp: string;
  Ver : Pchar;
begin
  Argc := ParamCount + 1;
  Argv := AllocMem((Argc + 1) * SizeOf(PChar));
  for I := 0 to Argc - 1 do
  begin
    Temp := ParamStr(I);
    {$R-}
    PCharArray(Argv^)[I] := AllocMem(Length(Temp)+1);
    StrCopy(PCharArray(Argv^)[I], PChar(Temp));
    {$R+}
  end;
  {$R-}
  PCharArray(Argv^)[Argc] := nil;
  {$R+}

  //  Check for correct version of GTK+ library
  Ver := gtk_check_version(2, 8, 0);
  FGTK280Up := Ver = nil;
  if not FGTK280Up then Ver := gtk_check_version(2, 6, 0);
  FGTK260Up := Ver = nil;
  if not FGTK260Up then Ver := gtk_check_version(2, 4, 0);
  FGTK240Up := Ver = nil;
  if not FGTK240Up then Ver := gtk_check_version(2, 2, 0);
  FGTK220Up := Ver = nil;
  if not FGTK220Up then Ver := gtk_check_version(2, 0, 5);
  FGTK205Up := Ver = nil;
  if not FGTK220Up then WriteLn('Warning: Your version of GTK+ is old and some workarounds has been activated. It is recommended to update GTK libraries at least to 2.2.0');
  if Ver <> nil then Ver := gtk_check_version(2, 0, 0);
  if Ver <> nil then WriteLn('Warning: There might be some problems with GTK+ library or version conflict.');

  //  Init threads
  my_g_thread_init(nil);
  
  (*  ATTENTION: do not call gdk_threads_init(), it causes deadlocks and we don't really need it  *)
//  gdk_threads_init;

  //  Initialize the widget set
  gtk_init(@argc, @argv);
{  if not gtk_init_check(@argc, @argv) then begin
    WriteLn('Unable to initialize GTK+ interface. Make sure you have correctly installed all of GTK libraries and have set a valid X server in the DISPLAY variable.');
    Halt(1);
  end;   }
end;

destructor TGTKApplication.Destroy;
type
  TExceptionEvent = procedure (E: Exception) of object;
var
  P: TNotifyEvent;
  E: TExceptionEvent;
begin
  UnhookSynchronizeWakeup;
  P := HandleException;
  if @P = @Classes.ApplicationHandleException then
    Classes.ApplicationHandleException := nil;
  E := ShowException;
  if @E = @Classes.ApplicationShowException then
    Classes.ApplicationShowException := nil; 
  inherited Destroy;
end;

procedure TGTKApplication.HookSynchronizeWakeup;
begin
  if not Assigned(Classes.WakeMainThread) then
    Classes.WakeMainThread := WakeMainThread;
end;

procedure TGTKApplication.UnhookSynchronizeWakeup;
var
  P: TNotifyEvent;
begin
  P := WakeMainThread;
  if @P = @Classes.WakeMainThread then
    Classes.WakeMainThread := nil;
end;

procedure TGTKApplication.HandleException(Sender: TObject);
begin
  if ExceptObject is Exception then
  begin
    if not (ExceptObject is EAbort) then
      if Assigned(FOnException) then
        FOnException(Sender, Exception(ExceptObject))
      else
        ShowException(Exception(ExceptObject));
  end else
    SysUtils.ShowException(ExceptObject, ExceptAddr);
end;

procedure TGTKApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
  Instance: TComponent;
begin
  Instance := TComponent(InstanceClass.NewInstance);
  TComponent(Reference) := Instance;
  try
    Instance.Create(Self);
  except
    TComponent(Reference) := nil;
    raise;
  end;
  if not FMainFormSet and (Instance is TCustomGTKForm) then
  begin
    // FMainForm will be set to the first form created by TForm.Create but
    // it will be reset by CreateForm if one was created early, such as through
    // a splash screen. This allows applications that don't use CreateForm to
    // still have a main form but preserve the semantics the first CreateForm
    // being the main form.
{    TCustomGTKForm(Instance).HandleNeeded; }
    FMainForm := TCustomGTKForm(Instance);
{    if TForm(Instance).ActiveControl = nil then
      TForm(Instance).SetFocusedControl(TForm(Instance));}
    FMainFormSet := True;
  end; 
end;

procedure TGTKApplication.ControlDestroyed(Control: TGTKControl);
begin
  if FMainForm = Control then FMainForm := nil;
  if Screen.FActiveForm = Control then Screen.FActiveForm := nil;
end;

procedure TGTKApplication.Initialize;
begin
end;

// function GetCurrentThreadID: Integer; external 'libpthread.so.0' name 'pthread_self';

procedure TGTKApplication.ProcessMessages;
begin
  while WordBool(gtk_events_pending) do gtk_main_iteration;
          //  QApplication_processEvents(Handle);
{  if GetCurrentThreadID = Integer(MainThreadID) then
    CheckSynchronize;  }
end;

procedure TGTKApplication.HandleMessage;
begin
//  QApplication_processOneEvent(Handle);
{  if GetCurrentThreadID = Integer(MainThreadID) then
    CheckSynchronize; }
end;

procedure _exit(status: longint); cdecl; external 'libc.so.6' name '_exit';
function __pthread_self: __pthread_t; cdecl; external 'libpthread.so.0' name 'pthread_self';

procedure TGTKApplication.Run;
begin
  repeat
    try
//      gdk_threads_enter;
      FThreadID := __pthread_self;
      gtk_main;
//      gdk_threads_leave;
    except
      on E : Exception do
        if E is EControlC then begin
          WriteLn('*** Exception: ', E.Message);
          _exit(1);
          Exit;
        end else HandleException(E);
    end;
  until Terminated;
end;

function TGTKApplication_MessageBox_key_press_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl;
begin
  Result := False;
  if event^.keyval = GDK_ESCAPE then begin
    gtk_dialog_response(PGtkDialog(widget), integer(user_data));
//    Beep;
    Result := True;
  end;
end;

function TGTKApplication.MessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle;
                                    Default, Escape: TMessageButton): TMessageButton;
var DialogParent: PGtkWindow;
begin
  if Screen.FormCount > 0
    then DialogParent := PGtkWindow(Screen.Forms[0].FWidget)
    else DialogParent := nil;
  Result := MessageBox(DialogParent, Text, Buttons, Style, Default, Escape);
end;

function TGTKApplication.MessageBox(ParentWindow: PGtkWindow; const Text: string; Buttons: TMessageButtons = [mbOK]; Style: TMessageStyle = mbInfo;
                                    Default: TMessageButton = mbNone; Escape: TMessageButton = mbNone): TMessageButton;
const TMessageStyleID : array[0..3] of TGtkMessageType = (GTK_MESSAGE_ERROR, GTK_MESSAGE_INFO, GTK_MESSAGE_QUESTION, GTK_MESSAGE_WARNING);
var Dialog: PGtkWidget;
    i: integer;
begin
  if Application.Terminated then
  begin
    Result := Escape;
    Exit;
  end;
  Dialog := gtk_message_dialog_new(ParentWindow, GTK_DIALOG_MODAL or GTK_DIALOG_DESTROY_WITH_PARENT, TMessageStyleID[Integer(Style)],
                                   GTK_BUTTONS_NONE, StringToPgchar(Text));
  for i := 1 to NumMessageButtons do
    if TMessageButton(i - 1) in Buttons
      then gtk_dialog_add_button(PGtkDialog(Dialog), MessageButtonID[i], i);
  if Escape <> mbNone then g_signal_connect(PGtkObject(Dialog), 'key-press-event', G_CALLBACK(@TGTKApplication_MessageBox_key_press_event),
                                            Pointer(Ord(Escape) + 1{MessageButtonID[Ord(Escape)]}));
  if Default <> mbNone then gtk_dialog_set_default_response(PGtkDialog(Dialog), Ord(Default));
  Result := TMessageButton(gtk_dialog_run(PGtkDialog(Dialog)) - 1);
  gtk_widget_destroy(Dialog);
end;

procedure TGTKApplication.ShowException(E: Exception);
var Msg: string;
begin
  Msg := E.Message;
  if (Msg <> '') and (AnsiLastChar(Msg) = '.') then Delete(Msg, Length(Msg), 1); 
  MessageBox(Format('An unhandled exception has occured: '#10'    %s'#10#10'It is strongly recommended to save your data and quit the application.', [Msg]), [mbOk], mbError);
end;

procedure TGTKApplication.Terminate;
begin
  if (not Application.Terminated) and CallTerminateProcs then begin
    FTerminated := True;
    Quit;
  end;
end;

procedure TGTKApplication.Quit;
begin
  gtk_main_quit();
{  //  The user lost interest
  gtk_exit(0); }
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidget := gtk_window_new(GTK_WINDOW_TOPLEVEL);
  gtk_window_add_accel_group(PGtkWindow(FWidget), FAccelGroup);
  g_signal_connect(PGtkObject(FWidget), 'delete-event', G_CALLBACK(@TCustomGTKForm_delete_event), Self);
  g_signal_connect(PGtkObject(FWidget), 'size-allocate', G_CALLBACK(@TCustomGTKForm_size_allocate), Self);
  g_signal_connect(PGtkObject(FWidget), 'show', G_CALLBACK(@TCustomGTKForm_show), Self);
  Visible := False;
  SetResizeable(True);
  FormCreate(Self);
  if Visible then Show;
end;

procedure TGTKForm.Hide;
begin
  SetVisible(False);
end;

procedure TGTKForm.Show;
begin
  SetVisible(True);
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
procedure TGTKDialog_response_event(dialog: PGtkDialog; arg1: gint; user_data: gpointer); cdecl;
begin
  if Assigned(TGTKDialog(user_data).FOnResponse) then TGTKDialog(user_data).FOnResponse(TGTKDialog(user_data), arg1);
end;

constructor TGTKDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidget := gtk_dialog_new;
  if Assigned(AOwner) and (AOwner is TCustomGTKForm) then SetTransientFor(AOwner as TCustomGTKForm);
  FOnResponse := nil;
  gtk_window_add_accel_group(PGtkWindow(FWidget), FAccelGroup);
  g_signal_connect(PGtkObject(FWidget), 'delete-event', G_CALLBACK(@TCustomGTKForm_delete_event), Self);
  g_signal_connect(PGtkObject(FWidget), 'show', G_CALLBACK(@TCustomGTKForm_show), Self);
  g_signal_connect(PGtkObject(FWidget), 'response', G_CALLBACK(@TGTKDialog_response_event), Self);
  ClientArea := TGTKVBox.CreateLinked(Self, PGtkDialog(FWidget)^.vbox);
  ActionArea := TGTKHBox.CreateLinked(Self, PGtkDialog(FWidget)^.action_area);
  FButtons := [];
  Visible := False;
  SetResizeable(True);
  FormCreate(Self);
  if Visible then Show;
end;

function TGTKDialog.Run: TMessageButton;
begin
  gtk_widget_show{_all}(FWidget);
  Result := TMessageButton(gtk_dialog_run(PGtkDialog(FWidget))); 
end;

procedure TGTKDialog.SetButtons(Value: TMessageButtons);
var i: integer;
begin
  for i := 1 to NumMessageButtons do
    if TMessageButton(i - 1) in Value
      then gtk_dialog_add_button(PGtkDialog(FWidget), MessageButtonID[i], i - 1);
end;

function TGTKDialog.GetShowSeparator: boolean;
begin
  Result := gtk_dialog_get_has_separator(PGtkDialog(FWidget));
end;

procedure TGTKDialog.SetShowSeparator(Value: boolean);
begin
  gtk_dialog_set_has_separator(PGtkDialog(FWidget), Value);
end;

procedure TGTKDialog.SetModalResult(Value: TMessageButton);
begin
  gtk_dialog_response(PGtkDialog(FWidget), Integer(Value));
end;

procedure TGTKDialog.SetDefaultButton(Value: TMessageButton);
begin
  gtk_dialog_set_default_response(PGtkDialog(FWidget), Integer(Value));
end;

procedure TGTKDialog.AddButton(ButtonCaption: string; ButtonID: integer);
begin
  gtk_dialog_add_button(PGtkDialog(FWidget), StringToPgchar(ButtonCaption), ButtonID);
end;

procedure TGTKDialog.SetResponseSensitive(ButtonID: integer; Sensitive: boolean);
begin
  gtk_dialog_set_response_sensitive(PGtkDialog(FWidget), ButtonID, Sensitive);
end;

procedure TGTKDialog.SetParentForm(Value: TCustomGTKForm);
begin
  if Value <> nil then gtk_window_set_transient_for(PGtkWindow(FWidget), PGtkWindow(Value.FWidget));
end;


(********************************************************************************************************************************)
(********************************************************************************************************************************)
function GetParentForm(Control: TGTKControl): TCustomGTKForm;
begin
  while Control.Parent <> nil do Control := Control.Parent;
  if Control is TCustomGTKForm then
    Result := TCustomGTKForm(Control) else
    Result := nil;
end;

initialization
  Screen := TGDKScreen.Create(nil);
  Application := TGTKApplication.Create(Screen);
finalization
  Application.Free;
  Screen.Free;
end.