Port to GOptionContext commandline argument parser

+ rework GTK initialization

1 files changed, 20 insertions, 95 deletions

diff --git a/libgtk_kylix/GTKForms.pas b/libgtk_kylix/GTKForms.pas
index 7c01b58..ad6e335 100644
--- a/libgtk_kylix/GTKForms.pas
+++ b/libgtk_kylix/GTKForms.pas
@@ -23,13 +23,9 @@ unit GTKForms;
 
 interface
 
-uses lazglib2, lazgobject2, lazgdk3, lazgtk3, Classes, SysUtils, GTKControls, GTKConsts;
-
-type    //  Some basic types
-  PCharArray = array[0..0] of PChar;
-
-  __pthread_t = {$ifdef cpu64}QWord{$else}DWord{$endif};
+uses lazglib2, lazgobject2, lazgdk3, lazgtk3, Classes, SysUtils, UnixType, GTKControls, GTKConsts;
 
+type
   TCustomGTKForm = class;
 
 (****************************************** TGDKSCREEN **************************************************************************)
@@ -174,18 +170,14 @@ type    //  Some basic types
     FOnException: TExceptionEvent;
     FMainForm: TCustomGTKForm;
     FMainFormSet: Boolean;
-    FThreadID: __pthread_t;
+    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;
@@ -195,23 +187,22 @@ type    //  Some basic types
     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 ThreadID: __pthread_t read FThreadID;
+    property ThreadID: pthread_t read FThreadID;
   end;
 
 
 { Global objects }
 
-var Application: TGTKApplication;
-    Screen: TGDKScreen;
+var Application: TGTKApplication = nil;
+    Screen: TGDKScreen = nil;
 
 function GetParentForm(Control: TGTKControl): TCustomGTKForm;
-   
-    
+procedure InitGTK();
+
 (********************************************************************************************************************************)
 (********************************************************************************************************************************)
 (********************************************************************************************************************************)
@@ -348,7 +339,7 @@ end;
 
 procedure TCustomGTKForm.FormCreate(Sender: TObject);
 begin
-  //  Dummy procedure, override it in ordinary instance if needed
+  inherited;
 end;
 
 procedure TCustomGTKForm.SetCaption(Value: string);
@@ -522,29 +513,9 @@ begin
     Classes.ApplicationHandleException := @HandleException;
   if not Assigned(Classes.ApplicationShowException) then
     Classes.ApplicationShowException := @ShowException;}
-  CreateHandle;
-  HookSynchronizeWakeup;
   FThreadID := 0;
 end;
 
-procedure TGTKApplication.CreateHandle;
-var argc: gint;
-    argv: PPgchar;
-    i: Integer;
-begin
-  argc := ParamCount;
-  argv := g_malloc0(argc * sizeof(Pointer));
-  for i := 0 to argc - 1 do
-    argv[i] := g_strdup(PChar(ParamStr(i)));
-
-  //  Initialize the widget set
-  gtk_init(@argc, @argv);
-
-  for i := 0 to argc - 1 do
-    g_free(argv[i]);
-  g_free(argv);
-end;
-
 destructor TGTKApplication.Destroy;
 type
   TExceptionEvent = procedure (E: Exception) of object;
@@ -552,7 +523,7 @@ var
   P: TNotifyEvent;
   E: TExceptionEvent;
 begin
-{  UnhookSynchronizeWakeup;
+{ 
   P := @HandleException;
   if @P = @Classes.ApplicationHandleException then
     Classes.ApplicationHandleException := nil;
@@ -563,22 +534,6 @@ begin
   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
@@ -613,7 +568,6 @@ begin
     // 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));}
@@ -631,46 +585,14 @@ 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
-      gtk_main();
-
-{  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;
-  }
+  gtk_main();
 end;
 
 function TGTKApplication_MessageBox_key_press_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl;
@@ -736,8 +658,6 @@ end;
 procedure TGTKApplication.Quit;
 begin
   gtk_main_quit();
-{  //  The user lost interest
-  gtk_exit(0); }
 end;
 
 (********************************************************************************************************************************)
@@ -838,13 +758,18 @@ begin
     Result := nil;
 end;
 
+procedure InitGTK();
+begin
+  Screen := TGDKScreen.Create(nil);
+  Application := TGTKApplication.Create(Screen);
+end;
+
 initialization
   // Mask FPU exceptions that are redefined by Gtk+
   // https://wiki.freepascal.org/SetExceptionMask
+  g_type_init();
   SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
-  Screen := TGDKScreen.Create(nil);
-  Application := TGTKApplication.Create(Screen);
 finalization
-  Application.Free;
-  Screen.Free;
+  if Assigned(Application) then Application.Free;
+  if Assigned(Screen) then Screen.Free;
 end.