diff --git a/example/brr/dune b/example/brr/dune new file mode 100644 --- /dev/null +++ b/example/brr/dune @@ -0,0 +1,13 @@ +(executable + (modes js) + (name index) + (libraries ansi bruit.brr) + (js_of_ocaml + (flags + (:standard --enable=effects)))) + +(rule + (deps index.bc.js index.html) + (targets index.js) + (action + (copy index.bc.js index.js))) diff --git a/example/brr/index.html b/example/brr/index.html new file mode 100644 --- /dev/null +++ b/example/brr/index.html @@ -0,0 +1,59 @@ + + + + + bruit + + + +
+
+
+ + +
+
+ + + + diff --git a/example/brr/index.ml b/example/brr/index.ml new file mode 100644 --- /dev/null +++ b/example/brr/index.ml @@ -0,0 +1,35 @@ +open Brr + +let h = ref [] + +let history prefix = + if prefix <> "" then List.filter (fun s -> String.starts_with ~prefix s) !h + else !h + +let complete s = + match String.get s 0 with + | 'h' -> [ "hello"; "hello there" ] + | _ | (exception Invalid_argument _) -> [] + +let stdin = Document.find_el_by_id G.document (Jstr.v "stdin") |> Option.get +let stdout = Document.find_el_by_id G.document (Jstr.v "stdout") |> Option.get +let prompt = Document.find_el_by_id G.document (Jstr.v "prompt") |> Option.get + +let () = + Eio_js_backend.start @@ fun () -> + El.append_children stdout [ El.style [ El.txt' Ansi.css ] ]; + let ctx = Bruit_brr.stdctx ~redirect:true stdin prompt stdout in + let rec loop sys_break = + let prompt = + if sys_break then "[\x1b[31m130\x1b[0m] \x1b[33m>>\x1b[0m " + else "\x1b[33m>>\x1b[0m " + in + match Bruit.bruit ~history ~complete ctx prompt with + | String (Some s) -> + El.append_children stdout [ El.txt' s ]; + h := s :: !h; + loop false + | String None -> () + | Ctrl_c -> loop true + in + loop false diff --git a/example/dune b/example/unix/dune rename from example/dune rename to example/unix/dune --- a/example/dune +++ b/example/unix/dune diff --git a/example/main.ml b/example/unix/main.ml rename from example/main.ml rename to example/unix/main.ml --- a/example/main.ml +++ b/example/unix/main.ml @@ -11,15 +11,16 @@ | _ | (exception Invalid_argument _) -> [] let () = Fmt_tty.setup_std_outputs (); + let ctx = Bruit_unix.stdctx () in let rec loop sys_break = let prompt = if sys_break then "[\x1b[31m130\x1b[0m] \x1b[33m>>\x1b[0m " else "\x1b[33m>>\x1b[0m " in - let ctx = Bruit_unix.stdctx () in match Bruit.bruit ~history ~complete ctx prompt with | String (Some s) -> - Fmt.pr "%s\n%!" s; + let _ : int = Unix.write_substring Unix.stdout s 0 (String.length s) in + let _ : int = Unix.write_substring Unix.stdout "\n" 0 1 in h := s :: !h; loop false | String None -> () diff --git a/src/brr/bruit_brr.ml b/src/brr/bruit_brr.ml new file mode 100644 --- /dev/null +++ b/src/brr/bruit_brr.ml @@ -0,0 +1,85 @@ +open Js_of_ocaml +open Brr + +let ansi = Ansi.create () + +let html s = + let out = El.pre [] in + let html = Ansi.process ansi s in + Jv.set (El.to_jv out) "innerHTML" (Jv.of_string html); + out + +let redirect_stdout stdout = + Sys_js.set_channel_flusher Out_channel.stdout (fun s -> + El.append_children stdout [ html s ]) + +let keyboard_event_to_key (e : Ev.Keyboard.t) : Bruit.key = + let ctrl = Ev.Keyboard.ctrl_key e in + let k = Ev.Keyboard.key e |> Jstr.to_string in + match (ctrl, k) with + | true, "a" -> Ctrl_a + | true, "b" -> Ctrl_b + | true, "c" -> Ctrl_c + | true, "d" -> Ctrl_d + | true, "e" -> Ctrl_e + | true, "f" -> Ctrl_f + | true, "g" -> Ctrl_g + | true, "p" -> Ctrl_p + | true, "r" -> Ctrl_r + | false, "Enter" -> Enter + | false, "ArrowUp" -> Arrow_up + | false, "ArrowDown" -> Arrow_down + | ctrl, "ArrowLeft" -> if ctrl then Ctrl_arrow_left else Arrow_left + | ctrl, "ArrowRight" -> if ctrl then Ctrl_arrow_right else Arrow_right + | ctrl, "Backspace" -> if ctrl then Ctrl_backspace else Backspace + | true, _ -> Ignore + | _, c when String.length c > 1 -> Ignore + | _, c -> + if String.length c > 0 then Unknown (Uchar.of_char (String.get c 0)) + else Unknown (Uchar.of_char '\000') + +let set_cursor_pos el pos = + let jv = Brr.El.to_jv el in + Jv.set jv "selectionStart" (Jv.of_int pos); + Jv.set jv "selectionEnd" (Jv.of_int pos) + +let render ~output ~prompt_el ~input cmd = + let open Brr in + match cmd with + | Bruit.Write_input_char _ -> () + | Bruit.Clear_screen -> El.set_children output [] + | Bruit.Newline -> + let prompt_text = El.text_content prompt_el in + let buf_text = El.prop El.Prop.value input |> Jstr.to_string in + El.append_children output + [ + El.div + [ El.span [ El.txt prompt_text ]; El.span [ El.txt' buf_text ] ]; + ]; + El.set_prop El.Prop.value (Jstr.v "") input + | Bruit.Refresh { prompt; buf; buf_len; cursor_pos; _ } -> + Jv.set (El.to_jv prompt_el) "innerHTML" + (Jv.of_jstr (Jstr.v (Ansi.process ansi @@ Bytes.to_string prompt))); + El.set_prop El.Prop.value (Jstr.v (Bytes.sub_string buf 0 buf_len)) input; + set_cursor_pos input cursor_pos + +let stdctx ?(redirect = false) (stdin : El.t) (prompt : El.t) (stdout : El.t) : + unit Bruit.ctx = + (* if redirect then redirect_stdout stdout; *) + ignore redirect; + let get_columns () = None in + let guess_printed_width = Terminal.guess_printed_width in + let next_key () = + let e = Eio_brr.Ev.next Ev.keydown (El.as_target stdin) in + Ev.prevent_default e; + e |> Ev.as_type |> keyboard_event_to_key + in + let write bs ~off ~len = + ignore (bs, off); + len + in + let enter_raw_mode () = () in + let exit_raw_mode () = () in + Bruit.make_ctx ~get_columns ~next_key ~write ~enter_raw_mode ~exit_raw_mode + ~guess_printed_width + (render ~output:stdout ~prompt_el:prompt ~input:stdin) diff --git a/src/brr/dune b/src/brr/dune new file mode 100644 --- /dev/null +++ b/src/brr/dune @@ -0,0 +1,5 @@ +(library + (optional) + (name bruit_brr) + (public_name bruit.brr) + (libraries brr bruit ansi eio_brr js_of_ocaml terminal)) diff --git a/src/bruit.ml b/src/bruit.ml --- a/src/bruit.ml +++ b/src/bruit.ml @@ -4,6 +4,18 @@ let max_line = 2048 type hint = string -> (string * Fmt.style) option +type render_cmd = + | Refresh of { + prompt : bytes; + buf : bytes; + buf_len : int; + cursor_pos : int; + width : int; + } + | Write_input_char of Uchar.t + | Newline + | Clear_screen + type key = | Enter | Ctrl_a @@ -15,12 +27,47 @@ | Ctrl_f | Ctrl_r | Ctrl_p | Ctrl_g + | Arrow_left + | Arrow_right + | Arrow_down + | Arrow_up + | Ctrl_arrow_left + | Ctrl_arrow_right | Backspace - | Escape_sequence + | Ctrl_backspace | Tab + | Ignore | Unknown of Uchar.t -let key_of_char c = +let key_of_escape_sequence read_char = + let c0 = read_char () in + match c0 with + | '[' -> + let c1 = read_char () in + if Char.compare c1 '0' >= 0 && Char.compare c1 '9' <= 0 then + let c2 = read_char () in + let c3 = match read_char () with c -> Some c | exception _ -> None in + let c4 = match read_char () with c -> Some c | exception _ -> None in + match (c2, c3) with + | ';', Some '5' -> ( + match c4 with + | Some 'D' -> Some Ctrl_arrow_left + | Some 'C' -> Some Ctrl_arrow_right + | _ -> None) + | _ -> None + else + begin match c1 with + | 'A' -> Some Arrow_up + | 'B' -> Some Arrow_down + | 'C' -> Some Arrow_right + | 'D' -> Some Arrow_left + | _ -> None + end + | _ -> None + +let key read_char = + (* TODO: Remove assert false *) + let c = read_char () in match Char.code c with | 1 -> Ctrl_a | 2 -> Ctrl_b @@ -29,29 +76,35 @@ | 4 -> Ctrl_d | 5 -> Ctrl_e | 6 -> Ctrl_f | 7 -> Ctrl_g + | 8 -> Ctrl_backspace | 16 -> Ctrl_p | 18 -> Ctrl_r | 9 -> Tab | 13 -> Enter - | 27 -> Escape_sequence + | 27 -> ( + match key_of_escape_sequence read_char with + | Some k -> k + | None -> Unknown (Uchar.of_char c)) | 127 -> Backspace | _ -> Unknown (Uchar.of_char c) type 'tio ctx = { get_columns : unit -> int option; guess_printed_width : string -> int; - read : bytes -> off:int -> len:int -> int; + next_key : unit -> key; write : bytes -> off:int -> len:int -> int; + render : render_cmd -> unit; enter_raw_mode : unit -> 'tio; exit_raw_mode : 'tio -> unit; } -let make_ctx ~get_columns ~guess_printed_width ~read ~write ~enter_raw_mode - ~exit_raw_mode = +let make_ctx ~get_columns ~guess_printed_width ~next_key ~write ~enter_raw_mode + ~exit_raw_mode render = { get_columns; guess_printed_width; - read; + next_key; + render; write; enter_raw_mode; exit_raw_mode; @@ -84,9 +137,9 @@ complete : completion option; hint : hint; } - let read t = + let next_key t = let (Ctxt c) = t.ctxt in - c.read + c.next_key let write t = let (Ctxt c) = t.ctxt in @@ -100,6 +153,18 @@ let guess_printed_width t = let (Ctxt c) = t.ctxt in c.guess_printed_width + let render t ~prompt ~buf ~buf_len ~cursor_pos ~width = + let (Ctxt c) = t.ctxt in + c.render (Refresh { prompt; buf; buf_len; cursor_pos; width }) + + let newline t = + let (Ctxt c) = t.ctxt in + c.render Newline + + let write_input_char t u = + let (Ctxt c) = t.ctxt in + c.render (Write_input_char u) + let buf t = Bytes.sub t.buf 0 t.len let make ?(in_completion = false) ?(completion_idx = 0) ?complete @@ -168,22 +233,15 @@ let len = Bytes.length s in let wrote = State.write state s ~off:0 ~len in assert (Int.equal len wrote) -let write_uchar (state : State.t) u = - let b_len = Uchar.utf_8_byte_length u in - let bs = Bytes.create b_len in - let wrote = Bytes.set_utf_8_uchar bs 0 u in - assert (Int.equal b_len wrote); - write_bytes state bs - type edit = Editing of State.t | Finished of bytes option | Ctrl_c let read_char (state : State.t) = (* try *) - let read = State.read state state.read_buf ~off:0 ~len:1 in - if read = 0 then `None else `Some (Bytes.unsafe_get state.read_buf 0) + let key = State.next_key state () in + `Some key (* with Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.EAGAIN), _, _) -> `Editing *) -let edit_start ~stdin:_ ~stdout:_ state fn = +let edit_start state fn = with_raw_mode state @@ fun () -> let cols = State.get_columns state |> Option.value ~default:80 in (* Bytes.set state.buf 0 '\000'; *) @@ -226,7 +284,7 @@ in Buffer.add_string ab (Format.flush_str_formatter ()) end -let refresh_single_line ?(flags = []) ?prompt (state : State.t) = +let _refresh_single_line ?(flags = []) ?prompt (state : State.t) = let prompt = match prompt with None -> state.prompt | Some p -> p in let pwidth = utf8_display_width state prompt state.plen in let poscol = ref @@ utf8_display_width state state.buf state.pos in @@ -271,7 +329,13 @@ end; write_bytes state (Buffer.to_bytes ab); state -let refresh_line state = refresh_single_line ~flags:[ Rewrite ] state +(* let refresh_line state = refresh_single_line ~flags:[ Rewrite ] state *) +(**) +let refresh_line ?prompt (state : State.t) = + let prompt = Option.value ~default:state.prompt prompt in + State.render state ~prompt ~buf:state.buf ~buf_len:state.len + ~cursor_pos:state.pos ~width:state.cols; + state let refresh_line_with_completions (state : State.t) lcs = if state.completion_idx < List.length lcs then @@ -302,7 +366,7 @@ utf8_display_width state state.prompt state.plen + utf8_display_width state state.buf state.len < state.cols then begin - write_uchar state c; + State.write_input_char state c; refresh_line state end else refresh_line state @@ -333,10 +397,10 @@ refresh_line state let complete_line (state : State.t) c cn = match cn (String.of_bytes (State.buf state)) with - | [] -> (State.override ~in_completion:false state, `Char c) + | [] -> (State.override ~in_completion:false state, `Key c) | xs -> let state, c = - match key_of_char c with + match c with | Tab -> if not state.in_completion then ( State.override ~in_completion:true ~completion_idx:0 state, @@ -357,7 +421,7 @@ State.override ~len:to_write_len ~pos:to_write_len state end else state in - (State.override ~in_completion:false state, `Char c) + (State.override ~in_completion:false state, `Key c) in if state.in_completion && state.completion_idx < List.length xs then begin (refresh_line_with_completions state (List.map Bytes.of_string xs), c) @@ -458,16 +522,13 @@ Fmt.str "(failed-reverse-i-search)`%s': " (Buffer.contents search_buf) in let new_char = ref false in let state = State.override ~pos:0 state in - let state = - refresh_single_line ~flags:[ Rewrite ] ~prompt:(String.to_bytes prompt) - state - in + let state = refresh_line ~prompt:(String.to_bytes prompt) state in let state = match read_char state with | `Editing -> loop state | `None -> loop state | `Some c -> ( - match key_of_char c with + match c with | Backspace -> if Buffer.length search_buf > 0 then begin (* Pretty wasteful... *) @@ -493,7 +554,8 @@ raise (Completed state) | Enter -> let state = State.override ~pos:state.len state in raise (Completed state) - | _ -> + | Unknown u -> + let c = Uchar.to_int u |> Char.chr in if Char.compare c ' ' > 0 then begin new_char := true; Buffer.add_char search_buf c; @@ -502,7 +564,10 @@ state end else State.override ~pos:state.len state |> refresh_line |> fun s -> - raise (Completed s)) + raise (Completed s) + | _ -> + State.override ~pos:state.len state |> refresh_line |> fun s -> + raise (Completed s)) in has_match := false; let state = @@ -571,74 +636,37 @@ match read_char state with | `Editing -> Editing state | `None -> Finished None | `Some c -> ( - let uc = Uchar.of_char c in + (* let uc = Uchar.of_char c in *) let state, c = - if state.in_completion || key_of_char c = Tab then + if state.in_completion || c = Tab then match state.complete with - | None -> (state, `Char c) + | None -> (state, `Key c) | Some cn -> complete_line state c cn - else (state, `Char c) + else (state, `Key c) in match c with | `Edit_more -> Editing state - | `Char c -> ( - match key_of_char c with + | `Key c -> ( + match c with | Enter -> Finished (Some (Bytes.sub state.buf 0 state.len)) | Ctrl_d -> if Int.equal state.len 0 then Finished None else Editing state | Ctrl_c -> Ctrl_c + | Ignore -> Editing state | Ctrl_b -> Editing (move_left state) | Ctrl_f -> Editing (move_right state) | Ctrl_r -> Editing (reverse_incr_search ~history state) | Backspace -> Editing (edit_backspace state) | Tab -> Editing state - | Escape_sequence -> ( - let c0 = - read_char state |> function `Some c -> c | _ -> assert false - in - match c0 with - | '[' -> - let c1 = - read_char state |> function - | `Some c -> c - | _ -> assert false - in - if Char.compare c1 '0' >= 0 && Char.compare c1 '9' <= 0 then - let c2 = - read_char state |> function - | `Some c -> c - | _ -> assert false - in - let c3 = - match read_char state with - | `Some c -> Some c - | (exception _) | _ -> None - in - let c4 = - match read_char state with - | `Some c -> Some c - | (exception _) | _ -> None - in - match (c2, c3) with - | ';', Some '5' -> ( - match c4 with - | Some 'D' -> Editing (move_left_next_word state) - | Some 'C' -> Editing (move_right_next_word state) - | _ -> Editing state) - | _ -> Editing state - else - begin match c1 with - | 'A' -> Editing (edit_history `Prev history state) - | 'B' -> Editing (edit_history `Next history state) - | 'C' -> Editing (move_right state) - | 'D' -> Editing (move_left state) - | _ -> Editing state - end - | _ -> Editing state) + | Arrow_left -> Editing (move_left state) + | Arrow_right -> Editing (move_right state) + | Ctrl_arrow_left -> Editing (move_left_next_word state) + | Ctrl_arrow_right -> Editing (move_right_next_word state) + | Arrow_down -> Editing (edit_history `Next history state) + | Arrow_up -> Editing (edit_history `Prev history state) | Ctrl_a | Ctrl_g | Ctrl_e | Ctrl_p -> Editing state - | Unknown c when Uchar.(equal (of_int 8) c) (* ctrl+backspace *) -> - Editing (delete_word state) - | Unknown _ -> + | Ctrl_backspace -> Editing (delete_word state) + | Unknown uc -> let state = edit_insert state uc in Editing state)) @@ -647,7 +675,7 @@ let blocking_edit ?complete ~history ~hint ctx buf ~prompt = let state = State.make ?complete ~hint ~prompt ctx buf in let res = - edit_start ~stdin ~stdout state @@ fun state -> + edit_start state @@ fun state -> let rec loop = function | Editing state -> loop (edit_feed ~history state) | Finished s -> String (Option.map Bytes.to_string s) @@ -655,6 +683,7 @@ | Ctrl_c -> Ctrl_c in loop (edit_feed ~history state) in + State.newline state; res type history = string -> string list diff --git a/src/bruit.mli b/src/bruit.mli --- a/src/bruit.mli +++ b/src/bruit.mli @@ -17,13 +17,52 @@ type 'terminal_io ctx (** The context is an abstraction that provides OS-specific backend details. *) +type render_cmd = + | Refresh of { + prompt : bytes; + buf : bytes; + buf_len : int; + cursor_pos : int; + width : int; + } + | Write_input_char of Uchar.t + | Newline + | Clear_screen (** Backend-specific render commands *) + +type key = + | Enter + | Ctrl_a + | Ctrl_b + | Ctrl_c + | Ctrl_d + | Ctrl_e + | Ctrl_f + | Ctrl_r + | Ctrl_p + | Ctrl_g + | Arrow_left + | Arrow_right + | Arrow_down + | Arrow_up + | Ctrl_arrow_left + | Ctrl_arrow_right + | Backspace + | Ctrl_backspace + | Tab + | Ignore + | Unknown of Uchar.t (** Supported key strokes *) + +val key : (unit -> char) -> key +(** [key read_char] will use the [read_char] function to read key strokes. *) + val make_ctx : get_columns:(unit -> int option) -> guess_printed_width:(string -> int) -> - read:(bytes -> off:int -> len:int -> int) -> + next_key:(unit -> key) -> write:(bytes -> off:int -> len:int -> int) -> enter_raw_mode:(unit -> 'tio) -> exit_raw_mode:('tio -> unit) -> + (render_cmd -> unit) -> 'tio ctx val bruit : diff --git a/src/unix/bruit_unix.ml b/src/unix/bruit_unix.ml --- a/src/unix/bruit_unix.ml +++ b/src/unix/bruit_unix.ml @@ -21,14 +21,74 @@ Unix.tcsetattr stdin TCSADRAIN tio; saved_tio let exit_raw_mode stdin saved_tio = Unix.tcsetattr stdin TCSADRAIN saved_tio -let read stdin b ~off ~len = Unix.read stdin b off len + +let read = + let b = Bytes.make 1 '\000' in + fun stdin -> + let i = Unix.read stdin b 0 1 in + assert (i = 1); + Bytes.unsafe_get b 0 + let write stdout b ~off ~len = Unix.write stdout b off len +let utf8_display_width b len = + let s = Bytes.to_string b in + Terminal.guess_printed_width (String.sub s 0 len) + +let utf8_next_char_len s off = + Bytes.get_utf_8_uchar s off + |> Uchar.utf_decode_uchar |> Uchar.utf_8_byte_length + +let render ofd = function + | Bruit.Clear_screen -> + let b = Bytes.of_string "\x1b[H\x1b[2J" in + let _ : int = write ofd b ~off:0 ~len:(Bytes.length b) in + () + | Bruit.Newline -> + let _ : int = write ofd (Bytes.of_string "\n") ~off:0 ~len:1 in + () + | Bruit.Write_input_char _ -> () + | Bruit.Refresh { prompt; buf; buf_len; cursor_pos; width } -> + let pwidth = utf8_display_width prompt (Bytes.length prompt) in + let poscol = ref @@ utf8_display_width buf cursor_pos in + let rec loop () = + if pwidth + !poscol >= width then begin + let clen = utf8_next_char_len buf 0 in + let c_width = + Uchar.utf_8_byte_length + (Bytes.get_utf_8_uchar buf clen |> Uchar.utf_decode_uchar) + in + poscol := !poscol - c_width; + loop () + end + else () + in + let () = loop () in + let ab = Buffer.create 0 in + (* Clear line *) + Buffer.add_char ab '\r'; + + (* Add prompt *) + Buffer.add_bytes ab prompt; + Buffer.add_bytes ab (Bytes.sub buf 0 buf_len); + + (* refresh_with_hints ~pwidth:state.len ~ab state; *) + + (* Erase to the right *) + Buffer.add_string ab "\x1b[0K"; + + (* Cursor to the original position *) + Buffer.add_string ab (Format.sprintf "\r\x1b[%dC" (!poscol + pwidth)); + let bs = Buffer.to_bytes ab in + let _ : int = write ofd bs ~off:0 ~len:(Bytes.length bs) in + () + let stdctx ?(stdin = Unix.stdin) ?(stdout = Unix.stdout) () = - let read = read stdin in + let read () = read stdin in + let next_key () = Bruit.key read in let write = write stdout in let enter_raw_mode = enter_raw_mode stdin in let exit_raw_mode = exit_raw_mode stdin in - Bruit.make_ctx ~read ~write ~enter_raw_mode ~exit_raw_mode + Bruit.make_ctx ~next_key ~write ~enter_raw_mode ~exit_raw_mode ~get_columns:Terminal.Size.get_columns - ~guess_printed_width:Terminal.guess_printed_width + ~guess_printed_width:Terminal.guess_printed_width (render stdout)