unikernel/duniverse/dune_/vendor/notty/src-unix/dune

@@ -0,0 +1,10 @@
+(library
+  (synopsis "Notty Unix IO")
+  (name dune_notty_unix)
+  (wrapped false)
+  (foreign_stubs
+    (language c)
+    (names winsize))
+  (libraries dune_notty unix))
+
+(include_subdirs unqualified)

unikernel/duniverse/dune_/vendor/notty/src-unix/native/winsize.c

@@ -0,0 +1,44 @@
+#include <caml/mlvalues.h>
+
+#ifdef _WIN32
+#include <windows.h>
+#else
+#include <sys/ioctl.h>
+#include <signal.h>
+#endif
+
+#ifdef __HAIKU__
+/* On some platforms, ioctl() is declared in <unistd.h>. */
+#include <unistd.h>
+#endif
+
+CAMLprim value caml_notty_winsize (value vfd) {
+#ifdef _WIN32
+  (void) vfd;
+  HANDLE hConsole = GetStdHandle(STD_OUTPUT_HANDLE);
+  if (hConsole == INVALID_HANDLE_VALUE) return Val_int (0);
+
+  CONSOLE_SCREEN_BUFFER_INFO csbi;
+  if (GetConsoleScreenBufferInfo(hConsole, &csbi)) {
+    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);
+#else
+  int fd = Int_val (vfd);
+  struct winsize w;
+  if (ioctl (fd, TIOCGWINSZ, &w) >= 0)
+    return Val_int ((w.ws_col << 16) + ((w.ws_row & 0x7fff) << 1));
+  return Val_int (0);
+#endif
+}
+
+CAMLprim value caml_notty_winch_number (value vunit) {
+  (void) vunit;
+#ifdef _WIN32
+  return Val_int (0);
+#else
+  return Val_int (SIGWINCH);
+#endif
+}

unikernel/duniverse/dune_/vendor/notty/src-unix/notty_unix.ml

