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