Source file terminal.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
open! Core
open! Import0

module Q = struct
  let ns = "ns" |> Symbol.intern
  let pc = "pc" |> Symbol.intern
  let w32 = "w32" |> Symbol.intern
  let x = "x" |> Symbol.intern
end

let is_terminal = Funcall.Wrap.("terminal-live-p" <: value @-> return bool)

include Value.Make_subtype (struct
    let name = "terminal"
    let here = [%here]
    let is_in_subtype = is_terminal
  end)

module Type = struct
  module T = struct
    type t =
      | Text
      | X11
      | Windows
      | Mac_os
      | Ms_dos
    [@@deriving enumerate, sexp_of]
  end

  include T

  let type_ =
    Value.Type.enum
      [%message "terminal-type"]
      (module T)
      (function
        | Text -> Value.t
        | X11 -> Q.x |> Symbol.to_value
        | Windows -> Q.w32 |> Symbol.to_value
        | Mac_os -> Q.ns |> Symbol.to_value
        | Ms_dos -> Q.pc |> Symbol.to_value)
  ;;

  let t = type_
end

let all_live = Funcall.Wrap.("terminal-list" <: nullary @-> return (list t))
let terminal_type = Funcall.Wrap.("terminal-live-p" <: t @-> return Type.t)
let name = Funcall.Wrap.("terminal-name" <: t @-> return string)

let graphical t =
  match terminal_type t with
  | Text | Ms_dos -> false
  | X11 | Windows | Mac_os -> true
;;