Gtk2: changed the way how main event loop iterates BUT ONLY VIA -dUSE_GTK_MAIN_CONTEXT_ITERATION until it's stable enough.

Now PostMessage() work correct when messages arrives from other threads. fixes #17548 and probably more issues with gtk2 threads usage.

git-svn-id: trunk@27829 -

lcl/interfaces/gtk2/gtk2int.pas

@@ -68,6 +68,9 @@ type
 
   TGtk2WidgetSet = class(TWidgetSet)
   private
+    {$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+    FMainPoll: PGPollFD;
+    {$ENDIF}
     FMultiThreadingEnabled: boolean;
     FocusTimer: cardinal;
     FLastFocusIn: PGtkWidget;

lcl/interfaces/gtk2/gtk2msgqueue.pp

@@ -26,7 +26,11 @@ unit Gtk2MsgQueue;
 
 interface
 
-uses LazLinkedList, LCLType, LMessages, Gtk2Globals, DynHashArray, Gtk2Proc;
+uses LazLinkedList, LCLType, LMessages, Gtk2Globals, DynHashArray, Gtk2Proc
+{$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+, glib2
+{$ENDIF}
+;
 
 type
   TFinalPaintMessageFlag=(FPMF_None,FPMF_Internal,FPMF_All);
@@ -47,7 +51,11 @@ type
   TGtkMessageQueue=class(TLinkList)
   private
     FPaintMessages: TDynHashArray; // Hash for paint messages
+    {$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+    FMainContext: PGMainContext;
+    {$ELSE}
     FCritSec: TRTLCriticalSection;
+    {$ENDIF}
     fLock: integer;
   protected
     function CreateItem : TLinkListItem;override;
@@ -71,6 +79,9 @@ type
     function   HasNonPaintMessages:boolean;
     function   NumberOfPaintMessages:integer;
     function   PopFirstMessage: PMsg;
+    {$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+    property   MainContext: PGMainContext read FMainContext;
+    {$ENDIF}
   end;
 
 
@@ -111,28 +122,46 @@ begin
   inherited Create;
   FPaintMessages := TDynHashArray.Create(-1);
   FPaintMessages.OwnerHashFunction := @HashPaintMessage;
+  {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
   InitCriticalSection(FCritSec);
+  {$ELSE}
+  FMainContext := g_main_context_new;
+  g_main_context_ref(FMainContext);
+  {$ENDIF}
 end;
 
 destructor TGtkMessageQueue.destroy;
 begin
   inherited Destroy;
   fPaintMessages.destroy;
+  {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
   DoneCriticalsection(FCritSec);
+  {$ELSE}
+  g_main_context_unref(FMainContext);
+  FMainContext := nil;
+  {$ENDIF}
 end;
 
 procedure TGtkMessageQueue.Lock;
 begin
   inc(fLock);
   if fLock=1 then
+    {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
     EnterCriticalsection(FCritSec);
+    {$ELSE}
+    g_main_context_acquire(FMainContext);
+    {$ENDIF}
 end;
 
 procedure TGtkMessageQueue.UnLock;
 begin
   dec(fLock);
   if fLock=0 then
+    {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
     LeaveCriticalsection(FCritSec);
+    {$ELSE}
+    g_main_context_release(FMainContext);
+    {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -292,8 +321,12 @@ begin
   Lock;
   try
     vlItem := FirstMessageItem;
+    if vlItem <> nil then
+    begin
       Result := vlItem.Msg;
       RemoveMessage(vlItem,FPMF_none,false);
+    end else
+      Result := nil;
   finally
     UnLock;
   end;

lcl/interfaces/gtk2/gtk2widgetset.inc

@@ -23,6 +23,37 @@
 //  {$DEFINE ASSERT_IS_ON}
 {$ENDIF}
 
+{$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+var
+  Gtk2MPF: TGPollFunc;
+
+function Gtk2PollFunction(ufds:PGPollFD; nfsd:guint; timeout:gint):gint;cdecl;
+var
+  i: Integer;
+begin
+  Result := nfsd;
+  if TimeOut = -1 then
+    Gtk2WidgetSet.FMainPoll := ufds
+  else
+    Gtk2WidgetSet.FMainPoll := nil;
+  if Gtk2MPF <> nil then
+  begin
+    if (glib_major_version = 2) and (glib_minor_version < 24) and
+      (Gtk2WidgetSet.FMainPoll <> nil) then
+    begin
+      while (Gtk2WidgetSet.FMainPoll <> nil) and
+        (Gtk2WidgetSet.FMainPoll^.revents = 0) do
+      begin
+        Gtk2MPF(ufds, nfsd, 1);
+        if Gtk2WidgetSet.FMessageQueue.Count > 0 then
+          break;
+      end;
+    end else
+      Gtk2MPF(ufds, nfsd, timeout);
+  end;
+end;
+{$ENDIF}
+
 function GTK2FocusCB( widget: PGtkWidget; event:PGdkEventFocus;
   data: gPointer) : GBoolean; cdecl;
 var
@@ -1076,6 +1107,11 @@ constructor TGtk2WidgetSet.Create;
 begin
   inherited Create;
   Gtk1Create;
+  {$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+  FMainPoll := nil;
+  Gtk2MPF := g_main_context_get_poll_func(g_main_context_default);
+  g_main_context_set_poll_func(g_main_context_default, @Gtk2PollFunction);
+  {$ENDIF}
   StayOnTopList := nil;
   im_context:=gtk_im_multicontext_new;
   g_signal_connect (G_OBJECT (im_context), 'commit',
@@ -2342,7 +2378,12 @@ procedure TGtk2WidgetSet.AppProcessMessages;
 
   function PendingGtkMessagesExists: boolean;
   begin
+    {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
     Result:=(gtk_events_pending<>0) or LCLtoGtkMessagePending;
+    {$ELSE}
+    Result := g_main_context_pending(g_main_context_default) or
+      LCLtoGtkMessagePending;
+    {$ENDIF}
   end;
 
 var
@@ -2357,10 +2398,20 @@ begin
 
     // let gtk handle up to 100 messages and call our callbacks
     i:=100;
-    while (gtk_events_pending<>0) and (i>0) do begin
+
+    {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+    while (gtk_events_pending<>0) and (i>0) do
+    begin
       gtk_main_iteration_do(False);
       dec(i);
     end;
+    {$ELSE}
+    while g_main_context_pending(g_main_context_default) and (i>0) do
+    begin
+      g_main_context_iteration(g_main_context_default, False);
+      dec(i);
+    end;
+    {$ENDIF}
 
     //DebugLn(['TGtk2WidgetSet.AppProcessMessages SendCachedGtkMessages']);
     // send cached gtk messages to the lcl
@@ -2404,12 +2455,15 @@ begin
 
       //debugln(['TGtk2WidgetSet.AppProcessMessages ',vlMsg^.Message,' ',LM_CHAR,' ',dbgsname(GetLCLObject(Pointer(vlMsg^.hwnd)))]);
       // Send message
+      if vlMsg <> nil then
+      begin
         try
           with vlMsg^ do SendMessage(hWND, Message, WParam, LParam);
         finally
           Dispose(vlMsg);
         end;
       end;
+    end;
 
     // proceed until all messages are handled
   until (not PendingGtkMessagesExists) or Application.Terminated;
@@ -2425,11 +2479,14 @@ end;
 procedure TGtk2WidgetSet.AppWaitMessage;
 begin
   WaitingForMessages:=true;
+  {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
   gtk_main_iteration_do(True);
+  {$ELSE}
+  g_main_context_iteration(g_main_context_default, True);
+  {$ENDIF}
   WaitingForMessages:=false;
 end;
 
-
 procedure TGtk2WidgetSet.FreeStockItems;
 
   procedure DeleteAndNilObject(var h: HGDIOBJ);

lcl/interfaces/gtk2/gtk2winapi.inc

@@ -6799,7 +6799,7 @@ begin
   AMessage^.WParam := WParam;
   AMessage^.LParam := LParam;
 
-  fMessageQueue.Lock;
+  FMessageQueue.Lock;
   try
     if (AMessage^.Message = LM_PAINT) or (AMessage^.Message = LM_GTKPAINT) then
     begin
@@ -6822,6 +6822,7 @@ begin
 
     FMessageQueue.AddMessage(AMessage);
 
+    {$IFNDEF USE_GTK_MAIN_CONTEXT_ITERATION}
     if GetCurrentThreadId <> MainThreadID then
     begin
       // awake gtk loop
@@ -6839,9 +6840,21 @@ begin
         DebugLn(['TGtk2WidgetSet.PostMessage ToDo: wake up gtk']);
       {$ENDIF}
     end;
+    {$ENDIF}
   finally
-    fMessageQueue.UnLock;
+    FMessageQueue.UnLock;
   end;
+
+  {$IFDEF USE_GTK_MAIN_CONTEXT_ITERATION}
+  if GetCurrentThreadId <> MainThreadID then
+  begin
+    // old glib versions needs another way to wake up.
+    if (glib_major_version = 2) and
+      (glib_minor_version < 24) and (FMainPoll <> nil) then
+      FMainPoll^.revents := 1;
+    g_main_context_wakeup(g_main_context_default);
+  end;
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------