@@ -0,0 +1,181 @@
+(* Copyright (c) 2016-2017 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md. *)
+
+open Notty
+
+external c_winsize : Unix.file_descr -> int = "caml_notty_winsize" [@@noalloc]
+external winch_number : unit -> int = "caml_notty_winch_number" [@@noalloc]
+
+let iter f = function Some x -> f x | _ -> ()
+let value x = function Some a -> a | _ -> x
+
+let winsize fd = match c_winsize fd with
+  | 0  -> None
+  | wh -> Some (wh lsr 16, wh lsr 1 land 0x7fff)
+
+module Private = struct
+
+  let once f = let v = lazy (f ()) in fun () -> Lazy.force v
+
+  let cap_for_fd =
+    let open Cap in
+    match Sys.getenv "TERM" with
+    | exception Not_found -> fun _ -> dumb
+    | (""|"dumb")         -> fun _ -> dumb
+    | _                   -> fun fd -> if Unix.isatty fd then ansi else dumb
+
+  let setup_tcattr ~nosig fd =
+    let open Unix in try
+      let tc = tcgetattr fd in
+      let tc1 = { tc with c_icanon = false; c_echo = false } in
+      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
+
+  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)
+
+  module Gen_output (O : sig
+    type fd
+    type k
+    val def   : fd
+    val to_fd : fd -> Unix.file_descr
+    val write : fd -> Buffer.t -> k
+  end) = struct
+
+    let scratch = lazy (Buffer.create 4096)
+
+    let output ?cap ?(fd = O.def) f =
+      let cap = cap |> value (cap_for_fd (O.to_fd fd)) in
+      let buf = Lazy.force scratch in
+      Buffer.reset buf; f buf cap fd; O.write fd buf
+
+    let output_image_size ?cap ?fd f =
+      output ?cap ?fd @@ fun buf cap fd ->
+        let size = winsize (O.to_fd fd) in
+        let i = f (value (80, 24) size) in
+        let dim = match size with
+          | Some (w, _) -> I.(w, height i)
+          | None        -> I.(width i, height i) in
+        Render.to_buffer buf cap (0, 0) dim i
+
+    let show_cursor ?cap ?fd x =
+      output ?cap ?fd @@ fun buf cap _ -> Direct.show_cursor buf cap x
+
+    let move_cursor ?cap ?fd x =
+      output ?cap ?fd @@ fun buf cap _ -> Direct.move_cursor buf cap x
+
+    let output_image ?cap ?fd i = output_image_size ?cap ?fd (fun _ -> i)
+
+    let eol i = I.(i <-> void 0 1)
+  end
+end
+
+open Private
+
+module Term = struct
+
+  module Winch = struct
+
+    let h  = Hashtbl.create 3
+    and id = ref 0
+
+    let add fd f =
+      let n = !id in
+      set_winch_handler (fun () -> Hashtbl.iter (fun _ f -> f ()) h) |> ignore;
+      Hashtbl.add h n (fun () -> winsize fd |> iter f); incr id;
+      `Revert (fun () -> Hashtbl.remove h n)
+  end
+
+  module Input = struct
+
+    type t = {
+      fd      : Unix.file_descr
+    ; flt     : Unescape.t
+    ; ibuf    : bytes
+    ; cleanup : unit -> unit
+    }
+
+    let bsize = 1024
+
+    let create ~nosig fd =
+      let flt  = Unescape.create ()
+      and ibuf = Bytes.create bsize
+      and `Revert cleanup = setup_tcattr ~nosig fd in
+      { fd; flt; ibuf; cleanup }
+
+    let rec event t =
+      match Unescape.next t.flt with
+      | #Unescape.event | `End as r -> r
+      | `Await ->
+          let n = Unix.read t.fd t.ibuf 0 bsize in
+          Unescape.input t.flt t.ibuf 0 n; event t
+  end
+
+  type t = {
+    output   : out_channel
+  ; trm      : Tmachine.t
+  ; buf      : Buffer.t
+  ; input    : Input.t
+  ; fds      : Unix.file_descr * Unix.file_descr
+  ; unwinch  : (unit -> unit) Lazy.t
+  ; mutable winched : bool
+  }
+
+  let write t =
+    Buffer.clear t.buf;
+    Tmachine.output t.trm t.buf;
+    Buffer.output_buffer t.output t.buf; flush t.output
+
+  let set_size t dim = Tmachine.set_size t.trm dim
+  let refresh t      = Tmachine.refresh t.trm; write t
+  let image t image  = Tmachine.image t.trm image; write t
+  let cursor t curs  = Tmachine.cursor t.trm curs; write t
+  let size t         = Tmachine.size t.trm
+
+  let release t =
+    if Tmachine.release t.trm then
+      ( Lazy.force t.unwinch ();
+        t.input.Input.cleanup ();
+        write t )
+
+  let create ?(dispose=true) ?(nosig=true) ?(mouse=true) ?(bpaste=true)
+             ?(input=Unix.stdin) ?(output=Unix.stdout) () =
+    let rec t = {
+        output  = Unix.out_channel_of_descr output
+      ; trm     = Tmachine.create ~mouse ~bpaste (cap_for_fd input)
+      ; buf     = Buffer.create 4096
+      ; input   = Input.create ~nosig input
+      ; fds     = (input, output)
+      ; winched = false
+      ; unwinch = lazy (
+          let `Revert f = Winch.add output @@ fun dim ->
+            Buffer.reset t.buf; t.winched <- true; set_size t dim in f)
+    } in
+    winsize output |> iter (set_size t);
+    (Lazy.force t.unwinch |> ignore) [@ocaml.warning "-5"];
+    if dispose then at_exit (fun () -> release t);
+    write t;
+    t
+
+  let rec event = function
+    | t when Tmachine.dead t.trm -> `End
+    | t when t.winched -> t.winched <- false; `Resize (size t)
+    | t -> Unix.(try Input.event t.input with Unix_error (EINTR, _, _) -> event t)
+
+  let pending t =
+    not (Tmachine.dead t.trm) &&
+    (t.winched || Unescape.pending t.input.Input.flt)
+
+  let fds t = t.fds
+end
+
+include Gen_output (struct
+  type fd = out_channel and k = unit
+  let def   = stdout
+  and to_fd = Unix.descr_of_out_channel
+  and write = Buffer.output_buffer
+end)

unikernel/duniverse/dune_/vendor/notty/src-unix/notty_unix.mli

