From f1050c7b4a32f2dadeffd36c4f4433a3e477b84a Mon Sep 17 00:00:00 2001 From: dmitry Date: Sat, 20 Mar 2010 10:04:28 +0000 Subject: [PATCH] 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 | 53 +++++++++++ lcl/interfaces/carbon/carbonobject.inc | 1 + lcl/interfaces/carbon/carbonprivatecommon.inc | 95 +++++++++++-------- lcl/interfaces/carbon/carbonprivatewindow.inc | 36 ++++--- lcl/interfaces/carbon/carbonwscontrols.pp | 2 +- 5 files changed, 129 insertions(+), 58 deletions(-) diff --git a/lcl/interfaces/carbon/carbondef.pp b/lcl/interfaces/carbon/carbondef.pp index d819481051..efb4dbea90 100644 --- a/lcl/interfaces/carbon/carbondef.pp +++ b/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. diff --git a/lcl/interfaces/carbon/carbonobject.inc b/lcl/interfaces/carbon/carbonobject.inc index 33b601288a..f9b96ee0e8 100644 --- a/lcl/interfaces/carbon/carbonobject.inc +++ b/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; diff --git a/lcl/interfaces/carbon/carbonprivatecommon.inc b/lcl/interfaces/carbon/carbonprivatecommon.inc index d45e047cf6..2dbe1e4dea 100644 --- a/lcl/interfaces/carbon/carbonprivatecommon.inc +++ b/lcl/interfaces/carbon/carbonprivatecommon.inc @@ -378,52 +378,63 @@ var const SName = 'CarbonCommon_SetFocusPart'; begin - if not (AWidget is TCarbonCustomControl) or (AWidget is TCarbonWindow) then - Result := CallNextEventHandler(ANextHandler, AEvent); - - if OSError( - GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil, - SizeOf(ControlPartCode), nil, @FocusPart), SName, - SGetEvent, SControlPart) then Exit; - - {$IFDEF VerboseCommonEvent} - DebugLn('CarbonCommon_SetFocusPart: ', DbgSName(AWidget.LCLObject), ' ' + - IntToStr(Integer(FocusPart))); - {$ENDIF} - - if (AWidget is TCarbonCustomControl) and not (AWidget is TCarbonWindow) then + if not Assigned(AWidget) then begin - OSError(HIViewGetFocusPart(AWidget.Content, CurrentFocus), - SName, 'HIViewGetFocusPart'); - - case FocusPart of - kControlFocusPrevPart, - kControlFocusNextPart: - if CurrentFocus = kControlNoPart then FocusPart := kControlEditTextPart - else FocusPart := kControlEditTextPart; - kControlEditTextPart:; - else - FocusPart := kControlNoPart; - end; - - OSError( - SetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, - SizeOf(ControlPartCode), @FocusPart), SName, SSetEvent, SControlPart); - - Result := noErr; + Result := CallNextEventHandler(ANextHandler, AEvent); + Exit; end; - if FocusPart <> kControlFocusNoPart then - begin - CarbonWidgetSet.SetFocusedWidget(HWND(AWidget)); - AWidget.FocusSet; - CarbonWidgetSet.SetFocusedWidget(0); - end - else - begin - if CarbonWidgetSet.GetFocusedWidget = HWND(AWidget) then + AWidget.BeginEventProc; + try + if not (AWidget is TCarbonCustomControl) or (AWidget is TCarbonWindow) then + Result := CallNextEventHandler(ANextHandler, AEvent); + + if OSError( + GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil, + SizeOf(ControlPartCode), nil, @FocusPart), SName, + SGetEvent, SControlPart) then Exit; + + {$IFDEF VerboseCommonEvent} + DebugLn('CarbonCommon_SetFocusPart: ', DbgSName(AWidget.LCLObject), ' ' + + IntToStr(Integer(FocusPart))); + {$ENDIF} + + if (AWidget is TCarbonCustomControl) and not (AWidget is TCarbonWindow) then + begin + OSError(HIViewGetFocusPart(AWidget.Content, CurrentFocus), + SName, 'HIViewGetFocusPart'); + + case FocusPart of + kControlFocusPrevPart, + kControlFocusNextPart: + if CurrentFocus = kControlNoPart then FocusPart := kControlEditTextPart + else FocusPart := kControlEditTextPart; + kControlEditTextPart:; + else + FocusPart := kControlNoPart; + end; + + OSError( + SetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, + SizeOf(ControlPartCode), @FocusPart), SName, SSetEvent, SControlPart); + + Result := noErr; + end; + + if FocusPart <> kControlFocusNoPart then + begin + CarbonWidgetSet.SetFocusedWidget(HWND(AWidget)); + AWidget.FocusSet; CarbonWidgetSet.SetFocusedWidget(0); - AWidget.FocusKilled; + end + else + begin + if CarbonWidgetSet.GetFocusedWidget = HWND(AWidget) then + CarbonWidgetSet.SetFocusedWidget(0); + AWidget.FocusKilled; + end; + finally + AWidget.EndEventProc; end; end; diff --git a/lcl/interfaces/carbon/carbonprivatewindow.inc b/lcl/interfaces/carbon/carbonprivatewindow.inc index ac99c5a68f..333b47d71b 100644 --- a/lcl/interfaces/carbon/carbonprivatewindow.inc +++ b/lcl/interfaces/carbon/carbonprivatewindow.inc @@ -851,7 +851,7 @@ const begin Result := EventNotHandledErr; - + Control := nil; if OSError(GetKeyboardFocus( TCarbonWindow(AWidget).fWindowRef, Control), SName, SGetKeyboardFocus) then Exit; @@ -869,22 +869,28 @@ begin end; if (Widget = nil) or (Control = AWidget.Content) then Widget := AWidget; - EventKind := GetEventKind(AEvent); - if EventKind = kEventRawKeyModifiersChanged then - begin - if not EmulateModifiersDownUp then Exit; - end - else - if not TranslateMacKeyCode then + Widget.BeginEventProc; + try + + EventKind := GetEventKind(AEvent); + if EventKind = kEventRawKeyModifiersChanged then begin - Debugln('[CarbonWindow_KeyboardProc] ***WARNING: TranslateMacKeyCode failed***'); - Exit; + if not EmulateModifiersDownUp then Exit; + end + else + if not TranslateMacKeyCode then + begin + Debugln('[CarbonWindow_KeyboardProc] ***WARNING: TranslateMacKeyCode failed***'); + Exit; + end; + + case EventKind of + kEventRawKeyDown : Result := HandleRawKeyDownEvent; + kEventRawKeyRepeat: Result := HandleRawKeyDownEvent; + kEventRawKeyUp : Result := HandleRawKeyUpEvent; end; - - case EventKind of - kEventRawKeyDown : Result := HandleRawKeyDownEvent; - kEventRawKeyRepeat: Result := HandleRawKeyDownEvent; - kEventRawKeyUp : Result := HandleRawKeyUpEvent; + finally + Widget.EndEventProc; end; end; diff --git a/lcl/interfaces/carbon/carbonwscontrols.pp b/lcl/interfaces/carbon/carbonwscontrols.pp index c0e89653c0..9ac12b00f4 100644 --- a/lcl/interfaces/carbon/carbonwscontrols.pp +++ b/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; {------------------------------------------------------------------------------