carbon: added delayed widget desctruction. Support added for focus switch and keyboard events. todo: add for all event processing. fix for #14237

git-svn-id: trunk@24108 -

lcl/interfaces/carbon/carbondef.pp

@@ -61,6 +61,7 @@ type
   
   TCarbonWidget = class
   private
+    FEventProcCount: Integer;
     FProperties: TStringList;
     FCursor: HCURSOR;
     FHasCaret: Boolean;
@@ -75,6 +76,12 @@ type
     procedure DestroyWidget; virtual; abstract;
     function GetContent: ControlRef; virtual; abstract;
     procedure UpdateLCLClientRect;
+  public
+    FNeedFree: Boolean;
+    procedure BeginEventProc;
+    procedure EndEventProc;
+    function isEventProcessing: Boolean;
+    procedure FreeCarbonWidget;
   public
     LCLObject: TWinControl;  // LCL control which created this widget
     Context: TCarbonContext; // Carbon content area context
@@ -169,11 +176,30 @@ function CheckWidget(const Handle: HWND; const AMethodName: String; AClass: TCla
 function RegisterObjectEventHandler(AHandler: TCarbonObjectEventHandlerProc): EventHandlerUPP;
 function RegisterEventHandler(AHandler: TCarbonEventHandlerProc): EventHandlerUPP;
 
+procedure NeedFreeWidget(AWidget: TCarbonWidget);
+procedure FreePendingWidgets;
+
 implementation
 
 uses
   CarbonProc, CarbonDbgConsts, CarbonUtils, CarbonCaret;
 
+var
+  WantFreeList : TFPList;
+
+procedure NeedFreeWidget(AWidget: TCarbonWidget);
+begin
+  WantFreeList.Add(AWidget);
+end;
+
+procedure FreePendingWidgets;
+var
+  i : integer;
+begin
+  for i:=0 to WantFreeList.Count-1 do
+    TCarbonWidget(WantFreeList[i]).Free;
+  WantfreeList.Clear;
+end;
 {------------------------------------------------------------------------------
   Name:    CheckHandle
   Params:  AWinControl  - Handle of window
@@ -445,6 +471,31 @@ begin
   end;
 end;
 
+procedure TCarbonWidget.BeginEventProc;
+begin
+  inc(FEventProcCount);
+end;
+
+procedure TCarbonWidget.EndEventProc;
+begin
+  dec(FEventProcCount);
+  if (FEventProcCount=0) and FNeedFree then
+    NeedFreeWidget(Self)
+end;
+
+function TCarbonWidget.isEventProcessing: Boolean;
+begin
+  Result:=FEventProcCount>0;
+end;
+
+procedure TCarbonWidget.FreeCarbonWidget;
+begin
+  if isEventProcessing then
+    FNeedFree:=True
+  else
+    Free;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonWidget.FocusSet
 
@@ -913,9 +964,11 @@ initialization
   LAZARUS_FOURCC := MakeFourCC('Laz ');
   WIDGETINFO_FOURCC := MakeFourCC('WInf');
   MENU_FOURCC := MakeFourCC('Menu');
+  WantFreeList:=TFPList.Create;
   
 finalization
 
   if UPPTree <> nil then FreeAndNil(UPPTree);
+  WantFreeList.Free;
 
 end.

lcl/interfaces/carbon/carbonobject.inc

@@ -529,6 +529,7 @@ begin
   CurEventClass.Chars[4] := #0;
   CurEventKind.Chars[4] := #0;
   repeat
+    FreePendingWidgets;
     if ReceiveNextEvent(0, nil, kEventDurationNoWait, True,
       Event) <> noErr then Break;
       

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -378,6 +378,14 @@ var
 const
   SName = 'CarbonCommon_SetFocusPart';
 begin
+  if not Assigned(AWidget) then
+  begin
+    Result := CallNextEventHandler(ANextHandler, AEvent);
+    Exit;
+  end;
+
+  AWidget.BeginEventProc;
+  try
     if not (AWidget is TCarbonCustomControl) or (AWidget is TCarbonWindow) then
       Result := CallNextEventHandler(ANextHandler, AEvent);
 
@@ -425,6 +433,9 @@ begin
         CarbonWidgetSet.SetFocusedWidget(0);
       AWidget.FocusKilled;
     end;
+  finally
+    AWidget.EndEventProc;
+  end;
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonprivatewindow.inc

@@ -869,6 +869,9 @@ begin
   end;
   if (Widget = nil) or (Control = AWidget.Content) then Widget := AWidget;
 
+  Widget.BeginEventProc;
+  try
+
     EventKind := GetEventKind(AEvent);
     if EventKind = kEventRawKeyModifiersChanged then
     begin
@@ -886,6 +889,9 @@ begin
       kEventRawKeyRepeat: Result := HandleRawKeyDownEvent;
       kEventRawKeyUp    : Result := HandleRawKeyUpEvent;
     end;
+  finally
+    Widget.EndEventProc;
+  end;
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonwscontrols.pp

@@ -351,7 +351,7 @@ class procedure TCarbonWSWinControl.DestroyHandle(const AWinControl: TWinControl
 begin
   if not CheckHandle(AWinControl, Self, 'DestroyHandle') then Exit;
 
-  TCarbonWidget(AWinControl.Handle).Free;
+  TCarbonWidget(AWinControl.Handle).FreeCarbonWidget;
 end;
 
 {------------------------------------------------------------------------------