Merge pull request #821 from tleedjarv/win-color

Try to detect if Windows terminal supports colors

Author: gdt

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
 

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
 

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"

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));
+}

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