diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/editor.ml | 16 | ||||
| -rw-r--r-- | lib/editorBuffer.ml | 257 | ||||
| -rw-r--r-- | lib/key.ml | 2 |
3 files changed, 211 insertions, 64 deletions
diff --git a/lib/editor.ml b/lib/editor.ml index f91e66d..69dc666 100644 --- a/lib/editor.ml +++ b/lib/editor.ml | |||
| @@ -11,6 +11,7 @@ type editor = { | |||
| 11 | offset : int * int; | 11 | offset : int * int; |
| 12 | cursor : cursor; | 12 | cursor : cursor; |
| 13 | buffer : Buffer.t option; | 13 | buffer : Buffer.t option; |
| 14 | rendered : bool; | ||
| 14 | pending : Key.t Sequence.t; | 15 | pending : Key.t Sequence.t; |
| 15 | i_pending : Command.t Sequence.t; | 16 | i_pending : Command.t Sequence.t; |
| 16 | n_pending : Command.t Sequence.t; | 17 | n_pending : Command.t Sequence.t; |
| @@ -25,6 +26,7 @@ let init (c : Config.t) : editor = | |||
| 25 | offset = (0, 0); | 26 | offset = (0, 0); |
| 26 | cursor = (1, 1); | 27 | cursor = (1, 1); |
| 27 | buffer = List.hd c.files |> Option.map ~f:Buffer.from_file; | 28 | buffer = List.hd c.files |> Option.map ~f:Buffer.from_file; |
| 29 | rendered = true; | ||
| 28 | pending = Key.stream; | 30 | pending = Key.stream; |
| 29 | i_pending = Command.i_stream; | 31 | i_pending = Command.i_stream; |
| 30 | n_pending = Command.n_stream; | 32 | n_pending = Command.n_stream; |
| @@ -104,10 +106,13 @@ module Action = struct | |||
| 104 | let aux e = | 106 | let aux e = |
| 105 | let x, y = e.offset | 107 | let x, y = e.offset |
| 106 | and ((r, c) as size) = e.term.size | 108 | and ((r, c) as size) = e.term.size |
| 107 | and fill = Sequence.singleton '~' in | 109 | and fill = Sequence.singleton '~' |
| 110 | and limit = | ||
| 111 | Buffer.(if e.rendered then rendered_view else unrendered_view) | ||
| 112 | in | ||
| 108 | let view = | 113 | let view = |
| 109 | Option.( | 114 | Option.( |
| 110 | e.buffer >>| Buffer.view x y r c | 115 | e.buffer >>| limit x y r c |
| 111 | |> value ~default:(welcome size) | 116 | |> value ~default:(welcome size) |
| 112 | |> Text.extend ~fill r) | 117 | |> Text.extend ~fill r) |
| 113 | in | 118 | in |
| @@ -117,6 +122,11 @@ module Action = struct | |||
| 117 | 122 | ||
| 118 | (* TODO: save logic *) | 123 | (* TODO: save logic *) |
| 119 | let quit n = Stdlib.exit n | 124 | let quit n = Stdlib.exit n |
| 125 | |||
| 126 | (* Debug *) | ||
| 127 | let get_rendered e = (e.rendered, e) | ||
| 128 | let set_rendered r e = ((), { e with rendered = r }) | ||
| 129 | let toggle_rendered = get_rendered >>| not >>= set_rendered | ||
| 120 | let noop = return () | 130 | let noop = return () |
| 121 | end | 131 | end |
| 122 | 132 | ||
| @@ -352,6 +362,8 @@ let handle_normal_command = | |||
| 352 | (* | Key 's' -> *) | 362 | (* | Key 's' -> *) |
| 353 | (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) | 363 | (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) |
| 354 | (* *> set_mode Insert *) | 364 | (* *> set_mode Insert *) |
| 365 | (* Debug *) | ||
| 366 | | Simple (Ctrl 'R') -> toggle_rendered | ||
| 355 | | _ -> noop | 367 | | _ -> noop |
| 356 | 368 | ||
| 357 | let handle_next_command m e = | 369 | let handle_next_command m e = |
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) | ||
| @@ -16,6 +16,7 @@ type key = | |||
| 16 | | Nul | 16 | | Nul |
| 17 | | Page_down | 17 | | Page_down |
| 18 | | Page_up | 18 | | Page_up |
| 19 | | Tab | ||
| 19 | 20 | ||
| 20 | type t = key | 21 | type t = key |
| 21 | 22 | ||
| @@ -24,6 +25,7 @@ let key c = Key c | |||
| 24 | 25 | ||
| 25 | let of_char = function | 26 | let of_char = function |
| 26 | | '\000' -> Nul | 27 | | '\000' -> Nul |
| 28 | | '\009' -> Tab | ||
| 27 | | '\013' -> Enter | 29 | | '\013' -> Enter |
| 28 | | '\027' -> Esc | 30 | | '\027' -> Esc |
| 29 | | '\127' -> Backspace | 31 | | '\127' -> Backspace |
