1 { $Id: Cocoawsmenus.pp 15309 2008-06-04 22:12:59Z vincents $}
2 {
3  *****************************************************************************
4  *                               CocoaWSMenus.pp                             *
5  *                               ------------                                *
6  *                                                                           *
7  *                                                                           *
8  *****************************************************************************
9 
10  *****************************************************************************
11   This file is part of the Lazarus Component Library (LCL)
12 
13   See the file COPYING.modifiedLGPL.txt, included in this distribution,
14   for details about the license.
15  *****************************************************************************
16 }
17 unit CocoaWSMenus;
18 
19 {$mode objfpc}{$H+}
20 {$modeswitch objectivec2}
21 {$include cocoadefines.inc}
22 
23 interface
24 
25 uses
26   // Libs
27   CocoaAll,
28   MacOSAll,
29   // RTL
30   sysutils,
31   // LCL
32   Controls, Forms, Menus, Graphics, LCLType, LMessages, LCLProc, Classes,
33   LCLMessageGlue, LCLStrConsts,
34   // Widgetset
35   WSMenus, WSLCLClasses,
36   // LCL Cocoa
37   Cocoa_extra,
38   CocoaPrivate, CocoaWSCommon, CocoaUtils, CocoaGDIObjects;
39 
40 type
41 
42   IMenuItemCallback = interface(ICommonCallBack)
43     procedure ItemSelected;
MenuItemTargetnull44     function MenuItemTarget: TMenuItem;
45   end;
46 
47   { TLCLMenuItemCallback }
48 
49   TLCLMenuItemCallback = class(TLCLCommonCallback, IMenuItemCallback)
50   private
51     FMenuItemTarget: TMenuItem;
52   public
53     constructor Create(AOwner: NSObject; AMenuItemTarget: TMenuItem); reintroduce;
54     procedure ItemSelected;
MenuItemTargetnull55     function MenuItemTarget: TMenuItem;
56   end;
57 
58   TCocoaMenuItem = objcclass;
59 
60   { TCocoaMenu }
61 
62   TCocoaMenu = objcclass(NSMenu)
63   private
64     appleMenu: TCocoaMenuItem;
65     attachedAppleMenu: Boolean;
66     isKeyEq: Boolean;
67   public
68     procedure lclItemSelected(sender: id); message 'lclItemSelected:';
69     procedure createAppleMenu(); message 'createAppleMenu';
70     procedure overrideAppleMenu(AItem: TCocoaMenuItem); message 'overrideAppleMenu:';
71     procedure attachAppleMenu(); message 'attachAppleMenu';
performKeyEquivalentnull72     function performKeyEquivalent(theEvent: NSEvent): LCLObjCBoolean; override;
lclIsKeyEquivalentnull73     function lclIsKeyEquivalent: LCLObjCBoolean; message 'lclIsKeyEquivalent';
74   end;
75 
76   { TCocoaMenuItem }
77 
78   TCocoaMenuItem = objcclass(NSMenuItem, NSMenuDelegateProtocol)
79   public
80     menuItemCallback: IMenuItemCallback;
81     attachedAppleMenuItems: Boolean;
82     FMenuItemTarget: TMenuItem;
83     procedure UncheckSiblings(AIsChangingToChecked: LCLObjCBoolean = False); message 'UncheckSiblings:';
GetMenuItemHandlenull84     function GetMenuItemHandle(): TMenuItem; message 'GetMenuItemHandle';
85     procedure lclItemSelected(sender: id); message 'lclItemSelected:';
lclGetCallbacknull86     function lclGetCallback: IMenuItemCallback; override;
87     procedure lclClearCallback; override;
88     procedure attachAppleMenuItems(); message 'attachAppleMenuItems';
isValidAppleMenunull89     function isValidAppleMenu(): LCLObjCBoolean; message 'isValidAppleMenu';
90     // menuWillOpen cannot be used. Because it SHOULD NOT change the contents
91     // of the menu. While LCL allows to modify the menu contents when the submenu
92     // is about to be activated.
93     procedure menuNeedsUpdate(AMenu: NSMenu); message 'menuNeedsUpdate:';
94     //procedure menuDidClose(AMenu: NSMenu); message 'menuDidClose:';
worksWhenModalnull95     function worksWhenModal: LCLObjCBoolean; message 'worksWhenModal';
96   end;
97 
98   TCocoaMenuItem_HideApp = objcclass(NSMenuItem)
99   public
100     procedure lclItemSelected(sender: id); message 'lclItemSelected:';
101   end;
102 
103   TCocoaMenuItem_HideOthers = objcclass(NSMenuItem)
104   public
105     procedure lclItemSelected(sender: id); message 'lclItemSelected:';
106   end;
107 
108   TCocoaMenuItem_ShowAllApp = objcclass(NSMenuItem)
109   public
110     procedure lclItemSelected(sender: id); message 'lclItemSelected:';
111   end;
112 
113   TCocoaMenuItem_Quit = objcclass(NSMenuItem)
114   public
115     procedure lclItemSelected(sender: id); message 'lclItemSelected:';
116   end;
117 
118   { TCocoaWSMenuItem }
119 
120   TCocoaWSMenuItem = class(TWSMenuItem)
121   private
122     class procedure Do_SetCheck(const ANSMenuItem: NSMenuItem; const Checked: boolean);
123     // used from the MenuMadness example
NSMenuCheckmarknull124     class function NSMenuCheckmark: NSImage;
NSMenuRadionull125     class function NSMenuRadio: NSImage;
isSeparatornull126     class function isSeparator(const ACaption: AnsiString): Boolean;
127   published
128     class procedure AttachMenu(const AMenuItem: TMenuItem); override;
CreateHandlenull129     class function  CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
130     class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
131     class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
132     class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override;
133     class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
SetChecknull134     class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
SetEnablenull135     class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
SetRadioItemnull136     class function SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; override;
SetRightJustifynull137     //class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
138     class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: TBitmap); override;
139   end;
140 
141   { TCocoaWSMenu }
142 
143   TCocoaWSMenu = class(TWSMenu)
144   published
CreateHandlenull145     class function CreateHandle(const AMenu: TMenu): HMENU; override;
146   end;
147 
148   { TCocoaWSMainMenu }
149 
150   TCocoaWSMainMenu = class(TWSMainMenu)
151   published
CreateHandlenull152     class function CreateHandle(const AMenu: TMenu): HMENU; override;
153   end;
154 
155   { TCocoaWSPopupMenu }
156 
157   TCocoaWSPopupMenu = class(TWSPopupMenu)
158   published
159     class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: Integer); override;
160   end;
161 
162 procedure NSMenuItemSetBitmap(mn: NSMenuItem; bmp: TBitmap);
163 
164 // the returned "Key" should not be released, as it's not memory owned
165 procedure ShortcutToKeyEquivalent(const AShortCut: TShortcut; out Key: NSString; out shiftKeyMask: NSUInteger);
166 
167 // returns the last state the menu was at
168 function ToggleAppMenu(ALogicalEnabled: Boolean): Boolean;
169 
170 function AllocCocoaMenu(const atitle: string = ''): TCocoaMenu;
171 function LCLMenuItemInit(item: NSMenuItem; const atitle: string; ashortCut: TShortCut): id;
172 function LCLMenuItemInit(item: NSMenuItem; const atitle: string; VKKey: Word = 0; State: TShiftState = []): id;
173 
174 implementation
175 
176 uses
177   CocoaInt;
178 
179 function LCLMenuItemInit(item: NSMenuItem; const atitle: string; ashortCut: TShortCut): id;
180 var
181   key   : NSString;
182   mask  : NSUInteger;
183 begin
184   ShortcutToKeyEquivalent(ashortCut, key, mask);
185 
186   Result := item.initWithTitle_action_keyEquivalent(
187     ControlTitleToNSStr(Atitle),
188     objcselector('lclItemSelected:'), // Selector is Hard-coded, that's why it's LCLMenuItemInit
189     key);
190   NSMenuItem(Result).setKeyEquivalentModifierMask(mask);
191   NSMenuItem(Result).setTarget(Result);
192 end;
193 
194 function LCLMenuItemInit(item: NSMenuItem; const atitle: string; VKKey: Word; State: TShiftState): id;
195 var
196   key   : NSString;
197   mask  : NSUInteger;
198 begin
199   Result := LCLMenuItemInit(item, atitle, ShortCut(VKKey, State));
200 end;
201 
202 function AllocCocoaMenu(const atitle: string = ''): TCocoaMenu;
203 begin
204   Result := TCocoaMenu.alloc.initWithTitle(ControlTitleToNSStr(atitle));
205   Result.setAutoenablesItems(false);
206 end;
207 
208 { TCocoaMenuItem_ShowAllApp }
209 
210 procedure TCocoaMenuItem_ShowAllApp.lclItemSelected(sender: id);
211 begin
212   NSApplication(NSApp).unhideAllApplications(sender);
213 end;
214 
215 { TLCLMenuItemCallback }
216 
217 constructor TLCLMenuItemCallback.Create(AOwner: NSObject; AMenuItemTarget: TMenuItem);
218 begin
219   Owner := AOwner;
220   FMenuItemTarget := AMenuItemTarget;
221 end;
222 
223 procedure TLCLMenuItemCallback.ItemSelected;
224 var
225   Msg:TLMessage;
226 begin
227   FillChar(Msg{%H-}, SizeOf(Msg), 0);
228   Msg.msg := LM_ACTIVATE;
229   // debugln('send LM_Activate');
230   LCLMessageGlue.DeliverMessage(FMenuItemTarget,Msg);
231 end;
232 
MenuItemTargetnull233 function TLCLMenuItemCallback.MenuItemTarget: TMenuItem;
234 begin
235   Result:=FMenuItemTarget;
236 end;
237 
238 { TCocoaMenu }
239 
240 procedure TCocoaMenu.lclItemSelected(sender:id);
241 begin
242 
243 end;
244 
245 // For when there is no menu item with title 
246 procedure TCocoaMenu.createAppleMenu();
247 var
248   nskey, nstitle, nssubmeykey: NSString;
249   lNSSubmenu: NSMenu;
250 begin
251   // create the menu item
252   nstitle := NSStringUtf8('');
253   appleMenu := TCocoaMenuItem.alloc.initWithTitle_action_keyEquivalent(nstitle,
254     objcselector('lclItemSelected:'), NSString.string_);
255   nstitle.release;
256 
257   // add the submenu
258   lNSSubmenu := NSMenu.alloc.initWithTitle(NSString.string_);
259   appleMenu.setSubmenu(lNSSubmenu);
260 
261   appleMenu.attachAppleMenuItems();
262 end;
263 
264 // For when there is a menu item with title 
265 procedure TCocoaMenu.overrideAppleMenu(AItem: TCocoaMenuItem);
266 begin
267   if appleMenu <> nil then
268   begin
269     if indexOfItem(appleMenu) >= 0 then
270       removeItem(appleMenu);
271     appleMenu.release;
272     appleMenu := nil;
273   end;
274   attachedAppleMenu := False;
275   AItem.attachAppleMenuItems();
276 end;
277 
278 procedure TCocoaMenu.attachAppleMenu();
279 begin
280   if attachedAppleMenu then Exit;
281   if appleMenu = nil then Exit;
282   attachedAppleMenu := True;
283   insertItem_atIndex(appleMenu, 0);
284 end;
285 
performKeyEquivalentnull286 function TCocoaMenu.performKeyEquivalent(theEvent: NSEvent): LCLObjCBoolean;
287 var
288   OldKeyEq: boolean;
289 begin
290   OldKeyEq:=isKeyEq;
291   isKeyEq := true;
292   try
293     Result := inherited performKeyEquivalent(theEvent);
294   finally
295     isKeyEq := OldKeyEq;
296   end;
297 end;
298 
lclIsKeyEquivalentnull299 function TCocoaMenu.lclIsKeyEquivalent: LCLObjCBoolean;
300 begin
301   Result := isKeyEq;
302 end;
303 
304 { TCocoaMenuITem }
305 
306 procedure TCocoaMenuItem.UncheckSiblings(AIsChangingToChecked: LCLObjCBoolean);
307 var
308   i: Integer;
309   lMenuItem, lSibling, lParentMenu: TMenuItem;
310   lSiblingHandle: NSMenuItem;
311 begin
312   //lMenuItem := GetMenuItemHandle();
313   lMenuItem := FMenuItemTarget;
314   if lMenuItem = nil then Exit;
315   if not lMenuItem.RadioItem then Exit;
316   if (not AIsChangingToChecked) and (not lMenuItem.Checked) then Exit;
317   lParentMenu := lMenuItem.Parent;
318   if lParentMenu = nil then Exit;
319   for i := 0 to lParentMenu.Count - 1 do
320   begin
321     lSibling := lParentMenu.Items[i];
322     if lSibling = nil then Continue;
323     if lSibling = lMenuItem then Continue;
324 
325     if lSibling.RadioItem and (lSibling.GroupIndex = lMenuItem.GroupIndex) and
326       lSibling.HandleAllocated() then
327     begin
328       lSiblingHandle := NSMenuItem(lSibling.Handle);
329       TCocoaWSMenuItem.Do_SetCheck(lSiblingHandle, False);
330     end;
331   end;
332 end;
333 
GetMenuItemHandlenull334 function TCocoaMenuItem.GetMenuItemHandle(): TMenuItem;
335 begin
336   Result := nil;
337   if menuItemCallback = nil then Exit;
338   Result := menuItemCallback.MenuItemTarget;
339 end;
340 
341 procedure TCocoaMenuItem.lclItemSelected(sender:id);
342 begin
343   menuItemCallback.ItemSelected;
344   UncheckSiblings();
345 end;
346 
lclGetCallbacknull347 function TCocoaMenuItem.lclGetCallback: IMenuItemCallback;
348 begin
349   result:=menuItemCallback;
350 end;
351 
352 procedure TCocoaMenuItem.lclClearCallback;
353 begin
354   menuItemCallback := nil;
355 end;
356 
357 procedure TCocoaMenuItem.attachAppleMenuItems();
358 var
359   item    : NSMenuItem;
360 begin
361   if attachedAppleMenuItems then Exit;
362   if not hasSubmenu() then Exit;
363 
364   // Separator
365   submenu.insertItem_atIndex(NSMenuItem.separatorItem, submenu.itemArray.count);
366 
367   // Services
368   item := LCLMenuItemInit( TCocoaMenuItem.alloc, rsMacOSMenuServices);
369   item.setTarget(nil);
370   item.setAction(nil);
371   submenu.insertItem_atIndex(item, submenu.itemArray.count);
372   item.setSubmenu(NSMenu.alloc.initWithTitle( ControlTitleToNSStr(rsMacOSMenuServices)));
373   NSApplication(NSApp).setServicesMenu(item.submenu);
374 
375   // Separator
376   submenu.insertItem_atIndex(NSMenuItem.separatorItem, submenu.itemArray.count);
377 
378   // Hide App     Meta-H
379   item := LCLMenuItemInit( TCocoaMenuItem_HideApp.alloc, Format(rsMacOSMenuHide, [Application.Title]), VK_H, [ssMeta]);
380   submenu.insertItem_atIndex(item, submenu.itemArray.count);
381 
382   // Hide Others  Meta-Alt-H
383   item := LCLMenuItemInit( TCocoaMenuItem_HideOthers.alloc, rsMacOSMenuHideOthers, VK_H, [ssMeta, ssAlt]);
384   submenu.insertItem_atIndex(item, submenu.itemArray.count);
385 
386   // Show All
387   item := LCLMenuItemInit( TCocoaMenuItem_ShowAllApp.alloc, rsMacOSMenuShowAll);
388   submenu.insertItem_atIndex(item, submenu.itemArray.count);
389 
390   // Separator
391   submenu.insertItem_atIndex(NSMenuItem.separatorItem, submenu.itemArray.count);
392 
393   // Quit   Meta-Q
394   item := LCLMenuItemInit( TCocoaMenuItem_Quit.alloc, Format(rsMacOSMenuQuit, [Application.Title]), VK_Q, [ssMeta]);
395   submenu.insertItem_atIndex(item, submenu.itemArray.count);
396 
397   attachedAppleMenuItems := True;
398 end;
399 
isValidAppleMenunull400 function TCocoaMenuItem.isValidAppleMenu(): LCLObjCBoolean;
401 begin
402   Result := hasSubmenu() and (submenu() <> nil);
403   Result := Result and ('' = NSStringToString(title));
404 end;
405 
406 procedure TCocoaMenuItem.menuNeedsUpdate(AMenu: NSMenu);
407 begin
408   if not Assigned(menuItemCallback) then Exit;
409   if (menu.isKindOfClass(TCocoaMenu)) then
410   begin
411     // Issue #37789
412     // Cocoa tries to find, if there's a menu with the key event
413     // so item is not actually selected yet. Thus should not send ItemSelected
414     if TCocoaMenu(menu).lclIsKeyEquivalent then
415       Exit;
416   end;
417 
418   //todo: call "measureItem"
419   menuItemCallback.ItemSelected;
420 end;
421 
worksWhenModalnull422 function TCocoaMenuItem.worksWhenModal: LCLObjCBoolean;
423 begin
424   // refer to NSMenuItem.target (Apple) documentation
425   // the method must be implemented in target and return TRUE
426   // otherwise it won't work for modal!
427   //
428   // The method COULD be used to protect the main menu from being clicked
429   // if a modal window doesn't have a menu.
430   // But LCL disables (is it?) the app menu manually on modal
431   Result := true;
432 end;
433 
434 {  menuDidClose should not change the structure of the menu.
435    The restructuring is causing issues on Apple's special menus (i.e. HELP menu)
436    See bug #35625
437 
438 procedure TCocoaMenuItem.menuDidClose(AMenu: NSMenu);
439 var
440   par : NSMenu;
441   idx : NSInteger;
442   mn  : NSMenuItem;
443 begin
444   // the only purpose of this code is to "invalidate" the submenu of the item.
445   // an invalidated menu will call menuNeedsUpdate.
446   // There's no other way in Cocoa to do the "invalidate"
447   par := amenu.supermenu;
448   if Assigned(par) then
449   begin
450     idx := par.indexOfItemWithSubmenu(AMenu);
451     if idx<>NSNotFound then
452     begin
453       mn := par.itemAtIndex(idx);
454       mn.setSubmenu(nil);
455       mn.setSubmenu(AMenu);
456     end;
457   end;
458 end;
459 }
460 
461 procedure TCocoaMenuItem_HideApp.lclItemSelected(sender: id);
462 begin
463   // Applicaiton.Minimize, calls WidgetSet.AppMinimize;
464   // which calls NSApplication.hide() anyway
465   Application.Minimize;
466 end;
467 
468 procedure TCocoaMenuItem_HideOthers.lclItemSelected(sender: id);
469 begin
470   NSApplication(NSApp).hideOtherApplications(sender);
471 end;
472 
473 procedure TCocoaMenuItem_Quit.lclItemSelected(sender: id);
474 begin
475   {$ifdef COCOALOOPHIJACK}
476   // see bug #36265. if hot-key (Cmd+Q) is used the menu item
477   // would be called once. 1) in LCL controlled loop 2) after the loop finished
478   // The following if statement prevents "double" form close
479   if LoopHiJackEnded then Exit;
480   {$endif}
481   // Should be used instead of Application.Terminate to allow events to be sent, see bug 32148
482   Application.MainForm.Close;
483 end;
484 
485 { TCocoaWSMenu }
486 
487 {------------------------------------------------------------------------------
488   Method:  TCocoaWSMenu.CreateHandle
489   Params:  AMenu - LCL menu
490   Returns: Handle to the menu in Cocoa interface
491 
492   Creates new menu in Cocoa interface
493  ------------------------------------------------------------------------------}
TCocoaWSMenu.CreateHandlenull494 class function TCocoaWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
495 begin
496   //WriteLn(':>[TCocoaWSMenu.CreateHandle]');
497   Result := HMENU(AllocCocoaMenu);
498 end;
499 
500 { TCocoaWSMainMenu }
501 
TCocoaWSMainMenu.CreateHandlenull502 class function TCocoaWSMainMenu.CreateHandle(const AMenu: TMenu): HMENU;
503 begin
504   Result := HMENU(AllocCocoaMenu);
505   TCocoaMenu(Result).createAppleMenu();
506 end;
507 
508 { TCocoaWSMenuItem }
509 
510 class procedure TCocoaWSMenuItem.Do_SetCheck(const ANSMenuItem: NSMenuItem; const Checked: boolean);
511 const
512   menustate : array [Boolean] of NSInteger = (NSOffState, NSOnState);
513 begin
514   ANSMenuItem.setState( menustate[Checked] );
515 end;
516 
517 // used from the MenuMadness example
TCocoaWSMenuItem.NSMenuCheckmarknull518 class function TCocoaWSMenuItem.NSMenuCheckmark: NSImage;
519 begin
520   Result:=NSImage.imageNamed(NSStringUtf8('NSMenuCheckmark'));
521 end;
522 
TCocoaWSMenuItem.NSMenuRadionull523 class function TCocoaWSMenuItem.NSMenuRadio: NSImage;
524 begin
525   Result:=NSImage.imageNamed(NSStringUtf8('NSMenuRadio'))
526 end;
527 
TCocoaWSMenuItem.isSeparatornull528 class function TCocoaWSMenuItem.isSeparator(const ACaption: AnsiString): Boolean;
529 begin
530   Result:=ACaption='-';
531 end;
532 
533 {------------------------------------------------------------------------------
534   Method:  TCocoaWSMenuItem.AttachMenu
535   Params:  AMenuItem - LCL menu item
536 
537   Attaches menu item to its parent menu in Cocoa interface
538  ------------------------------------------------------------------------------}
539 class procedure TCocoaWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
540 var
541   ParObj  : NSObject;
542   Parent  : TCocoaMenu;
543   item    : NSMenuItem;
544   MenuObj : NSObject;
545   Menu    : NSMenu;
546   idx     : Integer;
547 begin
548   if not Assigned(AMenuItem) or (AMenuItem.Handle=0) or not Assigned(AMenuItem.Parent) or (AMenuItem.Parent.Handle=0) then Exit;
549   ParObj:=NSObject(AMenuItem.Parent.Handle);
550   item:=NSMenuItem(AMenuItem.Handle);
551 
552   if ParObj.isKindOfClass(NSMenuItem) then
553   begin
554     if not NSMenuItem(ParObj).hasSubmenu then
555     begin
556       Parent := AllocCocoaMenu(AMenuItem.Parent.Caption);
557       Parent.setDelegate(TCocoaMenuItem(ParObj));
558       NSMenuItem(ParObj).setSubmenu(Parent);
559 
560       // no longer respond to clicks. LCL might still need to get an event
561       // yet the menu should not close
562       NSMenuItem(ParObj).setAction(nil);
563     end
564     else
565       Parent:=TCocoaMenu(NSMenuItem(ParObj).submenu);
566   end else if ParObj.isKindOfClass(NSMenu) then
567     Parent:=TCocoaMenu(ParObj)
568   else
569     Exit;
570 
571   item := nil;
572   MenuObj := NSObject(AMenuItem.Handle);
573   if MenuObj.isKindOfClass(NSMenuItem) then
574     item := NSMenuItem(MenuObj)
575   else if MenuObj.isKindOfClass(NSMenu) then
576   begin
577     Menu := NSMenu(MenuObj);
578     item := NSMenuItem(NSMenuItem.alloc).initWithTitle_action_keyEquivalent(
579       ControlTitleToNSStr(AMenuItem.Caption), nil, NSString.string_ );
580     item.setSubmenu( Menu );
581   end;
582 
583   if Assigned(item) then
584   begin
585     idx := AMenuItem.MenuVisibleIndex;
586     if idx < 0 then idx := Parent.numberOfItems;
587     Parent.insertItem_atIndex(NSMenuItem(item), idx)
588   end;
589 end;
590 
591 {------------------------------------------------------------------------------
592   Method:  TCocoaWSMenuItem.CreateHandle
593   Params:  AMenuItem - LCL menu item
594   Returns: Handle to the menu item in Cocoa interface
595 
596   Creates new menu item in Cocoa interface
597  ------------------------------------------------------------------------------}
TCocoaWSMenuItem.CreateHandlenull598 class function TCocoaWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
599 var
600   item    : NSMenuItem;
601   ANSMenu : NSMenu;
602 begin
603   if not Assigned(AMenuItem) then
604   begin
605     Result:=0;
606     Exit;
607   end;
608 
609   // A handle of TMenu.fItems (TMenuItem) could be recreated.
610   // in this case LCL calls TCocoaWSMenuItem.CreateHandle
611   // instead of the proper owner.
612   if (AMenuItem.Owner is TMainMenu) and (TMainMenu(AMenuItem.Owner).Items = AMenuItem) then begin
613     Result:=TCocoaWSMainMenu.CreateHandle(TMenu(AMenuItem.Owner));
614     Exit;
615   end else if (AMenuItem.Owner is TMenu) and (TMenu(AMenuItem.Owner).Items = AMenuItem) then begin
616     Result:=TCocoaWSMenu.CreateHandle(TMenu(AMenuItem.Owner));
617     Exit;
618   end;
619 
620   if AMenuItem.Caption = '-' then
621   begin
622     item := NSMenuItem.separatorItem;
623   end
624   else
625   begin
626     item := LCLMenuItemInit(TCocoaMenuItem.alloc, AMenuItem.Caption, AMenuItem.ShortCut);
627     TCocoaMenuItem(item).FMenuItemTarget := AMenuItem;
628 
629     if AMenuItem.IsInMenuBar then
630     begin
631       ANSMenu := AllocCocoaMenu(AMenuItem.Caption);
632       ANSMenu.setDelegate(TCocoaMenuItem(item));
633       item.setSubmenu(ANSMenu);
634     end;
635 
636     TCocoaMenuItem(item).menuItemCallback:=TLCLMenuItemCallback.Create(item, AMenuItem);
637 
638     // initial set of properties
639     {$ifdef BOOLFIX}
640     item.setEnabled_(Ord(AMenuItem.Enabled));
641     {$else}
642     item.setEnabled(AMenuItem.Enabled);
643     {$endif}
644 
645     if AMenuItem.RadioItem then
646       item.setOnStateImage( NSMenuRadio )
647     else
648       item.setOnStateImage(NSMenuCheckmark);
649 
650     Do_SetCheck(item, AMenuItem.Checked);
651 
652     if AMenuItem.HasIcon and ((AMenuItem.ImageIndex>=0) or (AMenuItem.HasBitmap)) then
653       NSMenuItemSetBitmap(item, AMenuItem.Bitmap);
654   end;
655 
656   Result:=HMENU(item);
657 end;
658 
659 {------------------------------------------------------------------------------
660   Method:  TCocoaWSMenuItem.DestroyHandle
661   Params:  AMenuItem - LCL menu item
662 
663   Destroys menu item in Cocoa interface
664  ------------------------------------------------------------------------------}
665 class procedure TCocoaWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
666 var
667   callback: IMenuItemCallback;
668   callbackObject: TObject;
669   item     : NSObject;
670   menuitem : TCocoaMenuItem;
671   nsitem   : NSMenuItem;
672 begin
673   item:=NSObject(AMenuItem.Handle);
674   if item.isKindOfClass_(TCocoaMenuItem) then
675   begin
676     menuitem := TCocoaMenuItem(item);
677     callback := menuitem.lclGetCallback;
678     if Assigned(callback) then
679     begin
680       callbackObject := callback.GetCallbackObject;
681       callback := nil;
682       menuitem.lclClearCallback;
683       callbackObject.Free;
684     end;
685     if Assigned(menuitem.menu) then
686       menuitem.menu.removeItem(menuitem);
687     AMenuItem.Handle := 0;
688     menuitem.release; // TCocoaMenuItems are "alloced" - thus should be released;
689   end else if item.isKindOfClass_(NSMenuItem) then begin
690     nsitem := NSMenuItem(item);
691     if nsitem.isSeparatorItem and Assigned(nsitem.menu) then
692       nsitem.menu.removeItem(nsitem);
693     // separator items are not "alloced", thus should not be released
694   end;
695 
696 end;
697 
698 {------------------------------------------------------------------------------
699   Method:  TCocoaWSMenuItem.SetCaption
700   Params:  AMenuItem - LCL menu item
701            ACaption  - Menu item caption
702 
703   Sets the caption of menu item in Cocoa interface
704  ------------------------------------------------------------------------------}
705 class procedure TCocoaWSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
706 var
707   ns : NSString;
708   s: string;
709 begin
710   if not Assigned(AMenuItem) or (AMenuItem.Handle=0) then Exit;
711   if NSMenuItem(AMenuItem.Handle).isSeparatorItem <> (ACaption='-') then
712     AMenuItem.RecreateHandle
713   else
714   begin
715     s := ACaption;
716     DeleteAmpersands(s);
717     ns:=NSStringUtf8(s);
718     NSMenuItem(AMenuItem.Handle).setTitle(ns);
719     if NSMenuItem(AMenuItem.Handle).hasSubmenu then
720       NSMenuItem(AMenuItem.Handle).submenu.setTitle(ns);
721     ns.release;
722   end;
723 end;
724 
725 {------------------------------------------------------------------------------
726   Method:  TCocoaWSMenuItem.SetShortCut
727   Params:  AMenuItem   - LCL menu item
728            ShortCutK1 and ShortCutK2 - New shortcut key1 and key2
729 
730   Sets the shortcut of menu item in Cocoa interface
731  ------------------------------------------------------------------------------}
732 class procedure TCocoaWSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
733   const ShortCutK1, ShortCutK2: TShortCut);
734 var
735   ShiftState: NSUInteger;
736   ns: NSString;
737 begin
738   ShortcutToKeyEquivalent(ShortCutK1, ns, ShiftState);
739   TCocoaMenuItem(AMenuItem.Handle).setKeyEquivalentModifierMask(ShiftState);
740   TCocoaMenuItem(AMenuItem.Handle).setKeyEquivalent(ns);
741 end;
742 
743 {------------------------------------------------------------------------------
744   Method:  TCocoaWSMenuItem.SetVisible
745   Params:  AMenuItem - LCL menu item
746            Visible   - Menu item visibility
747 
748   Sets the visibility of menu item in Cocoa interface
749  ------------------------------------------------------------------------------}
750 class procedure TCocoaWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
751   const Visible: boolean);
752 begin
753   if not Assigned(AMenuItem) or (AMenuItem.Handle=0) then Exit;
754   {$ifdef BOOLFIX}
755   NSMenuItem(AMenuItem.Handle).setHidden_( Ord(not Visible) );
756   {$else}
757   NSMenuItem(AMenuItem.Handle).setHidden( not Visible );
758   {$endif}
759 end;
760 
761 {------------------------------------------------------------------------------
762   Method:  TCocoaWSMenuItem.SetCheck
763   Params:  AMenuItem - LCL menu item
764            Checked   - Menu item checked
765   Returns: If the function succeeds
766 
767   Sets the check of menu item in Cocoa interface
768  ------------------------------------------------------------------------------}
TCocoaWSMenuItem.SetChecknull769 class function TCocoaWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
770   const Checked: boolean): boolean;
771 var
772   lHandle: NSMenuItem;
773   lCocoaHandle: TCocoaMenuItem absolute lHandle;
774 begin
775   Result := Assigned(AMenuItem) and AMenuItem.HandleAllocated() and (AMenuItem.Handle<>0);
776   if not Result then Exit;
777   lHandle := NSMenuItem(AMenuItem.Handle);
778   Result := Result and lHandle.isKindOfClass_(TCocoaMenuItem);
779   if not Result then Exit;
780   TCocoaWSMenuItem.Do_SetCheck(lHandle, Checked);
781   lCocoaHandle.UncheckSiblings(True);
782 end;
783 
784 {------------------------------------------------------------------------------
785   Method:  TCocoaWSMenuItem.SetEnable
786   Params:  AMenuItem - LCL menu item
787            Enabled   - Menu item enabled
788   Returns: If the function succeeds
789 
790   Sets the enabled of menu item in Cocoa interface
791  ------------------------------------------------------------------------------}
TCocoaWSMenuItem.SetEnablenull792 class function TCocoaWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
793   const Enabled: boolean): boolean;
794 begin
795   Result:=Assigned(AMenuItem) and (AMenuItem.Handle<>0);
796   if not Result then Exit;
797   {$ifdef BOOLFIX}
798   NSMenuItem(AMenuItem.Handle).setEnabled_( Ord(Enabled) );
799   {$else}
800   NSMenuItem(AMenuItem.Handle).setEnabled( Enabled );
801   {$endif}
802 end;
803 
804 {------------------------------------------------------------------------------
805   Method:  TCocoaWSMenuItem.SetRadioItem
806   Params:  AMenuItem - LCL menu item
807            RadioItem - Menu item has radio
808   Returns: If the function succeeds
809 
810   Sets the radio behaviour of menu item in Cocoa interface
811  ------------------------------------------------------------------------------}
TCocoaWSMenuItem.SetRadioItemnull812 class function TCocoaWSMenuItem.SetRadioItem(const AMenuItem: TMenuItem;
813   const RadioItem: boolean): boolean;
814 const
815   menustate : array [Boolean] of NSInteger = (NSOffState, NSOnState);
816 begin
817   Result:=Assigned(AMenuItem) and (AMenuItem.Handle<>0);
818   if not Result then Exit;
819   //todo: disable relative radio items
820   if RadioItem then
821     NSMenuItem(AMenuItem.Handle).setOnStateImage( NSMenuRadio )
822   else
823     NSMenuItem(AMenuItem.Handle).setOnStateImage(NSMenuCheckmark);
824 
825   NSMenuItem(AMenuItem.Handle).setState( menustate[RadioItem] );
826 end;
827 
828 procedure NSMenuItemSetBitmap(mn: NSMenuItem; bmp: TBitmap);
829 begin
830   if not Assigned(mn) then Exit;
831   if not Assigned(bmp) or (bmp.Handle = 0) then
832     mn.setImage(nil)
833   else
834     mn.setImage(TCocoaBitmap(bmp.Handle).Image);
835 end;
836 
837 class procedure TCocoaWSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem;
838   const HasIcon: Boolean; const AIcon: TBitmap);
839 var
840   mn : NSMenuItem;
841 begin
842   if not Assigned(AMenuItem) or (AMenuItem.Handle=0) then Exit;
843 
844   if NSObject(AMenuItem.Handle).isKindOfClass(NSMenuItem) then
845     NSMenuItemSetBitmap( NSMenuItem(AMenuItem.Handle), AIcon);
846 end;
847 
848 { TCocoaWSPopupMenu }
849 
850 {------------------------------------------------------------------------------
851   Method:  TCocoaWSPopupMenu.Popup
852   Params:  APopupMenu - LCL popup menu
853            X, Y       - Screen coordinates to popup
854 
855   Popups menu in Cocoa interface
856  ------------------------------------------------------------------------------}
857 class procedure TCocoaWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X,
858   Y: Integer);
859 var
860   res : Boolean;
861   mnu : NSMenuItem;
862   view : NSView;
863   w : NSWindow;
864   px, py: Integer;
865   wi: NSUInteger;
866 begin
867   if Assigned(APopupMenu) and (APopupMenu.Handle<>0) then
868   begin
869     // old method which doesn't consider position but supports 10.0+ (useless since we target 10.6+)
870     {w:=NSApp.keyWindow;
871     if Assigned(w) then
872     begin
873       NSMenu.popUpContextMenu_withEvent_forView( TCocoaMenu(APopupMenu.Handle),
874         NSApp.currentEvent, NSView(w.contentView));
875     end;}
876 
877     // New method for 10.6+
878     px := x;
879     py := y;
880     view := nil;
881     w :=NSApp.keyWindow;
882     if not Assigned(w) and (NSApp.windows.count>0) then
883     begin
884       // in macOS it's possible to "rightclick" without focusing a window
885       // so let's try to find the window
886       for wi := 0 to NSApp.windows.count-1 do
887       begin
888         w := NSWindow(NSApp.windows.objectAtIndex(wi));
889         if not w.isVisible then Continue;
890         view := w.contentView;
891         view.lclScreenToLocal(px, py);
892         if (px >= 0) and (py >= 0)
893           and (px<=Round(view.frame.size.width))
894           and (py<=Round(view.frame.size.height))
895         then
896         begin
897           px := X;
898           py := Y;
899           Break;
900         end;
901         w := nil;
902         px := X;
903         py := Y;
904       end;
905     end;
906 
907     if Assigned(w) then
908     begin
909       view := w.contentView;
910       if Assigned(view) then
911       begin
912         view.lclScreenToLocal(px, py);
913         // have to flip again, because popUpMenuPositioningItem expects point
914         // to be in View coordinates and it does respect Flipped flag
915         if not view.isFlipped then
916           py := Round(view.frame.size.height - py);
917       end;
918     end;
919     res := TCocoaMenu(APopupMenu.Handle).popUpMenuPositioningItem_atLocation_inView(
920       nil, NSMakePoint(px, py), view);
921     APopupMenu.Close; // notify LCL popup menu
922   end;
923 end;
924 
925 procedure ShortcutToKeyEquivalent(const AShortCut: TShortcut; out Key: NSString; out shiftKeyMask: NSUInteger);
926 var
927   w: word;
928   s: TShiftState;
929 begin
930   ShortCutToKey(AShortCut, w, s);
931   key := VirtualKeyCodeToMacString(w);
932   shiftKeyMask := 0;
933   if ssShift in s then
934     ShiftKeyMask := ShiftKeyMask + NSShiftKeyMask;
935   if ssAlt in s then
936     ShiftKeyMask := ShiftKeyMask + NSAlternateKeyMask;
937   if ssCtrl in s then
938     ShiftKeyMask := ShiftKeyMask + NSControlKeyMask;
939   if ssMeta in s then
940     ShiftKeyMask := ShiftKeyMask + NSCommandKeyMask;
941 end;
942 
943 procedure ToggleAppNSMenu(mn: NSMenu; ALogicalEnabled: Boolean);
944 var
945   it  : NSMenuItem;
946   obj : NSObject;
947   enb : Boolean;
948 begin
949   if not Assigned(mn) then Exit;
950   for obj in mn.itemArray do begin
951     if not obj.isKindOfClass(NSMenuItem) then continue;
952     it := NSMenuItem(obj);
953     enb := ALogicalEnabled;
954     if enb and (it.isKindOfClass(TCocoaMenuItem)) then
955     begin
956       enb := not Assigned(TCocoaMenuItem(it).FMenuItemTarget)
957          or ( TCocoaMenuItem(it).FMenuItemTarget.Enabled );
958     end;
959     {$ifdef BOOLFIX}
960     it.setEnabled_( Ord(enb));
961     {$else}
962     it.setEnabled(enb);
963     {$endif}
964     if (it.hasSubmenu) then
965     begin
966       ToggleAppNSMenu(it.submenu, ALogicalEnabled);
967     end;
968   end;
969 end;
970 
971 var
972   isMenuEnabled : Boolean = true;
973 
974 function ToggleAppMenu(ALogicalEnabled: Boolean): Boolean;
975 begin
976   Result := isMenuEnabled;
977   ToggleAppNSMenu( NSApplication(NSApp).mainMenu, ALogicalEnabled );
978   isMenuEnabled := ALogicalEnabled;
979 end;
980 
981 end.
982