summaryrefslogtreecommitdiff
path: root/lib/key.ml
blob: 85aa282905b0a054b41e5a36c65353614f2569d1 (plain) (blame)
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
open Base

type key =
  | Arrow_down
  | Arrow_left
  | Arrow_right
  | Arrow_up
  | Backspace
  | Ctrl of char
  | Delete
  | End
  | Enter
  | Esc
  | Home
  | Key of char
  | Nul
  | Page_down
  | Page_up

type t = key

let ctrl c = Ctrl c
let key c = Key c

let of_char = function
  | '\000' -> Nul
  | '\013' -> Enter
  | '\027' -> Esc
  | '\127' -> Backspace
  | c when Char.(c < ' ') -> Char.to_int c + 64 |> Char.of_int_exn |> ctrl
  | c -> Key c

let stream =
  let step s c =
    let open Sequence.Step in
    let escaped = function
      | 'A' -> Some Arrow_up
      | 'B' -> Some Arrow_down
      | 'C' -> Some Arrow_right
      | 'D' -> Some Arrow_left
      | 'F' -> Some End
      | 'H' -> Some Home
      | _ -> None
    and tilda = function
      | '1' -> Some Home
      | '3' -> Some Delete
      | '4' -> Some End
      | '5' -> Some Page_up
      | '6' -> Some Page_down
      | '7' -> Some Home
      | '8' -> Some End
      | _ -> None
    in
    match (s, c) with
    | `start, Some '\027' -> Skip { state = `esc }
    | `esc, None -> Yield { value = Esc; state = `start }
    | `esc, Some '[' | `escaped, Some 'O' -> Skip { state = `escaped }
    | `escaped, Some i when Char.(i = '1' || ('3' <= i && i <= '8')) ->
        Skip { state = `tilda i }
    | `escaped, c -> (
        match Option.(c >>= escaped) with
        | None -> Skip { state = `state }
        | Some c -> Yield { value = c; state = `start })
    | `tilda i, Some '~' -> (
        match tilda i with
        | None -> Skip { state = `start }
        | Some k -> Yield { value = k; state = `start })
    | `esc, Some _ | `tilda _, _ -> Skip { state = `start }
    | _, None -> Skip { state = `start }
    | _, Some c -> Yield { value = of_char c; state = `start }
  in
  Sequence.unfold_with ~init:`start ~f:step Terminal.char_stream