1 {
2 /***************************************************************************
3 CocoaInt.pas - CocoaInterface Object
4 ----------------------------------------
5
6 Initial Revision : Mon August 6th CST 2004
7
8
9 ***************************************************************************/
10
11 *****************************************************************************
12 This file is part of the Lazarus Component Library (LCL)
13
14 See the file COPYING.modifiedLGPL.txt, included in this distribution,
15 for details about the license.
16 *****************************************************************************
17 }
18
19 unit CocoaInt;
20
21 {$mode objfpc}{$H+}
22 {$modeswitch objectivec1}
23 {$modeswitch objectivec2}
24 {$include cocoadefines.inc}
25
26 interface
27
28 uses
29 // rtl+ftl
30 Types, Classes, SysUtils, Math, contnrs,
31 // carbon bindings
32 MacOSAll,
33 // interfacebase
34 LCLPlatformDef, InterfaceBase, GraphType,
35 // private
36 CocoaAll, CocoaPrivate, CocoaUtils, CocoaGDIObjects,
37 cocoa_extra, CocoaWSMenus, CocoaWSForms, CocoaWindows, CocoaScrollers,
38 CocoaWSClipboard, CocoaTextEdits, CocoaWSCommon,
39 // LCL
40 LCLStrConsts, LMessages, LCLMessageGlue, LCLProc, LCLIntf, LCLType,
41 Controls, Forms, Themes, Menus,
42 IntfGraphics, Graphics, CocoaWSFactory;
43
44 type
45
46 { TCocoaTimerObject }
47
48 TCocoaTimerObject = objcclass(NSObject)
49 func: TWSTimerProc;
50 procedure timerEvent; message 'timerEvent';
newWithFuncnull51 class function newWithFunc(afunc: TWSTimerProc): TCocoaTimerObject; message 'newWithFunc:';
52 end;
53
54 { TAppDelegate }
55
56 TWinLevelOrder = record
57 win : NSWindow;
58 lvl : NSInteger;
59 ord : NSinteger;
60 vis : Boolean;
61 end;
62 PWinLevelOrder = ^TWinLevelOrder;
63 TWinLevelOrderArray = array [Word] of TWinLevelOrder;
64 PWinLevelOrderArray = ^TWinLevelOrderArray;
65
66 TAppDelegate = objcclass(NSObject, NSApplicationDelegateProtocol)
67 public
68 orderArray : PWinLevelOrderArray;
69 orderArrayCount : Integer;
70 procedure application_openFiles(sender: NSApplication; filenames: NSArray);
71 procedure applicationDidHide(notification: NSNotification);
72 procedure applicationDidUnhide(notification: NSNotification);
73 procedure applicationWillBecomeActive(notification: NSNotification);
74 procedure applicationDidBecomeActive(notification: NSNotification);
75 procedure applicationDidResignActive(notification: NSNotification);
76 procedure applicationDidChangeScreenParameters(notification: NSNotification);
77 procedure applicationWillFinishLaunching(notification: NSNotification);
78 procedure handleQuitAppEvent_withReplyEvent(event: NSAppleEventDescriptor; replyEvent: NSAppleEventDescriptor); message 'handleQuitAppEvent:withReplyEvent:';
79 end;
80
81 { TCocoaApplication }
82
83 TCocoaApplication = objcclass(NSApplication)
84 aloop : TApplicationMainLoop;
85 isrun : Boolean;
86 modals : NSMutableDictionary;
87 inputclient : TCocoaInputClient;
88 inputctx : NSTextInputContext;
89
90 procedure dealloc; override;
91 {$ifdef COCOALOOPOVERRIDE}
92 procedure run; override;
93 {$endif}
94 procedure sendEvent(theEvent: NSEvent); override;
nextEventMatchingMask_untilDate_inMode_dequeuenull95 function nextEventMatchingMask_untilDate_inMode_dequeue(mask: NSUInteger; expiration: NSDate; mode: NSString; deqFlag: LCLObjCBoolean): NSEvent; override;
96
runModalForWindownull97 function runModalForWindow(theWindow: NSWindow): NSInteger; override;
98 procedure lclSyncCheck(arg: id); message 'lclSyncCheck:';
99 end;
100
101 { TModalSession }
102
103 TModalSession = class(TObject)
104 window : NSWindow;
105 sess : NSModalSession;
106 // recording menu state for the modality stack
107 // there's no limitation for a modal window to have its own menu
108 // if it override the mainMenu, we still need the information
109 // to restore the previous state of the mainmenu
110 prevMenuEnabled: Boolean;
111 cocoaMenu : NSMenu;
112 lclMenu : TMenu;
113 constructor Create(awin: NSWindow; asess: NSModalSession;
114 APrevMenuEnabled: Boolean;
115 amainmenu: NSMenu; ALCL: TMenu);
116 end;
117
118 { TCocoaWidgetSet }
119
120 TCocoaWidgetSet = class(TWidgetSet)
121 private
122 FTerminating: Boolean;
123 FNSApp: TCocoaApplication;
124 FNSApp_Delegate: TAppDelegate;
125 FCurrentCursor: HCursor;
126 FCaptureControl: HWND;
127
128 protected
129 FStockNullBrush: HBRUSH;
130 FStockBlackBrush: HBRUSH;
131 FStockLtGrayBrush: HBRUSH;
132 FStockGrayBrush: HBRUSH;
133 FStockDkGrayBrush: HBRUSH;
134 FStockWhiteBrush: HBRUSH;
135
136 FStockNullPen: HPEN;
137 FStockBlackPen: HPEN;
138 FStockWhitePen: HPEN;
139 FStockSystemFont: HFONT;
140 FStockFixedFont: HFONT;
141
142 FSysColorBrushes: array[0..MAX_SYS_COLORS] of HBrush;
143
144 // Sandboxing
145 SandboxingOn: Boolean;
146 fClipboard: TCocoaWSClipboard;
147
148 // Clipboard
149
150 // collecting objects that needs to be released AFTER an event
151 // has been processed
152 ToCollect: TList;
153 function RetainToCollect: Integer;
154 procedure ReleaseToCollect(fromIdx: integer);
155
156 procedure SyncClipboard();
157
158 function PromptUser(const DialogCaption, DialogMessage: String;
159 DialogType: longint; Buttons: PLongint; ButtonCount, DefaultIndex,
160 EscapeResult: Longint): Longint; override;
161 function MessageBox(HWnd: HWND; lpText, lpCaption: PChar;
162 uType: Cardinal): Integer; override;
163 function GetAppHandle: THandle; override;
164 function CreateThemeServices: TThemeServices; override;
165
166 procedure SendCheckSynchronizeMessage;
167 procedure OnWakeMainThread(Sender: TObject);
168
169 procedure DoSetMainMenu(AMenu: NSMenu; ALCLMenu: TMenu);
170 public
171 // modal session
172 CurModalForm: NSWindow;
173 Modals : TList;
174 ModalCounter: Integer; // the cheapest way to determine if modal window was called
175 // used in mouse handling (in callbackobject)
176 // Might not be needed, if native Modality used
177 MainMenuEnabled: Boolean; // the latest main menu status
178 PrevMenu : NSMenu;
179 PrevLCLMenu : TMenu;
180 CurLCLMenu: TMenu;
181 PrevMenuEnabled: Boolean; // previous mainmenu status
182
183 constructor Create; override;
184 destructor Destroy; override;
185
186 function LCLPlatform: TLCLPlatform; override;
187
188 procedure AppInit(var ScreenInfo: TScreenInfo); override;
189 procedure AppRun(const ALoop: TApplicationMainLoop); override;
190 procedure AppRunMessages(onlyOne: Boolean; eventExpDate: NSDate);
191 procedure AppWaitMessage; override;
192 procedure AppProcessMessages; override;
193 procedure AppTerminate; override;
194 procedure AppMinimize; override;
195 procedure AppRestore; override;
196 procedure AppBringToFront; override;
197 procedure AppSetIcon(const Small, Big: HICON); override;
198 procedure AppSetTitle(const ATitle: string); override;
199
200 function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override;
201
202 function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; override;
203 function DestroyTimer(TimerHandle: THandle): boolean; override;
204
205 procedure InitStockItems;
206 procedure FreeStockItems;
207 procedure FreeSysColorBrushes;
208
209 procedure SetMainMenu(const AMenu: HMENU; const ALCLMenu: TMenu);
210 function StartModal(awin: NSWindow; hasMenu: Boolean): Boolean;
211 procedure EndModal(awin: NSWindow);
212 function isTopModalWin(awin: NSWindow): Boolean;
213 function isModalSession: Boolean;
214
215 {todo:}
216 function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
217 procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
218 procedure DCRedraw(CanvasHandle: HDC); override;
219 procedure DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean); override;
220 procedure SetDesigning(AComponent: TComponent); override;
221
222 function RawImage_DescriptionFromCocoaBitmap(out ADesc: TRawImageDescription; ABitmap: TCocoaBitmap): Boolean;
223 function RawImage_FromCocoaBitmap(out ARawImage: TRawImage; ABitmap, AMask: TCocoaBitmap; ARect: PRect = nil): Boolean;
224 function RawImage_DescriptionToBitmapType(ADesc: TRawImageDescription; out bmpType: TCocoaBitmapType): Boolean;
225 function GetImagePixelData(AImage: CGImageRef; out bitmapByteCount: PtrUInt): Pointer;
226 class function Create32BitAlphaBitmap(ABitmap, AMask: TCocoaBitmap): TCocoaBitmap;
227 property NSApp: TCocoaApplication read FNSApp;
228 property CurrentCursor: HCursor read FCurrentCursor write FCurrentCursor;
229 property CaptureControl: HWND read FCaptureControl;
230 // the winapi compatibility methods
231 {$I cocoawinapih.inc}
232 // the extra LCL interface methods
233 {$I cocoalclintfh.inc}
234 procedure AddToCollect(obj: TObject);
235 end;
236
237 var
238 CocoaWidgetSet: TCocoaWidgetSet;
239 CocoaBasePPI : Integer = 96; // for compatiblity with LCL 1.8 release. The macOS base is 72ppi
240 MainPool : NSAutoreleasePool = nil;
241
242 // if set to true, then WS would not assign icons via TCocoaWSForm SetIcon
243 // The icon would have to be changed manually. By default LCL behaviour is used
244 CocoaIconUse: Boolean = false;
245 CocoaToggleBezel : NSBezelStyle = NSRoundedBezelStyle;
246 CocoaToggleType : NSButtonType = NSPushOnPushOffButton;
247
248 CocoaHideFocusNoBorder : Boolean = true;
249
250 {$ifdef COCOALOOPHIJACK}
251 // The flag is set to true once hi-jacked loop is finished (at the end of app)
252 // The flag is checked in Menus to avoid "double" Cmd+Q menu
253 LoopHiJackEnded : Boolean = false;
254 {$endif}
255
256 function CocoaScrollBarSetScrollInfo(bar: TCocoaScrollBar; const ScrollInfo: TScrollInfo): Integer;
257 function CocoaScrollBarGetScrollInfo(bar: TCocoaScrollBar; var ScrollInfo: TScrollInfo): Boolean;
258 procedure NSScrollerGetScrollInfo(docSz, pageSz: CGFloat; rl: NSSCroller; Var ScrollInfo: TScrollInfo);
259 procedure NSScrollViewGetScrollInfo(sc: NSScrollView; BarFlag: Integer; Var ScrollInfo: TScrollInfo);
260 procedure NSScrollerSetScrollInfo(docSz, pageSz: CGFloat; rl: NSSCroller; const ScrollInfo: TScrollInfo);
261 procedure NSScrollViewSetScrollPos(sc: NSScrollView; BarFlag: Integer; const ScrollInfo: TScrollInfo);
262
263 function CocoaPromptUser(const DialogCaption, DialogMessage: String;
264 DialogType: longint; Buttons: PLongint; ButtonCount, DefaultIndex,
265 EscapeResult: Longint;
266 sheetOfWindow: NSWindow = nil; modalSheet: Boolean = false): Longint;
267
268 implementation
269
270
271 // NSCursor doesn't support any wait cursor, so we need to use a non-native one
272 // Not supporting it at all would result in crashes in Screen.Cursor := crHourGlass;
273 {$R ../../cursor_hourglass.res}
274
275 uses
276 dl,dynlibs,
277 CocoaCaret,
278 CocoaThemes;
279
CocoaScrollBarSetScrollInfonull280 function CocoaScrollBarSetScrollInfo(bar: TCocoaScrollBar; const ScrollInfo: TScrollInfo): Integer;
281 var
282 pg : Integer;
283 mn : Integer;
284 mx : Integer;
285 dl : Integer;
286 begin
287 if not Assigned(bar) then
288 begin
289 Result := 0;
290 Exit;
291 end;
292
293 if ScrollInfo.fMask and SIF_PAGE>0 then
294 begin
295 pg:=ScrollInfo.nPage;
296 end
297 else pg:=bar.pageInt;
298
299 if ScrollInfo.fMask and SIF_RANGE>0 then
300 begin
301 mn:=ScrollInfo.nMin;
302 mx:=ScrollInfo.nMax;
303 end
304 else
305 begin
306 mn:=bar.minInt;
307 mx:=bar.maxInt;
308 end;
309
310 dl:=mx-mn;
311 {$ifdef BOOLFIX}
312 bar.setEnabled_(Ord(dl<>0));
313 {$else}
314 bar.SetEnabled(dl<>0);
315 {$endif}
316
317 // if changed page or range, the knob changes
318 if ScrollInfo.fMask and (SIF_RANGE or SIF_PAGE)>0 then
319 begin
320 if dl<>0 then
321 bar.setKnobProportion(pg/dl)
322 else
323 bar.setKnobProportion(1);
324 bar.pageInt:=pg;
325 bar.minInt:=mn;
326 bar.maxInt:=mx;
327 end;
328
329 if ScrollInfo.fMask and SIF_POS > 0 then
330 bar.lclSetPos( ScrollInfo.nPos );
331
332 Result:=bar.lclPos;
333 end;
334
CocoaScrollBarGetScrollInfonull335 function CocoaScrollBarGetScrollInfo(bar: TCocoaScrollBar; var ScrollInfo: TScrollInfo): Boolean;
336 var
337 l : integer;
338 begin
339 Result:=Assigned(bar);
340 if not Result then Exit;
341
342 FillChar(ScrollInfo, sizeof(ScrollInfo), 0);
343 ScrollInfo.cbSize:=sizeof(ScrollInfo);
344 ScrollInfo.fMask:=SIF_ALL;
345 ScrollInfo.nMin:=bar.minInt;
346 ScrollInfo.nMax:=bar.maxInt;
347 ScrollInfo.nPage:=bar.pageInt;
348 ScrollInfo.nPos:=bar.lclPos;
349 ScrollInfo.nTrackPos:=ScrollInfo.nPos;
350 Result:=true;
351 end;
352
353 procedure NSScrollerGetScrollInfo(docSz, pageSz: CGFloat; rl: NSSCroller; Var ScrollInfo: TScrollInfo);
354 begin
355 ScrollInfo.cbSize:=sizeof(ScrollInfo);
356 ScrollInfo.fMask:=SIF_ALL;
357 ScrollInfo.nPos:=round(rl.floatValue*(docSz-pageSz));
358 ScrollInfo.nTrackPos:=ScrollInfo.nPos;
359 ScrollInfo.nMin:=0;
360 ScrollInfo.nMax:=round(docSz);
361 ScrollInfo.nPage:=round(rl.knobProportion*docSz);
362 end;
363
364 procedure NSScrollViewGetScrollInfo(sc: NSScrollView; BarFlag: Integer; Var ScrollInfo: TScrollInfo);
365 var
366 ns : NSView;
367 vr : NSRect;
368 begin
369 ns:=sc.documentView;
370 if not Assigned(ns) then begin
371 FillChar(ScrollInfo, sizeof(ScrollInfo),0);
372 ScrollInfo.cbSize:=sizeof(ScrollInfo);
373 Exit;
374 end;
375 vr:=sc.documentVisibleRect;
376 if BarFlag = SB_Vert then
377 NSScrollerGetScrollInfo(ns.frame.size.height, vr.size.height, sc.verticalScroller, ScrollInfo)
378 else
379 NSScrollerGetScrollInfo(ns.frame.size.width, vr.size.width, sc.horizontalScroller, ScrollInfo);
380 end;
381
382 procedure NSScrollerSetScrollInfo(docSz, pageSz: CGFloat; rl: NSSCroller; const ScrollInfo: TScrollInfo);
383 var
384 sz : CGFloat;
385 begin
386 if ScrollInfo.fMask and SIF_POS>0 then begin
387 sz:=docSz-pageSz;
388 if sz=0 then rl.setFloatValue(0)
389 else rl.setFloatValue(ScrollInfo.nPos/sz);
390 end;
391 if ScrollInfo.fMask and SIF_PAGE>0 then begin
392 sz:=docSz-pageSz;
393 if sz=0 then rl.setKnobProportion(1)
394 else rl.setKnobProportion(1/sz);
395 end;
396 end;
397
398 procedure NSScrollViewSetScrollPos(sc: NSScrollView; BarFlag: Integer; const ScrollInfo: TScrollInfo);
399 var
400 ns : NSView;
401 vr : NSRect;
402 begin
403 ns:=sc.documentView;
404 if not Assigned(ns) then Exit;
405
406 vr:=sc.documentVisibleRect;
407 if BarFlag = SB_Vert then
408 begin
409 //NSScrollerSetScrollInfo(ns.frame.size.height, sc.verticalScroller, ScrollInfo)
410 if not sc.documentView.isFlipped then
411 vr.origin.y := sc.documentView.frame.size.height - ScrollInfo.nPos - vr.size.Height
412 else
413 vr.origin.y := ScrollInfo.nPos;
414 end
415 else
416 begin
417 //NSScrollerSetScrollInfo(ns.frame.size.width, sc.horizontalScroller, ScrollInfo);
418 vr.origin.x:=ScrollInfo.nPos;
419 end;
420 ns.scrollRectToVisible(vr);
421 end;
422
423 { TModalSession }
424
425 constructor TModalSession.Create(awin: NSWindow; asess: NSModalSession;
426 APrevMenuEnabled: Boolean; amainmenu: NSMenu; ALCL: TMenu);
427 begin
428 inherited Create;
429 window := awin;
430 sess := asess;
431 prevMenuEnabled := APrevMenuEnabled;
432 cocoaMenu := amainmenu;
433 lclMenu := alcl;
434 end;
435
436 { TCocoaApplication }
437
438 procedure TCocoaApplication.dealloc;
439 begin
440 if Assigned(modals) then modals.release;
441 if Assigned(inputclient) then inputclient.release;
442 inherited dealloc;
443 end;
444
445 {$ifdef COCOALOOPOVERRIDE}
446 procedure TCocoaApplication.run;
447 begin
448 aloop();
449 end;
450 {$endif}
451
452 procedure ForwardMouseMove(app: NSApplication; theEvent: NSEvent);
453 var
454 w : NSWindow;
455 kw : NSWindow;
456 ev : NSEvent;
457 p : NSPoint;
458 wfr : NSRect;
459 begin
460 kw := app.keyWindow;
461
462 // mouse move was consumed by the focused window
463 if Assigned(kw) and NSPointInRect( theEvent.mouseLocation, kw.frame) then
464 Exit;
465
466 for w in app.windows do
467 begin
468 if w = kw then Continue;
469 if not w.isVisible then Continue;
470 // todo: check for enabled windows? modal windows?
471
472 wfr := w.frame;
473 if not NSPointInRect( theEvent.mouseLocation, wfr) then Continue;
474
475 p := theEvent.mouseLocation;
476 p.x := p.x - w.frame.origin.x;
477 p.y := p.y - w.frame.origin.y;
478 ev := NSEvent.mouseEventWithType_location_modifierFlags_timestamp_windowNumber_context_eventNumber_clickCount_pressure(
479 theEvent.type_,
480 p,
481 theEvent.modifierFlags,
482 theEvent.timestamp,
483 w.windowNumber,
484 theEvent.context,
485 theEvent.eventNumber,
486 theEvent.clickCount,
487 theEvent.pressure
488 );
489 w.sendEvent(ev);
490 end;
491 end;
492
493 procedure TCocoaApplication.sendEvent(theEvent: NSEvent);
494 var
495 cb : ICommonCallback;
496 wnd: TCocoaWindow;
497 allowcocoa : Boolean;
498 idx: integer;
499 win : NSWindow;
500 cbnew : ICommonCallback;
501 begin
502 {$ifdef COCOALOOPNATIVE}
503 try
504 {$endif}
505 idx := CocoaWidgetSet.RetainToCollect;
506 win := theEvent.window;
507 if not Assigned(win) then win := self.keyWindow;
508
509 if Assigned(win) then
510 cb := win.firstResponder.lclGetCallback
511 else
512 cb := nil;
513 try
514 if (theEvent.type_ = NSKeyDown) or (theEvent.type_ = NSKeyUp) or
515 (theEvent.type_ = NSFlagsChanged) then begin
516 if Assigned(cb) then
517 begin
518 try
519 if win.isKindOfClass_(TCocoaWindow) then begin
520 wnd := TCocoaWindow(win);
521 wnd._keyEvCallback := cb;
522 end
523 else
524 wnd := nil;
525
526 if (theEvent.type_ = NSKeyDown)
527 and not (win.firstResponder.conformsToProtocol(objcprotocol(NSTextInputClientProtocol))) then
528 begin
529 if not Assigned(inputctx) then
530 begin
531 inputclient := TCocoaInputClient.alloc.init;
532 inputctx := NSTextInputContext.alloc.initWithClient(inputclient);
533 end;
534 inputctx.handleEvent(theEvent);
535 end;
536
537 cb.KeyEvBefore(theEvent, allowcocoa);
538 if allowcocoa then
539 inherited sendEvent(theEvent);
540 cb.KeyEvAfter;
541 finally
542 if Assigned(wnd) then
543 wnd._keyEvCallback := nil;
544 end;
545 Exit;
546 end;
547 end;
548
549 inherited sendEvent(theEvent);
550
551 if (theEvent.type_ = NSMouseMoved) then ForwardMouseMove(Self, theEvent);
552
553 // todo: this should be called for "Default" or "Modal" loops
554 NSApp.updateWindows;
555
556 finally
557
558 // Focus change notification used to be in makeFirstResponder method
559 // However, it caused many issues with infinite loops.
560 // Sometimes Cocoa like to switch focus to window (temporary) (i.e. when switching tabs)
561 // That's causing a conflict with LCL. LCL tries to switch focus back
562 // to the original control. And Cocoa keep switching it back to the Window.
563 // (Note, that for Cocoa, window should ALWAYS be focusable)
564 // Thus, Focus switching notification was moved to post event handling.
565 //
566 // can't have this code in TCocoaWindow, because some key events are not forwarded
567 // to the window
568 cbnew := win.firstResponder.lclGetCallback;
569 if not isCallbackForSameObject(cb, cbnew) then
570 begin
571 if Assigned(cb) then cb.ResignFirstResponder;
572 cbnew := win.firstResponder.lclGetCallback;
573 if Assigned(cbnew) then cbnew.BecomeFirstResponder;
574 end;
575
576 CocoaWidgetSet.ReleaseToCollect(idx);
577 end;
578 {$ifdef COCOALOOPNATIVE}
579 if CocoaWidgetSet.FTerminating then stop(nil);
580 except
581 if CocoaWidgetSet.FTerminating then stop(nil);
582 if Assigned(Application) and Application.CaptureExceptions then
583 Application.HandleException(Application)
584 else
585 raise;
586 end;
587 {$endif}
588 end;
589
isMouseMoveEventnull590 function isMouseMoveEvent(tp: NSEventType): Boolean; inline;
591 begin
592 Result := (tp = NSMouseMoved)
593 or (tp = NSLeftMouseDragged)
594 or (tp = NSRightMouseDragged)
595 or (tp = NSOtherMouseDragged);
596 end;
597
598 type
599 TCrackerApplication = class(TApplication);
600
nextEventMatchingMask_untilDate_inMode_dequeuenull601 function TCocoaApplication.nextEventMatchingMask_untilDate_inMode_dequeue(
602 mask: NSUInteger; expiration: NSDate; mode: NSString; deqFlag: LCLObjCBoolean
603 ): NSEvent;
604 var
605 cb : ICommonCallback;
606 begin
607 {$ifdef COCOALOOPHIJACK}
608 if not isrun and Assigned(aloop) then begin
609 isrun := True;
610 Result := nil;
611 aloop();
612 stop(nil); // this should stop the main loop
613 LoopHiJackEnded := true;
614 exit;
615 end;
616 {$endif}
617
618 {$ifdef BOOLFIX}
619 Result:=inherited nextEventMatchingMask_untilDate_inMode_dequeue_(
620 mask,
621 expiration, mode, Ord(deqFlag));
622 {$else}
623 Result:=inherited nextEventMatchingMask_untilDate_inMode_dequeue(mask,
624 expiration, mode, deqFlag);
625 {$endif}
626 if not Assigned(Result) then
627 begin
628 {$ifdef COCOALOOPNATIVE}
629 if Assigned(Application) then Application.Idle(true);
630 {$endif}
631 Exit;
632 end;
633
634 if ((mode = NSEventTrackingRunLoopMode) or mode.isEqualToString(NSEventTrackingRunLoopMode))
635 and Assigned(TrackedControl)
636 then
637 begin
638 if Result.type_ = NSLeftMouseUp then
639 begin
640 //todo: send callback!
641 TrackedControl := nil;
642 end
643 else
644 if isMouseMoveEvent(Result.type_) then
645 begin
646 cb := TrackedControl.lclGetCallback;
647 if Assigned(cb) then cb.MouseMove(Result);
648 end;
649 end;
650 end;
651
runModalForWindownull652 function TCocoaApplication.runModalForWindow(theWindow: NSWindow): NSInteger;
653 begin
654 ApplicationWillShowModal;
655
656 Result:=inherited runModalForWindow(theWindow);
657 end;
658
659 procedure TCocoaApplication.lclSyncCheck(arg: id);
660 begin
661 {$ifdef COCOALOOPNATIVE}
662 try
663 CheckSynchronize;
664 if Assigned(Application) then
665 TCrackerApplication(Application).ProcessAsyncCallQueue;
666 except
667 if Assigned(Application) and Application.CaptureExceptions then
668 Application.HandleException(Application)
669 else
670 raise;
671 end;
672 {$else}
673 CheckSynchronize;
674 if Assigned(Application) then
675 TCrackerApplication(Application).ProcessAsyncCallQueue;
676 {$endif}
677 end;
678
679
680 procedure InternalInit;
681 begin
682 // MacOSX 10.6 reports a lot of warnings during initialization process
683 // adding the autorelease pool for the whole Cocoa widgetset
684 MainPool := NSAutoreleasePool.alloc.init;
685 end;
686
687 procedure InternalFinal;
688 begin
689 if Assigned(MainPool) then
690 begin
691 MainPool.release;
692 MainPool := nil;
693 end;
694 end;
695
696 // the implementation of the utility methods
697 {$I cocoaobject.inc}
698 // the implementation of the winapi compatibility methods
699 {$I cocoawinapi.inc}
700 // the implementation of the extra LCL interface methods
701 {$I cocoalclintf.inc}
702
703 procedure TCocoaWidgetSet.DoSetMainMenu(AMenu: NSMenu; ALCLMenu: TMenu);
704 var
705 i: Integer;
706 lCurItem: TMenuItem;
707 lMenuObj: NSObject;
708 lNSMenu: NSMenu absolute AMenu;
709 begin
710 if Assigned(PrevMenu) then PrevMenu.release;
711 PrevMenu := NSApplication(NSApp).mainMenu;
712 PrevMenu.retain;
713
714 PrevLCLMenu := CurLCLMenu;
715
716 if (lNSMenu.isKindOfClass(TCocoaMenu)) then
717 TCocoaMenu(lNSMenu).attachAppleMenu();
718
719 NSApp.setMainMenu(lNSMenu);
720 CurLCLMenu := ALCLMenu;
721
722 if (ALCLMenu = nil) or not ALCLMenu.HandleAllocated then Exit;
723
724 // Find the Apple menu, if the user provided any by setting the Caption to
725 // Some older docs say we should use setAppleMenu to obtain the Services/Hide/Quit items,
726 // but its now private and in 10.10 it doesn't seam to do anything
727 // NSApp.setAppleMenu(NSMenu(lMenuObj));
728 for i := 0 to ALCLMenu.Items.Count-1 do
729 begin
730 lCurItem := ALCLMenu.Items.Items[i];
731 if not lNSMenu.isKindOfClass_(TCocoaMenu) then Break;
732 if not lCurItem.HandleAllocated then Continue;
733
734 lMenuObj := NSObject(lCurItem.Handle);
735 if not lMenuObj.isKindOfClass_(TCocoaMenuItem) then Continue;
736 if TCocoaMenuItem(lMenuObj).isValidAppleMenu() then
737 begin
738 TCocoaMenu(lNSMenu).overrideAppleMenu(TCocoaMenuItem(lMenuObj));
739 Break;
740 end;
741 end;
742 end;
743
744 procedure TCocoaWidgetSet.SetMainMenu(const AMenu: HMENU; const ALCLMenu: TMenu);
745 begin
746 if AMenu<>0 then
747 begin
748 DoSetMainMenu(NSMenu(AMenu), ALCLMenu);
749
750 PrevMenuEnabled := MainMenuEnabled;
751 MainMenuEnabled := true;
752 ToggleAppMenu(true);
753 //if not Assigned(ACustomForm.Menu) then ToggleAppMenu(false);
754
755 // for modal windows work around bug, but doesn't work :(
756 {$ifdef COCOA_USE_NATIVE_MODAL}
757 {if CurModalForm <> nil then
758 for i := 0 to lNSMenu.numberOfItems()-1 do
759 begin
760 lNSMenu.itemAtIndex(i).setTarget(TCocoaWSCustomForm.GetWindowFromHandle(CurModalForm));
761 end;}
762 {$endif}
763 end;
764 end;
765
StartModalnull766 function TCocoaWidgetSet.StartModal(awin: NSWindow; hasMenu: Boolean): Boolean;
767 var
768 sess : NSModalSession;
769 lvl : NSInteger;
770 begin
771 Result := false;
772 if not Assigned(awin) then Exit;
773
774 lvl := awin.level;
775
776 sess := NSApplication(NSApp).beginModalSessionForWindow(awin);
777 if not Assigned(sess) then Exit;
778
779 // beginModalSession "configures" the modality and potentially is changing window level
780 awin.setLevel(lvl);
781
782 if not Assigned(Modals) then Modals := TList.Create;
783
784 // If a modal menu has it's menu, then SetMainMenu has already been called
785 // (Show is called for modal windows prior to ShowModal. Show triggers Activate and Active is doing MainMenu)
786 if not hasMenu then begin
787 Modals.Add( TModalSession.Create(awin, sess, MainMenuEnabled, NSApplication(NSApp).mainMenu, CurLCLMenu));
788 MainMenuEnabled := false;
789 ToggleAppMenu(false); // modal menu doesn't have a window, disabling it
790 end else
791 // if modal window has its own menu, then the prior window is rescord in "Prev" fields
792 Modals.Add( TModalSession.Create(awin, sess, PrevMenuEnabled, PrevMenu, PrevLCLMenu));
793
794 Result := true;
795 inc(ModalCounter);
796 end;
797
798 procedure TCocoaWidgetSet.EndModal(awin: NSWindow);
799 var
800 ms : TModalSession;
801 begin
802 if not Assigned(Modals) or (Modals.Count = 0) then Exit;
803 ms := TModalSession(Modals[Modals.Count-1]);
804 if (ms.window <> awin) then Exit;
805 NSApplication(NSApp).endModalSession(ms.sess);
806
807 // restoring the menu status that was before the modality
808 DoSetMainMenu(ms.cocoaMenu, ms.lclMenu);
809 PrevMenuEnabled := MainMenuEnabled;
810 MainMenuEnabled := ms.prevMenuEnabled;
811 ToggleAppMenu(ms.prevMenuEnabled); // modal menu doesn't have a window, disabling it
812
813 ms.Free;
814 Modals.Delete(Modals.Count-1);
815 end;
816
isTopModalWinnull817 function TCocoaWidgetSet.isTopModalWin(awin: NSWindow): Boolean;
818 begin
819 if not isModalSession then begin
820 Result := false;
821 Exit;
822 end;
823 Result := TModalSession(Modals[Modals.Count-1]).window = awin;
824 end;
825
isModalSessionnull826 function TCocoaWidgetSet.isModalSession: Boolean;
827 begin
828 Result := Assigned(Modals) and (Modals.Count > 0);
829 end;
830
831 procedure TCocoaWidgetSet.AddToCollect(obj: TObject);
832 begin
833 // let's try to find an object. Do not add a duplicate
834 if (ToCollect.IndexOf(Obj)>=0) then Exit;
835 ToCollect.Add(obj);
836 end;
837
RetainToCollectnull838 function TCocoaWidgetSet.RetainToCollect: Integer;
839 begin
840 Result := ToCollect.Count;
841 end;
842
843 procedure TCocoaWidgetSet.ReleaseToCollect(fromIdx: integer);
844 var
845 i : integer;
846 begin
847 for i := fromIdx to ToCollect.Count - 1 do
848 begin
849 TObject(ToCollect[i]).Free;
850 ToCollect[i]:=nil;
851 end;
852 ToCollect.Pack;
853 end;
854
855 initialization
856 // {$I Cocoaimages.lrs}
857
858 finalization
859 InternalFinal;
860
861 end.
862