store editor tree navigation works????
This commit is contained in:
cqc
175
main.ml
175
main.ml
@ -346,7 +346,7 @@ module Event = struct
|
||||
| `Window_event -> `Unknown "`Window_event "
|
||||
| `Display_event -> `Unknown "`Display_event "
|
||||
| `Sensor_update -> `Unknown "`Sensor_update " in
|
||||
(* F.epr "event_of_sdlevent: %s@." (to_string r) ;*)
|
||||
(*F.epr "event_of_sdlevent: %s@." (to_string r) ;*)
|
||||
r
|
||||
|
||||
let key_up : Sdl.keycode = 0x40000052
|
||||
@ -357,27 +357,30 @@ module Event = struct
|
||||
|
||||
let actions_of_events (state : Input.Bind.state) (events : events) =
|
||||
let open Input.Bind in
|
||||
List.iter
|
||||
(function
|
||||
| `Key_down (k : Input.keystate) ->
|
||||
( match state.state with
|
||||
| Continue _ -> ()
|
||||
| _ -> state.last_keyseq <- [] ) ;
|
||||
state.state <-
|
||||
resolve k
|
||||
(get_resolver state.state
|
||||
(default_resolver state.bindings) ) ;
|
||||
state.last_keyseq <- k :: state.last_keyseq
|
||||
| _ -> () )
|
||||
events ;
|
||||
match state.state with
|
||||
| Accepted a ->
|
||||
state.last_actions <- a ;
|
||||
a
|
||||
| Rejected ->
|
||||
state.last_actions <- [] ;
|
||||
[]
|
||||
| _ -> []
|
||||
List.flatten
|
||||
(List.filter_map
|
||||
(fun e ->
|
||||
(*F.epr "action_of_events: %s@." (to_string e) ;*)
|
||||
match e with
|
||||
| `Key_down (k : Input.keystate) -> (
|
||||
( match state.state with
|
||||
| Continue _ -> ()
|
||||
| _ -> state.last_keyseq <- [] ) ;
|
||||
state.state <-
|
||||
resolve k
|
||||
(get_resolver state.state
|
||||
(default_resolver state.bindings) ) ;
|
||||
state.last_keyseq <- k :: state.last_keyseq ;
|
||||
match state.state with
|
||||
| Accepted a ->
|
||||
state.last_actions <- a ;
|
||||
Some a
|
||||
| Rejected ->
|
||||
state.last_actions <- [] ;
|
||||
None
|
||||
| _ -> None )
|
||||
| _ -> None )
|
||||
events )
|
||||
end
|
||||
|
||||
module Display = struct
|
||||
@ -793,7 +796,7 @@ module Panel = struct
|
||||
, ( Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box))
|
||||
, !node ) )
|
||||
|
||||
let default_bindings =
|
||||
let textedit_bindings =
|
||||
let open Input.Bind in
|
||||
add [([], Code Left)] [Zed Prev_char]
|
||||
@@ add [([], Code Right)] [Zed Next_char]
|
||||
@ -837,7 +840,7 @@ module Panel = struct
|
||||
type textedit =
|
||||
{ze: unit Zed_edit.t; zc: Zed_cursor.t; keybind: Input.Bind.state}
|
||||
|
||||
let make_textedit ?(keybinds = default_bindings) () =
|
||||
let make_textedit ?(keybinds = textedit_bindings) () =
|
||||
let z = Zed_edit.create () in
|
||||
{ ze= z
|
||||
; zc= Zed_edit.new_cursor z
|
||||
@ -958,6 +961,8 @@ module Text = Wall_text
|
||||
module Store = struct
|
||||
module Istore = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
|
||||
|
||||
(* storeview shows items of the selected level *)
|
||||
|
||||
type storeview =
|
||||
{ store: Istore.t
|
||||
; mutable view: string list
|
||||
@ -973,50 +978,56 @@ module Store = struct
|
||||
(Istore.Repo.v (Irmin_git.config storepath)) )
|
||||
branch )
|
||||
; view= path
|
||||
; selected= [2]
|
||||
; selected= [1]
|
||||
; edit= false }
|
||||
|
||||
let draw_storeview tree selected pp =
|
||||
let indent = ref 0 in
|
||||
let rec draw_levels ttree sel =
|
||||
indent := !indent + 1 ;
|
||||
List.iteri
|
||||
(fun i (step, node) ->
|
||||
Format.pp_open_vbox pp 0 ;
|
||||
Format.pp_open_hbox pp () ;
|
||||
for _ = 0 to !indent do
|
||||
Format.pp_print_space pp ()
|
||||
done ;
|
||||
if sel = [i] then
|
||||
Format.pp_open_stag pp
|
||||
Display.(
|
||||
Panel.Color_bg (Wall.Color.v 0.99 0.99 0.125 0.3)) ;
|
||||
Format.fprintf pp "%d-%s@." !indent step ;
|
||||
if sel = [i] then Format.pp_close_stag pp () ;
|
||||
Format.pp_close_box pp () ;
|
||||
let subtree = Lwt_main.run (Istore.Tree.list node []) in
|
||||
let subsel =
|
||||
if List.length sel > 0 && List.hd sel = i then List.tl sel
|
||||
else [] in
|
||||
draw_levels subtree subsel ;
|
||||
Format.pp_close_box pp () )
|
||||
ttree ;
|
||||
indent := !indent - 1 in
|
||||
draw_levels tree selected
|
||||
|
||||
let navigate sv action =
|
||||
let _root =
|
||||
let rec nodecount (ipath : int list) tree =
|
||||
match ipath with
|
||||
| [] ->
|
||||
Istore.Tree.list tree []
|
||||
>>= fun l -> Lwt.return (List.length l)
|
||||
| a :: b ->
|
||||
Istore.Tree.list tree []
|
||||
>>= fun l -> nodecount b (snd (List.nth l a)) in
|
||||
let removelast l = List.rev (List.tl (List.rev l)) in
|
||||
let last l = List.nth l (List.length l - 1) in
|
||||
fun () ->
|
||||
Lwt_main.run
|
||||
( Istore.get_tree sv.store sv.view
|
||||
>>= fun n -> Istore.Tree.list n [] ) in
|
||||
let rec listlast f = function
|
||||
| [] -> []
|
||||
| [x] -> F.epr "%d@." x ; [f x]
|
||||
| _ :: x -> listlast f x in
|
||||
fun () ->
|
||||
match action with
|
||||
| `Next -> sv.selected <- listlast succ sv.selected
|
||||
| `Prev -> sv.selected <- listlast pred sv.selected
|
||||
>>= fun top ->
|
||||
nodecount (removelast sv.selected) top
|
||||
>>= fun seln ->
|
||||
nodecount sv.selected top
|
||||
>>= fun subn ->
|
||||
Lwt.return
|
||||
( ( match action with
|
||||
| `Next ->
|
||||
F.epr
|
||||
"navigate `Next: (last sv.selected)=%d seln=%d@."
|
||||
(last sv.selected) seln ;
|
||||
if last sv.selected < seln - 1 then
|
||||
sv.selected <-
|
||||
List.mapi
|
||||
(fun i a ->
|
||||
if i >= List.length sv.selected - 1 then a + 1
|
||||
else a )
|
||||
sv.selected
|
||||
| `Prev ->
|
||||
if last sv.selected > 0 then
|
||||
sv.selected <-
|
||||
List.mapi
|
||||
(fun i a ->
|
||||
if i >= List.length sv.selected - 1 then a - 1
|
||||
else a )
|
||||
sv.selected
|
||||
| `Sub -> if subn > 0 then sv.selected <- sv.selected @ [0]
|
||||
| `Sup ->
|
||||
if List.length sv.selected > 1 then
|
||||
sv.selected <- removelast sv.selected ) ;
|
||||
F.epr "Store.editor selected: %d@."
|
||||
(List.nth sv.selected (List.length sv.selected - 1)) )
|
||||
)
|
||||
|
||||
let editor ?(branch = "current") storepath : Panel.t =
|
||||
let sv = make_storeview storepath branch in
|
||||
@ -1024,7 +1035,9 @@ module Store = struct
|
||||
let open CamomileLibrary in
|
||||
let open Input.Bind in
|
||||
add [([], Char 'n')] [Custom (navigate sv `Next)]
|
||||
@@ add [([], Char 'p')] [Custom (navigate sv `Prev)] empty in
|
||||
@@ add [([], Char 'p')] [Custom (navigate sv `Prev)]
|
||||
@@ add [([], Char 'd')] [Custom (navigate sv `Sub)]
|
||||
@@ add [([], Char 'u')] [Custom (navigate sv `Sup)] empty in
|
||||
let bindstate = Input.Bind.init keybinds in
|
||||
{ act=
|
||||
(fun panel events ->
|
||||
@ -1034,11 +1047,39 @@ module Store = struct
|
||||
(Panel.vbox panel.subpanels).act panel events )
|
||||
; subpanels=
|
||||
[ Panel.prettyprint (fun pp ->
|
||||
let indent = ref 0 in
|
||||
let rec draw_levels tree sel =
|
||||
indent := !indent + 1 ;
|
||||
List.iteri
|
||||
(fun i (step, node) ->
|
||||
Format.pp_open_vbox pp 0 ;
|
||||
Format.pp_open_hbox pp () ;
|
||||
for _ = 0 to !indent do
|
||||
Format.pp_print_space pp ()
|
||||
done ;
|
||||
if sel = [i] then
|
||||
Format.pp_open_stag pp
|
||||
Display.(
|
||||
Panel.Color_bg
|
||||
(Wall.Color.v 0.99 0.99 0.125 0.3)) ;
|
||||
Format.fprintf pp "%d-%s@." !indent step ;
|
||||
if sel = [i] then Format.pp_close_stag pp () ;
|
||||
Format.pp_close_box pp () ;
|
||||
let subtree =
|
||||
Lwt_main.run (Istore.Tree.list node []) in
|
||||
let subsel =
|
||||
if List.length sel > 0 && List.hd sel = i then
|
||||
List.tl sel
|
||||
else [] in
|
||||
draw_levels subtree subsel ;
|
||||
Format.pp_close_box pp () )
|
||||
tree ;
|
||||
indent := !indent - 1 in
|
||||
let root =
|
||||
Lwt_main.run
|
||||
( Istore.get_tree sv.store sv.view
|
||||
>>= fun n -> Istore.Tree.list n [] ) in
|
||||
draw_storeview root sv.selected pp )
|
||||
draw_levels root sv.selected )
|
||||
; Panel.bindingstate bindstate ]
|
||||
; tag= "store-editor" }
|
||||
end
|
||||
@ -1144,8 +1185,8 @@ let top_panel (t : top) =
|
||||
F.epr "Exception in pane_top//eval@." in
|
||||
t.te.keybind.bindings <-
|
||||
Input.(
|
||||
Bind.S.add
|
||||
[{mods= Keymod.of_list [Ctrl]; code= Enter}]
|
||||
Bind.add
|
||||
[([Ctrl], Code Enter)]
|
||||
Bind.[Custom eval]
|
||||
t.te.keybind.bindings) ;
|
||||
Panel.(
|
||||
|
||||
Reference in New Issue
Block a user