add UTop.set_margin_function

src/lib/uTop.cppo.ml

@@ -80,6 +80,8 @@ let topfind_verbose, get_topfind_verbose, set_topfind_verbose = make_variable fa
 let end_and_accept_current_phrase : LTerm_read_line.action =
   Edit (Custom (fun () -> assert false))
 
+let set_margin_function f = UTop_private.set_margin_function f
+
 (* +-----------------------------------------------------------------+
    | Keywords                                                        |
    +-----------------------------------------------------------------+ *)
@@ -104,7 +106,7 @@ let add_keyword kwd = keywords := String_set.add kwd !keywords
 let get_message func x =
   let buffer = Buffer.create 1024 in
   let pp = Format.formatter_of_buffer buffer in
-  Format.pp_set_margin pp (S.value size).cols;
+  UTop_private.set_margin pp;
   func pp x;
   Format.pp_print_flush pp ();
   Buffer.contents buffer
@@ -112,7 +114,7 @@ let get_message func x =
 let get_ocaml_error_message exn =
   let buffer = Buffer.create 1024 in
   let pp = Format.formatter_of_buffer buffer in
-  Format.pp_set_margin pp (S.value size).cols;
+  UTop_private.set_margin pp;
   Errors.report_error pp exn;
   Format.pp_print_flush pp ();
   let str = Buffer.contents buffer in
@@ -143,10 +145,9 @@ let collect_formatters buf pps f =
   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. *)
-  let cols = (S.value size).cols in
   List.iter
     (fun pp ->
-       Format.pp_set_margin pp cols;
+       UTop_private.set_margin pp;
        Format.pp_set_formatter_out_functions pp out_functions)
     pps;
   try

src/lib/uTop.mli

@@ -73,6 +73,16 @@ val get_show_box : unit -> bool
 val set_show_box : bool -> unit
   (** Modifies {!show_box}. *)
 
+val set_margin_function : (LTerm_geom.size -> int option) -> unit
+  (** Margin of the standard and error formatters as a function of the screen size.
+
+      The default is:
+
+      {[
+        fun size -> Some (max 80 size.cols)
+      ]}
+  *)
+
 (** Syntax. *)
 type syntax =
   | Normal

src/lib/uTop_main.cppo.ml

@@ -585,10 +585,6 @@ let rec read_phrase term =
       read_phrase term
     | exn -> Lwt.fail exn)
 
-let update_margin pp cols =
-  if Format.pp_get_margin pp () <> cols then
-    Format.pp_set_margin pp cols
-
 let print_error term msg =
   LTerm.set_style term styles.style_error >>= fun () ->
   Lwt_io.print msg >>= fun () ->
@@ -628,13 +624,12 @@ let rec loop term =
         (* Rewrite toplevel expressions. *)
         let phrase = rewrite phrase in
         (* Set the margin of standard formatters. *)
-        let cols = (LTerm.size term).cols in
+        UTop_private.set_margin Format.std_formatter;
-        update_margin Format.std_formatter cols;
+        UTop_private.set_margin Format.err_formatter;
-        update_margin Format.err_formatter cols;
         (* Formatter to get the output phrase. *)
         let buffer = Buffer.create 1024 in
         let pp = Format.formatter_of_buffer buffer in
-        Format.pp_set_margin pp (LTerm.size term).cols;
+        UTop_private.set_margin pp;
         (try
            Env.reset_cache_toplevel ();
            if !Clflags.dump_parsetree then Printast.top_phrase pp phrase;

src/lib/uTop_private.ml

@@ -29,3 +29,13 @@ let error_style = ref LTerm_style.none
 
 (* Config from ~/.utoprc *)
 let autoload = ref true
+
+let margin_function, set_margin_function =
+  S.create ~eq:( == ) (fun (size : LTerm_geom.size) -> Some (min 80 size.cols))
+
+let margin = S.app margin_function size
+
+let set_margin pp =
+  match S.value margin with
+  | None   -> ()
+  | Some n -> if Format.pp_get_margin pp () <> n then Format.pp_set_margin pp n