Merge pull request #821 from tleedjarv/win-color

Try to detect if Windows terminal supports colors
bcpierce00 · Nov 8, 2022 · c675869 · c675869
2 parents 788c267 + feda437
commit c675869
Show file tree

Hide file tree

Showing 5 changed files with 26 additions and 2 deletions.
diff --git a/src/system/system_generic.ml b/src/system/system_generic.ml
@@ -118,6 +118,8 @@ let terminalStateFunctions () =
     startReading = (fun () -> ());
     stopReading = (fun () -> ()) }
 
+let termVtCapable fd = Unix.isatty fd
+
 let has_stdout ~info:_ = true
 let has_stderr ~info:_ = true
 

diff --git a/src/system/system_intf.ml b/src/system/system_intf.ml
@@ -115,6 +115,8 @@ type terminalStateFunctions =
     startReading : unit -> unit; stopReading : unit -> unit }
 val terminalStateFunctions : unit -> terminalStateFunctions
 
+val termVtCapable : Unix.file_descr -> bool
+
 val has_stdout : info:string -> bool
 val has_stderr : info:string -> bool
 

diff --git a/src/system/system_win.ml b/src/system/system_win.ml
@@ -199,5 +199,7 @@ let terminalStateFunctions () =
     startReading = (fun () -> setConsoleMode 0x18);
     stopReading = (fun () -> setConsoleMode 0x19) }
 
+external termVtCapable : Unix.file_descr -> bool = "win_vt_capable"
+
 external has_stdout : info:string -> bool = "win_hasconsole_gui_stdout"
 external has_stderr : info:string -> bool = "win_hasconsole_gui_stderr"
diff --git a/src/system/system_win_stubs.c b/src/system/system_win_stubs.c
@@ -591,3 +591,19 @@ CAMLprim value win_set_console_output_cp (value cp) {
   }
   CAMLreturn(Val_unit);
 }
+
+CAMLprim value win_vt_capable(value fd)
+{
+  CAMLparam1(fd);
+  DWORD mode;
+
+  if (Handle_val(fd) == INVALID_HANDLE_VALUE) {
+    CAMLreturn(Val_int(0));
+  }
+
+  if (!GetConsoleMode(Handle_val(fd), &mode)) {
+    CAMLreturn(Val_int(0));
+  }
+
+  CAMLreturn(Val_int(mode & ENABLE_VIRTUAL_TERMINAL_PROCESSING));
+}
diff --git a/src/uitext.ml b/src/uitext.ml
@@ -104,13 +104,15 @@ let setColorPreference () =
   let envOk = try let _ = System.getenv "NO_COLOR" in false
     with Not_found -> true
   and termOk = try System.getenv "TERM" <> "dumb" with Not_found -> true
-  and ttyOk = (Unix.isatty Unix.stdin) && (Unix.isatty Unix.stderr) in
+  and ttyOk = (Unix.isatty Unix.stdout) && (Unix.isatty Unix.stderr) in
   let colorOk = envOk && termOk && ttyOk && not (Prefs.read dumbtty) in
   colorEnabled :=
     match Prefs.read colorMode with
     | `True    -> true
     | `False   -> false
-    | `Default -> colorOk && Sys.os_type <> "Win32"
+    | `Default -> colorOk && (not Sys.win32
+                    || (System.termVtCapable Unix.stdout
+                        && System.termVtCapable Unix.stderr))
 
 let color t =
   if not !colorEnabled then "" else