terminal user interface to jujutsu. Focused on speed and clarity
support key remapping and add default vim bindings
+174
-54
+1
-1
jj_tui/bin/file_view.ml
+1
-1
jj_tui/bin/file_view.ml
···
25
25
| None ->
26
26
let key_map = (Lwd.peek ui_state.config).key_map.file in
27
27
let registry = FileCommands.get_command_registry active_files get_command_mapping in
28
-
let mapping = build_command_list key_map registry in
28
+
let mapping = build_command_keymap key_map registry in
29
29
command_mapping := Some mapping;
30
30
mapping
31
31
;;
+1
-1
jj_tui/bin/graph_view.ml
+1
-1
jj_tui/bin/graph_view.ml
···
40
40
| None ->
41
41
let key_map = (Lwd.peek ui_state.config).key_map.graph in
42
42
let registry = GraphCommands.get_command_registry get_command_mapping in
43
-
let mapping = build_command_list key_map registry in
43
+
let mapping = build_command_keymap key_map registry in
44
44
command_mapping := Some mapping;
45
45
mapping
46
46
;;
+3
-2
jj_tui/bin/jj_commands.ml
+3
-2
jj_tui/bin/jj_commands.ml
···
285
285
match key with
286
286
| `ASCII k, modifiers ->
287
287
let key = { key = k; modifiers } in
288
+
(*remember that the key map here has been processed so it directly maps the keys to commands not to command ids*)
288
289
let cmd = keymap |> Key_Map.find_opt key in
289
290
(match cmd with
290
291
| Some cmd ->
···
447
448
command_input ~is_sub:false command_mapping
448
449
;;
449
450
450
-
(* Function to build command list from key_map and a command registry *)
451
-
let build_command_list key_map command_registry =
451
+
(* Function to build key=>command keymap from a key=>command_id map and a command registry *)
452
+
let build_command_keymap key_map command_registry =
452
453
(* Process a key_map item *)
453
454
let rec process_key_map_item key item =
454
455
match item with
+21
-2
jj_tui/bin/jj_ui.ml
+21
-2
jj_tui/bin/jj_ui.ml
···
38
38
W.button (Printf.sprintf "quit ") (fun () -> Vars.quit $= true) |> Lwd.pure
39
39
;;
40
40
41
+
(** Forward an event to a list of handlers until one of them returns `Handled *)
41
42
let rec forward_events handlers event =
42
43
match handlers with
43
44
| h :: rest ->
···
46
47
`Unhandled
47
48
;;
48
49
50
+
(** Handle inputs for the UI.
51
+
@param custom A custom handler that can be used to handle inputs that are not part of the default key bindings.
52
+
@param ui The UI to handle inputs for.
53
+
*)
49
54
let inputs ?(custom = fun _ -> `Unhandled) ui =
50
55
ui
51
56
|>$ Ui.keyboard_area @@ fun event ->
52
57
event
53
58
|> forward_events
54
59
[
55
-
custom
60
+
custom;
61
+
(fun x->
62
+
(*Try to remap the key if needed *)
63
+
match x with
64
+
| `ASCII k, modifiers ->
65
+
let key = Key.{ key = k; modifiers } in
66
+
let key=Key_map.Key_Map.find_opt key (Lwd.peek ui_state.config).key_map.remap in
67
+
( match key with
68
+
| Some remap ->
69
+
(** This needs to be type converted so our limited variants get upcast into a full nottui event*)
70
+
(`Remap (remap.remap, modifiers):> Nottui.Ui.may_handle)
71
+
| None ->
72
+
`Unhandled)
73
+
| _ ->
74
+
`Unhandled)
56
75
; (function
57
76
| `ASCII 'q', _ ->
58
77
Vars.quit $= true;
···
93
112
]
94
113
;;
95
114
96
-
(* shows a pretty box in the middle of the screen with our error in it*)
115
+
(** Shows a pretty box in the middle of the screen with our error in it*)
97
116
let render_startup_error error =
98
117
let message =
99
118
match error with
+1
-1
jj_tui/lib/key.ml
+1
-1
jj_tui/lib/key.ml
···
34
34
in
35
35
process_parts [] parts
36
36
37
-
let key_of_string_exn str= key_of_string str|>Result.get_ok
37
+
let key_of_string_exn str= match key_of_string str with Ok k -> k | Error msg -> failwith ("Invalid key: " ^ msg)
38
38
39
39
let key_to_string { key; modifiers } =
40
40
let modifier_str =
+147
-47
jj_tui/lib/key_map.ml
+147
-47
jj_tui/lib/key_map.ml
···
13
13
;;
14
14
end
15
15
16
+
module Nottui_remap = struct
17
+
(** Currently this only supports arrow remapping, but we could support any other keys/events *)
18
+
19
+
(** Extraction of the nottui arrow keys event type for remapping*)
20
+
type t = [ `Arrow of [ `Down | `Left | `Right | `Up ] ] [@@deriving show]
21
+
22
+
let of_string remap =
23
+
match remap with
24
+
| "up" ->
25
+
Ok (`Arrow `Up)
26
+
| "down" ->
27
+
Ok (`Arrow `Down)
28
+
| "left" ->
29
+
Ok (`Arrow `Left)
30
+
| "right" ->
31
+
Ok (`Arrow `Right)
32
+
| _ ->
33
+
Error (`Msg ("Invalid remap: " ^ remap))
34
+
;;
35
+
36
+
let of_string_exn remap =
37
+
match of_string remap with
38
+
| Ok remap ->
39
+
remap
40
+
| Error (`Msg msg) ->
41
+
failwith ("Invalid remap: " ^ msg)
42
+
;;
43
+
44
+
let to_string = function
45
+
| `Arrow `Up ->
46
+
"up"
47
+
| `Arrow `Down ->
48
+
"down"
49
+
| `Arrow `Left ->
50
+
"left"
51
+
| `Arrow `Right ->
52
+
"right"
53
+
;;
54
+
end
55
+
56
+
(**A functor to make a usable keymap module from a given item type*)
57
+
module MakeKeyMap (Item : sig
58
+
type t [@@deriving show]
59
+
60
+
val of_yaml : string * Yaml.value -> (Key.t * t, [ `Msg of string ]) result
61
+
val to_yaml : (t Key_Map.t -> Yaml.value) -> Key.t * t -> string * Yaml.value
62
+
end) =
63
+
struct
64
+
type t = Item.t Key_Map.t [@@deriving show]
65
+
type t_update_t = t
66
+
67
+
let of_yaml (yaml : Yaml.value) =
68
+
match yaml with
69
+
| `O top_level ->
70
+
List.map Item.of_yaml top_level
71
+
|> Base.Result.all
72
+
|> Result.map (fun x -> Key_Map.of_seq (List.to_seq x))
73
+
| _ ->
74
+
Error (`Msg "Invalid YAML structure")
75
+
;;
76
+
77
+
let of_yaml_exn yaml =
78
+
match of_yaml yaml with
79
+
| Ok key_map ->
80
+
key_map
81
+
| Error (`Msg msg) ->
82
+
failwith ("Invalid YAML structure: " ^ msg)
83
+
;;
84
+
85
+
open Yaml.Util
86
+
87
+
let rec to_yaml (key_map : Item.t Key_Map.t) : Yaml.value =
88
+
obj (key_map |> Key_Map.to_seq |> Seq.map (Item.to_yaml to_yaml) |> List.of_seq)
89
+
;;
90
+
let t_update_t_to_yaml (key_map : t) : Yaml.value =
91
+
to_yaml key_map
92
+
;;
93
+
94
+
let t_update_t_of_yaml (yaml : Yaml.value) = of_yaml yaml
95
+
96
+
(**Merge two key maps, checking for duplicate keys*)
97
+
let t_apply_update override og =
98
+
Key_Map.merge
99
+
(fun k v1 v2 ->
100
+
match v1, v2 with
101
+
| Some og, Some override ->
102
+
Some override
103
+
| Some v, None | None, Some v ->
104
+
Some v
105
+
| None, None ->
106
+
None)
107
+
og
108
+
override
109
+
;;
110
+
end
111
+
16
112
type command = { command : string } [@@deriving show]
113
+
type remap = { remap : Nottui_remap.t } [@@deriving show]
17
114
18
115
type sub_menu = {
19
116
title : string
20
117
; subcommands : key_map
21
118
}
119
+
[@@deriving show]
22
120
23
121
and key_map_item =
24
122
| Sub_menu of sub_menu
25
123
| Command of command
26
124
27
125
and key_map = key_map_item Key_Map.t [@@deriving show]
28
-
and key_map_update_t = key_map
126
+
and remap_key_map = remap Key_Map.t [@@deriving show]
29
127
30
128
let ( let* ) = Base.Result.Let_syntax.( >>= )
31
129
let ( let+ ) = Base.Result.Let_syntax.( >>| )
···
53
151
Error (`Msg "Invalid YAML structure")
54
152
;;
55
153
56
-
let key_map_of_yaml (yaml : Yaml.value) =
57
-
match yaml with
58
-
| `O top_level ->
59
-
List.map key_map_item_of_yaml top_level
60
-
|> Base.Result.all
61
-
|> Result.map (fun x -> Key_Map.of_seq (List.to_seq x))
154
+
let remap_key_map_item_of_yaml (value : string * Yaml.value) =
155
+
match value with
156
+
| key, `O [ ("remap", `String remap) ] ->
157
+
let* key =
158
+
Key.key_of_string key |> Result.map_error (fun msg -> `Msg ("Invalid key: " ^ msg))
159
+
in
160
+
let+ remap = Nottui_remap.of_string remap in
161
+
key, { remap }
62
162
| _ ->
63
163
Error (`Msg "Invalid YAML structure")
64
-
;;
65
-
66
-
let key_map_of_yaml_exn yaml =
67
-
match key_map_of_yaml yaml with
68
-
| Ok key_map ->
69
-
key_map
70
-
| Error (`Msg msg) ->
71
-
failwith ("Invalid YAML structure: " ^ msg)
72
164
;;
73
165
74
166
open Yaml.Util
75
167
76
-
let rec key_map_item_to_yaml = function
168
+
let key_map_item_to_yaml key_map_to_yaml key_map_item =
169
+
match key_map_item with
77
170
| key, Sub_menu { title; subcommands } ->
78
171
let sub_yaml = key_map_to_yaml subcommands in
79
172
let key = Key.key_to_string key in
···
81
174
| key, Command { command } ->
82
175
let key = Key.key_to_string key in
83
176
key, string command
177
+
;;
84
178
85
-
and key_map_to_yaml (key_map : key_map) : Yaml.value =
86
-
obj (key_map |> Key_Map.to_seq |> Seq.map key_map_item_to_yaml |> List.of_seq)
179
+
let remap_key_map_item_to_yaml _key_map_to_yaml key_map_item =
180
+
match key_map_item with
181
+
| key, { remap } ->
182
+
let key = Key.key_to_string key in
183
+
key, obj [ "remap", string (Nottui_remap.to_string remap) ]
87
184
;;
88
185
89
-
let key_map_update_t_to_yaml (key_map : key_map_update_t) : Yaml.value =
90
-
key_map_to_yaml key_map
91
-
;;
186
+
module Main_Key_Map = MakeKeyMap (struct
187
+
type t = key_map_item [@@deriving show]
188
+
189
+
let of_yaml = key_map_item_of_yaml
190
+
let to_yaml = key_map_item_to_yaml
191
+
end)
192
+
193
+
module Remap_Key_Map = MakeKeyMap (struct
194
+
type t = remap [@@deriving show]
195
+
196
+
let of_yaml = remap_key_map_item_of_yaml
197
+
let to_yaml = remap_key_map_item_to_yaml
198
+
end)
199
+
92
200
93
-
let key_map_update_t_of_yaml (yaml : Yaml.value) = key_map_of_yaml yaml
94
201
95
202
(* let rec key_map_merge (key_map1 : key_map) (key_map2 : key_map) : key_map =
96
203
let merged = Key_Map.create (Key_Map.length key_map1 + Key_Map.length key_map2) in
···
114
221
merged
115
222
;; *)
116
223
117
-
(**Merge two key maps, checking for duplicate keys*)
118
-
let key_map_apply_update override og =
119
-
Key_Map.merge
120
-
(fun k v1 v2 ->
121
-
match v1, v2 with
122
-
| Some og, Some override ->
123
-
Some override
124
-
| Some v, None | None, Some v ->
125
-
Some v
126
-
| None, None ->
127
-
None)
128
-
og
129
-
override
130
-
;;
224
+
131
225
132
226
let cmd key id =
133
227
let key = Key.key_of_string_exn key in
···
139
233
key, Sub_menu { title; subcommands = sub |> List.to_seq |> Key_Map.of_seq }
140
234
;;
141
235
236
+
let remap key remap =
237
+
let key = Key.key_of_string_exn key in
238
+
key, { remap = Nottui_remap.of_string_exn remap }
239
+
;;
240
+
142
241
let k_map list = list |> List.to_seq |> Key_Map.of_seq
143
242
144
243
type key_config = {
145
-
global : key_map [@updater]
146
-
; graph : key_map [@updater]
147
-
; file : key_map [@updater]
244
+
global : Main_Key_Map.t [@updater]
245
+
; graph : Main_Key_Map.t [@updater]
246
+
; file : Main_Key_Map.t [@updater]
247
+
; remap : Remap_Key_Map.t [@updater]
148
248
}
149
249
[@@deriving yaml, record_updater ~derive:yaml]
150
250
···
152
252
let default : key_config =
153
253
let open Key in
154
254
{
155
-
global =
156
-
k_map
157
-
[ cmd "y" "confirm"; cmd "n" "decline"; cmd "h" "left_alt"; cmd "l" "right_alt" ]
255
+
remap =
256
+
k_map [ remap "h" "left"; remap "j" "down"; remap "k" "up"; remap "l" "right" ]
257
+
; global = k_map [ cmd "y" "confirm"; cmd "n" "decline" ]
158
258
; graph =
159
259
k_map
160
260
[
···
270
370
271
371
let%expect_test "parse yaml" =
272
372
let yaml = Yaml.of_string_exn sample in
273
-
let key_map = key_map_of_yaml_exn yaml in
274
-
print_endline (Yaml.to_string_exn (key_map_to_yaml key_map));
373
+
let key_map = Main_Key_Map.of_yaml_exn yaml in
374
+
print_endline (Yaml.to_string_exn (Main_Key_Map.to_yaml key_map));
275
375
[%expect
276
376
{|
277
377
c:
···
292
392
293
393
let%expect_test "merge" =
294
394
let yaml = Yaml.of_string_exn sample in
295
-
let key_map = key_map_of_yaml_exn yaml in
395
+
let key_map = Main_Key_Map.of_yaml_exn yaml in
296
396
let overrides =
297
397
k_map [ cmd "c" "override"; sub "s" "Squash" [ cmd "c" "override2" ] ]
298
398
in
299
-
let merged = key_map_apply_update overrides key_map in
300
-
print_endline (Yaml.to_string_exn (key_map_to_yaml merged));
399
+
let merged = Main_Key_Map.t_apply_update overrides key_map in
400
+
print_endline (Yaml.to_string_exn (Main_Key_Map.to_yaml merged));
301
401
[%expect
302
402
{|
303
403
c: override