mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 23:39:26 +02:00
+ infrastructure for CtrlBreakHandler added
git-svn-id: trunk@8691 -
This commit is contained in:
parent
e70f1a26db
commit
58bca68e6a
@ -1203,3 +1203,18 @@ Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: AnsiStr
|
||||
begin
|
||||
Result:=FindResource(ModuleHandle,PChar(ResourceName),PChar(ResourceType));
|
||||
end;
|
||||
|
||||
const
|
||||
CtrlBreakHandler: TCtrlBreakHandler = nil;
|
||||
|
||||
{$IFNDEF FPC_HAS_SETCTRLBREAKHANDLER}
|
||||
(* It is possible to provide platform specific implementation performing *)
|
||||
(* special initialization; default implementation just sets the procedural *)
|
||||
(* variable to make it available for use from the exception handler. *)
|
||||
function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
|
||||
begin
|
||||
(* Return either nil or previous handler *)
|
||||
SysSetCtrlBreakHandler := CtrlBreakHandler;
|
||||
CtrlBreakHandler := Handler;
|
||||
end;
|
||||
{$ENDIF FPC_HAS_SETCTRLBREAKHANDLER}
|
||||
|
@ -318,6 +318,11 @@ type
|
||||
TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
|
||||
PPCharArray = ^TPCharArray;
|
||||
|
||||
(* CtrlBreak set to true signalizes Ctrl-Break signal, otherwise Ctrl-C. *)
|
||||
(* Return value of true means that the signal has been processed, false *)
|
||||
(* means that default handling should be used. *)
|
||||
TCtrlBreakHandler = function (CtrlBreak: boolean): boolean;
|
||||
|
||||
const
|
||||
{$ifdef cpui386}
|
||||
{ Always i386 or newer }
|
||||
@ -822,6 +827,10 @@ Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
|
||||
procedure AbstractError;external name 'FPC_ABSTRACTERROR';
|
||||
Function SysBackTraceStr(Addr:Pointer): ShortString;
|
||||
Procedure SysAssert(const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
|
||||
(* Supposed to return address of previous CtrlBreakHandler *)
|
||||
(* (may be nil), returned value of pointer (-1) means that *)
|
||||
(* attempt to setup CtrlBreakHandler wasn't successful. *)
|
||||
function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
|
||||
|
||||
{ Error handlers }
|
||||
Type
|
||||
|
Loading…
Reference in New Issue
Block a user