[fpc-pascal] How to use the `signals` unit?

[silvioprog]

On Thu, Oct 22, 2015 at 6:40 AM, Sven Barth <pascaldragon at googlemail.com>
wrote:

> Am 22.10.2015 09:23 schrieb "silvioprog" <silvioprog at gmail.com>:
> > What is the secret to use this it on Windows?
>
> The secret is to not use it. It's only real use is in the textmode IDE and
> maybe there it should be checked whether it can be replaced.
>
So is there some alternative for signals? ( SetConsoleCtrlHandler() on
Windows, but, what in Linux? )

I have a console  application, and I need to block the `Ctrl+C` command,
allowing only the `Ctrl+\` (or Ctrl+Break on Windows). See a small example
(*) that works fine on Windows (7 / 10) and Linux (*ubuntu 14.04). The
original demo was written in C and is hosted here[1].

> AFAIR the signals unit is even completely broken if SEH is enabled
> (default on x86_64-win64, but to be made default on i386-win32).
>
> Regards,
> Sven
>
(*)

=== begin code ===

program project1;

{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}
  BaseUnix,
{$ENDIF}
  ctypes, sysutils;

const
  LIB_NAME = {$IFDEF MSWINDOWS}'msvcrt'{$ELSE}'c'{$ENDIF};

{$IFDEF MSWINDOWS}
  SIGINT = 2;
  SIGILL = 4;
  SIGFPE = 8;
  SIGSEGV = 11;
  SIGTERM = 15;
  SIGBREAK = 21;
  SIGABRT = 22;
{$ENDIF}

type
  signal_func = procedure(sig: cint); cdecl;

  function signal(sig: cint; func: signal_func): signal_func; cdecl;
external LIB_NAME Name 'signal';

  procedure sigproc(sig: cint); cdecl;
  begin
    signal(SIGINT, @sigproc);
    WriteLn('you have pressed ctrl-c');
  end;

  procedure quitproc(sig: cint); cdecl;
  begin
    WriteLn('ctrl+break (or ctrl+\ on linux) pressed to quit');
    halt(0);
  end;

begin
  signal(SIGINT, @sigproc);
{$IFDEF MSWINDOWS}
  signal(SIGBREAK, @quitproc);
{$ELSE}
  signal(SIGTERM, @quitproc);
{$ENDIF}
  WriteLn('ctrl-c disabled use ctrl+break (or ctrl+\ on linux) to quit');
  while True do Sleep(100);
end.

=== end code ===

[1] https://www.cs.cf.ac.uk/Dave/C/node24.html

-- 
Silvio Clécio
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20151023/8b1cd499/attachment.html>