summaryrefslogtreecommitdiff
path: root/lib/editor.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/editor.ml')
-rw-r--r--lib/editor.ml271
1 files changed, 271 insertions, 0 deletions
diff --git a/lib/editor.ml b/lib/editor.ml
new file mode 100644
index 0000000..c3e298e
--- /dev/null
+++ b/lib/editor.ml
@@ -0,0 +1,271 @@
1open Base
2module Buffer = EditorBuffer
3open Util
4
5type mode = Normal | Insert
6type cursor = int * int
7
8type editor = {
9 term : Terminal.state;
10 mode : mode;
11 offset : int * int;
12 cursor : cursor;
13 buffer : Buffer.t option;
14 pending : Key.t Sequence.t;
15 i_pending : Command.t Sequence.t;
16 n_pending : Command.t Sequence.t;
17}
18
19type t = editor
20
21let init (c : Config.t) : editor =
22 {
23 term = Terminal.init ();
24 mode = Normal;
25 offset = (0, 0);
26 cursor = (1, 1);
27 buffer = List.hd c.files |> Option.map ~f:Buffer.from_file;
28 pending = Key.stream;
29 i_pending = Command.i_stream;
30 n_pending = Command.n_stream;
31 }
32
33type 'a action = t -> 'a * t
34
35module Action = struct
36 let run ~editor action = action () editor
37 let eval ~editor action = run ~editor action |> fst
38 let exec ~editor action = run ~editor action |> snd
39
40 include Applicative.Make (struct
41 type 'a t = 'a action
42
43 let return a s = (a, s)
44
45 let apply f a e =
46 let f, e' = f e in
47 let x, e'' = a e' in
48 (f x, e'')
49
50 let map = `Define_using_apply
51 end)
52
53 include Monad.Make (struct
54 type 'a t = 'a action
55
56 let return x s = (x, s)
57
58 let bind a ~f x =
59 let y, a' = a x in
60 f y a'
61
62 let map = `Define_using_bind
63 end)
64
65 let get e = (e, e)
66 let put e _ = ((), e)
67 let modify ~f e = ((), f e)
68
69 let update_cursor =
70 let aux e =
71 let dx, dy = e.offset and rs, cs = e.term.size in
72 match Option.map ~f:Buffer.cursor e.buffer with
73 | None -> { e with cursor = (1, 1); offset = (0, 0) }
74 | Some (cx, cy) ->
75 let dx' = Int.clamp_exn ~min:(cx - rs) ~max:cx dx
76 and dy' = Int.clamp_exn ~min:(cy - cs) ~max:cy dy in
77 { e with cursor = (cx - dx' + 1, cy - dy' + 1); offset = (dx', dy') }
78 in
79 modify ~f:aux
80
81 let get_mode s = (s.mode, s)
82 let set_mode m s = ((), { s with mode = m })
83 let get_focused_buffer e = (e.buffer, e)
84 let set_focused_buffer b e = ((), { e with buffer = Some b })
85
86 let on_focused_buffer f =
87 let f e = { e with buffer = Option.map ~f e.buffer } in
88 modify ~f *> update_cursor
89
90 let on_focused_buffer_or_new f =
91 (get_focused_buffer
92 >>| Option.value ~default:Buffer.empty
93 >>| f >>= set_focused_buffer)
94 *> update_cursor
95
96 let render =
97 let welcome (r, c) =
98 let open Text in
99 let hfill = ' ' and vfill = Sequence.empty in
100 "Welcome to the sand editor!" |> String.to_list |> Sequence.of_list
101 |> center ~fill:hfill c |> Sequence.singleton |> center ~fill:vfill r
102 in
103 let aux e =
104 let x, y = e.offset
105 and ((r, c) as size) = e.term.size
106 and fill = Sequence.singleton '~' in
107 let view =
108 Option.(
109 e.buffer >>| Buffer.view x y r c
110 |> value ~default:(welcome size)
111 |> Text.extend ~fill r)
112 in
113 Terminal.redraw view e.cursor
114 in
115 get >>| aux
116
117 (* TODO: save logic *)
118 let quit n = Stdlib.exit n
119 let noop = return ()
120end
121
122let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) =
123 (x + down - up, y + right - left)
124
125let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy)
126
127(* let get_next_command s = *)
128(* match Sequence.next s.pending with *)
129(* | None -> (None, s) *)
130(* | Some (h, t) -> (Some h, { s with pending = t }) *)
131
132(* let handle_insert_key = *)
133(* let open Action in *)
134(* let open Key in *)
135(* function *)
136(* | Arrow_down -> Buffer.Action.down |> on_focused_buffer *)
137(* | Arrow_left -> Buffer.Action.left |> on_focused_buffer *)
138(* | Arrow_right -> Buffer.Action.right |> on_focused_buffer *)
139(* | Arrow_up -> Buffer.Action.up |> on_focused_buffer *)
140(* | Backspace -> Buffer.Action.delete_before |> on_focused_buffer *)
141(* | Ctrl 'Q' -> quit 0 *)
142(* | Delete -> Buffer.Action.delete_after |> on_focused_buffer *)
143(* | Enter -> Buffer.Action.newline |> on_focused_buffer *)
144(* | Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal *)
145(* | Key k -> Buffer.Action.insert k |> on_focused_buffer *)
146(* | _ -> noop *)
147
148(* let handle_normal_key = *)
149(* let open Action in *)
150(* let open Key in *)
151(* function *)
152(* | Arrow_down | Key 'j' -> Buffer.Action.down |> on_focused_buffer *)
153(* | Arrow_left | Backspace | Key 'h' -> Buffer.Action.left |> on_focused_buffer *)
154(* | Arrow_right | Key ' ' | Key 'l' -> Buffer.Action.right |> on_focused_buffer *)
155(* | Arrow_up | Key 'k' -> Buffer.Action.up |> on_focused_buffer *)
156(* | Ctrl 'Q' -> quit 0 *)
157(* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *)
158(* | Key 'A' -> *)
159(* (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert *)
160(* | Key 'a' -> *)
161(* (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert *)
162(* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *)
163(* | Key 'I' -> *)
164(* noop *)
165(* (1* (Buffer.Action.bol |> on_focused_buffer_or_new) *> set_mode Insert *1) *)
166(* | Key 'i' -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert *)
167(* | Key 's' -> *)
168(* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *)
169(* *> set_mode Insert *)
170(* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *)
171(* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *)
172(* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *)
173(* | _ -> noop *)
174
175(* let handle_next_command = *)
176(* let f m = function *)
177(* | None -> Action.return () *)
178(* | Some k -> ( *)
179(* match m with *)
180(* | Insert -> handle_insert_key k *)
181(* | Normal -> handle_normal_key k) *)
182(* in *)
183(* Action.(map2 ~f get_mode get_next_command |> join) *)
184
185let handle_insert_command =
186 let open Command in
187 let open Action in
188 function
189 | Simple Arrow_down -> Buffer.Action.down |> on_focused_buffer
190 | Simple Arrow_left -> Buffer.Action.left |> on_focused_buffer
191 | Simple Arrow_right -> Buffer.Action.right |> on_focused_buffer
192 | Simple Arrow_up -> Buffer.Action.up |> on_focused_buffer
193 | Simple Backspace -> Buffer.Action.delete_before ~n:1 |> on_focused_buffer
194 | Simple (Ctrl 'Q') -> quit 0
195 | Simple Delete -> Buffer.Action.delete_after ~n:1 |> on_focused_buffer
196 | Simple Enter -> Buffer.Action.newline |> on_focused_buffer
197 | Simple Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal
198 | Type k -> Buffer.Action.insert k |> on_focused_buffer
199 | _ -> noop
200
201let handle_normal_command =
202 let open Command in
203 let open Action in
204 function
205 (* Movements *)
206 | Chord (_, n, Noop, _, Down) -> Buffer.Action.down ?n |> on_focused_buffer
207 | Chord (_, n, Noop, _, Left) -> Buffer.Action.left ?n |> on_focused_buffer
208 | Chord (_, n, Noop, _, Right) -> Buffer.Action.right ?n |> on_focused_buffer
209 | Chord (_, n, Noop, _, Up) -> Buffer.Action.up ?n |> on_focused_buffer
210 | Simple (Ctrl 'Q') -> quit 0
211 (* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *)
212 | Simple (Key 'A') ->
213 (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert
214 | Simple (Key 'a') ->
215 (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert
216 (* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *)
217 (* | Key 'I' -> noop *)
218 | Simple (Key 'i') -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert
219 (* | Key 's' -> *)
220 (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *)
221 (* *> set_mode Insert *)
222 (* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *)
223 (* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *)
224 (* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *)
225 | Shortcut (_, n, Change, Line) ->
226 let n = Option.value ~default:1 n - 1 in
227 (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol)
228 |> on_focused_buffer_or_new)
229 *> set_mode Insert
230 | Shortcut (_, _, Change, To_eol) ->
231 (Buffer.Action.delete_to_eol |> on_focused_buffer_or_new)
232 *> set_mode Insert
233 | Shortcut (_, _, Change, To_bol) ->
234 (Buffer.Action.delete_to_bol |> on_focused_buffer_or_new)
235 *> set_mode Insert
236 (* Delete *)
237 | Chord (_, n1, Delete, n2, Down) ->
238 let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in
239 Buffer.Action.delete_lines ~n |> on_focused_buffer_or_new
240 | Chord (_, n1, Delete, n2, Left) ->
241 let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
242 Buffer.Action.delete_before ~n |> on_focused_buffer_or_new
243 | Chord (_, n1, Delete, n2, Right) ->
244 let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
245 Buffer.Action.delete_after ~n |> on_focused_buffer_or_new
246 | Chord (_, n1, Delete, n2, Up) ->
247 let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in
248 Buffer.Action.delete_lines_before ~n |> on_focused_buffer_or_new
249 | Shortcut (_, n, Delete, Line) ->
250 Buffer.Action.delete_lines ~n:Option.(value ~default:1 n)
251 |> on_focused_buffer_or_new
252 | Shortcut (_, _, Delete, To_eol) ->
253 Buffer.Action.delete_to_eol |> on_focused_buffer_or_new
254 | Shortcut (_, _, Delete, To_bol) ->
255 Buffer.Action.delete_to_bol |> on_focused_buffer_or_new
256 | _ -> noop
257
258let handle_next_command2 m e =
259 match m with
260 | Insert -> (
261 match Sequence.next e.i_pending with
262 | None -> ((), e)
263 | Some (h, t) -> handle_insert_command h { e with i_pending = t })
264 | Normal -> (
265 match Sequence.next e.n_pending with
266 | None -> ((), e)
267 | Some (h, t) -> handle_normal_command h { e with n_pending = t })
268
269let handle_next_command2 =
270 let open Action in
271 get_mode >>= handle_next_command2