diff options
Diffstat (limited to 'lib/command.ml')
-rw-r--r-- | lib/command.ml | 115 |
1 files changed, 115 insertions, 0 deletions
diff --git a/lib/command.ml b/lib/command.ml new file mode 100644 index 0000000..7dedc6c --- /dev/null +++ b/lib/command.ml | |||
@@ -0,0 +1,115 @@ | |||
1 | open Base | ||
2 | open Key | ||
3 | |||
4 | type register = char option | ||
5 | type count = int option | ||
6 | type operation = Noop | Yank | Paste | Delete | Change | ||
7 | type scope = Line | To_bol | To_eol | Down | Left | Right | Up | ||
8 | |||
9 | type command = | ||
10 | | Type of char | ||
11 | | Simple of Key.t | ||
12 | | Partial of Key.t | ||
13 | | Shortcut of register * count * operation * scope | ||
14 | | Chord of register * count * operation * count * scope | ||
15 | |||
16 | type t = command | ||
17 | |||
18 | let shortcut ?r ?n c s = Shortcut (r, n, c, s) | ||
19 | let chord ?r ?n1 c ?n2 m = Chord (r, n1, c, n2, m) | ||
20 | |||
21 | let i_stream = | ||
22 | let step s k = | ||
23 | let open Sequence.Step in | ||
24 | match (s, k) with | ||
25 | | `start, Key c -> Yield { value = Type c; state = `start } | ||
26 | | `start, _ -> Yield { value = Simple k; state = `start } | ||
27 | | _, _ -> Skip { state = `start } | ||
28 | in | ||
29 | Sequence.unfold_with ~init:`start ~f:step Key.stream | ||
30 | |||
31 | let simple_movements = | ||
32 | [ | ||
33 | Key 'h'; | ||
34 | Key 'j'; | ||
35 | Key 'k'; | ||
36 | Key 'l'; | ||
37 | Key ' '; | ||
38 | Arrow_up; | ||
39 | Arrow_down; | ||
40 | Arrow_left; | ||
41 | Arrow_right; | ||
42 | Backspace; | ||
43 | ] | ||
44 | |||
45 | let to_scope = function | ||
46 | | Key 'j' | Arrow_down -> Down | ||
47 | | Key 'h' | Arrow_left | Backspace -> Left | ||
48 | | Key 'l' | Key ' ' | Arrow_right -> Right | ||
49 | | Key 'k' | Arrow_up -> Up | ||
50 | | _ -> failwith "Invalid motion." | ||
51 | |||
52 | let n_stream = | ||
53 | let step s k = | ||
54 | let open Sequence.Step in | ||
55 | let is_chord_op c = String.contains "ydc" (Char.lowercase c) in | ||
56 | let is_simple_movement k = List.mem ~equal:Poly.equal simple_movements k in | ||
57 | let to_op c = | ||
58 | match Char.lowercase c with | ||
59 | | 'y' -> Yank | ||
60 | | 'p' -> Paste | ||
61 | | 'd' -> Delete | ||
62 | | 'c' -> Change | ||
63 | | _ -> failwith "Invalid operation in chord." | ||
64 | in | ||
65 | match (s, k) with | ||
66 | | `start, Key '"' -> Yield { value = Partial k; state = `chord_reg_pre } | ||
67 | | `chord_reg_pre, Key c -> Yield { value = Partial k; state = `chord_reg c } | ||
68 | | `chord_reg r, Key n when Char.('1' <= n && n <= '9') -> | ||
69 | let n = Char.to_int n - 48 in | ||
70 | Yield { value = Partial k; state = `chord_n (Some r, n) } | ||
71 | | `start, Key n when Char.('1' <= n && n <= '9') -> | ||
72 | let n = Char.to_int n - 48 in | ||
73 | Yield { value = Partial k; state = `chord_n (None, n) } | ||
74 | | `chord_n (r, m), Key n when Char.('0' <= n && n <= '9') -> | ||
75 | let n = (10 * m) + Char.to_int n - 48 in | ||
76 | Yield { value = Partial k; state = `chord_n (r, n) } | ||
77 | | `start, Key c when is_chord_op c -> | ||
78 | if Char.is_uppercase c then | ||
79 | Yield { value = shortcut (to_op c) To_eol; state = `start } | ||
80 | else | ||
81 | Yield { value = Partial k; state = `chord_cmd (None, None, to_op c) } | ||
82 | | `chord_reg r, Key c when is_chord_op c -> | ||
83 | if Char.is_uppercase c then | ||
84 | Yield { value = shortcut ~r (to_op c) To_eol; state = `start } | ||
85 | else | ||
86 | Yield | ||
87 | { value = Partial k; state = `chord_cmd (Some r, None, to_op c) } | ||
88 | | `chord_n (r, n), Key c when is_chord_op c -> | ||
89 | if Char.is_uppercase c then | ||
90 | Yield { value = shortcut ?r ~n (to_op c) To_eol; state = `start } | ||
91 | else | ||
92 | Yield { value = Partial k; state = `chord_cmd (r, Some n, to_op c) } | ||
93 | | `chord_cmd (r, n, c), Key ch when is_chord_op ch && Poly.(c = to_op ch) -> | ||
94 | if Char.is_uppercase ch then | ||
95 | Yield { value = shortcut ?r ?n c To_bol; state = `start } | ||
96 | else Yield { value = shortcut ?r ?n c Line; state = `start } | ||
97 | | (`start | `chord_reg _), k when is_simple_movement k -> | ||
98 | Yield { value = chord Noop (to_scope k); state = `start } | ||
99 | | `chord_n (_, n), k when is_simple_movement k -> | ||
100 | Yield { value = chord ~n1:n Noop (to_scope k); state = `start } | ||
101 | | `chord_cmd (r, n, c), k when is_simple_movement k -> | ||
102 | Yield { value = chord ?r ?n1:n c (to_scope k); state = `start } | ||
103 | | `chord_cmd (r, n1, c), Key n when Char.('1' <= n && n <= '9') -> | ||
104 | let n = Char.to_int n - 48 in | ||
105 | Yield { value = Partial k; state = `chord_mv_n (r, n1, c, n) } | ||
106 | | `chord_mv_n (r, n1, c, n2), Key n when Char.('0' <= n && n <= '9') -> | ||
107 | let n2 = (10 * n2) + Char.to_int n - 48 in | ||
108 | Yield { value = Partial k; state = `chord_mv_n (r, n1, c, n2) } | ||
109 | | `chord_mv_n (r, n1, c, n2), k when is_simple_movement k -> | ||
110 | Yield { value = chord ?r ?n1 c ~n2 (to_scope k); state = `start } | ||
111 | (* Catch-all rules *) | ||
112 | | `start, _ -> Yield { value = Simple k; state = `start } | ||
113 | | _, _ -> Skip { state = `start } | ||
114 | in | ||
115 | Sequence.unfold_with ~init:`start ~f:step Key.stream | ||