blob: 510454988b04fd43adb6bcd04fedcccedf06fdb2 (
plain) (
blame)
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
|
open Base
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 up, down, left, 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 ~n = Fn.apply_n_times ~n (map_focus pop_after) |> on_content
let delete_before ~n = Fn.apply_n_times ~n (map_focus pop) |> 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 = Stdio.In_channel.read_lines f in
let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in
let content = 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)
|
