From 7948d888622ff448b134cd342acc82687a4eb6f1 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Wed, 25 Mar 2026 14:05:14 +0000 Subject: [PATCH] Add ctrls and fixes --- example/main.ml | 11 +- src/bruit.ml | 332 ++++++++++++++++++++++++++++++++++++++++++++---- src/bruit.mli | 15 ++- src/dune | 2 +- 4 files changed, 329 insertions(+), 31 deletions(-) diff --git a/example/main.ml b/example/main.ml index 8bfbea8..7735ea1 100644 --- a/example/main.ml +++ b/example/main.ml @@ -1,3 +1,9 @@ +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" ] @@ -10,9 +16,10 @@ let () = if sys_break then "[\x1b[31m130\x1b[0m] \x1b[33m>>\x1b[0m " else "\x1b[33m>>\x1b[0m " in - match Bruit.bruit ~complete prompt with + match Bruit.bruit ~history ~complete prompt with | String (Some s) -> - Fmt.pr "%s\n%!" s; + Fmt.pr "\n%s\n%!" s; + h := s :: !h; loop false | String None -> () | Ctrl_c -> loop true diff --git a/src/bruit.ml b/src/bruit.ml index 12997a4..9ac8020 100644 --- a/src/bruit.ml +++ b/src/bruit.ml @@ -1,7 +1,9 @@ (* See the end of the file for the original license of Linenoise. *) - +let () = Fmt.set_style_renderer Format.str_formatter `Ansi_tty let max_line = 2048 +type hint = string -> (string * Fmt.style) option + type key = | Enter | Ctrl_a @@ -9,6 +11,10 @@ type key = | Ctrl_c | Ctrl_d | Ctrl_e + | Ctrl_f + | Ctrl_r + | Ctrl_p + | Ctrl_g | Backspace | Escape_sequence | Tab @@ -21,6 +27,10 @@ let key_of_char c = | 3 -> Ctrl_c | 4 -> Ctrl_d | 5 -> Ctrl_e + | 6 -> Ctrl_f + | 7 -> Ctrl_g + | 16 -> Ctrl_p + | 18 -> Ctrl_r | 9 -> Tab | 13 -> Enter | 27 -> Escape_sequence @@ -45,15 +55,21 @@ module State = struct old_rows : int; old_row_pos : int; history_index : int; + history : string list; + saved_buf : string; read_buf : Bytes.t; in_completion : bool; completion_idx : int; complete : completion option; + hint : hint; } + let buf t = Bytes.sub t.buf 0 t.len + let make ?(in_completion = false) ?(completion_idx = 0) ?complete - ?(old_pos = 0) ?(pos = 0) ?(len = 0) ?(ifd = Unix.stdin) - ?(ofd = Unix.stdout) ~prompt buf = + ?(old_pos = 0) ?(pos = 0) ?(len = 0) ?(history = []) + ?(hint = fun _ -> None) ?(ifd = Unix.stdin) ?(ofd = Unix.stdout) ~prompt + buf = { in_completion; ifd; @@ -67,21 +83,29 @@ module State = struct len; cols = 0; old_row_pos = 1; + history; old_rows = 0; - history_index = 0; + history_index = -1; + saved_buf = ""; complete; completion_idx; - read_buf = Bytes.create 1 (* For reading a character *); + read_buf = Bytes.make 1 '\000' (* For reading a character *); + hint; } let override ?in_completion ?completion_idx ?complete ?ifd ?ofd ?buf ?buf_len ?prompt ?plen ?old_pos ?pos ?len ?cols ?old_rows ?old_row_pos - ?history_index (t : t) = + ?history_index ?history ?saved_buf (t : t) = + let () = + match buf with + | None -> () + | Some buf -> Bytes.blit buf 0 t.buf 0 (Bytes.length buf) + in { in_completion = Option.value ~default:t.in_completion in_completion; ifd = Option.value ~default:t.ifd ifd; ofd = Option.value ~default:t.ofd ofd; - buf = Option.value ~default:t.buf buf; + buf = t.buf; buf_len = Option.value ~default:t.buf_len buf_len; prompt = Option.value ~default:t.prompt prompt; plen = Option.value ~default:t.plen plen; @@ -95,6 +119,9 @@ module State = struct complete = (match complete with Some f -> Some f | None -> t.complete); read_buf = t.read_buf; completion_idx = Option.value ~default:t.completion_idx completion_idx; + history = Option.value ~default:t.history history; + saved_buf = Option.value ~default:t.saved_buf saved_buf; + hint = t.hint; } end @@ -120,7 +147,7 @@ let with_raw_mode (state : State.t) fn = c_vmin = 1; } in - Unix.tcsetattr state.ifd TCSAFLUSH tio; + Unix.tcsetattr state.ifd TCSADRAIN tio; Fun.protect ~finally:(fun () -> Unix.tcsetattr state.ifd TCSADRAIN saved_tio) fn @@ -148,7 +175,7 @@ let read_char state = let edit_start ~stdin:_ ~stdout:_ state fn = with_raw_mode state @@ fun () -> let cols = get_columns () in - Bytes.set state.buf 0 '\000'; + (* Bytes.set state.buf 0 '\000'; *) let state = State.override ~cols ~buf_len:(state.buf_len - 1) state in write_bytes state.ofd state.prompt; fn state @@ -174,8 +201,23 @@ let utf8_prev_char_len s off = type refresh_flag = Rewrite -let refresh_single_line ?(flags = []) (state : State.t) = - let pwidth = utf8_display_width state.prompt state.plen in +let refresh_with_hints ~pwidth ~ab (state : State.t) = + let buf_width = utf8_display_width state.buf state.len in + if pwidth + buf_width < state.cols then begin + match state.hint (State.buf state |> Bytes.to_string) with + | None -> () + | Some (hint, style) -> + let () = + Format.fprintf Format.str_formatter "%a" + Fmt.(styled style string) + hint + in + Buffer.add_string ab (Format.flush_str_formatter ()) + end + +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 prompt state.plen in let poscol = ref @@ utf8_display_width state.buf state.pos in let lencol = ref @@ utf8_display_width state.buf state.len in @@ -202,10 +244,12 @@ let refresh_single_line ?(flags = []) (state : State.t) = (* Add prompt *) if List.mem Rewrite flags then begin - Buffer.add_bytes ab state.prompt; + Buffer.add_bytes ab prompt; Buffer.add_bytes ab (Bytes.sub state.buf 0 state.len) end; + refresh_with_hints ~pwidth:state.len ~ab state; + (* Erase to the right *) Buffer.add_string ab "\x1b[0K"; @@ -248,12 +292,18 @@ let edit_insert (state : State.t) c = < state.cols then begin write_uchar state.ofd c; - state + refresh_line state end else refresh_line state end else begin - assert false + Bytes.blit state.buf state.pos state.buf (state.pos + clen) + (state.len - state.pos); + let _ : int = Bytes.set_utf_8_uchar state.buf state.pos c in + let state = + State.override ~len:(state.len + clen) ~pos:(state.pos + clen) state + in + refresh_line state end let edit_backspace (state : State.t) = @@ -271,7 +321,7 @@ let edit_backspace (state : State.t) = refresh_line state let complete_line (state : State.t) c cn = - match cn (String.of_bytes state.buf) with + match cn (String.of_bytes (State.buf state)) with | [] -> (State.override ~in_completion:false state, `Char c) | xs -> let state, c = @@ -305,7 +355,186 @@ let complete_line (state : State.t) c cn = (refresh_line state, c) end -let edit_feed state = +let move_left (state : State.t) = + let s = + if state.pos > 0 then + State.override + ~pos:(state.pos - utf8_prev_char_len state.buf state.pos) + state + else state + in + refresh_line s + +let complete_with_hint (state : State.t) = + let buf = State.buf state |> Bytes.to_string in + match state.hint buf with + | None -> state + | Some (h, _) -> + let new_buf = buf ^ h in + let end_buf = String.length new_buf in + Bytes.blit_string new_buf 0 state.buf 0 end_buf; + State.override ~pos:end_buf ~len:end_buf state + +let move_right (state : State.t) = + let s = + if state.pos < state.len then + State.override + ~pos:(state.pos + utf8_next_char_len state.buf state.pos) + state + else if state.pos = state.len then complete_with_hint state + else state + in + refresh_line s + +let move_right_next_word (state : State.t) = + let pos = ref state.pos in + while !pos < state.len && Bytes.get state.buf !pos = ' ' do + incr pos + done; + while !pos < state.len && Bytes.get state.buf !pos <> ' ' do + incr pos + done; + let s = State.override ~pos:!pos state in + refresh_line s + +let move_left_next_word (state : State.t) = + let pos = ref state.pos in + while !pos > 0 && Bytes.get state.buf !pos = ' ' do + decr pos + done; + while !pos > 0 && Bytes.get state.buf !pos <> ' ' do + decr pos + done; + let s = State.override ~pos:!pos state in + refresh_line s + +let reverse_incr_search ~history (state : State.t) = + let has_match = ref true in + let search_buf = Buffer.create 16 in + let search_pos = ref 0 in + let search_dir = ref (-1) in + let h = history "" in + let history_len = List.length h in + let saved_buf = Bytes.copy state.buf in + let exception Completed of State.t in + let rec loop state : State.t = + let prompt = + if !has_match then + Fmt.str "(reverse-i-search)`%s': " (Buffer.contents search_buf) + else + 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 = + match read_char state with + | `Editing -> loop state + | `None -> loop state + | `Some c -> ( + match key_of_char c with + | Backspace -> + if Buffer.length search_buf > 0 then begin + (* Pretty wasteful... *) + let s = Buffer.contents search_buf in + Buffer.clear search_buf; + Buffer.add_substring search_buf s 0 (String.length s - 1); + search_pos := 0 + end; + state + | Ctrl_p -> + search_dir := -1; + if !search_pos >= history_len then search_pos := history_len - 1; + state + | Ctrl_r -> + search_dir := 1; + if !search_pos < 0 then search_pos := 0; + state + | Ctrl_g -> + let l = Bytes.length saved_buf in + Bytes.blit saved_buf 0 state.buf 0 l; + let state = refresh_line (State.override ~pos:l ~len:l state) in + raise (Completed state) + | Enter -> + let state = State.override ~pos:state.len state in + raise (Completed state) + | _ -> + if Char.compare c ' ' > 0 then begin + new_char := true; + Buffer.add_char search_buf c; + search_pos := 0; + state + end + else + State.override ~pos:state.len state |> refresh_line |> fun s -> + raise (Completed s)) + in + has_match := false; + let state = + if Buffer.length search_buf > 0 then begin + let rec inner_loop () = + if !search_pos >= 0 && !search_pos < history_len then begin + let entry = List.nth h !search_pos in + match + ( Astring.String.cut ~sep:(Buffer.contents search_buf) entry, + !new_char + || not + @@ String.equal entry (Bytes.to_string (State.buf state)) ) + with + | Some (_l, _r), true -> + has_match := true; + Bytes.blit_string entry 0 state.buf 0 (String.length entry); + let state = State.override ~len:(String.length entry) state in + state + | _ -> + search_pos := !search_pos + !search_dir; + inner_loop () + end + else state + in + inner_loop () + end + else state + in + loop state + in + try loop state with Completed state -> state + +let edit_history dir fn (state : State.t) = + let saved_state = state in + let current_buf = Bytes.sub_string state.buf 0 state.len in + let state = + match (dir, state.history_index) with + | `Prev, -1 -> + State.override ~history:(fn current_buf) ~history_index:0 + ~saved_buf:current_buf state + | `Prev, m -> + let max_history = List.length state.history in + if m < max_history - 1 then + State.override ~history_index:(state.history_index + 1) state + else state + | `Next, m when m >= 0 -> + State.override ~history_index:(state.history_index - 1) state + | _ -> state + in + match (state.history, state.history_index) with + | [], _ -> saved_state + | _, -1 -> + let len = String.length state.saved_buf in + State.override ~buf:(Bytes.of_string state.saved_buf) ~pos:len ~len state + |> refresh_line + | _ -> + let max_history = List.length state.history in + let idx = min max_history state.history_index in + let s = List.nth state.history idx in + let s_len = String.length s in + State.override ~buf:(Bytes.of_string s) ~pos:s_len ~len:s_len state + |> refresh_line + +let edit_feed ~history state = match read_char state with | `Editing -> Editing state | `None -> Finished None @@ -322,37 +551,86 @@ let edit_feed state = | `Edit_more -> Editing state | `Char c -> ( match key_of_char c with - | Enter -> Finished (Some state.buf) + | Enter -> Finished (Some (Bytes.sub state.buf 0 state.len)) | Ctrl_d -> - if Int.equal state.len 0 then Finished None else assert false + if Int.equal state.len 0 then Finished None else Editing state | Ctrl_c -> Ctrl_c + | 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 - | Unknown _ | _ -> + | 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) + | _ -> let state = edit_insert state uc in Editing state)) type result = String of string option | Ctrl_c -let blocking_edit ?complete ~stdin ~stdout buf ~prompt = - let state = State.make ?complete ~prompt buf in +let blocking_edit ?complete ~history ~hint ~stdin ~stdout buf ~prompt = + let state = State.make ?complete ~hint ~prompt buf in let res = edit_start ~stdin ~stdout state @@ fun state -> let rec loop = function - | Editing state -> loop (edit_feed state) + | Editing state -> loop (edit_feed ~history state) | Finished s -> String (Option.map Bytes.to_string s) | Ctrl_c -> Ctrl_c in - loop (edit_feed state) + loop (edit_feed ~history state) in - Format.printf "\n%!"; res -let bruit ?complete prompt = +type history = string -> string list + +let bruit ?complete ?(history = fun _ -> []) ?(hint = fun _ -> None) prompt = let prompt = Bytes.of_string prompt in - let buf = Bytes.create max_line in + let buf = Bytes.make max_line '\000' in if not (Unix.isatty Unix.stdin) then failwith "Stdin is not a tty" - else blocking_edit ?complete ~stdin:Unix.stdin ~stdout:Unix.stdout buf ~prompt + else + blocking_edit ?complete ~history ~hint ~stdin:Unix.stdin ~stdout:Unix.stdout + buf ~prompt (* * Copyright (c) 2010-2023, Salvatore Sanfilippo diff --git a/src/bruit.mli b/src/bruit.mli index 9380c6c..cc6534d 100644 --- a/src/bruit.mli +++ b/src/bruit.mli @@ -4,9 +4,22 @@ The main entry point to the library is {! bruit}. *) +type history = string -> string list +(** The history callback that provides the user with the current line and + expects a list of history items to scroll through using the arrow keys. *) + +type hint = string -> (string * Fmt.style) option +(** The hint callback takes the current input and a user can return, optionally, + extra information to fill in on the current line. *) + type result = String of string option | Ctrl_c -val bruit : ?complete:(string -> string list) -> string -> result +val bruit : + ?complete:(string -> string list) -> + ?history:history -> + ?hint:hint -> + string -> + result (** [bruit ?complete prompt] reads from [stdin] and returns the read string if any, and on [ctrl+c] returns {! Ctrl_c}. diff --git a/src/dune b/src/dune index 2ad24cc..c846d59 100644 --- a/src/dune +++ b/src/dune @@ -1,4 +1,4 @@ (library (public_name bruit) - (libraries terminal unix fmt) + (libraries terminal unix fmt astring) (name bruit)) -- 2.51.2