refactored navigation and displays contents
This commit is contained in:
cqc
189
main.ml
189
main.ml
@ -965,69 +965,62 @@ module Store = struct
|
||||
|
||||
type storeview =
|
||||
{ store: Istore.t
|
||||
; mutable view: string list
|
||||
; mutable selected: int list
|
||||
(* values of offset to Istore.Tree.list because ugh *)
|
||||
; mutable edit: bool }
|
||||
; mutable view: Istore.key
|
||||
; mutable selection: Istore.key
|
||||
; mutable editmode: bool }
|
||||
|
||||
let make_storeview ?(path = []) storepath branch =
|
||||
{ store=
|
||||
Lwt_main.run
|
||||
(Istore.of_branch
|
||||
(Lwt_main.run
|
||||
(Istore.Repo.v (Irmin_git.config storepath)) )
|
||||
branch )
|
||||
; view= path
|
||||
; selected= [1]
|
||||
; edit= false }
|
||||
Lwt_main.run
|
||||
( Istore.Repo.v (Irmin_git.config storepath)
|
||||
>>= fun repo ->
|
||||
Istore.of_branch repo branch
|
||||
>>= fun store ->
|
||||
let view = Istore.Key.v path in
|
||||
Istore.list store view
|
||||
>>= fun viewlist ->
|
||||
Lwt.return
|
||||
{ store
|
||||
; view
|
||||
; selection= Istore.Key.v [fst (List.hd viewlist)]
|
||||
; editmode= false } )
|
||||
|
||||
let navigate sv action =
|
||||
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
|
||||
let rec findi value = function
|
||||
| [] -> 0
|
||||
| a :: b -> (if a = value then -1 else findi value b) + 1 in
|
||||
fun () ->
|
||||
Lwt_main.run
|
||||
( Istore.get_tree sv.store sv.view
|
||||
>>= 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)) )
|
||||
)
|
||||
match Istore.Key.rdecons sv.selection with
|
||||
| Some (ppath, step) ->
|
||||
Istore.Tree.list top ppath
|
||||
>>= fun neighbors ->
|
||||
let steplist = fst (List.split neighbors) in
|
||||
let stepi = findi step steplist in
|
||||
Istore.Tree.list (snd (List.nth neighbors stepi)) []
|
||||
>>= fun subtreelist ->
|
||||
Lwt.return
|
||||
( match action with
|
||||
| `Next ->
|
||||
let stepi = findi step steplist in
|
||||
if List.length steplist - 1 > stepi then
|
||||
sv.selection <-
|
||||
Istore.Key.rcons ppath
|
||||
(List.nth steplist (stepi + 1))
|
||||
| `Prev ->
|
||||
if stepi > 0 then
|
||||
sv.selection <-
|
||||
Istore.Key.rcons ppath
|
||||
(List.nth steplist (stepi - 1))
|
||||
| `Sub ->
|
||||
if List.length subtreelist > 0 then
|
||||
sv.selection <-
|
||||
sv.selection @ [fst (List.hd subtreelist)]
|
||||
| `Sup ->
|
||||
if List.length ppath > 0 then sv.selection <- ppath
|
||||
)
|
||||
| None -> Lwt.return_unit )
|
||||
|
||||
let editor ?(branch = "current") storepath : Panel.t =
|
||||
let sv = make_storeview storepath branch in
|
||||
@ -1036,8 +1029,10 @@ module Store = struct
|
||||
let open Input.Bind in
|
||||
add [([], Char 'n')] [Custom (navigate sv `Next)]
|
||||
@@ add [([], Char 'p')] [Custom (navigate sv `Prev)]
|
||||
@@ add [([], Char 'w')] [Custom (navigate sv `Prev)]
|
||||
@@ add [([], Char 's')] [Custom (navigate sv `Next)]
|
||||
@@ add [([], Char 'd')] [Custom (navigate sv `Sub)]
|
||||
@@ add [([], Char 'u')] [Custom (navigate sv `Sup)] empty in
|
||||
@@ add [([], Char 'a')] [Custom (navigate sv `Sup)] empty in
|
||||
let bindstate = Input.Bind.init keybinds in
|
||||
{ act=
|
||||
(fun panel events ->
|
||||
@ -1046,40 +1041,54 @@ module Store = struct
|
||||
(Event.actions_of_events bindstate events) ;
|
||||
(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_levels root sv.selected )
|
||||
[ Panel.hbox
|
||||
[ Panel.prettyprint (fun pp ->
|
||||
let indent = ref 0 in
|
||||
let rec draw_levels (tree : Istore.tree)
|
||||
(sel : Istore.key) =
|
||||
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 = [step] 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 = [step] then
|
||||
Format.pp_close_stag pp () ;
|
||||
Format.pp_close_box pp () ;
|
||||
let subsel =
|
||||
match Istore.Key.decons sel with
|
||||
| Some (_tstep, subkey) -> subkey
|
||||
| None -> [] in
|
||||
indent := succ !indent ;
|
||||
draw_levels node subsel ;
|
||||
indent := pred !indent ;
|
||||
Format.pp_close_box pp () )
|
||||
(Lwt_main.run (Istore.Tree.list tree [])) in
|
||||
let root =
|
||||
Lwt_main.run (Istore.get_tree sv.store sv.view)
|
||||
in
|
||||
draw_levels root sv.selection )
|
||||
; Panel.prettyprint (fun pp ->
|
||||
let contents =
|
||||
Lwt_main.run
|
||||
( Istore.get_tree sv.store sv.view
|
||||
>>= fun t ->
|
||||
Istore.Tree.kind t sv.selection
|
||||
>>= function
|
||||
| Some a -> (
|
||||
match a with
|
||||
| `Contents -> Istore.Tree.get t sv.selection
|
||||
| `Node -> Lwt.return "Node..." )
|
||||
| None -> Lwt.return "Invalid Selection..." )
|
||||
in
|
||||
Format.fprintf pp "%s @." contents ) ]
|
||||
; Panel.bindingstate bindstate ]
|
||||
; tag= "store-editor" }
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user