diff --git a/lcl/include/application.inc b/lcl/include/application.inc index edbbc816b8..109af908cc 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -416,13 +416,20 @@ end; TApplication ProcesssMessages "Enter the messageloop and process until empty" ------------------------------------------------------------------------------} procedure TApplication.ProcessMessages; +var + context: TLCLHandle; begin if Self=nil then begin // when the programmer did a mistake, avoid getting strange errors raise Exception.Create('Application=nil'); end; - WidgetSet.AppProcessMessages; - ProcessAsyncCallQueue; + context := WidgetSet.BeginMessageProcess; + try + WidgetSet.AppProcessMessages; + ProcessAsyncCallQueue; + finally + WidgetSet.EndMessageProcess(context); + end; end; {------------------------------------------------------------------------------ @@ -1267,9 +1274,16 @@ end; Handles all messages first then the Idle ------------------------------------------------------------------------------} procedure TApplication.HandleMessage; +var + context: TLCLHandle; begin - WidgetSet.AppProcessMessages; // process all events - if not Terminated then Idle(true); + context := WidgetSet.BeginMessageProcess; + try + WidgetSet.AppProcessMessages; // process all events + if not Terminated then Idle(true); + finally + WidgetSet.EndMessageProcess(context); + end; end; function TApplication.HelpContext(Context: THelpContext): Boolean; diff --git a/lcl/include/interfacebase.inc b/lcl/include/interfacebase.inc index 0608326c5c..b27c4e208e 100644 --- a/lcl/include/interfacebase.inc +++ b/lcl/include/interfacebase.inc @@ -84,6 +84,15 @@ procedure TWidgetSet.AppSetupMainForm(AMainForm: TObject); //e.g. handle widge begin end; +function TWidgetSet.BeginMessageProcess: TLCLHandle; +begin + Result := 0; +end; + +procedure TWidgetSet.EndMessageProcess(context: TLCLHandle); +begin +end; + function TWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt; begin case ACapability of diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index f3bae3db07..657d9616c0 100644 --- a/lcl/interfacebase.pp +++ b/lcl/interfacebase.pp @@ -147,7 +147,14 @@ type function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; virtual; procedure AppSetMainFormOnTaskBar(const DoSet: Boolean); virtual; procedure AppSetupMainForm(AMainForm: TObject); virtual; - + + // Begin/End processing messages, which can be used to acquire/release + // resources during message processing. + // for example, on Cocoa, it needs to be used to release AutoReleasePool + // to avoid resource leaks. + function BeginMessageProcess: TLCLHandle; virtual; + procedure EndMessageProcess(context: TLCLHandle); virtual; + function LCLPlatform: TLCLPlatform; virtual; abstract; function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; virtual; diff --git a/lcl/interfaces/cocoa/cocoaint.pas b/lcl/interfaces/cocoa/cocoaint.pas index 1cc7421a56..54791ff416 100644 --- a/lcl/interfaces/cocoa/cocoaint.pas +++ b/lcl/interfaces/cocoa/cocoaint.pas @@ -201,6 +201,9 @@ type procedure AppSetIcon(const Small, Big: HICON); override; procedure AppSetTitle(const ATitle: string); override; + function BeginMessageProcess: TLCLHandle; override; + procedure EndMessageProcess(context: TLCLHandle); override; + function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override; function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): TLCLHandle; override; @@ -296,6 +299,22 @@ const // Lack of documentation, provisional definition LazarusApplicationDefinedSubtypeWakeup = 13579; +procedure InternalInit; +begin + // MacOSX 10.6 reports a lot of warnings during initialization process + // adding the autorelease pool for the whole Cocoa widgetset + MainPool := NSAutoreleasePool.alloc.init; +end; + +procedure InternalFinal; +begin + if Assigned(MainPool) then + begin + MainPool.release; + MainPool := nil; + end; +end; + procedure wakeupEventLoop; var ev: NSevent; @@ -476,6 +495,8 @@ end; {$ifdef COCOALOOPOVERRIDE} procedure TCocoaApplication.run; begin + InternalFinal; // MainPool Stage 1 final + InternalInit; // MainPool Stage 2 init {$ifdef COCOAPPRUNNING_SETINTPROPERTY} setValue_forKey(NSNumber.numberWithBool(true), NSSTR('_running')); {$endif} @@ -743,22 +764,6 @@ begin end; {$endif} -procedure InternalInit; -begin - // MacOSX 10.6 reports a lot of warnings during initialization process - // adding the autorelease pool for the whole Cocoa widgetset - MainPool := NSAutoreleasePool.alloc.init; -end; - -procedure InternalFinal; -begin - if Assigned(MainPool) then - begin - MainPool.release; - MainPool := nil; - end; -end; - type AppClassMethod = objccategory external (NSObject) function sharedApplication: NSApplication; message 'sharedApplication'; @@ -939,9 +944,10 @@ begin end; initialization + InternalInit; // MainPool Stage 1 init // {$I Cocoaimages.lrs} finalization - InternalFinal; + InternalFinal; // MainPool Stage 2 Final end. diff --git a/lcl/interfaces/cocoa/cocoaobject.inc b/lcl/interfaces/cocoa/cocoaobject.inc index afa6e5b5d6..686e4adf2c 100644 --- a/lcl/interfaces/cocoa/cocoaobject.inc +++ b/lcl/interfaces/cocoa/cocoaobject.inc @@ -31,8 +31,6 @@ begin {$IFDEF VerboseObject} DebugLn('TCocoaWidgetSet.AppInit'); {$ENDIF} - InternalInit; - WakeMainThread := @OnWakeMainThread; ScreenInfo.PixelsPerInchX := CocoaBasePPI; ScreenInfo.PixelsPerInchY := CocoaBasePPI; @@ -124,6 +122,17 @@ begin AppRunMessages(true, NSDate.distantFuture); end; +function TCocoaWidgetSet.BeginMessageProcess: TLCLHandle; +begin + Result := TLCLHandle(NSAutoreleasePool.alloc.init); +end; + +procedure TCocoaWidgetSet.EndMessageProcess(context: TLCLHandle); +begin + NSAutoreleasePool(context).release; +end; + + {------------------------------------------------------------------------------ Method: TCocoaWidgetSet.Create diff --git a/lcl/interfaces/cocoa/cocoawsforms.pas b/lcl/interfaces/cocoa/cocoawsforms.pas index 01e6082d3c..20834df316 100644 --- a/lcl/interfaces/cocoa/cocoawsforms.pas +++ b/lcl/interfaces/cocoa/cocoawsforms.pas @@ -852,6 +852,7 @@ begin // it should be removed from "parentWindow" if Assigned(win.parentWindow) then win.parentWindow.removeChildWindow(win); + win.setLevel(NSNormalWindowLevel); win.close; win.setContentView(nil); cb := win.lclGetCallback();