mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-24 17:40:26 +02:00
Merge branch 'lcl/cocoa/leak'
This commit is contained in:
commit
935e7edaff
@ -416,13 +416,20 @@ end;
|
|||||||
TApplication ProcesssMessages "Enter the messageloop and process until empty"
|
TApplication ProcesssMessages "Enter the messageloop and process until empty"
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TApplication.ProcessMessages;
|
procedure TApplication.ProcessMessages;
|
||||||
|
var
|
||||||
|
context: TLCLHandle;
|
||||||
begin
|
begin
|
||||||
if Self=nil then begin
|
if Self=nil then begin
|
||||||
// when the programmer did a mistake, avoid getting strange errors
|
// when the programmer did a mistake, avoid getting strange errors
|
||||||
raise Exception.Create('Application=nil');
|
raise Exception.Create('Application=nil');
|
||||||
end;
|
end;
|
||||||
WidgetSet.AppProcessMessages;
|
context := WidgetSet.BeginMessageProcess;
|
||||||
ProcessAsyncCallQueue;
|
try
|
||||||
|
WidgetSet.AppProcessMessages;
|
||||||
|
ProcessAsyncCallQueue;
|
||||||
|
finally
|
||||||
|
WidgetSet.EndMessageProcess(context);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -1267,9 +1274,16 @@ end;
|
|||||||
Handles all messages first then the Idle
|
Handles all messages first then the Idle
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TApplication.HandleMessage;
|
procedure TApplication.HandleMessage;
|
||||||
|
var
|
||||||
|
context: TLCLHandle;
|
||||||
begin
|
begin
|
||||||
WidgetSet.AppProcessMessages; // process all events
|
context := WidgetSet.BeginMessageProcess;
|
||||||
if not Terminated then Idle(true);
|
try
|
||||||
|
WidgetSet.AppProcessMessages; // process all events
|
||||||
|
if not Terminated then Idle(true);
|
||||||
|
finally
|
||||||
|
WidgetSet.EndMessageProcess(context);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TApplication.HelpContext(Context: THelpContext): Boolean;
|
function TApplication.HelpContext(Context: THelpContext): Boolean;
|
||||||
|
@ -84,6 +84,15 @@ procedure TWidgetSet.AppSetupMainForm(AMainForm: TObject); //e.g. handle widge
|
|||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TWidgetSet.BeginMessageProcess: TLCLHandle;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TWidgetSet.EndMessageProcess(context: TLCLHandle);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
function TWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt;
|
function TWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt;
|
||||||
begin
|
begin
|
||||||
case ACapability of
|
case ACapability of
|
||||||
|
@ -147,7 +147,14 @@ type
|
|||||||
function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; virtual;
|
function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; virtual;
|
||||||
procedure AppSetMainFormOnTaskBar(const DoSet: Boolean); virtual;
|
procedure AppSetMainFormOnTaskBar(const DoSet: Boolean); virtual;
|
||||||
procedure AppSetupMainForm(AMainForm: TObject); 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 LCLPlatform: TLCLPlatform; virtual; abstract;
|
||||||
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; virtual;
|
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; virtual;
|
||||||
|
|
||||||
|
@ -201,6 +201,9 @@ type
|
|||||||
procedure AppSetIcon(const Small, Big: HICON); override;
|
procedure AppSetIcon(const Small, Big: HICON); override;
|
||||||
procedure AppSetTitle(const ATitle: string); override;
|
procedure AppSetTitle(const ATitle: string); override;
|
||||||
|
|
||||||
|
function BeginMessageProcess: TLCLHandle; override;
|
||||||
|
procedure EndMessageProcess(context: TLCLHandle); override;
|
||||||
|
|
||||||
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override;
|
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override;
|
||||||
|
|
||||||
function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): TLCLHandle; override;
|
function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): TLCLHandle; override;
|
||||||
@ -296,6 +299,22 @@ const
|
|||||||
// Lack of documentation, provisional definition
|
// Lack of documentation, provisional definition
|
||||||
LazarusApplicationDefinedSubtypeWakeup = 13579;
|
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;
|
procedure wakeupEventLoop;
|
||||||
var
|
var
|
||||||
ev: NSevent;
|
ev: NSevent;
|
||||||
@ -476,6 +495,8 @@ end;
|
|||||||
{$ifdef COCOALOOPOVERRIDE}
|
{$ifdef COCOALOOPOVERRIDE}
|
||||||
procedure TCocoaApplication.run;
|
procedure TCocoaApplication.run;
|
||||||
begin
|
begin
|
||||||
|
InternalFinal; // MainPool Stage 1 final
|
||||||
|
InternalInit; // MainPool Stage 2 init
|
||||||
{$ifdef COCOAPPRUNNING_SETINTPROPERTY}
|
{$ifdef COCOAPPRUNNING_SETINTPROPERTY}
|
||||||
setValue_forKey(NSNumber.numberWithBool(true), NSSTR('_running'));
|
setValue_forKey(NSNumber.numberWithBool(true), NSSTR('_running'));
|
||||||
{$endif}
|
{$endif}
|
||||||
@ -743,22 +764,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$endif}
|
{$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
|
type
|
||||||
AppClassMethod = objccategory external (NSObject)
|
AppClassMethod = objccategory external (NSObject)
|
||||||
function sharedApplication: NSApplication; message 'sharedApplication';
|
function sharedApplication: NSApplication; message 'sharedApplication';
|
||||||
@ -939,9 +944,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
InternalInit; // MainPool Stage 1 init
|
||||||
// {$I Cocoaimages.lrs}
|
// {$I Cocoaimages.lrs}
|
||||||
|
|
||||||
finalization
|
finalization
|
||||||
InternalFinal;
|
InternalFinal; // MainPool Stage 2 Final
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -31,8 +31,6 @@ begin
|
|||||||
{$IFDEF VerboseObject}
|
{$IFDEF VerboseObject}
|
||||||
DebugLn('TCocoaWidgetSet.AppInit');
|
DebugLn('TCocoaWidgetSet.AppInit');
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
InternalInit;
|
|
||||||
|
|
||||||
WakeMainThread := @OnWakeMainThread;
|
WakeMainThread := @OnWakeMainThread;
|
||||||
ScreenInfo.PixelsPerInchX := CocoaBasePPI;
|
ScreenInfo.PixelsPerInchX := CocoaBasePPI;
|
||||||
ScreenInfo.PixelsPerInchY := CocoaBasePPI;
|
ScreenInfo.PixelsPerInchY := CocoaBasePPI;
|
||||||
@ -124,6 +122,17 @@ begin
|
|||||||
AppRunMessages(true, NSDate.distantFuture);
|
AppRunMessages(true, NSDate.distantFuture);
|
||||||
end;
|
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
|
Method: TCocoaWidgetSet.Create
|
||||||
|
|
||||||
|
@ -852,6 +852,7 @@ begin
|
|||||||
// it should be removed from "parentWindow"
|
// it should be removed from "parentWindow"
|
||||||
if Assigned(win.parentWindow) then
|
if Assigned(win.parentWindow) then
|
||||||
win.parentWindow.removeChildWindow(win);
|
win.parentWindow.removeChildWindow(win);
|
||||||
|
win.setLevel(NSNormalWindowLevel);
|
||||||
win.close;
|
win.close;
|
||||||
win.setContentView(nil);
|
win.setContentView(nil);
|
||||||
cb := win.lclGetCallback();
|
cb := win.lclGetCallback();
|
||||||
|
Loading…
Reference in New Issue
Block a user