MS Windows console support

dune-project

@@ -2,5 +2,6 @@
 (name notty-community)
 (version 0.2.4)
 
+(homepage https://github.com/ocaml-community/notty-community)
 (formatting disabled)
 (generate_opam_files false)

src-unix/dune

@@ -1,14 +1,20 @@
+(rule
+  (with-stdout-to c_flags.cc (echo "(-Wall -Wextra -O3)")))
+
+(rule
+  (with-stdout-to c_flags.msvc (echo "(/W2 /Ox)")))
+
 (library
   (public_name notty-community.unix)
   (synopsis "Notty Unix IO")
   (name notty_unix)
   (wrapped false)
   (foreign_stubs
     (language c)
-    (names winsize)
+    (names winsize win_console)
     (flags
       :standard
-      (-Wall -Wextra -O3)))
+      (:include c_flags.%{ocaml-config:ccomp_type})))
   (optional)
   (libraries notty-community unix))
 

src-unix/native/win_console.c

@@ -0,0 +1,69 @@
+#include <caml/mlvalues.h>
+
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+/* Some older MinGW/CYGWIN distributions don't define these */
+#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
+#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
+#endif
+
+#ifndef ENABLE_VIRTUAL_TERMINAL_INPUT
+#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
+#endif
+
+#ifndef DISABLE_NEWLINE_AUTO_RETURN
+#define DISABLE_NEWLINE_AUTO_RETURN 0x0008
+#endif
+
+/* Enable ANSI escape sequence processing on Windows 10+ console
+   Returns 1 on success, 0 on failure */
+CAMLprim value caml_notty_setup_windows_console(value vunit) {
+  (void) vunit;
+
+  HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
+  HANDLE hIn = GetStdHandle(STD_INPUT_HANDLE);
+
+  if (hOut == INVALID_HANDLE_VALUE || hIn == INVALID_HANDLE_VALUE) {
+    return Val_int(0);
+  }
+
+  DWORD outMode = 0, inMode = 0;
+
+  /* Enable VT processing for output (colors, cursor control, etc.) */
+  if (GetConsoleMode(hOut, &outMode)) {
+    outMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
+    /* Disable wrapping at end of line to avoid scrolling issues */
+    outMode |= DISABLE_NEWLINE_AUTO_RETURN;
+    if (!SetConsoleMode(hOut, outMode)) {
+      return Val_int(0);
+    }
+  } else {
+    return Val_int(0);
+  }
+
+  /* Enable VT processing for input (better key handling) */
+  if (GetConsoleMode(hIn, &inMode)) {
+    inMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
+    /* Disable line input and echo for raw input */
+    inMode &= ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT);
+    /* Enable window input for resize events */
+    inMode |= ENABLE_WINDOW_INPUT;
+    if (!SetConsoleMode(hIn, inMode)) {
+      /* Input mode failure is not critical, continue */
+    }
+  }
+
+  return Val_int(1);
+}
+
+#else
+
+/* Non-Windows platforms: no-op, always return success */
+CAMLprim value caml_notty_setup_windows_console(value vunit) {
+  (void) vunit;
+  return Val_int(1);
+}
+
+#endif

src-unix/native/winsize.c

@@ -1,6 +1,47 @@
+#include <caml/mlvalues.h>
+
+/* Portable unused parameter macro */
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L
+#define unused(x) [[maybe_unused]] x
+#elif defined(__GNUC__)
+#define unused(x) __attribute__((unused)) x
+#else
+#define unused(x) x
+#endif
+
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+CAMLprim value caml_notty_winsize (unused(value vfd))
+{
+  CONSOLE_SCREEN_BUFFER_INFO csbi;
+  HANDLE hConsole = GetStdHandle(STD_OUTPUT_HANDLE);
+  if (hConsole == INVALID_HANDLE_VALUE) return Val_int(0);
+
+  if (GetConsoleScreenBufferInfo(hConsole, &csbi)) {
+    /* Use window dimensions (visible area) not buffer size */
+    int columns = csbi.srWindow.Right - csbi.srWindow.Left + 1;
+    int rows = csbi.srWindow.Bottom - csbi.srWindow.Top + 1;
+    return Val_int((columns << 16) + ((rows & 0x7fff) << 1));
+  }
+  return Val_int(0);
+}
+
+CAMLprim value caml_notty_winch_number (unused(value vunit)) {
+  /* Windows doesn't have SIGWINCH, return 0 to indicate no signal */
+  return Val_int(0);
+}
+
+#else
+
 #include <sys/ioctl.h>
 #include <signal.h>
