diff options
| -rw-r--r-- | otherlibs/labltk/browser/jg_message.ml | 15 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/jg_message.mli | 1 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/main.ml | 1 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/typecheck.ml | 21 |
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 |