paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 22:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

carbon: fix with application event loop calling, caused by previous update.

Browse Source 
git-svn-id: trunk@19689 -
This commit is contained in:
dmitry 2009-04-29 10:16:52 +00:00
parent a168077e2a
commit 84e400ca0c
2 changed files with 64 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/interfaces/carbon/carbonint.pas
View File

@ -72,8 +72,6 @@ type
FOpenEventHandlerUPP: AEEventHandlerUPP;
FQuitEventHandlerUPP: AEEventHandlerUPP;
FEventLoopUPP: EventHandlerUPP;
FEventLoopHandler: EventHandlerRef;
FAppLoop: TApplicationMainLoop;
{$ifdef CarbonUseCocoa}
@ -87,9 +85,6 @@ type
procedure RegisterEvents;
procedure InitMainLoop;
procedure ReleaseMainLoop;
public
constructor Create; override;
destructor Destroy; override;

147
lcl/interfaces/carbon/carbonobject.inc
View File

@ -358,7 +358,7 @@ begin
ReleaseDC(0, ScreenDC);
end;
InitMainLoop;
fMainEventQueue:=GetMainEventQueue;
end;
{------------------------------------------------------------------------------
@ -371,12 +371,74 @@ procedure TCarbonWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
// rest of your application to maintain a global variable,
// gNumberOfRunningThreads, that reflects the number of threads
// that are ready to run.
var
DummyEvent: EventRef;
EventSpec: EventTypeSpec;
EventLoopUPP: EventHandlerUPP;
EventLoopHandler: EventHandlerRef;
begin
{$IFDEF VerboseObject}
DebugLn('TCarbonWidgetSet.AppRun');
{$ENDIF}
FAppLoop:=ALoop;
RunApplicationEventLoop;
DummyEvent := nil;
// Create a UPP for EventLoopEventHandler and QuitEventHandler
EventLoopUPP := NewEventHandlerUPP(EventHandlerProcPtr(
Pointer(@EventLoopEventHandler)));
if EventLoopUPP = nil then
RaiseGDBException('TCarbonWidgetSet.InitMainLoop no eventhandler');
// Install EventLoopEventHandler, create a dummy event and post it,
// and then call RunApplicationEventLoop. The rationale for this
// is as follows: We want to unravel RunApplicationEventLoop so
// that we can can yield to cooperative threads. In fact, the
// core code for RunApplicationEventLoop is pretty easy (you
// can see it above in EventLoopEventHandler). However, if you
// just execute this code you miss out on all the standard event
// handlers. These are relatively easy to reproduce (handling
// the quit event and so on), but doing so is a pain because
// a) it requires a bunch boilerplate code, and b) if Apple
// extends the list of standard event handlers, your application
// wouldn't benefit. So, we execute our event loop from within
// a Carbon event handler that we cause to be executed by
// explicitly posting an event to our event loop. Thus, the
// standard event handlers are installed while our event loop runs.
EventSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindMain);
if not InstallApplicationEventHandler(EventLoopUPP, 1, @EventSpec, Self,
@EventLoopHandler) then Exit;
try
if CreateEvent(nil, EventSpec.eventClass, EventSpec.eventKind, 0,
kEventAttributeNone, DummyEvent) <> noErr
then
RaiseGDBException('TCarbonWidgetSet.InitMainLoop create first dummy event failed');
try
{if SetEventParameter(DummyEvent, MakeFourCC('Loop'),
MakeFourCC('TAML'), SizeOf(ALoop),
@ALoop) <> noErr
then
RaiseGDBException('TCarbonWidgetSet.InitMainLoop setparam to first event failed');}
//DebuglnThrea dLog('TCarbonWidgetSet.AppRun '+dbgs(GetMainEventQueue));
if PostEventToQueue(FMainEventQueue, DummyEvent,
kEventPriorityHigh) <> noErr
then
RaiseGDBException('TCarbonWidgetSet.AppRun post dummy event failed');
finally
ReleaseEvent(DummyEvent);
end;
SignalFirstAppEvent;
RunApplicationEventLoop;
finally
MacOSAll.RemoveEventHandler(EventLoopHandler);
DisposeEventHandlerUPP(EventLoopUPP);
end;
{$IFDEF VerboseObject}
DebugLn('TCarbonWidgetSet.AppRun END');
{$ENDIF}
@ -488,7 +550,6 @@ end;
------------------------------------------------------------------------------}
destructor TCarbonWidgetSet.Destroy;
begin
ReleaseMainLoop;
FreeAndNil(FTimerMap);
DisposeAEEventHandlerUPP(FOpenEventHandlerUPP);
DisposeAEEventHandlerUPP(FQuitEventHandlerUPP);
@ -898,86 +959,6 @@ begin
Self, SName, 'AEInstallEventHandler');
end;
procedure TCarbonWidgetSet.InitMainLoop;
// A reimplementation of RunApplicationEventLoop that supports
// yielding time to cooperative threads. It relies on the
// rest of your application to maintain a global variable,
// gNumberOfRunningThreads, that reflects the number of threads
// that are ready to run.
var
DummyEvent: EventRef;
EventSpec: EventTypeSpec;
CurMainEventQueue: EventQueueRef;
begin
{$IFDEF VerboseObject}
DebugLn('TCarbonWidgetSet.InitMainLoop');
{$ENDIF}
DummyEvent := nil;
// Create a UPP for EventLoopEventHandler and QuitEventHandler
FEventLoopUPP := NewEventHandlerUPP(EventHandlerProcPtr(
Pointer(@EventLoopEventHandler)));
if FEventLoopUPP = nil then
RaiseGDBException('TCarbonWidgetSet.InitMainLoop no eventhandler');
// Install EventLoopEventHandler, create a dummy event and post it,
// and then call RunApplicationEventLoop. The rationale for this
// is as follows: We want to unravel RunApplicationEventLoop so
// that we can can yield to cooperative threads. In fact, the
// core code for RunApplicationEventLoop is pretty easy (you
// can see it above in EventLoopEventHandler). However, if you
// just execute this code you miss out on all the standard event
// handlers. These are relatively easy to reproduce (handling
// the quit event and so on), but doing so is a pain because
// a) it requires a bunch boilerplate code, and b) if Apple
// extends the list of standard event handlers, your application
// wouldn't benefit. So, we execute our event loop from within
// a Carbon event handler that we cause to be executed by
// explicitly posting an event to our event loop. Thus, the
// standard event handlers are installed while our event loop runs.
EventSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindMain);
if not InstallApplicationEventHandler(FEventLoopUPP, 1, @EventSpec, Self,
@FEventLoopHandler) then Exit;
if CreateEvent(nil, EventSpec.eventClass, EventSpec.eventKind, 0,
kEventAttributeNone, DummyEvent) <> noErr
then
RaiseGDBException('TCarbonWidgetSet.InitMainLoop create first dummy event failed');
try
{if SetEventParameter(DummyEvent, MakeFourCC('Loop'),
MakeFourCC('TAML'), SizeOf(ALoop),
@ALoop) <> noErr
then
RaiseGDBException('TCarbonWidgetSet.InitMainLoop setparam to first event failed');}
//DebuglnThrea dLog('TCarbonWidgetSet.AppRun '+dbgs(GetMainEventQueue));
CurMainEventQueue:=GetMainEventQueue;
if PostEventToQueue(CurMainEventQueue, DummyEvent,
kEventPriorityHigh) <> noErr
then
RaiseGDBException('TCarbonWidgetSet.AppRun post dummy event failed');
finally
ReleaseEvent(DummyEvent);
end;
fMainEventQueue:=CurMainEventQueue;
SignalFirstAppEvent;
{$IFDEF VerboseObject}
DebugLn('TCarbonWidgetSet.InitMainLoop END');
{$ENDIF}
end;
procedure TCarbonWidgetSet.ReleaseMainLoop;
begin
fMainEventQueue:=nil;
if Assigned(FEventLoopHandler) then MacOSAll.RemoveEventHandler(FEventLoopHandler);
if Assigned(FEventLoopUPP) then DisposeEventHandlerUPP(FEventLoopUPP);
end;
{------------------------------------------------------------------------------
Method: TCarbonWidgetSet.AppTerminate