open Base open Key type register = char option type count = int option type operation = Noop | Yank | Paste | Delete | Change type scope = Line | To_bol | To_eol | Down | Left | Right | Up type command = | Type of char | Simple of Key.t | Partial of Key.t | Shortcut of register * count * operation * scope | Chord of register * count * operation * count * scope type t = command let shortcut ?r ?n c s = Shortcut (r, n, c, s) let chord ?r ?n1 c ?n2 m = Chord (r, n1, c, n2, m) let i_stream = let step s k = let open Sequence.Step in match (s, k) with | `start, Key c -> Yield { value = Type c; state = `start } | `start, _ -> Yield { value = Simple k; state = `start } | _, _ -> Skip { state = `start } in Sequence.unfold_with ~init:`start ~f:step Key.stream let simple_movements = [ Key 'h'; Key 'j'; Key 'k'; Key 'l'; Key ' '; Arrow_up; Arrow_down; Arrow_left; Arrow_right; Backspace; ] let to_scope = function | Key 'j' | Arrow_down -> Down | Key 'h' | Arrow_left | Backspace -> Left | Key 'l' | Key ' ' | Arrow_right -> Right | Key 'k' | Arrow_up -> Up | _ -> failwith "Invalid motion." let n_stream = let step s k = let open Sequence.Step in let is_chord_op c = String.contains "ydc" (Char.lowercase c) in let is_simple_movement k = List.mem ~equal:Poly.equal simple_movements k in let to_op c = match Char.lowercase c with | 'y' -> Yank | 'p' -> Paste | 'd' -> Delete | 'c' -> Change | _ -> failwith "Invalid operation in chord." in match (s, k) with | `start, Key '"' -> Yield { value = Partial k; state = `chord_reg_pre } | `chord_reg_pre, Key c -> Yield { value = Partial k; state = `chord_reg c } | `chord_reg r, Key n when Char.('1' <= n && n <= '9') -> let n = Char.to_int n - 48 in Yield { value = Partial k; state = `chord_n (Some r, n) } | `start, Key n when Char.('1' <= n && n <= '9') -> let n = Char.to_int n - 48 in Yield { value = Partial k; state = `chord_n (None, n) } | `chord_n (r, m), Key n when Char.('0' <= n && n <= '9') -> let n = (10 * m) + Char.to_int n - 48 in Yield { value = Partial k; state = `chord_n (r, n) } | `start, Key c when is_chord_op c -> if Char.is_uppercase c then Yield { value = shortcut (to_op c) To_eol; state = `start } else Yield { value = Partial k; state = `chord_cmd (None, None, to_op c) } | `chord_reg r, Key c when is_chord_op c -> if Char.is_uppercase c then Yield { value = shortcut ~r (to_op c) To_eol; state = `start } else Yield { value = Partial k; state = `chord_cmd (Some r, None, to_op c) } | `chord_n (r, n), Key c when is_chord_op c -> if Char.is_uppercase c then Yield { value = shortcut ?r ~n (to_op c) To_eol; state = `start } else Yield { value = Partial k; state = `chord_cmd (r, Some n, to_op c) } | `chord_cmd (r, n, c), Key ch when is_chord_op ch && Poly.(c = to_op ch) -> if Char.is_uppercase ch then Yield { value = shortcut ?r ?n c To_bol; state = `start } else Yield { value = shortcut ?r ?n c Line; state = `start } | (`start | `chord_reg _), k when is_simple_movement k -> Yield { value = chord Noop (to_scope k); state = `start } | `chord_n (_, n), k when is_simple_movement k -> Yield { value = chord ~n1:n Noop (to_scope k); state = `start } | `chord_cmd (r, n, c), k when is_simple_movement k -> Yield { value = chord ?r ?n1:n c (to_scope k); state = `start } | `chord_cmd (r, n1, c), Key n when Char.('1' <= n && n <= '9') -> let n = Char.to_int n - 48 in Yield { value = Partial k; state = `chord_mv_n (r, n1, c, n) } | `chord_mv_n (r, n1, c, n2), Key n when Char.('0' <= n && n <= '9') -> let n2 = (10 * n2) + Char.to_int n - 48 in Yield { value = Partial k; state = `chord_mv_n (r, n1, c, n2) } | `chord_mv_n (r, n1, c, n2), k when is_simple_movement k -> Yield { value = chord ?r ?n1 c ~n2 (to_scope k); state = `start } (* Catch-all rules *) | `start, _ -> Yield { value = Simple k; state = `start } | _, _ -> Skip { state = `start } in Sequence.unfold_with ~init:`start ~f:step Key.stream