lcl: fixed call queued messages

demo/LazDesignerForm/demodesignerform1.lpr

@@ -10,6 +10,7 @@ uses
   athreads,
   {$ENDIF}
   Interfaces, // this includes the LCL widgetset
+  Fresnel, // this includes the Fresnel LCL backend
   Forms, MainUnit;
 
 {$R *.res}

src/base/fresnel.asynccalls.pp

@@ -1,16 +1,17 @@
-unit fresnel.asynccalls;
+unit Fresnel.AsyncCalls;
 
 {$mode objfpc}{$H+}
 
 interface
 
 uses
-  Classes, SysUtils, syncobjs , Contnrs;
+  Classes, SysUtils, SyncObjs, Contnrs;
 
 Type
   EAsyncCall = Class(Exception);
 
   { TAsyncCallQueues }
+
   TAsyncDataEvent = procedure (Data: Pointer) of object;
 
   TAsyncCallQueues = Class(TObject)
@@ -30,15 +31,17 @@ Type
     FLock: TRTLCriticalSection;
     FCur: TAsyncCallQueue; // currently processing
     FNext: TAsyncCallQueue; // new calls added to this queue
+    FOnQueueStarted: TNotifyEvent;
     FWakeMainThreadOnCalls : Boolean;
   Protected
     Procedure Lock; inline;
     Procedure Unlock; inline;
   Public
-    procedure ProcessQueue;
+    procedure ProcessQueue; // called by
     procedure QueueAsyncCall(const aMethod: TAsyncDataEvent; aData: Pointer; aFreeObject : Boolean = false);
     procedure RemoveAsyncCalls(const aObject: TObject);
-    Property WakeMainThreadOnCalls : Boolean Read FWakeMainThreadOnCalls Write FWakeMainThreadOnCalls;
+    property WakeMainThreadOnCalls : Boolean Read FWakeMainThreadOnCalls Write FWakeMainThreadOnCalls;
+    property OnQueueStarted: TNotifyEvent read FOnQueueStarted write FOnQueueStarted; // called everytime the Queue got its first message
   end;
 
 implementation
