-
Notifications
You must be signed in to change notification settings - Fork 106
/
batFormat.ml
89 lines (75 loc) · 2.98 KB
/
batFormat.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
(*
* ExtFormat - Extended Format module
* Copyright (C) 1996 Pierre Weis
* 2009 David Teller, LIFO, Universite d'Orleans
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
open BatIO
open Format
let output_of out = fun s i o -> ignore (really_output out s i o)
let flush_of out = BatInnerIO.get_flush out
let newline_of out= fun () -> BatInnerIO.write out '\n'
let spaces_of out=
(* Default function to output spaces.
Copied from base format.ml*)
let blank_line = String.make 80 ' ' in
let rec display_blanks n =
if n > 0 then
if n <= 80 then ignore (really_output out blank_line 0 n) else
begin
ignore (really_output out blank_line 0 80);
display_blanks (n - 80)
end
in display_blanks
(**{6 New functions}*)
let formatter_of_output out =
let output = output_of out
and flush = flush_of out
in
let f = make_formatter output flush in
BatInnerIO.on_close_out out (fun _ -> pp_print_flush f ()); (*Note: we can't just use [flush] as [f] contains a cache.*)
pp_set_all_formatter_output_functions f
~out:output
~flush
~newline:(newline_of out)
~spaces:(spaces_of out);
f
let set_formatter_output out =
BatInnerIO.on_close_out out (fun _ -> pp_print_flush Format.std_formatter ());
set_all_formatter_output_functions
~out:(output_of out)
~flush:(flush_of out)
~newline:(newline_of out)
~spaces:(spaces_of out)
let pp_set_formatter_output f out =
BatInnerIO.on_close_out out (fun _ -> pp_print_flush f ());
pp_set_all_formatter_output_functions f
~out:(output_of out)
~flush:(flush_of out)
~newline:(newline_of out)
~spaces:(spaces_of out)
(**{6 Old values, new semantics}*)
let formatter_of_out_channel = formatter_of_output
let set_formatter_out_channel = set_formatter_output
let pp_set_formatter_out_channel = pp_set_formatter_output
let std_formatter = formatter_of_output BatIO.stdout
let err_formatter = formatter_of_output BatIO.stderr
(**{6 Initialization}*)
let _ =
set_formatter_output BatIO.stdout;
pp_set_formatter_output Format.std_formatter stdout;
pp_set_formatter_output Format.err_formatter stderr