From 53916fc3f7dcbefd90e3d0340a2a8f32bf331d1d Mon Sep 17 00:00:00 2001 From: Federico Igne Date: Sun, 28 Jan 2024 01:22:52 +0100 Subject: feat: add plain search functionality (with history) --- lib/command.ml | 17 ++++++- lib/control.ml | 32 ++++++++++++ lib/editor.ml | 137 +++++++++++++++++++++++++++++++++++++++++++++------- lib/editorBuffer.ml | 60 ++++++++++++++++++++++- lib/mode.ml | 3 ++ lib/modes.ml | 18 ------- 6 files changed, 229 insertions(+), 38 deletions(-) create mode 100644 lib/control.ml create mode 100644 lib/mode.ml delete mode 100644 lib/modes.ml (limited to 'lib') diff --git a/lib/command.ml b/lib/command.ml index 9ab36f6..ac1dbf1 100644 --- a/lib/command.ml +++ b/lib/command.ml @@ -14,6 +14,8 @@ type operation = | Paste_after | Erase_before | Erase_after + | Search + | Search_rev type scope = Line | To_bol | To_eol | Down | Left | Right | Up @@ -70,7 +72,18 @@ let to_scope = function let is_simple_movement k = List.mem ~equal:Poly.equal simple_movements k let instant_operation = - [ Key 'C'; Key 'D'; Key 'Y'; Key 'J'; Key 'P'; Key 'X'; Key 'p'; Key 'x' ] + [ + Key 'C'; + Key 'D'; + Key 'Y'; + Key 'J'; + Key 'n'; + Key 'N'; + Key 'P'; + Key 'X'; + Key 'p'; + Key 'x'; + ] let chord_operation = [ Key 'c'; Key 'd'; Key 'y' ] @@ -79,6 +92,8 @@ let to_op = function | Key 'c' | Key 'C' -> Change | Key 'd' | Key 'D' -> Delete | Key 'y' | Key 'Y' -> Yank + | Key 'n' -> Search + | Key 'N' -> Search_rev | Key 'p' -> Paste_after | Key 'P' -> Paste_before | Key 'x' -> Erase_after diff --git a/lib/control.ml b/lib/control.ml new file mode 100644 index 0000000..670175c --- /dev/null +++ b/lib/control.ml @@ -0,0 +1,32 @@ +open Base + +type t = { prompt : Key.t; content : char Zipper.t } +type result = Search of bool * char Sequence.t | No_result + +let create prompt = { prompt; content = Zipper.empty } + +let render c = + let prompt = Key.to_string c.prompt |> String.to_list + and content = c.content |> Zipper.to_seq in + Sequence.shift_right_with_list content prompt + +let is_search c = match c.prompt with Key '/' | Key '?' -> true | _ -> false + +let cursor c = + String.length (Key.to_string c.prompt) + Zipper.left_length c.content + 1 + +let get_result c = + let open Zipper in + match c.prompt with + | Key '/' -> Search (true, c.content |> to_seq) + | Key '?' -> Search (false, c.content |> to_seq) + | _ -> No_result + +let set_content s c = { c with content = Zipper.(of_seq s |> far_right) } +let move_left c = { c with content = Zipper.left c.content } +let move_right c = { c with content = Zipper.right c.content } +let delete_before c = { c with content = Zipper.pop_before c.content |> snd } +let delete_after c = { c with content = Zipper.pop c.content |> snd } +let bol c = { c with content = Zipper.far_left c.content } +let eol c = { c with content = Zipper.far_right c.content } +let insert k c = { c with content = Zipper.push_before k c.content } diff --git a/lib/editor.ml b/lib/editor.ml index 043c00e..5a68e53 100644 --- a/lib/editor.ml +++ b/lib/editor.ml @@ -2,8 +2,6 @@ open Base module Buffer = EditorBuffer open Util -type mode = Normal | Insert | Control - type selection = | Empty | Glyphwise of char Sequence.t Sequence.t @@ -13,7 +11,7 @@ type cursor = int * int type editor = { term : Terminal.state; - mode : mode; + mode : Mode.t; offset : int * int; cursor : cursor; buffer : Buffer.t; @@ -26,6 +24,8 @@ type editor = { message_duration : float; pending_command : string; registers : selection Array.t; + control : Control.t; + search_history : (bool * char Sequence.t) Zipper.t; } type t = editor @@ -49,19 +49,16 @@ let init (c : Config.t) : editor = message_duration = 5.; pending_command = ""; registers = Array.create ~len:128 Empty; + control = Control.create Key.Nul; + search_history = Zipper.empty; } -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 mode = e.mode |> Mode.to_string |> sequence_of_string in let lsize = Sequence.length mode and c = e.buffer.kind |> Buffer.string_of_kind |> sequence_of_string and br, bc = Buffer.size e.buffer @@ -79,9 +76,12 @@ let statusbar e = let rsize = Sequence.length nav in spread ~l:(bold mode) ~lsize ~c ~r:(bold nav) ~rsize ~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 + match e.mode with + | Control -> Control.render e.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) @@ -117,8 +117,16 @@ module Action = struct let map = `Define_using_bind end) + let ( let+ ) e f = map e ~f let ( let* ) e f = bind e ~f let ( and* ) = both + + let rec repeat ?(n = 1) a = + match n with + | _ when n <= 0 -> return () + | 1 -> a + | _ -> a *> repeat ~n:(n - 1) a + let get e = (e, e) let put e _ = ((), e) let modify ~f e = ((), f e) @@ -149,8 +157,22 @@ module Action = struct let* b = get_focused_buffer in return (f b |> fst) + let get_control_buffer e = (e.control, e) + let set_control_buffer c e = ((), { e with control = c }) + + let on_control_buffer f = + let* c = get_control_buffer in + set_control_buffer (f c) + let get_mode e = (e.mode, e) let set_mode m e = ((), { e with mode = m }) + let get_search_history e = (e.search_history, e) + let set_search_history h e = ((), { e with search_history = h }) + let on_search_history f = get_search_history >>| f >>= set_search_history + + let set_last_search dir word = + Zipper.(far_left &> swap_focus (dir, word)) |> on_search_history + let get_terminal_size e = (e.term.size, e) let get_register ?(r = '"') e = @@ -179,8 +201,14 @@ module Action = struct |> Text.extend ~fill r |> Fn.flip Sequence.take (r - ssize) in - let screen = Sequence.append bufview status in - Terminal.redraw screen e.cursor + let screen = Sequence.append bufview status + and cursor = + let open Mode in + match e.mode with + | Control -> (r, Control.cursor e.control) + | _ -> e.cursor + in + Terminal.redraw screen cursor in get >>| aux @@ -189,7 +217,7 @@ module Action = struct (* Statusbar *) let set_message m e = - ((), { e with message = m; message_timestamp = Unix.time () }) + ((), { e with message = Some 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 }) @@ -209,6 +237,15 @@ module Action = struct in get >>| check_message_timestamp >>= put + (* Control line *) + let search dir word = + let* coords = Buffer.Action.(search dir word |> on_focused_buffer) in + match coords with + | None -> + let word = word |> Sequence.to_list |> String.of_list in + set_message (Printf.sprintf "Pattern not found: %s" word) + | Some (r, c) -> Buffer.Action.goto r c |> on_focused_buffer + (* Debug *) let get_rendered e = (e.rendered, e) let set_rendered r e = ((), { e with rendered = r }) @@ -448,7 +485,28 @@ let handle_normal_command c = | Shortcut (_, n, Join) -> let n = Option.(value ~default:2 n) in Buffer.Action.join_lines ~n |> on_focused_buffer - (* Quit *) + (* Control *) + | Simple (Key ':' as k) -> + let c = Control.create k in + set_control_buffer c *> set_mode Control + | Simple (Key '/' as k) -> + let c = Control.create k in + (Zipper.(far_left &> push (true, Sequence.empty)) |> on_search_history) + *> set_control_buffer c *> set_mode Control + | Simple (Key '?' as k) -> + let c = Control.create k in + (Zipper.(far_left &> push (false, Sequence.empty)) |> on_search_history) + *> set_control_buffer c *> set_mode Control + | Shortcut (_, n, Search) -> ( + let* h = get_search_history in + match Zipper.focus h with + | None -> set_message "No search history" + | Some (dir, word) -> search dir word |> repeat ?n) + | Shortcut (_, n, Search_rev) -> ( + let* h = get_search_history in + match Zipper.focus h with + | None -> set_message "No search history" + | Some (dir, word) -> search (not dir) word |> repeat ?n) | Simple (Ctrl 'Q') -> quit 0 (* Misc *) | Simple (Key 'A') -> @@ -467,7 +525,49 @@ let handle_normal_command c = in compute_action *> update_command_cue +let handle_control_command = + let open Command in + let open Action in + function + | Simple Arrow_down -> + let* c = get_control_buffer in + if Control.is_search c then + let* () = Zipper.left |> on_search_history + and* h = get_search_history in + match Zipper.focus h with + | None -> noop + | Some (_, word) -> Control.set_content word |> on_control_buffer + else failwith "Control line command history unimplemented!" + | Simple Arrow_left -> Control.move_left |> on_control_buffer + | Simple Arrow_right -> Control.move_right |> on_control_buffer + | Simple Arrow_up -> + let* c = get_control_buffer in + if Control.is_search c then + let* () = Zipper.right |> on_search_history + and* h = get_search_history in + match Zipper.focus h with + | None -> noop + | Some (_, word) -> Control.set_content word |> on_control_buffer + else failwith "Control line command history unimplemented!" + | Simple Backspace -> Control.delete_before |> on_control_buffer + | Simple Delete -> Control.delete_after |> on_control_buffer + | Simple Enter -> ( + let* () = set_mode Normal and* c = get_control_buffer in + match Control.get_result c with + | Search (dir, word) -> search dir word *> set_last_search dir word + | No_result -> noop) + | Simple Esc -> ( + let* () = set_mode Normal and* c = get_control_buffer in + match Control.get_result c with + | Search _ -> Zipper.(far_left &> pop &> snd) |> on_search_history + | No_result -> noop) + | Simple Home -> Control.bol |> on_control_buffer + | Simple End -> Control.eol |> on_control_buffer + | Type k -> Control.insert k |> on_control_buffer + | _ -> noop + let handle_next_command m e = + let open Mode in match m with | Insert -> ( match Sequence.next e.istream with @@ -477,7 +577,10 @@ let handle_next_command m e = match Sequence.next e.nstream with | None -> ((), e) | Some (h, t) -> handle_normal_command h { e with nstream = t }) - | Control -> failwith "unimplemented" + | Control -> ( + match Sequence.next e.istream with + | None -> ((), e) + | Some (h, t) -> handle_control_command h { e with istream = t }) let handle_next_command = let open Action in diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml index 52b1115..1f363ef 100644 --- a/lib/editorBuffer.ml +++ b/lib/editorBuffer.ml @@ -88,8 +88,10 @@ module Action = struct let ( let+ ) b f = map b ~f let get b = (b, b) let put b _ = ((), b) - let modify ~f = get >>= (put &> f) - let on_content f b = ((), { b with content = Result.map ~f b.content }) + let modify ~f = get >>| f >>= put + let get_content b = (b.content, b) + let set_content c b = ((), { b with content = c }) + let on_content f = get_content >>| Result.map ~f >>= set_content let on_content_with_output ~default f b = match b.content with @@ -143,6 +145,11 @@ module Action = struct in (horizontal left, horizontal right) + let goto r c = + let change_content = Zipper.(goto r &> map_focus (goto c)) |> on_content + and change_rendered = Zipper.goto r |> on_rendered in + change_content *> change_rendered + let bol ?(n = 0) = move_down ~n *> (map_focus far_left |> on_content) let eol ?(n = 0) = move_down ~n *> (map_focus far_right |> on_content) @@ -374,6 +381,55 @@ module Action = struct in bind_n_times ~n (change_content *> change_rendered) + let search forward word = + let rec tails s = + match Sequence.next s with + | None -> Sequence.empty + | Some (_, t) -> Sequence.shift_right (tails t) s + and prefix p l = + match Sequence.(next p, next l) with + | Some (ph, pt), Some (lh, lt) when Char.(ph = lh) -> prefix pt lt + | None, _ -> true + | _ -> false + in + let search_line w l = + Sequence.findi ~f:(fun _ -> prefix w) (tails l) |> Option.map ~f:fst + in + let* b = get in + let cr, cc = cursor ~rendered:false b in + let* c = get_content in + match c with + | Error _ -> return None + | Ok c -> ( + if forward then + match Sequence.next (Zipper.after c) with + | None -> return None + | Some (h, t) -> ( + match Zipper.(h |> right |> after) |> search_line word with + | Some i -> return (Some (cr, cc + i + 1)) + | None -> + let f r z = + z |> to_seq |> search_line word + |> Option.map ~f:(fun c -> (cr + r + 1, c)) + in + return (Sequence.find_mapi t ~f)) + else + let word = Sequence.(word |> to_list_rev |> of_list) in + let wlen = Sequence.length word in + match Zipper.(c |> right |> before) |> Sequence.next with + | None -> return None + | Some (h, t) -> ( + match h |> Zipper.before |> search_line word with + | Some i -> return (Some (cr, cc - wlen - i)) + | None -> + let f r z = + let z = z |> far_right in + let len = left_length z in + z |> before |> search_line word + |> Option.map ~f:(fun c -> (cr - r - 1, len - wlen - c)) + in + return (Sequence.find_mapi t ~f))) + (* let save_history_to ?(clear = true) r = () *) end diff --git a/lib/mode.ml b/lib/mode.ml new file mode 100644 index 0000000..86f76d5 --- /dev/null +++ b/lib/mode.ml @@ -0,0 +1,3 @@ +type t = Normal | Insert | Control + +let to_string = function Insert -> " I " | Normal -> " N " | Control -> " C " diff --git a/lib/modes.ml b/lib/modes.ml deleted file mode 100644 index 3d0e354..0000000 --- a/lib/modes.ml +++ /dev/null @@ -1,18 +0,0 @@ -type mode = Normal | Insert -type t = mode -type state = int -type 'a state_monad = state -> 'a * state - -let run (f : 'a state_monad) (s : state) : 'a = f s |> fst -let return (a : 'a) : 'a state_monad = fun s -> (a, s) - -let ( >>= ) (f : 'a state_monad) (g : 'a -> 'b state_monad) : 'b state_monad = - fun s -> - let a, s' = f s in - g a s' - -let draw () : unit state_monad = return () -let get_keypress () : char state_monad = return 'a' -let handle_key (_ : char) : unit state_monad = return () -let rec loop () = () |> draw >>= get_keypress >>= handle_key >>= loop -let test = run (loop ()) 0 -- cgit v1.2.3