diff options
Diffstat (limited to 'lib/editorBuffer.ml')
-rw-r--r-- | lib/editorBuffer.ml | 257 |
1 files changed, 195 insertions, 62 deletions
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml index ea89fb9..e1706dd 100644 --- a/lib/editorBuffer.ml +++ b/lib/editorBuffer.ml | |||
@@ -5,104 +5,237 @@ open Util | |||
5 | 5 | ||
6 | type kind = File of string | No_name | Scratch | 6 | type kind = File of string | No_name | Scratch |
7 | type error = No_such_file | Other | 7 | type error = No_such_file | Other |
8 | type buffer = { kind : kind; content : (char zipper zipper, error) Result.t } | 8 | |
9 | type buffer = { | ||
10 | kind : kind; | ||
11 | content : (char zipper zipper, error) Result.t; | ||
12 | rendered : char Sequence.t zipper; | ||
13 | } | ||
14 | |||
9 | type t = buffer | 15 | type t = buffer |
10 | 16 | ||
11 | let empty = | 17 | let empty = |
12 | { kind = No_name; content = empty |> push_after empty |> Result.return } | 18 | { |
19 | kind = No_name; | ||
20 | content = empty |> push empty |> Result.return; | ||
21 | rendered = push Sequence.empty empty; | ||
22 | } | ||
23 | |||
24 | let render = | ||
25 | let open Sequence in | ||
26 | let tabsize = 8 in | ||
27 | let f i = function | ||
28 | | '\t' -> | ||
29 | let width = tabsize - (i % tabsize) in | ||
30 | (i + width, take (repeat '.') width) | ||
31 | | c -> (i + 1, singleton c) | ||
32 | in | ||
33 | folding_map ~init:0 ~f &> join | ||
34 | |||
35 | let cursor ?(rendered = true) b = | ||
36 | match b.content with | ||
37 | | Error _ -> (0, 0) | ||
38 | | Ok c -> | ||
39 | let hlen z = | ||
40 | if rendered then | ||
41 | Sequence.(length (before z |> to_list_rev |> of_list |> render)) | ||
42 | else left_length z | ||
43 | in | ||
44 | (left_length c, apply_focus_or ~default:0 hlen c) | ||
13 | 45 | ||
14 | module Action = struct | 46 | module Action = struct |
15 | let on_content f b = { b with content = Result.map ~f b.content } | 47 | let on_content f b = { b with content = Result.map ~f b.content } |
48 | let on_rendered f b = { b with rendered = f b.rendered } | ||
49 | |||
50 | (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *) | ||
16 | 51 | ||
17 | let move_up, move_down, move_left, move_right = | 52 | let update_render_at_cursor b = |
18 | let vertical f ?(n = 1) = | 53 | match b.content with |
54 | | Error _ -> b | ||
55 | | Ok c -> | ||
56 | let l = apply_focus_or ~default:Sequence.empty (to_seq &> render) c in | ||
57 | { b with rendered = swap_focus l b.rendered } | ||
58 | |||
59 | let move_up ?(n = 1) = | ||
60 | let change_content = | ||
61 | on_content (fun z -> | ||
62 | let col = apply_focus_or ~default:0 left_length z in | ||
63 | Fn.apply_n_times ~n left z |> map_focus (goto col)) | ||
64 | and change_rendered = on_rendered (Fn.apply_n_times ~n left) in | ||
65 | change_content &> change_rendered | ||
66 | |||
67 | let move_down ?(n = 1) = | ||
68 | let change_content = | ||
19 | on_content (fun z -> | 69 | on_content (fun z -> |
20 | let col = focus_or ~default:Zipper.empty z |> left_length in | 70 | let col = apply_focus_or ~default:0 left_length z in |
21 | Fn.apply_n_times ~n f z |> map_focus (goto col)) | 71 | Fn.apply_n_times ~n right z |> map_focus (goto col)) |
22 | and horizontal f ?(n = 1) = | 72 | and change_rendered = on_rendered (Fn.apply_n_times ~n right) in |
23 | Fn.apply_n_times ~n (map_focus f) |> on_content | 73 | change_content &> change_rendered |
74 | |||
75 | let move_left, move_right = | ||
76 | let horizontal f ?(n = 1) = | ||
77 | let change_content = map_focus (Fn.apply_n_times ~n f) |> on_content in | ||
78 | change_content &> update_render_at_cursor | ||
24 | in | 79 | in |
25 | (vertical left, vertical right, horizontal left, horizontal right) | 80 | (horizontal left, horizontal right) |
26 | 81 | ||
27 | let bol = map_focus far_left |> on_content | 82 | let bol = map_focus far_left |> on_content |
28 | let eol = map_focus far_right |> on_content | 83 | let eol = map_focus far_right |> on_content |
29 | let bof = far_left |> on_content | 84 | |
30 | let eof = far_right |> on_content | 85 | let bof = |
31 | let insert k = map_focus (push k) |> on_content | 86 | let change_content = far_left |> on_content |
87 | and change_rendered = far_left |> on_rendered in | ||
88 | change_content &> change_rendered | ||
89 | |||
90 | let eof = | ||
91 | let change_content = far_right |> on_content | ||
92 | and change_rendered = far_right |> on_rendered in | ||
93 | change_content &> change_rendered | ||
94 | |||
95 | let insert k = | ||
96 | let change_content = map_focus (push_before k) |> on_content in | ||
97 | change_content &> update_render_at_cursor | ||
98 | |||
32 | (* let replace k = () *) | 99 | (* let replace k = () *) |
33 | 100 | ||
34 | let delete_after ?(cross_lines = false) ~n = | 101 | let join_lines ?(n = 2) = |
35 | let aux z = | 102 | let change_content = |
36 | let line = focus_or ~default:Zipper.empty z in | 103 | let join_2_lines z = |
37 | if cross_lines && is_far_right line && not (is_far_right z) then | 104 | if right_length z < 2 then z |
38 | pop_after z |> map_focus_or ~default:line (far_left &> join line) | 105 | else |
39 | else map_focus pop_after z | 106 | let to_join = right z |> focus_or ~default:Zipper.empty in |
107 | map_focus (join ~z2:to_join) z |> pop_after | ||
108 | in | ||
109 | Fn.apply_n_times ~n:(n - 1) join_2_lines |> on_content | ||
110 | and change_rendered = pop_after ~n:(n - 1) |> on_rendered in | ||
111 | change_content &> change_rendered &> update_render_at_cursor | ||
112 | |||
113 | let delete_after ?(cross_lines = false) ~n b = | ||
114 | let lines_to_delete = | ||
115 | match b.content with | ||
116 | | Error _ -> 0 | ||
117 | | Ok z -> ( | ||
118 | match Sequence.next (after z) with | ||
119 | | None -> 0 | ||
120 | | Some (h, t) -> | ||
121 | let init = right_length h | ||
122 | and f acc z = | ||
123 | let acc' = acc + length z + 1 in | ||
124 | (acc', acc') | ||
125 | in | ||
126 | Sequence.shift_right (Sequence.folding_map t ~init ~f) init | ||
127 | |> Sequence.findi ~f:(fun _ a -> n <= a) | ||
128 | |> Option.map ~f:fst | ||
129 | |> Option.value ~default:(Sequence.length t)) | ||
40 | in | 130 | in |
41 | Fn.apply_n_times ~n aux |> on_content | 131 | let change_content = |
42 | 132 | let delete_1_after z = | |
43 | let delete_before ?(cross_lines = false) ~n = | 133 | let line = focus_or ~default:Zipper.empty z in |
44 | let aux z = | 134 | if cross_lines && is_far_right line && not (is_far_right z) then |
45 | let line = focus_or ~default:Zipper.empty z in | 135 | let to_join = right z |> focus_or ~default:Zipper.empty in |
46 | if cross_lines && is_far_left line && not (is_far_left z) then | 136 | map_focus (join ~z2:to_join) z |> pop_after |
47 | pop_after z |> left |> map_focus (far_right &> Fn.flip join line) | 137 | else map_focus pop z |
48 | else map_focus pop z | 138 | in |
139 | Fn.apply_n_times ~n delete_1_after |> on_content | ||
140 | and change_rendered = | ||
141 | if cross_lines then pop_after ~n:lines_to_delete |> on_rendered else Fn.id | ||
49 | in | 142 | in |
50 | Fn.apply_n_times ~n aux |> on_content | 143 | b |> change_content |> change_rendered |> update_render_at_cursor |
144 | |||
145 | let delete_before ?(cross_lines = false) ~n b = | ||
146 | let lines_to_delete = | ||
147 | match b.content with | ||
148 | | Error _ -> 0 | ||
149 | | Ok z -> | ||
150 | let init = apply_focus_or ~default:0 left_length z | ||
151 | and f acc z = | ||
152 | let acc' = acc + length z + 1 in | ||
153 | (acc', acc') | ||
154 | in | ||
155 | Sequence.shift_right (Sequence.folding_map (before z) ~init ~f) init | ||
156 | |> Sequence.findi ~f:(fun _ a -> n <= a) | ||
157 | |> Option.map ~f:fst | ||
158 | |> Option.value ~default:(left_length z) | ||
159 | in | ||
160 | let change_content = | ||
161 | let delete_1_before z = | ||
162 | let line = focus_or ~default:Zipper.empty z in | ||
163 | if cross_lines && is_far_left line && not (is_far_left z) then | ||
164 | left z |> map_focus (join ~z2:line) |> pop_after | ||
165 | else map_focus pop_before z | ||
166 | in | ||
167 | Fn.apply_n_times ~n delete_1_before |> on_content | ||
168 | and change_rendered = | ||
169 | if cross_lines then pop_before ~n:lines_to_delete |> on_rendered | ||
170 | else Fn.id | ||
171 | in | ||
172 | b |> change_content |> change_rendered |> update_render_at_cursor | ||
173 | |||
174 | let delete_to_eol = | ||
175 | map_focus (split &> fst) |> on_content &> update_render_at_cursor | ||
51 | 176 | ||
52 | let delete_to_eol = map_focus (split &> fst) |> on_content | 177 | let delete_to_bol = |
53 | let delete_to_bol = map_focus (split &> snd) |> on_content | 178 | map_focus (split &> snd) |> on_content &> update_render_at_cursor |
54 | let delete_lines ~n = Fn.apply_n_times ~n pop_after |> on_content | 179 | |
55 | let delete_lines_before ~n = Fn.apply_n_times ~n pop_before |> on_content | 180 | let delete_lines ~n = |
181 | let change_content = pop ~n |> on_content | ||
182 | and change_rendered = pop ~n |> on_rendered in | ||
183 | change_content &> change_rendered | ||
184 | |||
185 | let delete_lines_before ~n = | ||
186 | let change_content = pop_before ~n |> on_content | ||
187 | and change_rendered = pop_before ~n |> on_rendered in | ||
188 | change_content &> change_rendered | ||
56 | 189 | ||
57 | let newline = | 190 | let newline = |
58 | let aux z = | 191 | let change_content = |
59 | let l1, l2 = focus_or ~default:Zipper.empty z |> split in | 192 | let aux z = |
60 | push_before l1 z |> map_focus (Fn.const l2) | 193 | let default = (Zipper.empty, Zipper.empty) in |
61 | in | 194 | let l1, l2 = apply_focus_or ~default split z in |
62 | on_content aux | 195 | push_before l1 z |> swap_focus l2 |
63 | 196 | in | |
64 | let join_lines ~n = | 197 | on_content aux |
65 | let aux z = | 198 | and change_rendered b = |
66 | if is_far_right z || is_far_right (right z) then z | 199 | match b.content with |
67 | else | 200 | | Error _ -> b |
68 | let line = focus_or ~default:Zipper.empty z |> far_right in | 201 | | Ok c -> ( |
69 | pop_after z |> map_focus (far_left &> join line) | 202 | match Sequence.next (before c) with |
203 | | None -> failwith "newline > change_rendered: unreachable" | ||
204 | | Some (h, _) -> | ||
205 | { b with rendered = push_before (to_seq h |> render) b.rendered }) | ||
70 | in | 206 | in |
71 | Fn.apply_n_times ~n aux |> on_content | 207 | change_content &> change_rendered &> update_render_at_cursor |
72 | 208 | ||
73 | (* let save_history_to ?(clear = true) r = () *) | 209 | (* let save_history_to ?(clear = true) r = () *) |
74 | end | 210 | end |
75 | 211 | ||
76 | let from_file f = | 212 | let from_file f = |
77 | let lines = | 213 | let lines = |
214 | let line_to_seq l = String.to_list l |> Sequence.of_list in | ||
78 | try | 215 | try |
79 | let fd = Unix.(openfile f [ O_RDONLY ] 0o640) in | 216 | let fd = Unix.(openfile f [ O_RDONLY ] 0o640) in |
80 | let ic = Unix.in_channel_of_descr fd in | 217 | let ic = Unix.in_channel_of_descr fd in |
81 | let lines = In_channel.input_lines ic in | 218 | let lines = In_channel.input_lines ic in |
82 | In_channel.close ic; | 219 | In_channel.close ic; |
83 | lines | 220 | Sequence.(of_list lines |> map ~f:line_to_seq) |
84 | with Unix.Unix_error (ENOENT, _, _) -> [] | 221 | with Unix.Unix_error (ENOENT, _, _) -> Sequence.empty |
85 | in | 222 | in |
86 | let content = | 223 | let rendered = Sequence.map ~f:render lines |> of_seq in |
87 | let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in | 224 | let content = Sequence.map ~f:of_seq lines |> of_seq in |
88 | Sequence.(of_list lines |> map ~f:line_to_zipper) |> of_seq | 225 | { kind = File f; content = Ok content; rendered } |
89 | in | ||
90 | { kind = File f; content = Ok content } | ||
91 | |||
92 | let cursor b = | ||
93 | let open Option in | ||
94 | let x = Result.(map ~f:left_length b.content |> ok |> value ~default:0) | ||
95 | and y = | ||
96 | Result.(map ~f:focus b.content |> ok) | ||
97 | |> join |> map ~f:left_length |> value ~default:0 | ||
98 | in | ||
99 | (x, y) | ||
100 | 226 | ||
101 | let view x y h w b = | 227 | let unrendered_view x y h w b = |
102 | match b.content with | 228 | match b.content with |
103 | | Error _ -> Sequence.empty | 229 | | Error _ -> Sequence.empty |
104 | | Ok z -> | 230 | | Ok z -> |
105 | let cx, _ = cursor b in | 231 | let cx, _ = cursor b in |
106 | context ~b:(cx - x) ~a:(x + h - cx) z | 232 | context ~l:(cx - x) ~r:(x + h - cx) z |
107 | |> to_seq | 233 | |> to_seq |
108 | |> Sequence.map ~f:(window ~from:y ~len:w) | 234 | |> Sequence.map ~f:(window ~from:y ~len:w) |
235 | |||
236 | let rendered_view x y h w b = | ||
237 | let window from len seq = Sequence.(take (drop_eagerly seq from) len) in | ||
238 | let cx, _ = cursor b in | ||
239 | context ~l:(cx - x) ~r:(x + h - cx) b.rendered | ||
240 | |> to_seq | ||
241 | |> Sequence.map ~f:(window y w) | ||