open Base module Buffer = EditorBuffer open Util type mode = Normal | Insert | Control type cursor = int * int type editor = { term : Terminal.state; mode : mode; offset : int * int; cursor : cursor; buffer : Buffer.t option; rendered : bool; istream : Command.t Sequence.t; nstream : Command.t Sequence.t; status_size : int; message : string option; message_timestamp : float; message_duration : float; pending_command : string; } type t = editor let init (c : Config.t) : editor = { term = Terminal.init (); mode = Normal; offset = (0, 0); cursor = (1, 1); buffer = List.hd c.files |> Option.map ~f:Buffer.from_file; rendered = true; istream = Command.i_stream; nstream = Command.n_stream; status_size = 2; message = Some "Hello, control line!"; message_timestamp = Unix.time (); message_duration = 5.; pending_command = ""; } let string_of_mode = function | Insert -> " I " | Normal -> " N " | Control -> " C " let statusbar e = let open Text in (* let open Sequence.Infix in *) let w = e.term.size |> snd in let status = let mode = e.mode |> string_of_mode |> sequence_of_string in let msize = Sequence.length mode and path = Buffer.( e.buffer |> Option.map ~f:kind |> Option.value ~default:No_name |> string_of_kind |> sequence_of_string) and br, bc = Option.(e.buffer |> map ~f:Buffer.size |> value ~default:(0, 0)) and cr, cc = Option.( e.buffer |> map ~f:(Buffer.cursor ~rendered:false) |> value ~default:(0, 0)) in let perc = match cr with | 0 -> "Top" | n when n = br -> "Bot" | n -> Printf.sprintf "%2d%%" (100 * n / br) in let nav = Printf.sprintf "%d/%d %2d/%2d [%s] " cr br cc bc perc |> sequence_of_string in let nsize = Sequence.length nav in spread ~l:(bold mode) ~lsize:msize ~c:path ~r:(bold nav) ~rsize:nsize ~fill:' ' w |> invert and control = let msg = Option.value ~default:"" e.message |> sequence_of_string and cmd = e.pending_command |> sequence_of_string in spread ~l:msg ~r:cmd ~fill:' ' w in Sequence.(take (of_list [ status; control ]) e.status_size) type 'a action = t -> 'a * t module Action = struct let run ~editor action = action () editor let eval ~editor action = run ~editor action |> fst let exec ~editor action = run ~editor action |> snd include Applicative.Make (struct type 'a t = 'a action let return a s = (a, s) let apply f a e = let f, e' = f e in let x, e'' = a e' in (f x, e'') let map = `Define_using_apply end) include Monad.Make (struct type 'a t = 'a action let return x s = (x, s) let bind a ~f x = let y, a' = a x in f y a' let map = `Define_using_bind end) let get e = (e, e) let put e _ = ((), e) let modify ~f e = ((), f e) let update_cursor = let aux e = let dx, dy = e.offset and rs, cs = e.term.size in (* Limit cursor to buffer view *) let rs = rs - e.status_size in match Option.map ~f:Buffer.cursor e.buffer with | None -> { e with cursor = (1, 1); offset = (0, 0) } | Some (cx, cy) -> let dx' = Int.clamp_exn ~min:(cx - rs + 1) ~max:cx dx and dy' = Int.clamp_exn ~min:(cy - cs + 1) ~max:cy dy in { e with cursor = (cx - dx' + 1, cy - dy' + 1); offset = (dx', dy') } in modify ~f:aux let get_mode e = (e.mode, e) let set_mode m e = ((), { e with mode = m }) let get_focused_buffer e = (e.buffer, e) let set_focused_buffer b e = ((), { e with buffer = Some b }) let get_terminal_size e = (e.term.size, e) let on_focused_buffer f = let f e = { e with buffer = Option.map ~f e.buffer } in modify ~f *> update_cursor let on_focused_buffer_or_new f = (get_focused_buffer >>| Option.value ~default:Buffer.empty >>| f >>= set_focused_buffer) *> update_cursor let render = let welcome (r, c) = let open Text in let hfill = ' ' and vfill = Sequence.empty in "Welcome to the sand editor!" |> String.to_list |> Sequence.of_list |> center ~fill:hfill c |> Sequence.singleton |> center ~fill:vfill r in let aux e = let x, y = e.offset and ((r, c) as size) = e.term.size and fill = Sequence.singleton '~' and status = statusbar e and limit = Buffer.(if e.rendered then rendered_view else unrendered_view) in let ssize = e.status_size in let bufview = Option.( e.buffer >>| limit x y (r - ssize) c |> value ~default:(welcome size) |> Text.extend ~fill r |> Fn.flip Sequence.take (r - ssize)) in let screen = Sequence.append bufview status in Terminal.redraw screen e.cursor in get >>| aux (* TODO: save logic *) let quit n = Stdlib.exit n (* Statusbar *) let set_message m e = ((), { e with message = m; message_timestamp = Unix.time () }) let get_pending_command e = (e.pending_command, e) let set_pending_command p e = ((), { e with pending_command = p }) let append_pending_command k = let aux p = p ^ Key.to_string k in get_pending_command >>| aux >>= set_pending_command let clear_pending_command = set_pending_command "" let tick = let check_message_timestamp e = let now = Unix.time () in let expired = Float.(e.message_timestamp < now - e.message_duration) in if Option.is_some e.message && expired then { e with message = None } else e in get >>| check_message_timestamp >>= put (* Debug *) let get_rendered e = (e.rendered, e) let set_rendered r e = ((), { e with rendered = r }) let toggle_rendered = get_rendered >>| not >>= set_rendered let noop = return () end let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) = (x + down - up, y + right - left) let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy) (* let get_next_command s = *) (* match Sequence.next s.pending with *) (* | None -> (None, s) *) (* | Some (h, t) -> (Some h, { s with pending = t }) *) (* let handle_insert_key = *) (* let open Action in *) (* let open Key in *) (* function *) (* | Arrow_down -> Buffer.Action.down |> on_focused_buffer *) (* | Arrow_left -> Buffer.Action.left |> on_focused_buffer *) (* | Arrow_right -> Buffer.Action.right |> on_focused_buffer *) (* | Arrow_up -> Buffer.Action.up |> on_focused_buffer *) (* | Backspace -> Buffer.Action.delete_before |> on_focused_buffer *) (* | Ctrl 'Q' -> quit 0 *) (* | Delete -> Buffer.Action.delete_after |> on_focused_buffer *) (* | Enter -> Buffer.Action.newline |> on_focused_buffer *) (* | Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal *) (* | Key k -> Buffer.Action.insert k |> on_focused_buffer *) (* | _ -> noop *) (* let handle_normal_key = *) (* let open Action in *) (* let open Key in *) (* function *) (* | Arrow_down | Key 'j' -> Buffer.Action.down |> on_focused_buffer *) (* | Arrow_left | Backspace | Key 'h' -> Buffer.Action.left |> on_focused_buffer *) (* | Arrow_right | Key ' ' | Key 'l' -> Buffer.Action.right |> on_focused_buffer *) (* | Arrow_up | Key 'k' -> Buffer.Action.up |> on_focused_buffer *) (* | Ctrl 'Q' -> quit 0 *) (* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *) (* | Key 'A' -> *) (* (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert *) (* | Key 'a' -> *) (* (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert *) (* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *) (* | Key 'I' -> *) (* noop *) (* (1* (Buffer.Action.bol |> on_focused_buffer_or_new) *> set_mode Insert *1) *) (* | Key 'i' -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert *) (* | Key 's' -> *) (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) (* *> set_mode Insert *) (* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *) (* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *) (* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *) (* | _ -> noop *) (* let handle_next_command = *) (* let f m = function *) (* | None -> Action.return () *) (* | Some k -> ( *) (* match m with *) (* | Insert -> handle_insert_key k *) (* | Normal -> handle_normal_key k) *) (* in *) (* Action.(map2 ~f get_mode get_next_command |> join) *) let handle_insert_command = let open Command in let open Action in function | Simple Arrow_down -> Buffer.Action.move_down |> on_focused_buffer | Simple Arrow_left -> Buffer.Action.move_left |> on_focused_buffer | Simple Arrow_right -> Buffer.Action.move_right |> on_focused_buffer | Simple Arrow_up -> Buffer.Action.move_up |> on_focused_buffer | Simple Backspace -> Buffer.Action.delete_before ~cross_lines:true ~n:1 |> on_focused_buffer | Simple (Ctrl 'Q') -> quit 0 | Simple Delete -> Buffer.Action.delete_after ~cross_lines:true ~n:1 |> on_focused_buffer | Simple Enter -> Buffer.Action.newline |> on_focused_buffer | Simple Esc -> (Buffer.Action.move_left |> on_focused_buffer) *> set_mode Normal | Simple Page_down | Simple (Ctrl 'F') -> fun e -> (* TODO consider using the buffer window size (i.e., subtract status_size) *) let (n, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_down ~n) e | Simple Page_up | Simple (Ctrl 'B') -> fun e -> let (n, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_up ~n) e | Simple (Ctrl 'D') -> fun e -> let (r, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_down ~n:(r / 2)) e | Simple (Ctrl 'U') -> fun e -> let (r, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_up ~n:(r / 2)) e | Simple Home -> Buffer.Action.bol |> on_focused_buffer | Simple End -> Buffer.Action.eol |> on_focused_buffer | Simple Tab -> Buffer.Action.insert '\t' |> on_focused_buffer | Type k -> Buffer.Action.insert k |> on_focused_buffer | _ -> noop let handle_normal_command c = let open Command in let open Action in let update_command_cue = match c with | Partial k -> append_pending_command k | _ -> clear_pending_command and compute_action = match c with (* Movements *) | Chord (_, n, Noop, _, Down) -> Buffer.Action.move_down ?n |> on_focused_buffer | Chord (_, n, Noop, _, Left) -> Buffer.Action.move_left ?n |> on_focused_buffer | Chord (_, n, Noop, _, Right) -> Buffer.Action.move_right ?n |> on_focused_buffer | Chord (_, n, Noop, _, Up) -> Buffer.Action.move_up ?n |> on_focused_buffer | Chord (_, n, Noop, _, To_bol) -> let n = Option.value ~default:1 n - 1 in Buffer.Action.(move_down ~n &> bol) |> on_focused_buffer | Chord (_, n, Noop, _, To_eol) -> let n = Option.value ~default:1 n - 1 in Buffer.Action.(move_down ~n &> eol) |> on_focused_buffer | Simple Page_down | Simple (Ctrl 'F') -> fun e -> let (n, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_down ~n) e | Simple Page_up | Simple (Ctrl 'B') -> fun e -> let (n, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_up ~n) e | Simple (Ctrl 'D') -> fun e -> let (r, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_down ~n:(r / 2)) e | Simple (Ctrl 'U') -> fun e -> let (r, _), e = get_terminal_size e in on_focused_buffer (Buffer.Action.move_up ~n:(r / 2)) e (* Change *) | Shortcut (_, n, Change) -> let n = Option.value ~default:1 n - 1 in (Buffer.Action.( delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, Line) -> let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol) |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, Down) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol) |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, Left) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in (Buffer.Action.delete_before ~n |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, Right) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in (Buffer.Action.delete_after ~n |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, Up) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in (Buffer.Action.(bol &> delete_to_eol &> delete_lines_before ~n) |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, To_bol) -> let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in (Buffer.Action.( delete_to_bol &> move_down &> delete_lines ~n &> move_up &> bol) |> on_focused_buffer_or_new) *> set_mode Insert | Chord (_, n1, Change, n2, To_eol) -> let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in (Buffer.Action.( delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) |> on_focused_buffer_or_new) *> set_mode Insert (* Delete *) | Shortcut (_, n, Delete) -> let n = Option.value ~default:1 n - 1 in Buffer.Action.( delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, Line) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in Buffer.Action.delete_lines ~n |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, Down) -> let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in Buffer.Action.delete_lines ~n |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, Left) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in Buffer.Action.delete_before ~n |> on_focused_buffer_or_new | Shortcut (_, n, Erase_before) -> let n = Option.(value ~default:1 n) in Buffer.Action.delete_before ~n |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, Right) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in Buffer.Action.delete_after ~n |> on_focused_buffer_or_new | Shortcut (_, n, Erase_after) -> let n = Option.(value ~default:1 n) in Buffer.Action.delete_after ~n |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, Up) -> let n = Option.(value ~default:1 n1 * value ~default:1 n2) in Buffer.Action.(delete_lines ~n:1 &> delete_lines_before ~n) |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, To_bol) -> let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in Buffer.Action.( delete_to_bol &> move_down &> delete_lines ~n &> move_up &> bol) |> on_focused_buffer_or_new | Chord (_, n1, Delete, n2, To_eol) -> let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in Buffer.Action.( delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol) |> on_focused_buffer_or_new (* Join *) | Shortcut (_, n, Join) -> let n = Option.(value ~default:1 n) in Buffer.Action.join_lines ~n |> on_focused_buffer_or_new (* Quit *) | Simple (Ctrl 'Q') -> quit 0 (* Misc *) | Simple (Key 'A') -> (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert | Simple (Key 'a') -> (Buffer.Action.move_right |> on_focused_buffer_or_new) *> set_mode Insert (* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *) (* | Key 'I' -> noop *) | Simple (Key 'i') -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert (* | Key 's' -> *) (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) (* *> set_mode Insert *) (* Debug *) | Simple (Ctrl 'R') -> toggle_rendered | _ -> noop in compute_action *> update_command_cue let handle_next_command m e = match m with | Insert -> ( match Sequence.next e.istream with | None -> ((), e) | Some (h, t) -> handle_insert_command h { e with istream = t }) | Normal -> ( match Sequence.next e.nstream with | None -> ((), e) | Some (h, t) -> handle_normal_command h { e with nstream = t }) | Control -> failwith "unimplemented" let handle_next_command = let open Action in get_mode >>= handle_next_command