diff options
Diffstat (limited to 'lib/editor.ml')
-rw-r--r-- | lib/editor.ml | 271 |
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 @@ | |||
1 | open Base | ||
2 | module Buffer = EditorBuffer | ||
3 | open Util | ||
4 | |||
5 | type mode = Normal | Insert | ||
6 | type cursor = int * int | ||
7 | |||
8 | type 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 | |||
19 | type t = editor | ||
20 | |||
21 | let 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 | |||
33 | type 'a action = t -> 'a * t | ||
34 | |||
35 | module 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 () | ||
120 | end | ||
121 | |||
122 | let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) = | ||
123 | (x + down - up, y + right - left) | ||
124 | |||
125 | let 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 | |||
185 | let 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 | |||
201 | let 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 | |||
258 | let 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 | |||
269 | let handle_next_command2 = | ||
270 | let open Action in | ||
271 | get_mode >>= handle_next_command2 | ||