diff --git a/lcl/interfaces/gtk2/gtk2int.pas b/lcl/interfaces/gtk2/gtk2int.pas index cbea40501b..3bcc35dcb5 100644 --- a/lcl/interfaces/gtk2/gtk2int.pas +++ b/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; diff --git a/lcl/interfaces/gtk2/gtk2msgqueue.pp b/lcl/interfaces/gtk2/gtk2msgqueue.pp index f048255a83..aeae219949 100644 --- a/lcl/interfaces/gtk2/gtk2msgqueue.pp +++ b/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; - Result := vlItem.Msg; - RemoveMessage(vlItem,FPMF_none,false); + if vlItem <> nil then + begin + Result := vlItem.Msg; + RemoveMessage(vlItem,FPMF_none,false); + end else + Result := nil; finally UnLock; end; diff --git a/lcl/interfaces/gtk2/gtk2widgetset.inc b/lcl/interfaces/gtk2/gtk2widgetset.inc index 189eb42c0b..e220698362 100644 --- a/lcl/interfaces/gtk2/gtk2widgetset.inc +++ b/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,10 +2455,13 @@ begin //debugln(['TGtk2WidgetSet.AppProcessMessages ',vlMsg^.Message,' ',LM_CHAR,' ',dbgsname(GetLCLObject(Pointer(vlMsg^.hwnd)))]); // Send message - try - with vlMsg^ do SendMessage(hWND, Message, WParam, LParam); - finally - Dispose(vlMsg); + if vlMsg <> nil then + begin + try + with vlMsg^ do SendMessage(hWND, Message, WParam, LParam); + finally + Dispose(vlMsg); + end; end; end; @@ -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); diff --git a/lcl/interfaces/gtk2/gtk2winapi.inc b/lcl/interfaces/gtk2/gtk2winapi.inc index c0b28ddc0b..dd7bcd970a 100644 --- a/lcl/interfaces/gtk2/gtk2winapi.inc +++ b/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; {------------------------------------------------------------------------------