@@ -135,6 +138,7 @@ procedure TAsyncCallQueues.QueueAsyncCall(const aMethod: TAsyncDataEvent; aData:
 
 var
   lItem: PAsyncCallQueueItem;
+  WasFirst: Boolean;
 begin
   New(lItem);
   lItem^.Method := aMethod;
@@ -143,6 +147,7 @@ begin
   lItem^.Free := aFreeObject;
   Lock;
   try
+    WasFirst:=FNext.Top=nil;
     with FNext do
       begin
       lItem^.PrevItem := Last;
@@ -159,8 +164,13 @@ begin
   finally
     Unlock;
   end;
-  if WakeMainThreadOnCalls and Assigned(WakeMainThread) then
-    WakeMainThread(nil);
+  if WasFirst then
+    begin
+    if Assigned(OnQueueStarted) then
+      OnQueueStarted(Self);
+    if WakeMainThreadOnCalls and Assigned(WakeMainThread) then
+      WakeMainThread(nil);
+    end;
 end;
 
 procedure TAsyncCallQueues.RemoveAsyncCalls(const aObject: TObject);

src/base/fresnel.forms.pas

@@ -5,10 +5,10 @@ unit Fresnel.Forms;
 interface
 
 uses
-  Classes, SysUtils, Math, CustApp, fpCSSResolver, fpCSSTree, contnrs,
+  Classes, SysUtils, Math, CustApp, fpCSSResolver, fpCSSTree, Contnrs,
   Fresnel.StrConsts, Fresnel.Classes, Fresnel.Resources,
   Fresnel.DOM, Fresnel.Renderer, Fresnel.Layouter, Fresnel.WidgetSet,
-  Fresnel.Events, fcl.events, fresnel.asynccalls;
+  Fresnel.Events, FCL.Events, Fresnel.AsyncCalls;
 
 
 
@@ -196,9 +196,6 @@ type
     Class Function FresnelEventID : TEventID; override;
   end;
 
-
-  { TFresnelBaseApplication }
-
   { TFresnelFormManager }
 
   TFresnelFormManager = Class(TComponent)
@@ -217,10 +214,12 @@ type
   end;
   TFresnelFormManagerClass = Class of TFresnelFormManager;
 
+  { TFresnelBaseApplication }
+
   TFresnelBaseApplication = class(TCustomApplication)
   private
     FAsyncCall: TAsyncCallQueues;
-    FEventDispatcher : TFresnelEventDispatcher;
+    FEventDispatcher: TFresnelEventDispatcher;
     procedure DoFresnelLog(aType: TEventType; const Msg: UTF8String);
     function GetHookFresnelLog: Boolean;
     procedure SetHookFresnelLog(AValue: Boolean);
@@ -234,13 +233,13 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    procedure ProcessMessages;
+    procedure ProcessMessages; virtual;
     procedure QueueAsyncCall(const aMethod: TDataEvent; aData: Pointer);
     procedure RemoveAsyncCalls(const aObject: TObject);
-    Procedure CreateForm(aClass : TComponentClass; Out FormVariable);
-    Procedure CreateFormNew(aClass : TComponentClass; Out FormVariable);
-    function AddEventListener(aID : TEventID; aHandler : TFresnelEventHandler) : Integer;
-    function AddEventListener(Const aName: TEventName; aHandler : TFresnelEventHandler): Integer;
+    Procedure CreateForm(aClass : TComponentClass; Out FormVariable); virtual;
+    Procedure CreateFormNew(aClass : TComponentClass; Out FormVariable); virtual;
+    function AddEventListener(aID : TEventID; const aHandler : TFresnelEventHandler) : Integer;
+    function AddEventListener(Const aName: TEventName; const aHandler : TFresnelEventHandler): Integer;
     property EventDispatcher : TFresnelEventDispatcher Read FEventDispatcher;
     Property HookFresnelLog : Boolean Read GetHookFresnelLog Write SetHookFresnelLog;
   end;
@@ -291,12 +290,12 @@ begin
   if Designer<>nil then
     begin
     Writeln('Designer renderer');
-    Result:=Designer.GetRenderer
+    Result:=Designer.GetRenderer;
     end
   else if WSFormAllocated then
     begin
     Writeln('WSForm renderer');
-    Result:=WSForm.Renderer
+    Result:=WSForm.Renderer;
     end
   else
     begin
@@ -440,13 +439,13 @@ end;
 
 procedure TFresnelCustomForm.OnQueuedLayout(Data: Pointer);
 begin
-  //debugln(['TFresnelCustomForm.OnQueuedLayout ',DbgSName(Self),' ',LayoutQueued]);
+  //FLLog(etDebug,['TFresnelCustomForm.OnQueuedLayout ',Name,':',ClassName,' LayoutQueued=',BoolToStr(LayoutQueued,true)]);
   if not LayoutQueued then exit;
   try
     ApplyCSS;
     //Layouter.WriteLayoutTree;
     Layouter.Apply(Self);
-    //debugln(['TFresnelCustomForm.OnQueuedLayout ',DbgSName(Self),' After Layouter.Apply, Invalidate...']);
+    //FLLog(etDebug,['TFresnelCustomForm.OnQueuedLayout ',Name,':',ClassName,' After Layouter.Apply, Invalidate...']);
     Invalidate;
   finally
     Exclude(FFormStates,fsLayoutQueued);
@@ -796,7 +795,6 @@ begin
     Result:=(TFresnelComponent._LogHook=@DoFresnelLog);
 end;
 
-
 function TFresnelBaseApplication.CreateEventDispatcher(aDefaultSender: TObject): TFresnelEventDispatcher;
 begin
   Result:=TFresnelEventDispatcher.Create(aDefaultSender);
@@ -810,14 +808,12 @@ end;
 class procedure TFresnelBaseApplication.RegisterApplicationEvents;
 
   Procedure R(aClass : TFresnelEventClass);
-
   begin
      TFresnelEventDispatcher.FresnelRegistry.RegisterEventWithID(aClass.FresnelEventID,aClass);
   end;
 
 begin
   R(TFresnelAfterProcessMessagesEvent);
-
 end;
 
 procedure TFresnelBaseApplication.DoProcessMessages;
@@ -825,7 +821,6 @@ begin
   WidgetSet.AppProcessMessages;
 end;
 
-
 procedure TFresnelBaseApplication.ShowMainForm;
 begin
   FLLog(etDebug,'ShowMainForm');
@@ -834,7 +829,6 @@ begin
   FormManager.MainForm.Show;
 end;
 
-
 constructor TFresnelBaseApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
@@ -856,13 +850,14 @@ end;
 
 procedure TFresnelBaseApplication.ProcessMessages;
 begin
-  // FLLog(etDebug,'ProcessMessages');
+  //FLLog(etDebug,'ProcessMessages');
   DoProcessMessages;
   DoHandleAsyncCalls;
   FEventDispatcher.DispatchEvent(evtAfterProcessMessages);
 end;
 
-procedure TFresnelBaseApplication.QueueAsyncCall(const AMethod: TDataEvent; aData: Pointer);
+procedure TFresnelBaseApplication.QueueAsyncCall(const aMethod: TDataEvent;
+  aData: Pointer);
 begin
   FAsyncCall.QueueAsyncCall(aMethod,aData);
 end;
@@ -885,12 +880,14 @@ begin
     TComponent(FormVariable):=aClass.Create(Self)
 end;
 
-Function TFresnelBaseApplication.AddEventListener(aID: TEventID; aHandler: TFresnelEventHandler) : Integer;
+function TFresnelBaseApplication.AddEventListener(aID: TEventID;
+  const aHandler: TFresnelEventHandler): Integer;
 begin
   Result:=FEventDispatcher.RegisterHandler(aHandler,aID).ID;
 end;
 
-function TFresnelBaseApplication.AddEventListener(const aName: TEventName; aHandler: TFresnelEventHandler): Integer;
+function TFresnelBaseApplication.AddEventListener(const aName: TEventName;
+  const aHandler: TFresnelEventHandler): Integer;
 begin
   Result:=FEventDispatcher.RegisterHandler(aHandler,aName).ID;
 end;

src/lcl/fresnel.lcl.pas

@@ -141,9 +141,9 @@ type
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
 
-    procedure AppProcessMessages; override;
-    procedure AppTerminate; override;
-    procedure AppWaitMessage; override;
+    procedure AppProcessMessages; override; // called by user
+    procedure AppTerminate; override; // called by user
+    procedure AppWaitMessage; override; // called by user
     procedure CreateWSForm(aFresnelForm: TFresnelComponent); override;
   end;
 

src/lcl/fresnel.lclapp.pas

@@ -13,13 +13,16 @@ type
   { TFresnelLCLApplication }
 
   TFresnelLCLApplication = class(TFresnelBaseApplication)
+  private
+    FCritSecQueue: TRTLCriticalSection;
+    FLCLQueued: boolean; // true if waiting for LCL message queue to process our messages
+    procedure OnLCLQueue(Data: PtrInt);
+    procedure OnQueueStarted(Sender: TObject); // can be called by other threads
+    procedure SetLCLQueued(const AValue: boolean);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-{    procedure QueueAsyncCall(const AMethod: TDataEvent; Data: Pointer); override;
-    procedure RemoveAsyncCalls(const AnObject: TObject); override;
-    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
-    procedure ReleaseComponent(AComponent: TComponent); override;}
+    property LCLQueued: boolean read FLCLQueued write SetLCLQueued;
   end;
 
 var
@@ -29,40 +32,49 @@ implementation
 
 { TFresnelLCLApplication }
 
-constructor TFresnelLCLApplication.Create(AOwner: TComponent);
+procedure TFresnelLCLApplication.OnQueueStarted(Sender: TObject);
 begin
-  inherited Create(AOwner);
-  FresnelLCLApp:=Self;
+  LCLQueued:=true;
 end;
 
-destructor TFresnelLCLApplication.Destroy;
+procedure TFresnelLCLApplication.OnLCLQueue(Data: PtrInt);
 begin
-  inherited Destroy;
-  FresnelLCLApp:=nil;
+  LCLQueued:=false;
+  if Data=0 then ;
+  ProcessMessages;
 end;
 
-(*
-procedure TFresnelLCLApplication.QueueAsyncCall(const AMethod: TDataEvent;
-  Data: Pointer);
+procedure TFresnelLCLApplication.SetLCLQueued(const AValue: boolean);
 begin
-  Forms.Application.QueueAsyncCall(Forms.TDataEvent(AMethod),{%H-}PtrInt(Data));
+  EnterCriticalSection(FCritSecQueue);
+  try
+    if FLCLQueued=AValue then Exit;
+    FLCLQueued:=AValue;
+    if AValue then
+      Forms.Application.QueueAsyncCall(@OnLCLQueue,0)
+    else
+      Forms.Application.RemoveAsyncCalls(Self);
+  finally
+    LeaveCriticalSection(FCritSecQueue);
+  end;
 end;
 
-procedure TFresnelLCLApplication.RemoveAsyncCalls(const AnObject: TObject);
+constructor TFresnelLCLApplication.Create(AOwner: TComponent);
 begin
-  Forms.Application.RemoveAsyncCalls(AnObject);
+  inherited Create(AOwner);
+  InitCriticalSection(FCritSecQueue);
+  FresnelLCLApp:=Self;
+  AsyncCalls.OnQueueStarted:=@OnQueueStarted;
 end;
 
-procedure TFresnelLCLApplication.RemoveAllHandlersOfObject(AnObject: TObject);
+destructor TFresnelLCLApplication.Destroy;
 begin
-  Forms.Application.RemoveAllHandlersOfObject(AnObject);
+  AsyncCalls.OnQueueStarted:=nil;
+  DoneCriticalSection(FCritSecQueue);
+  inherited Destroy;
+  FresnelLCLApp:=nil;
 end;
 
-procedure TFresnelLCLApplication.ReleaseComponent(AComponent: TComponent);
-begin
-  Forms.Application.ReleaseComponent(AComponent);
-end;
-*)
 initialization
   TFresnelLCLApplication.Create(nil);
 finalization