-#include <caml/mlvalues.h>
+
+#ifdef __HAIKU__
+/* On some platforms, ioctl() is declared in <unistd.h>. */
+#include <unistd.h>
+#endif
 
 CAMLprim value caml_notty_winsize (value vfd) {
   int fd = Int_val (vfd);
@@ -10,8 +51,8 @@ CAMLprim value caml_notty_winsize (value vfd) {
   return Val_int (0);
 }
 
-#define __unit() value unit __attribute__((unused))
-
-CAMLprim value caml_notty_winch_number (__unit()) {
+CAMLprim value caml_notty_winch_number (unused(value vunit)) {
   return Val_int (SIGWINCH);
 }
+
+#endif

src-unix/notty_unix.ml

@@ -5,6 +5,7 @@ open Notty
 
 external c_winsize : Unix.file_descr -> int = "caml_notty_winsize" [@@noalloc]
 external winch_number : unit -> int = "caml_notty_winch_number" [@@noalloc]
+external setup_windows_console : unit -> int = "caml_notty_setup_windows_console" [@@noalloc]
 
 let iter f = function Some x -> f x | _ -> ()
 let value x = function Some a -> a | _ -> x
@@ -19,10 +20,14 @@ module Private = struct
 
   let cap_for_fd =
     let open Cap in
+    let windows_vt_enabled = lazy (setup_windows_console () = 1) in
     match Sys.getenv "TERM" with
-    | exception Not_found -> fun _ -> dumb
-    | (""|"dumb")         -> fun _ -> dumb
-    | _                   -> fun fd -> if Unix.isatty fd then ansi else dumb
+    | exception Not_found ->
+        (* No TERM variable: likely Windows. Try to enable VT processing. *)
+        fun fd ->
+          if Unix.isatty fd && Lazy.force windows_vt_enabled then ansi else dumb
+    | (""|"dumb") -> fun _ -> dumb
+    | _ -> fun fd -> if Unix.isatty fd then ansi else dumb
 
   let setup_tcattr ~nosig fd =
     let open Unix in try
@@ -31,12 +36,16 @@ module Private = struct
       tcsetattr fd TCSANOW
         ( if nosig then { tc1 with c_isig = false; c_ixon = false } else tc1 );
       `Revert (once @@ fun _ -> tcsetattr fd TCSANOW tc)
-    with Unix_error (ENOTTY, _, _) -> `Revert ignore
+    with
+    | Unix_error (ENOTTY, _, _) -> `Revert ignore
+    | Invalid_argument _ -> `Revert ignore  (* Windows: tcgetattr not implemented *)
 
   let set_winch_handler f =
-    let signum = winch_number () in
-    let old_hdl = Sys.(signal signum (Signal_handle (fun _ -> f ()))) in
-    `Revert (once @@ fun () -> Sys.set_signal signum old_hdl)
+    match winch_number () with
+    | 0 -> `Revert (once @@ fun () -> ())
+    | signum ->
+       let old_hdl = Sys.(signal signum (Signal_handle (fun _ -> f ()))) in
+       `Revert (once @@ fun () -> Sys.set_signal signum old_hdl)
 
   module Gen_output (O : sig
     type fd

src/notty.ml

@@ -739,7 +739,7 @@ module Unescape = struct
 
     | C0 '\x1b'        -> key `Escape []
     | C0 ('\b'|'\x7f') -> key `Backspace []
-    | C0 '\n'          -> key `Enter []
+    | C0 ('\n'|'\r')   -> key `Enter []
     | C0 '\t'          -> key `Tab []
 
     | C0 x -> key (`ASCII Char.(code x + 0x40 |> unsafe_chr)) [`Ctrl]