summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--otherlibs/labltk/browser/jg_message.ml15
-rw-r--r--otherlibs/labltk/browser/jg_message.mli1
-rw-r--r--otherlibs/labltk/browser/main.ml1
-rw-r--r--otherlibs/labltk/browser/typecheck.ml21
4 files changed, 21 insertions, 17 deletions
diff --git a/otherlibs/labltk/browser/jg_message.ml b/otherlibs/labltk/browser/jg_message.ml
index 95783af22..7238126d7 100644
--- a/otherlibs/labltk/browser/jg_message.ml
+++ b/otherlibs/labltk/browser/jg_message.ml
@@ -41,7 +41,8 @@ class formatted :parent :width :maxheight :minheight =
end
*)
-let formatted :title ?:on ?(:width=60) ?(:maxheight=10) ?(:minheight=0) () =
+let formatted :title ?:on ?(:ppf = Format.std_formatter)
+ ?(:width=60) ?(:maxheight=10) ?(:minheight=0) () =
let tl, frame =
match on with
Some frame -> coe frame, frame
@@ -54,15 +55,15 @@ let formatted :title ?:on ?(:width=60) ?(:maxheight=10) ?(:minheight=0) () =
in
let tw = Text.create frame :width wrap:`Word in
pack [tw] side:`Left fill:`Both expand:true;
- Format.print_flush ();
- Format.set_margin (width - 2);
- let fof,fff = Format.get_formatter_output_functions () in
- Format.set_formatter_output_functions
+ Format.pp_print_flush ppf ();
+ Format.pp_set_margin ppf (width - 2);
+ let fof,fff = Format.pp_get_formatter_output_functions ppf () in
+ Format.pp_set_formatter_output_functions ppf
out:(Jg_text.output tw) flush:(fun () -> ());
tl, tw,
begin fun () ->
- Format.print_flush ();
- Format.set_formatter_output_functions out:fof flush:fff;
+ Format.pp_print_flush ppf ();
+ Format.pp_set_formatter_output_functions ppf out:fof flush:fff;
let `Linechar (l, _) = Text.index tw index:(tposend 1) in
Text.configure tw height:(max minheight (min l maxheight));
if l > 5 then
diff --git a/otherlibs/labltk/browser/jg_message.mli b/otherlibs/labltk/browser/jg_message.mli
index 5803bc0cd..ed638db40 100644
--- a/otherlibs/labltk/browser/jg_message.mli
+++ b/otherlibs/labltk/browser/jg_message.mli
@@ -16,6 +16,7 @@
val formatted :
title:string ->
?on:Widget.frame Widget.widget ->
+ ?ppf:Format.formatter ->
?width:int ->
?maxheight:int ->
?minheight:int ->
diff --git a/otherlibs/labltk/browser/main.ml b/otherlibs/labltk/browser/main.ml
index 217c3acde..e59d65781 100644
--- a/otherlibs/labltk/browser/main.ml
+++ b/otherlibs/labltk/browser/main.ml
@@ -38,6 +38,7 @@ let _ =
errmsg:"ocamlbrowser :";
Config.load_path := List.rev !path @ [Config.standard_library];
Warnings.parse_options !Shell.warnings;
+ Unix.putenv "TERM" "noterminal";
begin
try Searchid.start_env := Env.open_pers_signature "Pervasives" Env.initial
with Env.Error _ -> ()
diff --git a/otherlibs/labltk/browser/typecheck.ml b/otherlibs/labltk/browser/typecheck.ml
index c3666c8da..90cd1aca5 100644
--- a/otherlibs/labltk/browser/typecheck.ml
+++ b/otherlibs/labltk/browser/typecheck.ml
@@ -25,7 +25,8 @@ let f txt =
let error_messages = ref [] in
let text = Jg_text.get_all txt.tw
and env = ref (Env.open_pers_signature "Pervasives" Env.initial) in
- let tl, ew, end_message = Jg_message.formatted title:"Warnings" () in
+ let tl, ew, end_message =
+ Jg_message.formatted title:"Warnings" ppf:Format.err_formatter () in
Text.tag_remove txt.tw tag:"error" start:tstart end:tend;
begin
txt.structure <- [];
@@ -61,31 +62,31 @@ let f txt =
error_messages := et :: !error_messages;
let s, e = match exn with
Lexer.Error (err, s, e) ->
- Lexer.report_error Format.err_formatter err; s,e
+ Lexer.report_error Format.std_formatter err; s,e
| Syntaxerr.Error err ->
- Syntaxerr.report_error Format.err_formatter err;
+ Syntaxerr.report_error Format.std_formatter err;
let l =
match err with
Syntaxerr.Unclosed(l,_,_,_) -> l
| Syntaxerr.Other l -> l
in l.loc_start, l.loc_end
| Typecore.Error (l,err) ->
- Typecore.report_error Format.err_formatter err;
+ Typecore.report_error Format.std_formatter err;
l.loc_start, l.loc_end
| Typeclass.Error (l,err) ->
- Typeclass.report_error Format.err_formatter err;
+ Typeclass.report_error Format.std_formatter err;
l.loc_start, l.loc_end
| Typedecl.Error (l, err) ->
- Typedecl.report_error Format.err_formatter err;
+ Typedecl.report_error Format.std_formatter err;
l.loc_start, l.loc_end
| Typemod.Error (l,err) ->
- Typemod.report_error Format.err_formatter err; l.loc_start, l.loc_end
+ Typemod.report_error Format.std_formatter err; l.loc_start, l.loc_end
| Typetexp.Error (l,err) ->
- Typetexp.report_error Format.err_formatter err; l.loc_start, l.loc_end
+ Typetexp.report_error Format.std_formatter err; l.loc_start, l.loc_end
| Includemod.Error errl ->
- Includemod.report_error Format.err_formatter errl; 0, 0
+ Includemod.report_error Format.std_formatter errl; 0, 0
| Env.Error err ->
- Env.report_error Format.err_formatter err; 0, 0
+ Env.report_error Format.std_formatter err; 0, 0
| Ctype.Tags(l, l') ->
Format.printf "In this program,@ variant constructors@ `%s and `%s@ have same hash value.@." l l'; 0, 0
| _ -> assert false