diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/command.ml | 3 | ||||
| -rw-r--r-- | lib/editor.ml | 98 | ||||
| -rw-r--r-- | lib/editorBuffer.ml | 55 | ||||
| -rw-r--r-- | lib/zipper.ml | 12 | ||||
| -rw-r--r-- | lib/zipper.mli | 12 |
5 files changed, 117 insertions, 63 deletions
diff --git a/lib/command.ml b/lib/command.ml index 74b616a..a55fb9e 100644 --- a/lib/command.ml +++ b/lib/command.ml | |||
| @@ -93,7 +93,8 @@ let n_stream = | |||
| 93 | match (s, k) with | 93 | match (s, k) with |
| 94 | | `start, Key '"' -> (`chord_reg_pre, Partial k) | 94 | | `start, Key '"' -> (`chord_reg_pre, Partial k) |
| 95 | (* Register *) | 95 | (* Register *) |
| 96 | | `chord_reg_pre, Key c -> (`chord_reg c, Partial k) | 96 | | `chord_reg_pre, Key c when Char.('!' <= c && c <= '~') -> |
| 97 | (`chord_reg c, Partial k) | ||
| 97 | (* Count (first) *) | 98 | (* Count (first) *) |
| 98 | | `start, Key n when Char.('1' <= n && n <= '9') -> | 99 | | `start, Key n when Char.('1' <= n && n <= '9') -> |
| 99 | let n = Char.to_int n - 48 in | 100 | let n = Char.to_int n - 48 in |
diff --git a/lib/editor.ml b/lib/editor.ml index f8091b8..0ed2229 100644 --- a/lib/editor.ml +++ b/lib/editor.ml | |||
| @@ -3,6 +3,12 @@ module Buffer = EditorBuffer | |||
| 3 | open Util | 3 | open Util |
| 4 | 4 | ||
| 5 | type mode = Normal | Insert | Control | 5 | type mode = Normal | Insert | Control |
| 6 | |||
| 7 | type selection = | ||
| 8 | | Empty | ||
| 9 | | Glyphwise of char Sequence.t Sequence.t | ||
| 10 | | Linewise of char Sequence.t Sequence.t | ||
| 11 | |||
| 6 | type cursor = int * int | 12 | type cursor = int * int |
| 7 | 13 | ||
| 8 | type editor = { | 14 | type editor = { |
| @@ -19,6 +25,7 @@ type editor = { | |||
| 19 | message_timestamp : float; | 25 | message_timestamp : float; |
| 20 | message_duration : float; | 26 | message_duration : float; |
| 21 | pending_command : string; | 27 | pending_command : string; |
| 28 | registers : selection Array.t; | ||
| 22 | } | 29 | } |
| 23 | 30 | ||
| 24 | type t = editor | 31 | type t = editor |
| @@ -38,6 +45,7 @@ let init (c : Config.t) : editor = | |||
| 38 | message_timestamp = Unix.time (); | 45 | message_timestamp = Unix.time (); |
| 39 | message_duration = 5.; | 46 | message_duration = 5.; |
| 40 | pending_command = ""; | 47 | pending_command = ""; |
| 48 | registers = Array.create ~len:128 Empty; | ||
| 41 | } | 49 | } |
| 42 | 50 | ||
| 43 | let string_of_mode = function | 51 | let string_of_mode = function |
| @@ -142,6 +150,16 @@ module Action = struct | |||
| 142 | let set_focused_buffer b e = ((), { e with buffer = Some b }) | 150 | let set_focused_buffer b e = ((), { e with buffer = Some b }) |
| 143 | let get_terminal_size e = (e.term.size, e) | 151 | let get_terminal_size e = (e.term.size, e) |
| 144 | 152 | ||
| 153 | let get_register r e = | ||
| 154 | assert (Char.('!' <= r && r <= '~')); | ||
| 155 | (e.registers.(Char.to_int r), e) | ||
| 156 | |||
| 157 | let set_register r z e = | ||
| 158 | assert (Char.('!' <= r && r <= '~')); | ||
| 159 | e.registers.(Char.to_int '"') <- z; | ||
| 160 | e.registers.(Char.to_int r) <- z; | ||
| 161 | ((), e) | ||
| 162 | |||
| 145 | let on_focused_buffer f = | 163 | let on_focused_buffer f = |
| 146 | let f e = { e with buffer = Option.map ~f e.buffer } in | 164 | let f e = { e with buffer = Option.map ~f e.buffer } in |
| 147 | modify ~f *> update_cursor | 165 | modify ~f *> update_cursor |
| @@ -218,64 +236,6 @@ let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) = | |||
| 218 | 236 | ||
| 219 | let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy) | 237 | let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy) |
| 220 | 238 | ||
| 221 | (* let get_next_command s = *) | ||
| 222 | (* match Sequence.next s.pending with *) | ||
| 223 | (* | None -> (None, s) *) | ||
| 224 | (* | Some (h, t) -> (Some h, { s with pending = t }) *) | ||
| 225 | |||
| 226 | (* let handle_insert_key = *) | ||
| 227 | (* let open Action in *) | ||
| 228 | (* let open Key in *) | ||
| 229 | (* function *) | ||
| 230 | (* | Arrow_down -> Buffer.Action.down |> on_focused_buffer *) | ||
| 231 | (* | Arrow_left -> Buffer.Action.left |> on_focused_buffer *) | ||
| 232 | (* | Arrow_right -> Buffer.Action.right |> on_focused_buffer *) | ||
| 233 | (* | Arrow_up -> Buffer.Action.up |> on_focused_buffer *) | ||
| 234 | (* | Backspace -> Buffer.Action.delete_before |> on_focused_buffer *) | ||
| 235 | (* | Ctrl 'Q' -> quit 0 *) | ||
| 236 | (* | Delete -> Buffer.Action.delete_after |> on_focused_buffer *) | ||
| 237 | (* | Enter -> Buffer.Action.newline |> on_focused_buffer *) | ||
| 238 | (* | Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal *) | ||
| 239 | (* | Key k -> Buffer.Action.insert k |> on_focused_buffer *) | ||
| 240 | (* | _ -> noop *) | ||
| 241 | |||
| 242 | (* let handle_normal_key = *) | ||
| 243 | (* let open Action in *) | ||
| 244 | (* let open Key in *) | ||
| 245 | (* function *) | ||
| 246 | (* | Arrow_down | Key 'j' -> Buffer.Action.down |> on_focused_buffer *) | ||
| 247 | (* | Arrow_left | Backspace | Key 'h' -> Buffer.Action.left |> on_focused_buffer *) | ||
| 248 | (* | Arrow_right | Key ' ' | Key 'l' -> Buffer.Action.right |> on_focused_buffer *) | ||
| 249 | (* | Arrow_up | Key 'k' -> Buffer.Action.up |> on_focused_buffer *) | ||
| 250 | (* | Ctrl 'Q' -> quit 0 *) | ||
| 251 | (* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *) | ||
| 252 | (* | Key 'A' -> *) | ||
| 253 | (* (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert *) | ||
| 254 | (* | Key 'a' -> *) | ||
| 255 | (* (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert *) | ||
| 256 | (* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *) | ||
| 257 | (* | Key 'I' -> *) | ||
| 258 | (* noop *) | ||
| 259 | (* (1* (Buffer.Action.bol |> on_focused_buffer_or_new) *> set_mode Insert *1) *) | ||
| 260 | (* | Key 'i' -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert *) | ||
| 261 | (* | Key 's' -> *) | ||
| 262 | (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) | ||
| 263 | (* *> set_mode Insert *) | ||
| 264 | (* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *) | ||
| 265 | (* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *) | ||
| 266 | (* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *) | ||
| 267 | (* | _ -> noop *) | ||
| 268 | |||
| 269 | (* let handle_next_command = *) | ||
| 270 | (* let f m = function *) | ||
| 271 | (* | None -> Action.return () *) | ||
| 272 | (* | Some k -> ( *) | ||
| 273 | (* match m with *) | ||
| 274 | (* | Insert -> handle_insert_key k *) | ||
| 275 | (* | Normal -> handle_normal_key k) *) | ||
| 276 | (* in *) | ||
| 277 | (* Action.(map2 ~f get_mode get_next_command |> join) *) | ||
| 278 | |||
| 279 | let handle_insert_command = | 239 | let handle_insert_command = |
| 280 | let open Command in | 240 | let open Command in |
| 281 | let open Action in | 241 | let open Action in |
| @@ -434,6 +394,28 @@ let handle_normal_command c = | |||
| 434 | Buffer.Action.( | 394 | Buffer.Action.( |
| 435 | delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) | 395 | delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) |
| 436 | |> on_focused_buffer_or_new | 396 | |> on_focused_buffer_or_new |
| 397 | (* Paste *) | ||
| 398 | | Shortcut (r, n, Paste_after) -> | ||
| 399 | let r = Option.value ~default:'"' r in | ||
| 400 | let paste = function | ||
| 401 | | Empty -> noop | ||
| 402 | | Glyphwise z -> Buffer.Action.paste ?n z |> on_focused_buffer_or_new | ||
| 403 | | Linewise z -> | ||
| 404 | Buffer.Action.paste ~linewise:true ?n z | ||
| 405 | |> on_focused_buffer_or_new | ||
| 406 | in | ||
| 407 | get_register r >>= paste | ||
| 408 | | Shortcut (r, n, Paste_before) -> | ||
| 409 | let r = Option.value ~default:'"' r in | ||
| 410 | let paste = function | ||
| 411 | | Empty -> noop | ||
| 412 | | Glyphwise z -> | ||
| 413 | Buffer.Action.paste ~before:true ?n z |> on_focused_buffer_or_new | ||
| 414 | | Linewise z -> | ||
| 415 | Buffer.Action.paste ~before:true ~linewise:true ?n z | ||
| 416 | |> on_focused_buffer_or_new | ||
| 417 | in | ||
| 418 | get_register r >>= paste | ||
| 437 | (* Join *) | 419 | (* Join *) |
| 438 | | Shortcut (_, n, Join) -> | 420 | | Shortcut (_, n, Join) -> |
| 439 | let n = Option.(value ~default:1 n) in | 421 | let n = Option.(value ~default:1 n) in |
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml index c492b8b..295e6e7 100644 --- a/lib/editorBuffer.ml +++ b/lib/editorBuffer.ml | |||
| @@ -61,12 +61,22 @@ module Action = struct | |||
| 61 | 61 | ||
| 62 | (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *) | 62 | (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *) |
| 63 | 63 | ||
| 64 | let update_render_at_cursor b = | 64 | let update_render ?(before = false) ~n b = |
| 65 | match b.content with | 65 | match b.content with |
| 66 | | Error _ -> b | 66 | | Error _ -> b |
| 67 | | Ok c -> | 67 | | Ok c -> |
| 68 | let l = apply_focus_or ~default:Sequence.empty (to_seq &> render) c in | 68 | let step = if before then left else right in |
| 69 | { b with rendered = swap_focus l b.rendered } | 69 | let rec aux i r c = |
| 70 | if i = 0 then r | ||
| 71 | else | ||
| 72 | let default = Sequence.empty in | ||
| 73 | let l = apply_focus_or ~default (to_seq &> render) c in | ||
| 74 | let c' = step c and r' = swap_focus l r |> step in | ||
| 75 | aux (i - 1) r' c' | ||
| 76 | in | ||
| 77 | { b with rendered = aux n b.rendered c |> goto (left_length c) } | ||
| 78 | |||
| 79 | let update_render_at_cursor = update_render ~n:1 | ||
| 70 | 80 | ||
| 71 | let move_up ?(n = 1) = | 81 | let move_up ?(n = 1) = |
| 72 | let change_content = | 82 | let change_content = |
| @@ -218,6 +228,45 @@ module Action = struct | |||
| 218 | in | 228 | in |
| 219 | change_content &> change_rendered &> update_render_at_cursor | 229 | change_content &> change_rendered &> update_render_at_cursor |
| 220 | 230 | ||
| 231 | let paste ?(before = false) ?(linewise = false) ?(n = 1) s = | ||
| 232 | let change_content = | ||
| 233 | if linewise then | ||
| 234 | let push = if before then push_before_seq else push_after_seq in | ||
| 235 | push (Sequence.map ~f:of_seq s) |> on_content | ||
| 236 | else | ||
| 237 | let aux z = | ||
| 238 | match Sequence.next s with | ||
| 239 | | None -> z | ||
| 240 | | Some (h, t) -> | ||
| 241 | let init = | ||
| 242 | let default = Zipper.(of_seq h |> far_right) in | ||
| 243 | map_focus_or ~default (push_before_seq h) z | ||
| 244 | and f z l = | ||
| 245 | let default = (Zipper.empty, Zipper.empty) in | ||
| 246 | let z1, z2 = apply_focus_or ~default split z in | ||
| 247 | z |> push_before z1 |> swap_focus z2 | ||
| 248 | |> map_focus (push_before_seq l) | ||
| 249 | in | ||
| 250 | let folded = Sequence.fold ~init ~f t in | ||
| 251 | if before then folded | ||
| 252 | else | ||
| 253 | folded | ||
| 254 | |> Fn.apply_n_times ~n:(Sequence.length t) left | ||
| 255 | |> map_focus (Fn.apply_n_times ~n:(Sequence.length h) left) | ||
| 256 | in | ||
| 257 | on_content aux | ||
| 258 | and change_rendered = | ||
| 259 | if linewise then | ||
| 260 | let push = if before then push_before_seq else push_after_seq in | ||
| 261 | push (Sequence.map ~f:render s) |> on_rendered | ||
| 262 | else | ||
| 263 | let len = Sequence.length s in | ||
| 264 | let push = if before then push_before else push in | ||
| 265 | let aux z = Fn.apply_n_times ~n:(len - 1) (push Sequence.empty) z in | ||
| 266 | on_rendered aux &> update_render ~before ~n:len | ||
| 267 | in | ||
| 268 | Fn.apply_n_times ~n (change_content &> change_rendered) | ||
| 269 | |||
| 221 | (* let save_history_to ?(clear = true) r = () *) | 270 | (* let save_history_to ?(clear = true) r = () *) |
| 222 | end | 271 | end |
| 223 | 272 | ||
diff --git a/lib/zipper.ml b/lib/zipper.ml index 202f6d4..413f365 100644 --- a/lib/zipper.ml +++ b/lib/zipper.ml | |||
| @@ -61,11 +61,21 @@ let pop_after ?(n = 1) z = | |||
| 61 | if right_length z < 2 then z else right z |> pop ~n |> left | 61 | if right_length z < 2 then z else right z |> pop ~n |> left |
| 62 | 62 | ||
| 63 | let push x z = { z with after = Sequence.shift_right z.after x } | 63 | let push x z = { z with after = Sequence.shift_right z.after x } |
| 64 | let push_seq s z = { z with after = Sequence.append s z.after } | ||
| 64 | let push_after x z = right z |> push x |> left | 65 | let push_after x z = right z |> push x |> left |
| 66 | let push_after_seq s z = right z |> push_seq s |> left | ||
| 65 | 67 | ||
| 66 | let push_before x z = | 68 | let push_before x z = |
| 67 | { z with pos = z.pos + 1; before = Sequence.shift_right z.before x } | 69 | { z with pos = z.pos + 1; before = Sequence.shift_right z.before x } |
| 68 | 70 | ||
| 71 | let push_before_seq s z = | ||
| 72 | let f a e = Sequence.shift_right a e in | ||
| 73 | { | ||
| 74 | z with | ||
| 75 | pos = z.pos + Sequence.length s; | ||
| 76 | before = Sequence.fold ~init:z.before ~f s; | ||
| 77 | } | ||
| 78 | |||
| 69 | let split z = | 79 | let split z = |
| 70 | ( { z with after = Sequence.empty }, | 80 | ( { z with after = Sequence.empty }, |
| 71 | { z with pos = 0; before = Sequence.empty } ) | 81 | { z with pos = 0; before = Sequence.empty } ) |
| @@ -119,7 +129,7 @@ let filter p z = z |> filter_left p |> filter_right p | |||
| 119 | let context_left n z = { z with before = Sequence.take z.before n } | 129 | let context_left n z = { z with before = Sequence.take z.before n } |
| 120 | let context_right n z = { z with after = Sequence.take z.after n } | 130 | let context_right n z = { z with after = Sequence.take z.after n } |
| 121 | let context ~l ?(r = l) z = z |> context_left l |> context_right r | 131 | let context ~l ?(r = l) z = z |> context_left l |> context_right r |
| 122 | let swap_focus a = map_focus (Fn.const a) | 132 | let swap_focus a = map_focus_or ~default:a (Fn.const a) |
| 123 | let of_seq s = { empty with after = s } | 133 | let of_seq s = { empty with after = s } |
| 124 | let to_seq z = z |> far_left |> after | 134 | let to_seq z = z |> far_left |> after |
| 125 | let window ~from ~len z = goto from z |> context_right len |> after | 135 | let window ~from ~len z = goto from z |> context_right len |> after |
diff --git a/lib/zipper.mli b/lib/zipper.mli index d79604e..0bbdf27 100644 --- a/lib/zipper.mli +++ b/lib/zipper.mli | |||
| @@ -136,17 +136,29 @@ val push : 'a -> 'a zipper -> 'a zipper | |||
| 136 | Calling [push 0 z], if [z] is [([3; 2; 1], [4; 5])], | 136 | Calling [push 0 z], if [z] is [([3; 2; 1], [4; 5])], |
| 137 | the result is [([3; 2; 1], [0; 4; 5]))], *) | 137 | the result is [([3; 2; 1], [0; 4; 5]))], *) |
| 138 | 138 | ||
| 139 | val push_seq : 'a Sequence.t -> 'a zipper -> 'a zipper | ||
| 140 | (** Like {!Zipper.push}, but inserts a sequence of elements at the cursor | ||
| 141 | position. *) | ||
| 142 | |||
| 139 | val push_after : 'a -> 'a zipper -> 'a zipper | 143 | val push_after : 'a -> 'a zipper -> 'a zipper |
| 140 | (** Insert an element after the cursor. Behaves like {!Zipper.push} if | 144 | (** Insert an element after the cursor. Behaves like {!Zipper.push} if |
| 141 | the cursor is at the far right of the zipper. | 145 | the cursor is at the far right of the zipper. |
| 142 | Calling [push_after 0 z], if [z] is [([3; 2; 1], [4; 5])], | 146 | Calling [push_after 0 z], if [z] is [([3; 2; 1], [4; 5])], |
| 143 | the result is [([3; 2; 1], [4; 0; 5]))], *) | 147 | the result is [([3; 2; 1], [4; 0; 5]))], *) |
| 144 | 148 | ||
| 149 | val push_after_seq : 'a Sequence.t -> 'a zipper -> 'a zipper | ||
| 150 | (** Like {!Zipper.push_after}, but inserts a sequence of elements after | ||
| 151 | the cursor. *) | ||
| 152 | |||
| 145 | val push_before : 'a -> 'a zipper -> 'a zipper | 153 | val push_before : 'a -> 'a zipper -> 'a zipper |
| 146 | (** Insert an element before the cursor. Return the modified zipper. | 154 | (** Insert an element before the cursor. Return the modified zipper. |
| 147 | Calling [push_before 0 z], if [z] is [([3; 2; 1], [4; 5])], | 155 | Calling [push_before 0 z], if [z] is [([3; 2; 1], [4; 5])], |
| 148 | the result is [([0; 3; 2; 1], [4; 5]))]. *) | 156 | the result is [([0; 3; 2; 1], [4; 5]))]. *) |
| 149 | 157 | ||
| 158 | val push_before_seq : 'a Sequence.t -> 'a zipper -> 'a zipper | ||
| 159 | (** Like {!Zipper.push_before}, but inserts a sequence of elements | ||
| 160 | before the cursor. *) | ||
| 161 | |||
| 150 | val split : 'a zipper -> 'a zipper * 'a zipper | 162 | val split : 'a zipper -> 'a zipper * 'a zipper |
| 151 | (** [split z] splits the zipper in two. [([3; 2; 1], [4; 5])] becomes | 163 | (** [split z] splits the zipper in two. [([3; 2; 1], [4; 5])] becomes |
| 152 | [([3; 2; 1], []), ([], [4; 5])]. *) | 164 | [([3; 2; 1], []), ([], [4; 5])]. *) |
