From 055c743c55bde27f4475d3434c26d8383c0c3ea1 Mon Sep 17 00:00:00 2001
From: Federico Igne <undyamon@disroot.org>
Date: Thu, 11 Jan 2024 19:31:31 +0100
Subject: bulk: add PoC of vim-like modular editor

---
 lib/command.ml | 115 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 115 insertions(+)
 create mode 100644 lib/command.ml

(limited to 'lib/command.ml')

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 @@
+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
-- 
cgit v1.2.3