2016-02-18 07:11:59 -08:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* OCaml *)
|
|
|
|
(* *)
|
|
|
|
(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* OCaml port by John Malecki and Xavier Leroy *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. *)
|
|
|
|
(* *)
|
|
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
1996-11-29 08:55:09 -08:00
|
|
|
|
|
|
|
(* Handling of keyboard interrupts *)
|
|
|
|
|
|
|
|
let interrupted = ref false
|
|
|
|
|
1997-11-13 01:04:16 -08:00
|
|
|
let is_protected = ref false
|
1996-11-29 08:55:09 -08:00
|
|
|
|
2016-03-09 15:27:42 -08:00
|
|
|
let break _signum =
|
1997-11-13 01:04:16 -08:00
|
|
|
if !is_protected
|
1996-11-29 08:55:09 -08:00
|
|
|
then interrupted := true
|
|
|
|
else raise Sys.Break
|
|
|
|
|
|
|
|
let _ =
|
2008-07-29 01:31:41 -07:00
|
|
|
match Sys.os_type with
|
|
|
|
"Win32" -> ()
|
|
|
|
| _ ->
|
|
|
|
Sys.set_signal Sys.sigint (Sys.Signal_handle break);
|
2013-03-09 14:38:52 -08:00
|
|
|
Sys.set_signal Sys.sigpipe (Sys.Signal_handle(fun _ -> raise End_of_file))
|
1996-11-29 08:55:09 -08:00
|
|
|
|
1997-11-13 01:04:16 -08:00
|
|
|
let protect f =
|
|
|
|
if !is_protected then
|
1996-11-29 08:55:09 -08:00
|
|
|
f ()
|
|
|
|
else begin
|
1997-11-13 01:04:16 -08:00
|
|
|
is_protected := true;
|
1996-11-29 08:55:09 -08:00
|
|
|
if not !interrupted then
|
|
|
|
f ();
|
1997-11-13 01:04:16 -08:00
|
|
|
is_protected := false;
|
1996-11-29 08:55:09 -08:00
|
|
|
if !interrupted then begin interrupted := false; raise Sys.Break end
|
|
|
|
end
|
|
|
|
|
1997-11-13 01:04:16 -08:00
|
|
|
let unprotect f =
|
|
|
|
if not !is_protected then
|
1996-11-29 08:55:09 -08:00
|
|
|
f ()
|
|
|
|
else begin
|
1997-11-13 01:04:16 -08:00
|
|
|
is_protected := false;
|
1996-11-29 08:55:09 -08:00
|
|
|
if !interrupted then begin interrupted := false; raise Sys.Break end;
|
|
|
|
f ();
|
1997-11-13 01:04:16 -08:00
|
|
|
is_protected := true
|
1996-11-29 08:55:09 -08:00
|
|
|
end
|