@@ -0,0 +1,222 @@
+(* Copyright (c) 2016-2017 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md. *)
+
+(** [Notty] IO for pure [Unix].
+
+    This is an IO module for {!Notty}.
+
+    {e 3.20.2 — {{:https://github.com/ocaml/dune }homepage}} *)
+
+open Notty
+
+(** {1:fullscreen Fullscreen input and output}. *)
+
+(** Terminal IO abstraction for fullscreen, interactive applications.
+
+    This module provides both input and output. It assumes exclusive ownership of
+    the IO streams between {{!create}initialization} and {{!release}shutdown}. *)
+module Term : sig
+
+  type t
+  (** Representation of the terminal, giving structured access to IO. *)
+
+  (** {1 Construction and destruction} *)
+
+  val create : ?dispose:bool ->
+               ?nosig:bool ->
+               ?mouse:bool ->
+               ?bpaste:bool ->
+               ?input:Unix.file_descr ->
+               ?output:Unix.file_descr ->
+               unit -> t
+  (** [create ~dispose ~nosig ~mouse ~input ~output ()] creates a fresh
+      {{!t}terminal}. It has the following side effects:
+      {ul
+      {- [Unix.tcsetattr] is applied to [input] to disable {e echo} and
+         {e canonical mode}.}
+      {- [output] is set to {e alternate screen mode}, and the cursor is
+         hidden. Mouse and {e bracketed paste} reporting are (optionally)
+         enabled.}
+      {- [SIGWINCH] signal, normally ignored, is handled.}}
+
+      [~dispose] arranges for automatic {{!release}cleanup} of the terminal
+      before the process terminates. The downside is that a reference to this
+      terminal is retained until the program exits. Defaults to [true].
+
+      [~nosig] additionally turns off signal delivery and flow control
+      ({e isig} and {e ixon}) on input. Inhibits automatic handling of
+      {e CTRL-\{C,Z,\,S,Q\}}. Defaults to [true].
+
+      [~mouse] activates mouse reporting. Defaults to [true].
+
+      [~bpaste] activates bracketed paste reporting. Defaults to [true].
+
+      [~input] is the input file descriptor. Defaults to [stdin].
+
+      [~output] is the output file descriptor. Defaults to [stdout]. *)
+
+  val release : t -> unit
+  (** Dispose of this terminal. Original behavior of input fd is reinstated,
+      cursor is restored, mouse reporting disabled, and alternate mode is
+      terminated.
+
+      It is an error to use the {{!cmds}commands} on a released terminal, and
+      will raise [Invalid_argument], while [release] itself is idempotent. *)
+
+  (** {1:cmds Commands} *)
+
+  val image : t -> image -> unit
+  (** [image t i] sets [i] as [t]'s current image and redraws the terminal. *)
+
+  val refresh : t -> unit
+  (** [refresh t] redraws the terminal using the current image.
+
+      Useful if the output might have become garbled. *)
+
+  val cursor : t -> (int * int) option -> unit
+  (** [cursor t pos] sets and redraws the cursor.
+
+      [None] hides it. [Some (x, y)] places it at column [x] and row [y], with
+      the origin at [(0, 0)], mapping to the upper-left corner. *)
+
+  (** {1 Events} *)
+
+  val event : t -> [ Unescape.event | `Resize of (int * int) | `End ]
+  (** Wait for a new event. [event t] can be:
+      {ul
+      {- [#Unescape.event], an {{!Notty.Unescape.event}[event]} from the input fd;}
+      {- [`End] if the input fd is closed, or the terminal was released; or}
+      {- [`Resize (cols, rows)] giving the current size of the output tty, if a
+         [SIGWINCH] was delivered before or during this call to [event].}}
+
+      {b Note} [event] is buffered. Calls can either block or immediately
+      return. Use {{!pending}[pending]} to detect when the next call would not
+      block. *)
+
+  val pending : t -> bool
+  (** [pending t] is [true] if the next call to {{!event}[event]} would not
+      block and the terminal has not yet been released. *)
+
+  (** {1 Properties} *)
+
+  val size : t -> int * int
+  (** [size t] is the current size of the terminal's output tty. *)
+
+  val fds : t -> Unix.file_descr * Unix.file_descr
+  (** [fds t] are [t]'s input and output file descriptors. *)
+
+  (** {1 Window size change notifications} *)
+
+  (** Manual [SIGWINCH] handling.
+
+      Unix delivers notifications about tty size changes through the [SIGWINCH]
+      signal. A handler for this signal is installed as soon as a new terminal
+      is {{!create}created}. Replacing the global [SIGWINCH] handler using
+      the [Sys] module will cause this module to malfunction, as the size change
+      notifications will no longer be delivered.
+
+      You might still want to ignore resizes reported by {{!event}[event]} and
+      directly listen to [SIGWINCH]. This module allows installing such
+      listeners without conflicting with the rest of the machinery. *)
+  module Winch : sig
+
+    val add : Unix.file_descr -> ((int * int) -> unit) -> [`Revert of unit -> unit]
+    (** [add fd f] registers a [SIGWINCH] handler. Every time the signal is
+        delivered, [f] is called with the current size of the tty backing [fd].
+        If [fd] is not a tty, [f] is never called.
+
+        Return value is a function that removes the handler [f].
+
+        Handlers are called in an unspecified order. *)
+
+  end
+end
+
+(** {1:inline Inline output}
+
+    These operations do not assume exclusive access to the output. This means
+    that they can be combined with other means of producing output. At the same
+    time, it means that they are affected by the current terminal state, and
+    that this state is not tracked. *)
+
+val winsize : Unix.file_descr -> (int * int) option
+(** [winsize fd] is [Some (columns, rows)], the current dimensions of [fd]'s
+    backing tty, or [None], when [fd] is not backed by a tty. *)
+
+val eol : image -> image
+(** [eol image] is [image], producing an extra newline when printed. *)
+
+val output_image :
+  ?cap:Cap.t -> ?fd:out_channel -> image -> unit
+(** [output_image ?cap ?fd image] writes [image] to [fd].
+
+    The image is displayed in its full height. If the output is a tty, image
+    width is clipped to the output width. Otherwise, full width is used.
+
+    [~cap] is the {{!caps}optional} terminal capability set.
+
+    [~fd] defaults to [stdout]. *)
+
+val output_image_size : ?cap:Cap.t -> ?fd:out_channel -> (int * int -> image) -> unit
+(** [output_image_size ?cap ?fd f] is
+    [output_image ?cap ?fd (f size)] where [size] are [fd]'s current
+    {{!winsize}output dimensions}.
+
+    If [fd] is not backed by a tty, as a matter of convenience, [f] is applied
+    to [(80, 24)]. Use {!Unix.isatty} or {{!winsize}[winsize]} to detect whether
+    the output has a well-defined size. *)
+
+val show_cursor : ?cap:Cap.t -> ?fd:out_channel -> bool -> unit
+(** [show_cursor ?cap ?fd visible] toggles the cursor visibility on [fd]. *)
+
+val move_cursor :
+  ?cap:Cap.t -> ?fd:out_channel ->
+    [ `Home | `By of int * int | `To of int * int ] -> unit
+(** [move_cursor ?cap ?fd motion] moves the cursor on [fd].
+
+    [motion] is one of:
+    {ul
+    {- [`To (column, line)], positioning the cursor to [(column, line)]. Origin
+       is [(0, 0)], the upper-left corner of the screen.}
+    {- [`Home], moving the cursor the beginning of line.}
+    {- [`By (columns, lines)], moving the cursor [columns] to the right (left if
+       negative) and [lines] down (up if negative).
+
+       {b Note} Behavior is terminal dependent if the movement overshoots the
+       output size.}} *)
+
+(** {1:caps Capability detection}
+
+    All [image] output requires {{!Notty.Cap.t}terminal capabilities}.
+
+    When not provided, capabilities are auto-detected, by checking that the
+    output is a tty, that the environment variable [$TERM] is set, and that it
+    is not set to either [""] or ["dumb"]. If these conditions hold,
+    {{!Notty.Cap.ansi}ANSI} escapes are used. Otherwise, {{!Notty.Cap.dumb}no}
+    escapes are used. *)
+
+(**/**)
+(** {1 Private}
+
+    These are private interfaces, prone to breakage. Don't use them. *)
+module Private : sig
+
+  val cap_for_fd        : Unix.file_descr -> Cap.t
+  val setup_tcattr      : nosig:bool -> Unix.file_descr -> [ `Revert of (unit -> unit) ]
+  val set_winch_handler : (unit -> unit) -> [ `Revert of (unit -> unit) ]
+
+  module Gen_output (O : sig
+    type fd
+    type k
+    val def   : fd
+    val to_fd : fd -> Unix.file_descr
+    val write : fd -> Buffer.t -> k
+  end ) : sig
+    val output_image : ?cap:Cap.t -> ?fd:O.fd -> image -> O.k
+    val output_image_size : ?cap:Cap.t -> ?fd:O.fd -> (int * int -> image) -> O.k
+    val show_cursor : ?cap:Cap.t -> ?fd:O.fd -> bool -> O.k
+    val move_cursor : ?cap:Cap.t -> ?fd:O.fd -> [ `Home | `By of int * int | `To of int * int ] -> O.k
+    val eol : image -> image
+  end
+end
+(**/**)