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

fixed debugger stop

Browse Source 
git-svn-id: trunk@4225 -
This commit is contained in:
mattias 2003-06-02 21:37:30 +00:00
parent 02dd1c8887
commit 2929675a0b
3 changed files with 31 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
debugger/debugger.pp
View File

@ -554,7 +554,7 @@ type
procedure DoDbgOutput(const AText: String);
procedure DoException(const AExceptionClass: String; const AExceptionText: String);
procedure DoOutput(const AText: String);
procedure DoState(const OldState: TDBGState);
procedure DoState(const OldState: TDBGState); virtual;
function ChangeFileName: Boolean; virtual;
function GetCommands: TDBGCommands;
function GetSupportedCommands: TDBGCommands; virtual;
@ -2287,6 +2287,9 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.35 2003/06/02 21:37:30 mattias
fixed debugger stop
Revision 1.34 2003/05/29 18:47:27 mattias
fixed reposition sourcemark

20
lcl/forms.pp
View File

@ -640,12 +640,16 @@ type
ControlHasHint: boolean;
end;
TApplicationFlag = (AppWaiting, AppIdleEndSent);
TApplicationFlag = (
AppWaiting,
AppIdleEndSent,
AppHandlingException
);
TApplicationFlags = set of TApplicationFlag;
TApplication = class(TComponent)
private
FFlag: TApplicationFlags;
FFlags: TApplicationFlags;
FHandle : THandle;
//FHelpSystem : IHelpSystem;
FHelpFile: string;
@ -1133,7 +1137,6 @@ end;
constructor TDataModule.Create(TheOwner: TComponent);
begin
writeln('TDataModule.Create START');
//GlobalNameSpace.BeginWrite;
try
CreateNew(TheOwner,0);
@ -1145,7 +1148,6 @@ begin
end;
if OldCreateOrder then DoCreate;
end;
writeln('TDataModule.Create END');
finally
//GlobalNameSpace.EndWrite;
end;
@ -1153,33 +1155,27 @@ end;
procedure TDataModule.AfterConstruction;
begin
writeln('TDataModule.AfterConstruction');
if not OldCreateOrder then DoCreate;
end;
constructor TDataModule.CreateNew(TheOwner: TComponent; CreateMode: Integer);
begin
writeln('TDataModule.CreateNew START');
inherited Create(TheOwner);
if Assigned(AddDataModule) and (CreateMode >= 0) then
AddDataModule(Self);
writeln('TDataModule.CreateNew END');
end;
procedure TDataModule.BeforeDestruction;
begin
writeln('TDataModule.BeforeDestruction START');
//GlobalNameSpace.BeginWrite;
Destroying;
RemoveFixupReferences(Self, '');
if not OldCreateOrder then DoDestroy;
writeln('TDataModule.BeforeDestruction END');
end;
destructor TDataModule.Destroy;
begin
writeln('TDataModule.Destroy START');
if not (csDestroying in ComponentState) then
; //GlobalNameSpace.BeginWrite;
try
@ -1190,7 +1186,6 @@ begin
finally
//GlobalNameSpace.EndWrite;
end;
writeln('TDataModule.Destroy END');
end;
procedure TDataModule.DoCreate;
@ -1200,7 +1195,6 @@ begin
FOnCreate(Self);
except
begin
writeln('TDataModule.DoCreate A');
if not HandleCreateException then
raise;
end;
@ -1214,7 +1208,6 @@ begin
FOnDestroy(Self);
except
begin
writeln('TDataModule.DoDestroy A');
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
@ -1279,7 +1272,6 @@ end;
function TDataModule.HandleCreateException: Boolean;
begin
writeln('TDataModule.HandleCreateException A');
if Assigned(ApplicationHandleException) then
begin
ApplicationHandleException(Self);

28
lcl/include/application.inc
View File

@ -277,11 +277,11 @@ begin
NotifyIdleHandler;
if Done then begin
// wait till something happens
Include(FFlag,AppWaiting);
Exclude(FFlag,AppIdleEndSent);
Include(FFlags,AppWaiting);
Exclude(FFlags,AppIdleEndSent);
InterfaceObject.WaitMessage;
DoOnIdleEnd;
Exclude(FFlag,AppWaiting);
Exclude(FFlags,AppWaiting);
end;
end;
@ -646,6 +646,13 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.HandleException(Sender: TObject);
begin
if AppHandlingException in FFlags then begin
// there was an exception during showing the exception -> break the circle
writeln('TApplication.HandleException: ',
'there was a second exception during showing the first exception');
exit;
end;
Include(FFlags,AppHandlingException);
if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
if ExceptObject is Exception then begin
writeln('TApplication.HandleException ',Exception(ExceptObject).Message);
@ -656,6 +663,7 @@ begin
ShowException(Exception(ExceptObject));
end else
SysUtils.ShowException(ExceptObject, ExceptAddr);
Exclude(FFlags,AppHandlingException);
end;
{------------------------------------------------------------------------------
@ -720,7 +728,7 @@ end;
------------------------------------------------------------------------------}
function TApplication.IsWaiting: boolean;
begin
Result:=AppWaiting in FFlag;
Result:=AppWaiting in FFlags;
end;
{------------------------------------------------------------------------------
@ -807,10 +815,10 @@ end;
procedure TApplication.DoOnIdleEnd;
begin
if (AppIdleEndSent in FFlag) then exit;
if (AppIdleEndSent in FFlags) then exit;
if Assigned(OnIdleEnd) then OnIdleEnd(Self);
NotifyIdleEndHandler;
Include(FFlag,AppIdleEndSent);
Include(FFlags,AppIdleEndSent);
end;
{------------------------------------------------------------------------------
@ -836,7 +844,10 @@ var
begin
Msg := E.Message;
if (Msg <> '') and (Msg[length(Msg)] > '.') then Msg := Msg + '.';
MessageBox(PChar(Msg), PChar(GetTitle), MB_OK + MB_ICONERROR);
if (not FTerminate) and (Self<>nil) then
MessageBox(PChar(Msg), PChar(GetTitle), MB_OK + MB_ICONERROR)
else
SysUtils.ShowException(ExceptObject, ExceptAddr);
end;
{------------------------------------------------------------------------------}
@ -1016,6 +1027,9 @@ end;
{ =============================================================================
$Log$
Revision 1.56 2003/06/02 21:37:30 mattias
fixed debugger stop
Revision 1.55 2003/05/31 10:07:33 mattias
changed projects forms into components