LCL carbon: fixed bug #0011043: Mac OS X : Top level menu not firing click events...

git-svn-id: trunk@14688 -

lcl/interfaces/carbon/carbondef.pp

@@ -136,6 +136,10 @@ type
   end;
   
 type
+  TCarbonObjectEventHandlerProc = function (ANextHandler: EventHandlerCallRef;
+    AEvent: EventRef;
+    AWidget: TObject): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+
   TCarbonEventHandlerProc = function (ANextHandler: EventHandlerCallRef;
     AEvent: EventRef;
     AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
@@ -156,6 +160,7 @@ function CheckHandle(const AWinControl: TWinControl; const AClass: TClass; const
 function CheckWidget(const Handle: HWND; const AMethodName: String; AParamName: String = ''): Boolean;
 function CheckWidget(const Handle: HWND; const AMethodName: String; AClass: TClass): Boolean;
 
+function RegisterObjectEventHandler(AHandler: TCarbonObjectEventHandlerProc): EventHandlerUPP;
 function RegisterEventHandler(AHandler: TCarbonEventHandlerProc): EventHandlerUPP;
 
 implementation
@@ -291,6 +296,31 @@ begin
   inherited Destroy;
 end;
 
+{------------------------------------------------------------------------------
+  Name:    RegisterObjectEventHandler
+  Params:  AHandler - Carbon object event handler procedure
+  Returns: Event handler UPP
+
+  Registers new carbon object event handler procedure
+ ------------------------------------------------------------------------------}
+function RegisterObjectEventHandler(AHandler: TCarbonObjectEventHandlerProc): EventHandlerUPP;
+var
+  Node: TUPPAVLTreeNode;
+begin
+  if UPPTree = nil then UPPTree := TAVLTree.Create;
+
+  Node := TUPPAVLTreeNode(UPPTree.Find(AHandler));
+  if Node = nil then
+  begin
+    Node := TUPPAVLTreeNode.Create;
+    Node.Data := AHandler;
+    Node.UPP := NewEventHandlerUPP(EventHandlerProcPtr(AHandler));
+    UPPTree.Add(Node);
+  end;
+
+  Result := Node.UPP;
+end;
+
 {------------------------------------------------------------------------------
   Name:    RegisterEventHandler
   Params:  AHandler - Carbon event handler procedure

lcl/interfaces/carbon/carbonmenus.pp

@@ -51,6 +51,9 @@ type
     function GetIndex: Integer;
   protected
     procedure Update;
+    procedure RegisterEvents;
+    procedure Opening;
+    procedure Closed;
   public
     LCLMenuItem: TMenuItem; // LCL menu item which created this widget
     Menu: MenuRef;          // Reference to the Carbon menu
@@ -106,6 +109,42 @@ end;
 
 { TCarbonMenu }
 
+{------------------------------------------------------------------------------
+  Name:  CarbonMenu_Opening
+  Handles menu opening
+ ------------------------------------------------------------------------------}
+function CarbonMenu_Opening(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TObject): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+begin
+  {$IFDEF VerboseMenu}
+    DebugLn('CarbonMenu_Opening');
+  {$ENDIF}
+  
+  if AWidget is TCarbonMenu then
+    (AWidget as TCarbonMenu).Opening;
+
+  Result := CallNextEventHandler(ANextHandler, AEvent);
+end;
+
+{------------------------------------------------------------------------------
+  Name:  CarbonMenu_Closed
+  Handles menu closed
+ ------------------------------------------------------------------------------}
+function CarbonMenu_Closed(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TObject): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+begin
+  {$IFDEF VerboseMenu}
+    DebugLn('CarbonMenu_Closed');
+  {$ENDIF}
+
+  if AWidget is TCarbonMenu then
+    (AWidget as TCarbonMenu).Closed;
+
+  Result := CallNextEventHandler(ANextHandler, AEvent);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonMenu.MenuNeeded
 
@@ -122,6 +161,8 @@ begin
       [LCLMenuItem.Name, LCLMenuItem.ClassName]);
   end;
   
+  RegisterEvents;
+  
   if FParentMenu <> nil then
   begin
     SetCaption(LCLMenuItem.Caption);
@@ -171,6 +212,56 @@ begin
   SetEnable(LCLMenuItem.Enabled);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonMenu.RegisterEvents
+
+  Register menu events
+ ------------------------------------------------------------------------------}
+procedure TCarbonMenu.RegisterEvents;
+var
+  TmpSpec: EventTypeSpec;
+begin
+  {$IFDEF VerboseMenu}
+    DebugLn('TCarbonMenu.RegisterEvents ' + LCLMenuItem.Name);
+  {$ENDIF}
+  
+  TmpSpec := MakeEventSpec(kEventClassMenu, kEventMenuOpening);
+  InstallMenuEventHandler(Menu, RegisterObjectEventHandler(@CarbonMenu_Opening),
+    1, @TmpSpec, Pointer(Self), nil);
+
+  TmpSpec := MakeEventSpec(kEventClassMenu, kEventMenuClosed);
+  InstallMenuEventHandler(Menu, RegisterObjectEventHandler(@CarbonMenu_Closed),
+    1, @TmpSpec, Pointer(Self), nil);
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonMenu.Opening
+ ------------------------------------------------------------------------------}
+procedure TCarbonMenu.Opening;
+var
+  Msg: TLMessage;
+begin
+  {$IFDEF VerboseMenu}
+    DebugLn('TCarbonMenu.Opening ' + LCLMenuItem.Name);
+  {$ENDIF}
+  
+  // menu item has sub menu - call click when opening
+  if LCLMenuItem.IsInMenuBar or (LCLMenuItem.Count > 0) then
+  begin
+    FillChar(Msg, SizeOf(Msg), 0);
+    Msg.msg := LM_ACTIVATE;
+    LCLMenuItem.Dispatch(Msg);
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonMenu.Closed
+ ------------------------------------------------------------------------------}
+procedure TCarbonMenu.Closed;
+begin
+  //DebugLn('TCarbonMenu.Closed');
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonMenu.Create
   Params:  AMenuItem - LCL Menu item to create

