dune_console: make refresh rate configurable and default INSIDE_EMACS…

… to 15 (ocaml#8812)

Signed-off-by: Ali Caglayan <alizter@gmail.com>

doc/changes/emacs_fps.md

@@ -0,0 +1 @@
+- Dune will now run at a lower framerate of 15 fps rather than 60 when `INSIDE_EMACS`.

src/dune_config/config.ml

@@ -168,3 +168,19 @@ let threaded_console =
   register t;
   t
 ;;
+
+let threaded_console_frames_per_second =
+  let t =
+    { name = "threaded_console_frames_per_second"
+    ; of_string =
+        (fun x ->
+          match Int.of_string x with
+          | Some x when x > 0 && x <= 1000 -> Ok (`Custom x)
+          | Some _ -> Error (sprintf "value must be between 1 and 1000")
+          | None -> Error (sprintf "could not parse %S as an integer" x))
+    ; value = `Default
+    }
+  in
+  register t;
+  t
+;;

src/dune_config/config.mli

@@ -48,8 +48,12 @@ val background_sandboxes : Toggle.t t
 (** Run file operations when executing rules in background threads *)
 val background_file_system_operations_in_rule_execution : Toggle.t t
 
+(** Whether to use the threaded console. *)
 val threaded_console : Toggle.t t
 
+(** The number of frames per second for the threaded console. *)
+val threaded_console_frames_per_second : [ `Default | `Custom of int ] t
+
 (** Before any configuration value is accessed, this function must be called
     with all the configuration values from the relevant config file
     ([dune-workspace], or [dune-config]).

src/dune_config_file/display.ml

@@ -40,7 +40,9 @@ let console_backend = function
        Dune_console.Backend.dumb
      | true ->
        (match Config.(get threaded_console) with
-        | `Enabled -> Dune_threaded_console.progress ()
+        | `Enabled ->
+          Dune_threaded_console.progress
+            ~frames_per_second:(Dune_util.frames_per_second ())
         | `Disabled ->
           Dune_util.Terminal_signals.unblock ();
           Dune_console.Backend.progress))

src/dune_threaded_console/dune_threaded_console.ml

@@ -1,11 +1,7 @@
 include Dune_threaded_console_intf
 open Stdune
 
-(** [threaded (module T)] is a backend that renders the user interface in a
-    separate thread. The module [T] must implement the [Threaded] interface.
-    There are special functions included to handle various functions of a user
-    interface. *)
-let make (module Base : S) : (module Dune_console.Backend) =
+let make ~frames_per_second (module Base : S) : (module Dune_console.Backend) =
   let module T = struct
     let mutex = Mutex.create ()
     let finish_cv = Condition.create ()
@@ -73,7 +69,7 @@ let make (module Base : S) : (module Dune_console.Backend) =
       @@ fun () ->
       Dune_util.Terminal_signals.unblock ();
       let last = ref (Unix.gettimeofday ()) in
-      let frame_rate = 1. /. 60. in
+      let frame_rate = 1. /. float_of_int frames_per_second in
       let cleanup exn =
         state.finished <- true;
         Option.iter exn ~f:(fun exn ->
@@ -158,8 +154,9 @@ let make (module Base : S) : (module Dune_console.Backend) =
   (module T)
 ;;
 
-let progress () =
+let progress ~frames_per_second =
   make
+    ~frames_per_second
     (module struct
       include (val Dune_console.Backend.progress_no_flush)
 

src/dune_threaded_console/dune_threaded_console.mli

@@ -1,4 +1,11 @@
 include module type of Dune_threaded_console_intf
 
-val make : (module S) -> Dune_console.Backend.t
-val progress : unit -> Dune_console.Backend.t
+(** [make ~frames_per_second (module T)] is a backend that renders the user interface in a
+    separate thread. The module [T] must implement the [Threaded] interface. There are
+    special functions included to handle various functions of a user interface.
+
+    The [frames_per_second] argument controls how often the user interface is updated. *)
+val make : frames_per_second:int -> (module S) -> Dune_console.Backend.t
+
+(** Threaded variant of [Dune_console.Backend.progress]. *)
+val progress : frames_per_second:int -> Dune_console.Backend.t

src/dune_tui/dune

@@ -7,6 +7,7 @@
   dune_nottui
   dune_notty
   dune_notty_unix
+  dune_config
   dune_console
   dune_threaded_console
   threads.posix)

src/dune_tui/dune_tui.ml

@@ -378,7 +378,12 @@ module Console_backend = struct
 end
 
 let backend =
-  let t = lazy (Dune_threaded_console.make (module Console_backend)) in
+  let t =
+    lazy
+      (Dune_threaded_console.make
+         ~frames_per_second:(Dune_util.frames_per_second ())
+         (module Console_backend))
+  in
   fun () ->
     match (Platform.OS.value : Platform.OS.t) with
     | Windows -> User_error.raise [ Pp.text "TUI is currently not supported on Windows." ]

src/dune_util/dune_util.ml

@@ -28,3 +28,10 @@ let xdg =
      in
      Xdg.create ~env:(Env.get env_map) ())
 ;;
+
+let frames_per_second () =
+  match Dune_config.Config.(get threaded_console_frames_per_second) with
+  | `Custom fps -> fps
+  | `Default when Execution_env.inside_emacs -> 15
+  | `Default -> 60
+;;