From 5d96ed12d23a1a1d51d17e7cb0e1b40d4c7f92c4 Mon Sep 17 00:00:00 2001 From: cqc Date: Fri, 3 Sep 2021 09:24:24 -0500 Subject: [PATCH] refactored all keybindings --- main.ml | 148 ++++++++++++++++++++++---------------------------------- 1 file changed, 58 insertions(+), 90 deletions(-) diff --git a/main.ml b/main.ml index 6aea33a..19f7bf3 100644 --- a/main.ml +++ b/main.ml @@ -27,7 +27,7 @@ module Input = struct (** Type of key code. *) type code = - | Char of UChar.t (** A unicode character. *) + | UChar of UChar.t (** A unicode character. *) | Enter | Escape | Tab @@ -57,6 +57,8 @@ module Input = struct | Unknown | None + type key = Char of char | Code of code + module KeymodSet = struct type t = Shift | Ctrl | Meta | Fn @@ -67,10 +69,10 @@ module Input = struct let modset = Keymod.of_list - type key = {mods: Keymod.t; code: code} + type keystate = {mods: Keymod.t; code: code} module Key = struct - type t = key + type t = keystate let compare = compare end @@ -88,14 +90,18 @@ module Input = struct type state = { mutable bindings: t ; mutable state: result - ; mutable last_keyseq: key list + ; mutable last_keyseq: keystate list ; mutable last_actions: action list } let add events action bindings = let events = List.map (fun (m, k) -> - {mods= Keymod.of_list m; code= Char (UChar.of_char k)} ) + { mods= Keymod.of_list m + ; code= + ( match k with + | Char c -> UChar (UChar.of_char c) + | Code c -> c ) } ) events in S.add events action bindings @@ -111,7 +117,7 @@ module Input = struct (* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *) let string_of_code = function - | Char ch -> Printf.sprintf "Char 0x%02x" (UChar.code ch) + | UChar ch -> Printf.sprintf "Char 0x%02x" (UChar.code ch) | Enter -> "Enter" | Escape -> "Escape" | Tab -> "Tab" @@ -157,7 +163,7 @@ module Input = struct if Keymod.mem Shift key.mods then Buffer.add_string buffer "S-" ; if Keymod.mem Fn key.mods then Buffer.add_string buffer "Fn-" ; ( match key.code with - | Char ch -> + | UChar ch -> let code = UChar.code ch in if code <= 255 then match Char.chr code with @@ -191,8 +197,8 @@ module Event = struct type mouse = int * int type t = - [ `Key_down of Input.key - | `Key_up of Input.key + [ `Key_down of Input.keystate + | `Key_up of Input.keystate | `Text_editing of string | `Text_input of string | `Mouse of mouse @@ -270,7 +276,7 @@ module Event = struct |'&' | '$' | '*' | '%' | '!' | '?' | ',' | ';' | ':' |'/' | '\\' | '.' | '@' | '=' | '+' | '-' | ' ' | '"' |'\'' | '>' | '<' | '^' | '`' | '|' -> - Char (UChar.of_int k) + UChar (UChar.of_int k) | _ -> None ) in let mods = List.filter_map @@ -353,7 +359,7 @@ module Event = struct let open Input.Bind in List.iter (function - | `Key_down (k : Input.key) -> + | `Key_down (k : Input.keystate) -> ( match state.state with | Continue _ -> () | _ -> state.last_keyseq <- [] ) ; @@ -789,82 +795,44 @@ module Panel = struct let default_bindings = let open Input.Bind in - let open CamomileLibrary in - let open Zed_edit in - let m = Input.Keymod.of_list in - let b = ref empty in - let add e a = b := Input.Bind.S.add e a !b in - add [{mods= m []; code= Left}] [Zed Prev_char] ; - add [{mods= m []; code= Right}] [Zed Next_char] ; - add [{mods= m []; code= Up}] [Zed Prev_line] ; - add [{mods= m []; code= Down}] [Zed Next_line] ; - add [{mods= m []; code= Home}] [Zed Goto_bol] ; - add [{mods= m []; code= End}] [Zed Goto_eol] ; - add [{mods= m []; code= Insert}] [Zed Switch_erase_mode] ; - add [{mods= m []; code= Delete}] [Zed Delete_next_char] ; - add [{mods= m []; code= Enter}] [Zed Newline] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char ' ')}] - [Zed Set_mark] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'a')}] - [Zed Goto_bol] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'e')}] - [Zed Goto_eol] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'd')}] - [Zed Delete_next_char] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'h')}] - [Zed Delete_prev_char] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'k')}] - [Zed Kill_next_line] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'u')}] - [Zed Kill_prev_line] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'n')}] - [Zed Next_line] ; - add - [{mods= m [Ctrl]; code= Char (UChar.of_char 'p')}] - [Zed Prev_line] ; - add [{mods= m [Ctrl]; code= Char (UChar.of_char 'w')}] [Zed Kill] ; - add [{mods= m [Ctrl]; code= Char (UChar.of_char 'y')}] [Zed Yank] ; - add [{mods= m []; code= Backspace}] [Zed Delete_prev_char] ; - add [{mods= m [Meta]; code= Char (UChar.of_char 'w')}] [Zed Copy] ; - add - [{mods= m [Meta]; code= Char (UChar.of_char 'c')}] - [Zed Capitalize_word] ; - add - [{mods= m [Meta]; code= Char (UChar.of_char 'l')}] - [Zed Lowercase_word] ; - add - [{mods= m [Meta]; code= Char (UChar.of_char 'u')}] - [Zed Uppercase_word] ; - add - [{mods= m [Meta]; code= Char (UChar.of_char 'b')}] - [Zed Prev_word] ; - add - [{mods= m [Meta]; code= Char (UChar.of_char 'f')}] - [Zed Next_word] ; - add [{mods= m [Meta]; code= Right}] [Zed Next_word] ; - add [{mods= m [Meta]; code= Left}] [Zed Prev_word] ; - add [{mods= m [Ctrl]; code= Right}] [Zed Next_word] ; - add [{mods= m [Ctrl]; code= Left}] [Zed Prev_word] ; - add [{mods= m [Meta]; code= Backspace}] [Zed Kill_prev_word] ; - add [{mods= m [Meta]; code= Delete}] [Zed Kill_prev_word] ; - add [{mods= m [Ctrl]; code= Delete}] [Zed Kill_next_word] ; - add - [{mods= m [Meta]; code= Char (UChar.of_char 'd')}] - [Zed Kill_next_word] ; - add [{mods= m [Ctrl]; code= Char (UChar.of_char '/')}] [Zed Undo] ; - add - [ {mods= m [Ctrl]; code= Char (UChar.of_char 'x')} - ; {mods= m []; code= Char (UChar.of_char 'u')} ] - [Zed Undo] ; - !b + add [([], Code Left)] [Zed Prev_char] + @@ add [([], Code Right)] [Zed Next_char] + @@ add [([], Code Up)] [Zed Prev_line] + @@ add [([], Code Down)] [Zed Next_line] + @@ add [([], Code Home)] [Zed Goto_bol] + @@ add [([], Code End)] [Zed Goto_eol] + @@ add [([], Code Insert)] [Zed Switch_erase_mode] + @@ add [([], Code Delete)] [Zed Delete_next_char] + @@ add [([], Code Enter)] [Zed Newline] + @@ add [([Ctrl], Char ' ')] [Zed Set_mark] + @@ add [([Ctrl], Char 'a')] [Zed Goto_bol] + @@ add [([Ctrl], Char 'e')] [Zed Goto_eol] + @@ add [([Ctrl], Char 'd')] [Zed Delete_next_char] + @@ add [([Ctrl], Char 'h')] [Zed Delete_prev_char] + @@ add [([Ctrl], Char 'k')] [Zed Kill_next_line] + @@ add [([Ctrl], Char 'u')] [Zed Kill_prev_line] + @@ add [([Ctrl], Char 'n')] [Zed Next_line] + @@ add [([Ctrl], Char 'p')] [Zed Prev_line] + @@ add [([Ctrl], Char 'w')] [Zed Kill] + @@ add [([Ctrl], Char 'y')] [Zed Yank] + @@ add [([], Code Backspace)] [Zed Delete_prev_char] + @@ add [([Meta], Char 'w')] [Zed Copy] + @@ add [([Meta], Char 'c')] [Zed Capitalize_word] + @@ add [([Meta], Char 'l')] [Zed Lowercase_word] + @@ add [([Meta], Char 'u')] [Zed Uppercase_word] + @@ add [([Meta], Char 'b')] [Zed Prev_word] + @@ add [([Meta], Char 'f')] [Zed Next_word] + @@ add [([Meta], Code Right)] [Zed Next_word] + @@ add [([Meta], Code Left)] [Zed Prev_word] + @@ add [([Ctrl], Code Right)] [Zed Next_word] + @@ add [([Ctrl], Code Left)] [Zed Prev_word] + @@ add [([Meta], Code Backspace)] [Zed Kill_prev_word] + @@ add [([Meta], Code Delete)] [Zed Kill_prev_word] + @@ add [([Ctrl], Code Delete)] [Zed Kill_next_word] + @@ add [([Meta], Char 'd')] [Zed Kill_next_word] + @@ add [([Ctrl], Char '/')] [Zed Undo] + @@ add [([Ctrl], Char 'x'); ([], Char 'u')] [Zed Undo] + @@ empty type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t; keybind: Input.Bind.state} @@ -885,7 +853,7 @@ module Panel = struct (* collect events and update Zed context *) List.iter (function - | `Key_down (k : Input.key) -> ( + | `Key_down (k : Input.keystate) -> ( let open Input.Bind in ( match te.keybind.state with | Accepted _ | Rejected -> @@ -1055,8 +1023,8 @@ module Store = struct let keybinds = let open CamomileLibrary in let open Input.Bind in - add [([], 'n')] [Custom (navigate sv `Next)] - @@ add [([], 'p')] [Custom (navigate sv `Prev)] empty in + add [([], Char 'n')] [Custom (navigate sv `Next)] + @@ add [([], Char 'p')] [Custom (navigate sv `Prev)] empty in let bindstate = Input.Bind.init keybinds in { act= (fun panel events ->