lcl/interfaces/carbon/carbonobject.inc

@@ -195,6 +195,7 @@ begin
         {$ENDIF}
         if CarbonMenu <> nil then
         begin
+          FillChar(Msg, SizeOf(Msg), 0);
           Msg.msg := LM_ACTIVATE;
           CarbonMenu.LCLMenuItem.Dispatch(Msg);
           

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -376,10 +376,11 @@ begin
     DebugLn('CarbonCommon_GetNextFocusCandidate: ', DbgSName(AWidget.LCLObject));
   {$ENDIF}
   //Result := CallNextEventHandler(ANextHandler, AEvent);
-  
+
+  StartControl := nil;
   if OSError(GetEventParameter(AEvent, kEventParamStartControl, typeControlRef,
       nil, SizeOf(ControlRef), nil, @StartControl), SName, SGetEvent,
-    'kEventParamStartControl') then Exit;
+    'kEventParamStartControl', eventParameterNotFoundErr) then Exit;
     
   if OSError(
     GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,
@@ -388,8 +389,21 @@ begin
   TabIndex := 0;
   TabList := TFPList.Create;
   try
-    (AWidget.LCLObject.GetTopParent as TWinControl).GetTabOrderList(TabList);
-    AControl := GetCarbonWidget(StartControl);
+    if StartControl <> nil then
+    begin
+      AControl := GetCarbonWidget(StartControl);
+      (AWidget.LCLObject.GetTopParent as TWinControl).GetTabOrderList(TabList);
+    end
+    else
+    begin
+      AControl := AWidget;
+      (AWidget.LCLObject as TWinControl).GetTabOrderList(TabList);
+      if TabList.Count = 0 then
+      begin
+        TabList.Free;
+        (AWidget.LCLObject.GetTopParent as TWinControl).GetTabOrderList(TabList);
+      end;
+    end;
     
     if AControl <> nil then
     begin
@@ -407,7 +421,9 @@ begin
           if TabIndex < 0 then TabIndex := TabList.Count - 1;
         end;
       end
-      else TabIndex := 0;
+      else
+        if FocusPart = kControlFocusNextPart then TabIndex := 0
+        else TabIndex := TabList.Count - 1;
     end;
     
     if TabIndex < TabList.Count then

lcl/interfaces/carbon/carbonutils.pas

@@ -48,6 +48,9 @@ function MakeEventSpec(AClass, AKind: UInt32): EventTypeSpec; //inline;
 function MakeFourCC(AFourCC: TFourCC): FourCharCode; //inline;
 
 // Some missing macros (params differ)
+function InstallMenuEventHandler(inMenu: MenuRef;
+  inHandler: EventHandlerUPP; inNumTypes: UInt32; inList: EventTypeSpecPtr;
+  inUserData: Pointer; outRef: EventHandlerRefPtr): Boolean;
 function InstallControlEventHandler(inControl: ControlRef;
   inHandler: EventHandlerUPP; inNumTypes: UInt32; inList: EventTypeSpecPtr;
   inUserData: Pointer; outRef: EventHandlerRefPtr): Boolean;
@@ -111,6 +114,27 @@ begin
   Result := FourCharCode(AFourCC);
 end;
 
+{------------------------------------------------------------------------------
+  Name:    InstallMenuEventHandler
+  Params:  inMenu     - Event target menu
+           inHandler  - Event handler
+           inNumTypes - Count of event types in list
+           inList     - The list of event types
+           inUserData - User data passed to handler
+           outRef     - Reference to handler for disposing
+  Returns: If the function succeeds
+
+  Installs the handler for the specified event types on the menu
+ ------------------------------------------------------------------------------}
+function InstallMenuEventHandler(inMenu: MenuRef; inHandler: EventHandlerUPP;
+  inNumTypes: UInt32; inList: EventTypeSpecPtr; inUserData: Pointer;
+  outRef: EventHandlerRefPtr): Boolean;
+begin
+  Result := not OSError(
+    InstallEventHandler(GetMenuEventTarget(inMenu), inHandler, inNumTypes,
+      inList, inUserData, outRef), 'InstallMenuEventHandler', SInstallEvent);
+end;
+
 {------------------------------------------------------------------------------
   Name:    InstallControlEventHandler
   Params:  inControl  - Event target control