瀏覽代碼

+ infrastructure for CtrlBreakHandler added

git-svn-id: trunk@8691 -
Tomas Hajny 18 年之前
父節點
當前提交
58bca68e6a
共有 2 個文件被更改,包括 24 次插入0 次删除
  1. 15 0
      rtl/inc/system.inc
  2. 9 0
      rtl/inc/systemh.inc

+ 15 - 0
rtl/inc/system.inc

@@ -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}

+ 9 - 0
rtl/inc/systemh.inc

@@ -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