diff options
Diffstat (limited to 'lib/editorBuffer.ml')
-rw-r--r-- | lib/editorBuffer.ml | 72 |
1 files changed, 72 insertions, 0 deletions
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml new file mode 100644 index 0000000..5104549 --- /dev/null +++ b/lib/editorBuffer.ml | |||
@@ -0,0 +1,72 @@ | |||
1 | open Base | ||
2 | open Zipper | ||
3 | open Util | ||
4 | |||
5 | type kind = File of string | No_name | Scratch | ||
6 | type error = No_such_file | Other | ||
7 | type buffer = { kind : kind; content : (char zipper zipper, error) Result.t } | ||
8 | type t = buffer | ||
9 | |||
10 | let empty = | ||
11 | { kind = No_name; content = empty |> push_after empty |> Result.return } | ||
12 | |||
13 | module Action = struct | ||
14 | let on_content f b = { b with content = Result.map ~f b.content } | ||
15 | |||
16 | let up, down, left, right = | ||
17 | let vertical f ?(n = 1) = | ||
18 | on_content (fun z -> | ||
19 | let col = focus_or ~default:Zipper.empty z |> left_length in | ||
20 | Fn.apply_n_times ~n f z |> map_focus (goto col)) | ||
21 | and horizontal f ?(n = 1) = | ||
22 | Fn.apply_n_times ~n (map_focus f) |> on_content | ||
23 | in | ||
24 | (vertical left, vertical right, horizontal left, horizontal right) | ||
25 | |||
26 | let bol = map_focus far_left |> on_content | ||
27 | let eol = map_focus far_right |> on_content | ||
28 | let bof = far_left |> on_content | ||
29 | let eof = far_right |> on_content | ||
30 | let insert k = map_focus (push k) |> on_content | ||
31 | let delete_after ~n = Fn.apply_n_times ~n (map_focus pop_after) |> on_content | ||
32 | let delete_before ~n = Fn.apply_n_times ~n (map_focus pop) |> on_content | ||
33 | let delete_to_eol = map_focus (split &> fst) |> on_content | ||
34 | let delete_to_bol = map_focus (split &> snd) |> on_content | ||
35 | let delete_lines ~n = Fn.apply_n_times ~n pop_after |> on_content | ||
36 | |||
37 | let delete_lines_before ~n = | ||
38 | on_content (fun z -> pop_after z |> Fn.apply_n_times ~n:(n - 1) pop_before) | ||
39 | |||
40 | let newline = | ||
41 | let aux z = | ||
42 | let l1, l2 = focus_or ~default:Zipper.empty z |> split in | ||
43 | push_before l1 z |> map_focus (Fn.const l2) | ||
44 | in | ||
45 | on_content aux | ||
46 | |||
47 | (* let save_history_to ?(clear = true) r = () *) | ||
48 | end | ||
49 | |||
50 | let from_file f = | ||
51 | let lines = Stdio.In_channel.read_lines f in | ||
52 | let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in | ||
53 | let content = Sequence.(of_list lines |> map ~f:line_to_zipper) |> of_seq in | ||
54 | { kind = File f; content = Ok content } | ||
55 | |||
56 | let cursor b = | ||
57 | let open Option in | ||
58 | let x = Result.(map ~f:left_length b.content |> ok |> value ~default:0) | ||
59 | and y = | ||
60 | Result.(map ~f:focus b.content |> ok) | ||
61 | |> join |> map ~f:left_length |> value ~default:0 | ||
62 | in | ||
63 | (x, y) | ||
64 | |||
65 | let view x y h w b = | ||
66 | match b.content with | ||
67 | | Error _ -> Sequence.empty | ||
68 | | Ok z -> | ||
69 | let cx, _ = cursor b in | ||
70 | context ~b:(cx - x) ~a:(x + h - cx) z | ||
71 | |> to_seq | ||
72 | |> Sequence.map ~f:(window ~from:y ~len:w) | ||