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