1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
open Base
open Stdio
open Zipper
open Util
type kind = File of string | No_name | Scratch
type error = No_such_file | Other
type buffer = { kind : kind; content : (char zipper zipper, error) Result.t }
type t = buffer
let empty =
{ kind = No_name; content = empty |> push_after empty |> Result.return }
module Action = struct
let on_content f b = { b with content = Result.map ~f b.content }
let move_up, move_down, move_left, move_right =
let vertical f ?(n = 1) =
on_content (fun z ->
let col = focus_or ~default:Zipper.empty z |> left_length in
Fn.apply_n_times ~n f z |> map_focus (goto col))
and horizontal f ?(n = 1) =
Fn.apply_n_times ~n (map_focus f) |> on_content
in
(vertical left, vertical right, horizontal left, horizontal right)
let bol = map_focus far_left |> on_content
let eol = map_focus far_right |> on_content
let bof = far_left |> on_content
let eof = far_right |> on_content
let insert k = map_focus (push k) |> on_content
let delete_after ?(cross_lines = false) ~n =
let aux z =
let line = focus_or ~default:Zipper.empty z in
if cross_lines && is_far_right line && not (is_far_right z) then
(* let next = right z |> focus_or ~default:Zipper.empty |> far_left in *)
(* right z |> pop_after |> left |> map_focus (Fn.flip join next) *)
pop_after z |> map_focus_or ~default:line (far_left &> join line)
else map_focus pop_after z
in
Fn.apply_n_times ~n aux |> on_content
let delete_before ?(cross_lines = false) ~n =
let aux z =
let line = focus_or ~default:Zipper.empty z in
if cross_lines && is_far_left line && not (is_far_left z) then
pop_after z |> left |> map_focus (far_right &> Fn.flip join line)
else map_focus pop z
in
Fn.apply_n_times ~n aux |> on_content
let delete_to_eol = map_focus (split &> fst) |> on_content
let delete_to_bol = map_focus (split &> snd) |> on_content
let delete_lines ~n = Fn.apply_n_times ~n pop_after |> on_content
let delete_lines_before ~n =
on_content (fun z -> pop_after z |> Fn.apply_n_times ~n:(n - 1) pop_before)
let newline =
let aux z =
let l1, l2 = focus_or ~default:Zipper.empty z |> split in
push_before l1 z |> map_focus (Fn.const l2)
in
on_content aux
(* let save_history_to ?(clear = true) r = () *)
end
let from_file f =
let lines =
try
let fd = Unix.(openfile f [ O_RDONLY ] 0o640) in
let ic = Unix.in_channel_of_descr fd in
let lines = In_channel.input_lines ic in
In_channel.close ic;
lines
with Unix.Unix_error (ENOENT, _, _) -> []
in
let content =
let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in
Sequence.(of_list lines |> map ~f:line_to_zipper) |> of_seq
in
{ kind = File f; content = Ok content }
let cursor b =
let open Option in
let x = Result.(map ~f:left_length b.content |> ok |> value ~default:0)
and y =
Result.(map ~f:focus b.content |> ok)
|> join |> map ~f:left_length |> value ~default:0
in
(x, y)
let view x y h w b =
match b.content with
| Error _ -> Sequence.empty
| Ok z ->
let cx, _ = cursor b in
context ~b:(cx - x) ~a:(x + h - cx) z
|> to_seq
|> Sequence.map ~f:(window ~from:y ~len:w)
|
