haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Migrate from deprecated Format functions.

This commit is contained in:
Peter Zotov 2014-10-20 16:51:50 +04:00
parent 2eea83a65f
commit 789417bfce
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/lib/uTop.cppo.ml
View File

@ -124,25 +124,26 @@ let collect_formatters buf pps f =
(* First flush all formatters. *) (* First flush all formatters. *)
List.iter (fun pp -> Format.pp_print_flush pp ()) pps; List.iter (fun pp -> Format.pp_print_flush pp ()) pps;
(* Save all formatter functions. *) (* Save all formatter functions. *)
let save = List.map (fun pp -> Format.pp_get_all_formatter_output_functions pp ()) pps in let save = List.map (fun pp -> Format.pp_get_formatter_out_functions pp ()) pps in
let restore () = let restore () =
List.iter2 List.iter2
(fun pp (out, flush, newline, spaces) -> (fun pp out_functions ->
Format.pp_print_flush pp (); Format.pp_print_flush pp ();
Format.pp_set_all_formatter_output_functions pp ~out ~flush ~newline ~spaces) Format.pp_set_formatter_out_functions pp out_functions)
pps save pps save
in in
(* Output functions. *) (* Output functions. *)
let out str ofs len = Buffer.add_substring buf str ofs len in let out_string str ofs len = Buffer.add_substring buf str ofs len
let flush = ignore in and out_flush = ignore
let newline () = Buffer.add_char buf '\n' in and out_newline () = Buffer.add_char buf '\n'
let spaces n = for i = 1 to n do Buffer.add_char buf ' ' done in and out_spaces n = for i = 1 to n do Buffer.add_char buf ' ' done in
let out_functions = { Format.out_string; out_flush; out_newline; out_spaces } in
(* Replace formatter functions. *) (* Replace formatter functions. *)
let cols = (S.value size).cols in let cols = (S.value size).cols in
List.iter List.iter
(fun pp -> (fun pp ->
Format.pp_set_margin pp cols; Format.pp_set_margin pp cols;
Format.pp_set_all_formatter_output_functions pp ~out ~flush ~newline ~spaces) Format.pp_set_formatter_out_functions pp out_functions)
pps; pps;
try try
let x = f () in let x = f () in
@ -156,21 +157,21 @@ let discard_formatters pps f =
(* First flush all formatters. *) (* First flush all formatters. *)
List.iter (fun pp -> Format.pp_print_flush pp ()) pps; List.iter (fun pp -> Format.pp_print_flush pp ()) pps;
(* Save all formatter functions. *) (* Save all formatter functions. *)
let save = List.map (fun pp -> Format.pp_get_all_formatter_output_functions pp ()) pps in let save = List.map (fun pp -> Format.pp_get_formatter_out_functions pp ()) pps in
let restore () = let restore () =
List.iter2 List.iter2
(fun pp (out, flush, newline, spaces) -> (fun pp out_functions ->
Format.pp_print_flush pp (); Format.pp_print_flush pp ();
Format.pp_set_all_formatter_output_functions pp ~out ~flush ~newline ~spaces) Format.pp_set_formatter_out_functions pp out_functions)
pps save pps save
in in
(* Output functions. *) (* Output functions. *)
let out str ofs len = () in let out_functions = {
let flush = ignore in Format.out_string = (fun _ _ _ -> ()); out_flush = ignore;
let newline = ignore in out_newline = ignore; out_spaces = ignore;
let spaces = ignore in } in
(* Replace formatter functions. *) (* Replace formatter functions. *)
List.iter (fun pp -> Format.pp_set_all_formatter_output_functions pp ~out ~flush ~newline ~spaces) pps; List.iter (fun pp -> Format.pp_set_formatter_out_functions pp out_functions) pps;
try try
let x = f () in let x = f () in
restore (); restore ();