paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 19:29:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Use globdir.inc HasSignal conditional

Browse Source 
+ Uses PutKeyEvent for CtrlC
This commit is contained in:
pierre 2000-03-07 21:09:20 +00:00
parent 2265547871
commit 71d00830cf
1 changed files with 42 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
ide/text/fpcatch.pas
View File

@ -16,53 +16,78 @@
Unit fpcatch; Unit fpcatch;
interface interface
{$i globdir.inc}
{$ifdef linux} {$ifdef linux}
{$define has_signal}
uses uses
linux; linux;
{$endif} {$endif}
{$ifdef go32v2} {$ifdef go32v2}
{$define has_signal}
uses uses
dpmiexcp; dpmiexcp;
{$endif} {$endif}
{$ifdef has_signal} {$ifdef HasSignal}
Var Var
NewSignal,OldSigSegm,OldSigInt : SignalHandler; NewSignal,OldSigSegm,OldSigInt : SignalHandler;
{$endif} {$endif}
Const
CtrlCPressed : Boolean = false;
Implementation Implementation
uses uses
{$ifdef FPC}
keyboard,
drivers,
{$endif FPC}
app,commands,msgbox, app,commands,msgbox,
fpide,fpviews; fpide,fpviews;
{$ifdef has_signal} {$ifdef HasSignal}
{$ifdef linux} {$ifdef linux}
Procedure CatchSignal(Sig : Integer);cdecl; Procedure CatchSignal(Sig : Integer);cdecl;
{$else} {$else}
Function CatchSignal(Sig : longint):longint; Function CatchSignal(Sig : longint):longint;
{$endif} {$endif}
var CanQuit: boolean; var MustQuit: boolean;
begin begin
case Sig of case Sig of
SIGSEGV : begin SIGSEGV : begin
if Assigned(Application) then IDEApp.Done; if Assigned(Application) then IDEApp.Done;
Writeln('Internal Error caught'); Writeln('Internal Error caught');
{$ifndef DEBUG}
Halt; Halt;
{$else DEBUG}
RunError(216);
{$endif DEBUG}
end; end;
SIGINT : begin SIGINT : begin
if Assigned(Application) then IF NOT CtrlCPressed and Assigned(Application) then
CanQuit:=MessageBox(#3'Do You really want to quit?',nil,mferror+mfyesbutton+mfnobutton)=cmYes begin
MustQuit:=false;
{$ifdef FPC}
CtrlCPressed:=true;
Keyboard.PutKeyEvent((kbCtrl shl 16) or kbCtrlC);
{$endif FPC}
end
else else
CanQuit:=true; begin
if CanQuit then if Assigned(Application) then
MustQuit:=MessageBox(#3'Do You really want to quit?',nil,mferror+mfyesbutton+mfnobutton)=cmYes
else
MustQuit:=true;
end;
if MustQuit then
begin begin
if Assigned(Application) then IDEApp.Done; if Assigned(Application) then IDEApp.Done;
{$ifndef DEBUG}
Halt; Halt;
{$else DEBUG}
RunError(216);
{$endif DEBUG}
end; end;
end; end;
end; end;
@ -70,11 +95,11 @@ begin
CatchSignal:=0; CatchSignal:=0;
{$endif} {$endif}
end; end;
{$endif def has_signal} {$endif def HasSignal}
begin begin
{$ifdef has_signal} {$ifdef HasSignal}
{$ifndef TP} {$ifndef TP}
NewSignal:=SignalHandler(@CatchSignal); NewSignal:=SignalHandler(@CatchSignal);
{$else TP} {$else TP}
@ -87,7 +112,11 @@ end.
{ {
$Log$ $Log$
Revision 1.3 1999-12-20 14:23:16 pierre Revision 1.4 2000-03-07 21:09:20 pierre
* Use globdir.inc HasSignal conditional
+ Uses PutKeyEvent for CtrlC
Revision 1.3 1999/12/20 14:23:16 pierre
* MyApp renamed IDEApp * MyApp renamed IDEApp
* TDebugController.ResetDebuggerRows added to * TDebugController.ResetDebuggerRows added to
get resetting of debugger rows get resetting of debugger rows