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 =
|
type storeview =
|
||||||
{ store: Istore.t
|
{ store: Istore.t
|
||||||
; mutable view: string list
|
; mutable view: Istore.key
|
||||||
; mutable selected: int list
|
; mutable selection: Istore.key
|
||||||
(* values of offset to Istore.Tree.list because ugh *)
|
; mutable editmode: bool }
|
||||||
; mutable edit: bool }
|
|
||||||
|
|
||||||
let make_storeview ?(path = []) storepath branch =
|
let make_storeview ?(path = []) storepath branch =
|
||||||
{ store=
|
Lwt_main.run
|
||||||
Lwt_main.run
|
( Istore.Repo.v (Irmin_git.config storepath)
|
||||||
(Istore.of_branch
|
>>= fun repo ->
|
||||||
(Lwt_main.run
|
Istore.of_branch repo branch
|
||||||
(Istore.Repo.v (Irmin_git.config storepath)) )
|
>>= fun store ->
|
||||||
branch )
|
let view = Istore.Key.v path in
|
||||||
; view= path
|
Istore.list store view
|
||||||
; selected= [1]
|
>>= fun viewlist ->
|
||||||
; edit= false }
|
Lwt.return
|
||||||
|
{ store
|
||||||
|
; view
|
||||||
|
; selection= Istore.Key.v [fst (List.hd viewlist)]
|
||||||
|
; editmode= false } )
|
||||||
|
|
||||||
let navigate sv action =
|
let navigate sv action =
|
||||||
let rec nodecount (ipath : int list) tree =
|
let rec findi value = function
|
||||||
match ipath with
|
| [] -> 0
|
||||||
| [] ->
|
| a :: b -> (if a = value then -1 else findi value b) + 1 in
|
||||||
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 () ->
|
fun () ->
|
||||||
Lwt_main.run
|
Lwt_main.run
|
||||||
( Istore.get_tree sv.store sv.view
|
( Istore.get_tree sv.store sv.view
|
||||||
>>= fun top ->
|
>>= fun top ->
|
||||||
nodecount (removelast sv.selected) top
|
match Istore.Key.rdecons sv.selection with
|
||||||
>>= fun seln ->
|
| Some (ppath, step) ->
|
||||||
nodecount sv.selected top
|
Istore.Tree.list top ppath
|
||||||
>>= fun subn ->
|
>>= fun neighbors ->
|
||||||
Lwt.return
|
let steplist = fst (List.split neighbors) in
|
||||||
( ( match action with
|
let stepi = findi step steplist in
|
||||||
| `Next ->
|
Istore.Tree.list (snd (List.nth neighbors stepi)) []
|
||||||
F.epr
|
>>= fun subtreelist ->
|
||||||
"navigate `Next: (last sv.selected)=%d seln=%d@."
|
Lwt.return
|
||||||
(last sv.selected) seln ;
|
( match action with
|
||||||
if last sv.selected < seln - 1 then
|
| `Next ->
|
||||||
sv.selected <-
|
let stepi = findi step steplist in
|
||||||
List.mapi
|
if List.length steplist - 1 > stepi then
|
||||||
(fun i a ->
|
sv.selection <-
|
||||||
if i >= List.length sv.selected - 1 then a + 1
|
Istore.Key.rcons ppath
|
||||||
else a )
|
(List.nth steplist (stepi + 1))
|
||||||
sv.selected
|
| `Prev ->
|
||||||
| `Prev ->
|
if stepi > 0 then
|
||||||
if last sv.selected > 0 then
|
sv.selection <-
|
||||||
sv.selected <-
|
Istore.Key.rcons ppath
|
||||||
List.mapi
|
(List.nth steplist (stepi - 1))
|
||||||
(fun i a ->
|
| `Sub ->
|
||||||
if i >= List.length sv.selected - 1 then a - 1
|
if List.length subtreelist > 0 then
|
||||||
else a )
|
sv.selection <-
|
||||||
sv.selected
|
sv.selection @ [fst (List.hd subtreelist)]
|
||||||
| `Sub -> if subn > 0 then sv.selected <- sv.selected @ [0]
|
| `Sup ->
|
||||||
| `Sup ->
|
if List.length ppath > 0 then sv.selection <- ppath
|
||||||
if List.length sv.selected > 1 then
|
)
|
||||||
sv.selected <- removelast sv.selected ) ;
|
| None -> Lwt.return_unit )
|
||||||
F.epr "Store.editor selected: %d@."
|
|
||||||
(List.nth sv.selected (List.length sv.selected - 1)) )
|
|
||||||
)
|
|
||||||
|
|
||||||
let editor ?(branch = "current") storepath : Panel.t =
|
let editor ?(branch = "current") storepath : Panel.t =
|
||||||
let sv = make_storeview storepath branch in
|
let sv = make_storeview storepath branch in
|
||||||
@ -1036,8 +1029,10 @@ module Store = struct
|
|||||||
let open Input.Bind in
|
let open Input.Bind in
|
||||||
add [([], Char 'n')] [Custom (navigate sv `Next)]
|
add [([], Char 'n')] [Custom (navigate sv `Next)]
|
||||||
@@ add [([], Char 'p')] [Custom (navigate sv `Prev)]
|
@@ 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 '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
|
let bindstate = Input.Bind.init keybinds in
|
||||||
{ act=
|
{ act=
|
||||||
(fun panel events ->
|
(fun panel events ->
|
||||||
@ -1046,40 +1041,54 @@ module Store = struct
|
|||||||
(Event.actions_of_events bindstate events) ;
|
(Event.actions_of_events bindstate events) ;
|
||||||
(Panel.vbox panel.subpanels).act panel events )
|
(Panel.vbox panel.subpanels).act panel events )
|
||||||
; subpanels=
|
; subpanels=
|
||||||
[ Panel.prettyprint (fun pp ->
|
[ Panel.hbox
|
||||||
let indent = ref 0 in
|
[ Panel.prettyprint (fun pp ->
|
||||||
let rec draw_levels tree sel =
|
let indent = ref 0 in
|
||||||
indent := !indent + 1 ;
|
let rec draw_levels (tree : Istore.tree)
|
||||||
List.iteri
|
(sel : Istore.key) =
|
||||||
(fun i (step, node) ->
|
List.iteri
|
||||||
Format.pp_open_vbox pp 0 ;
|
(fun _i (step, node) ->
|
||||||
Format.pp_open_hbox pp () ;
|
Format.pp_open_vbox pp 0 ;
|
||||||
for _ = 0 to !indent do
|
Format.pp_open_hbox pp () ;
|
||||||
Format.pp_print_space pp ()
|
for _ = 0 to !indent do
|
||||||
done ;
|
Format.pp_print_space pp ()
|
||||||
if sel = [i] then
|
done ;
|
||||||
Format.pp_open_stag pp
|
if sel = [step] then
|
||||||
Display.(
|
Format.pp_open_stag pp
|
||||||
Panel.Color_bg
|
Display.(
|
||||||
(Wall.Color.v 0.99 0.99 0.125 0.3)) ;
|
Panel.Color_bg
|
||||||
Format.fprintf pp "%d-%s@." !indent step ;
|
(Wall.Color.v 0.99 0.99 0.125 0.3)) ;
|
||||||
if sel = [i] then Format.pp_close_stag pp () ;
|
Format.fprintf pp "%d-%s@." !indent step ;
|
||||||
Format.pp_close_box pp () ;
|
if sel = [step] then
|
||||||
let subtree =
|
Format.pp_close_stag pp () ;
|
||||||
Lwt_main.run (Istore.Tree.list node []) in
|
Format.pp_close_box pp () ;
|
||||||
let subsel =
|
let subsel =
|
||||||
if List.length sel > 0 && List.hd sel = i then
|
match Istore.Key.decons sel with
|
||||||
List.tl sel
|
| Some (_tstep, subkey) -> subkey
|
||||||
else [] in
|
| None -> [] in
|
||||||
draw_levels subtree subsel ;
|
indent := succ !indent ;
|
||||||
Format.pp_close_box pp () )
|
draw_levels node subsel ;
|
||||||
tree ;
|
indent := pred !indent ;
|
||||||
indent := !indent - 1 in
|
Format.pp_close_box pp () )
|
||||||
let root =
|
(Lwt_main.run (Istore.Tree.list tree [])) in
|
||||||
Lwt_main.run
|
let root =
|
||||||
( Istore.get_tree sv.store sv.view
|
Lwt_main.run (Istore.get_tree sv.store sv.view)
|
||||||
>>= fun n -> Istore.Tree.list n [] ) in
|
in
|
||||||
draw_levels root sv.selected )
|
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 ]
|
; Panel.bindingstate bindstate ]
|
||||||
; tag= "store-editor" }
|
; tag= "store-editor" }
|
||||||
end
|
end
|
||||||
|
|||||||
Reference in New Issue
Block a user