]> rtime.felk.cvut.cz Git - l4.git/blob - l4/pkg/ocaml/contrib/ocamlbuild/log.ml
update
[l4.git] / l4 / pkg / ocaml / contrib / ocamlbuild / log.ml
1 (***********************************************************************)
2 (*                             ocamlbuild                              *)
3 (*                                                                     *)
4 (*  Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
5 (*                                                                     *)
6 (*  Copyright 2007 Institut National de Recherche en Informatique et   *)
7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
8 (*  under the terms of the Q Public License version 1.0.               *)
9 (*                                                                     *)
10 (***********************************************************************)
11
12
13 (* Original author: Nicolas Pouillard *)
14 open My_std
15
16 module Debug = struct
17 let mode _ = true
18 end
19 include Debug
20
21 let level = ref 1
22
23 let classic_display = ref false
24 let internal_display = ref None
25 let failsafe_display = lazy (Display.create ~mode:`Classic ~log_level:!level ())
26
27 let ( !- ) r =
28   match !r with
29   | None -> !*failsafe_display
30   | Some x -> x
31
32 let init log_file =
33   let mode =
34     if !classic_display || !*My_unix.is_degraded || !level <= 0 || not (My_unix.stdout_isatty ()) then
35       `Classic
36     else
37       `Sophisticated
38   in
39   internal_display := Some (Display.create ~mode ?log_file ~log_level:!level ())
40
41 let raw_dprintf log_level = Display.dprintf ~log_level !-internal_display
42
43 let dprintf log_level fmt = raw_dprintf log_level ("@[<2>"^^fmt^^"@]@.")
44 let eprintf fmt = dprintf (-1) fmt
45
46 let update () = Display.update !-internal_display
47 let event ?pretend x = Display.event !-internal_display ?pretend x
48 let display x = Display.display !-internal_display x
49
50 let finish ?how () =
51   match !internal_display with
52   | None -> ()
53   | Some d -> Display.finish ?how d
54
55 (*let () = My_unix.at_exit_once finish*)