removing entries and creating subtrees kinda works
This commit is contained in:
cqc
178
main.ml
178
main.ml
@ -1012,8 +1012,9 @@ module Panel = struct
|
||||
add [([], Code Enter)]
|
||||
[ Custom
|
||||
(fun () ->
|
||||
me.handle (Textedit.contents me.te) ;
|
||||
me.input <- None ) ]
|
||||
(* set input first so a modal can trigger another modal *)
|
||||
me.input <- None ;
|
||||
me.handle (Textedit.contents me.te) ) ]
|
||||
Textedit.bindings in
|
||||
me.te.keybind.bindings <- keybinds ;
|
||||
{ act=
|
||||
@ -1167,61 +1168,14 @@ module Store = struct
|
||||
|
||||
let editor ?(branch = "current") storepath : Panel.t =
|
||||
let sv = make_storeview storepath branch in
|
||||
let te = Panel.Textedit.make "" () in
|
||||
let top = Toplevel.init () in
|
||||
let modalstate = Panel.Modal.make () in
|
||||
directives top sv ;
|
||||
let te = Panel.Textedit.make "" () in
|
||||
let save store path content =
|
||||
Lwt_main.run
|
||||
(Istore.set_exn store
|
||||
~info:(Irmin_unix.info "editor-save")
|
||||
path content ) in
|
||||
let navbinds =
|
||||
let open Input.Bind in
|
||||
let new_contents name content =
|
||||
Lwt_main.run
|
||||
(let s =
|
||||
match Istore.Key.rdecons sv.selection with
|
||||
| Some (t, _) -> t
|
||||
| None -> Istore.Key.empty in
|
||||
Istore.get_tree sv.store (sv.view @ s)
|
||||
>>= fun tree ->
|
||||
Istore.Tree.add tree name content
|
||||
>>= fun newtree ->
|
||||
Istore.set_tree_exn
|
||||
~info:(Irmin_unix.info "new Contents")
|
||||
sv.store sv.view newtree ) 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 'a')] [Custom (navigate sv `Sup)]
|
||||
@@ add [([], Char 'e')]
|
||||
[Custom (fun () -> sv.editmode <- not sv.editmode)]
|
||||
@@ add
|
||||
[([], Char 'f')] (* find: enter path in modal *)
|
||||
[Custom (fun () -> ())]
|
||||
@@ add
|
||||
[([], Char 'c')] (* contents: create new contents node *)
|
||||
[ Custom
|
||||
(fun () ->
|
||||
Panel.Modal.start ~prompt:"Contents name > "
|
||||
modalstate "" (fun name ->
|
||||
new_contents (Istore.Key.v [name]) "" ) ) ]
|
||||
@@ add [([], Char 't')]
|
||||
[ Custom
|
||||
(fun () ->
|
||||
Panel.Modal.start ~prompt:"Node name := " modalstate
|
||||
"" (fun nodename ->
|
||||
Panel.Modal.start
|
||||
~prompt:"Initial Contents name > " modalstate
|
||||
"" (fun contentsname ->
|
||||
new_contents
|
||||
(Istore.Key.v [nodename; contentsname])
|
||||
"" ) ) ) ]
|
||||
(* tree: create new subtree *)
|
||||
empty in
|
||||
let editbinds =
|
||||
let open Input.Bind in
|
||||
add
|
||||
@ -1245,28 +1199,111 @@ module Store = struct
|
||||
(fun () ->
|
||||
Toplevel.eval top (Panel.Textedit.contents te) ) ]
|
||||
Panel.Textedit.bindings in
|
||||
let bindstate = Input.Bind.init navbinds in
|
||||
{ act=
|
||||
(fun panel events ->
|
||||
if sv.editmode then bindstate.bindings <- editbinds
|
||||
else bindstate.bindings <- navbinds ;
|
||||
List.iter
|
||||
Input.Bind.(function Custom f -> f () | _ -> ())
|
||||
(Event.actions_of_events bindstate events) ;
|
||||
if not sv.editmode then (
|
||||
let contents =
|
||||
te.keybind.bindings <- editbinds ;
|
||||
let is_node path =
|
||||
Lwt_main.run
|
||||
( Istore.get_tree sv.store sv.view
|
||||
>>= fun t ->
|
||||
Istore.Tree.kind t path
|
||||
>>= function
|
||||
| Some `Node -> Lwt.return_true | _ -> Lwt.return_false )
|
||||
in
|
||||
let update_textedit () =
|
||||
Panel.Textedit.clear te ;
|
||||
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
|
||||
Panel.Textedit.clear te ;
|
||||
Panel.Textedit.insert te contents ) ;
|
||||
| Some `Contents ->
|
||||
Istore.Tree.get t sv.selection
|
||||
>>= fun content ->
|
||||
Panel.Textedit.insert te content ;
|
||||
Lwt.return_unit
|
||||
| Some `Node ->
|
||||
Panel.Textedit.insert te "Node..." ;
|
||||
Lwt.return_unit
|
||||
| None -> Lwt.return_unit ) in
|
||||
let navbinds =
|
||||
let open Input.Bind in
|
||||
let new_contents name content =
|
||||
Lwt_main.run
|
||||
(let s =
|
||||
match Istore.Key.rdecons sv.selection with
|
||||
| Some (t, _) -> t
|
||||
| None -> Istore.Key.empty in
|
||||
Istore.get_tree sv.store (sv.view @ s)
|
||||
>>= fun tree ->
|
||||
Istore.Tree.add tree name content
|
||||
>>= fun newtree ->
|
||||
Istore.set_tree_exn
|
||||
~info:(Irmin_unix.info "new Contents")
|
||||
sv.store sv.view newtree ) 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 'a')] [Custom (navigate sv `Sup)]
|
||||
@@ add [([], Char 'e')]
|
||||
[ Custom
|
||||
(fun () ->
|
||||
if not (is_node sv.selection) then
|
||||
sv.editmode <- not sv.editmode ) ]
|
||||
@@ add
|
||||
[([], Char 'f')] (* find: enter path in modal *)
|
||||
[Custom (fun () -> ())]
|
||||
@@ add
|
||||
[([], Char 'c')] (* contents: create new contents node *)
|
||||
[ Custom
|
||||
(fun () ->
|
||||
Panel.Modal.start ~prompt:"Contents name > "
|
||||
modalstate "" (fun name ->
|
||||
new_contents (Istore.Key.v [name]) "" ) ) ]
|
||||
@@ add
|
||||
[([], Char 't')] (* tree: create new subtree *)
|
||||
[ Custom
|
||||
(fun () ->
|
||||
Panel.Modal.start ~prompt:"Node name > " modalstate
|
||||
"" (fun nodename ->
|
||||
Panel.Modal.start
|
||||
~prompt:"Initial Contents name > " modalstate
|
||||
"" (fun contentsname ->
|
||||
new_contents
|
||||
(Istore.Key.v [nodename; contentsname])
|
||||
"" ) ) ) ]
|
||||
@@ add
|
||||
[([], Char 'r')] (* remove contents/node *)
|
||||
[ Custom
|
||||
(fun () ->
|
||||
let selection = sv.selection in
|
||||
navigate sv `Next () ;
|
||||
Lwt_main.run
|
||||
( Istore.get_tree sv.store sv.view
|
||||
>>= fun tree ->
|
||||
Istore.Tree.remove tree selection
|
||||
>>= fun newtree ->
|
||||
Istore.set_tree_exn
|
||||
~info:(Irmin_unix.info "remove Contents/Node")
|
||||
sv.store sv.view newtree ) ) ]
|
||||
@@ add
|
||||
[([], Char 'x')] (* execute contents/node *)
|
||||
[ Custom
|
||||
(fun () ->
|
||||
Panel.Modal.start ~prompt:"!!Not implemented!!"
|
||||
modalstate "" (fun _ -> ()) ) ]
|
||||
empty in
|
||||
let bindstate = Input.Bind.init navbinds in
|
||||
{ act=
|
||||
(fun panel events ->
|
||||
if
|
||||
(not sv.editmode)
|
||||
&& not (Panel.Modal.is_active modalstate)
|
||||
then (
|
||||
List.iter
|
||||
Input.Bind.(function Custom f -> f () | _ -> ())
|
||||
(Event.actions_of_events bindstate events) ;
|
||||
update_textedit () ) ;
|
||||
(Panel.vbox panel.subpanels).act panel events )
|
||||
; subpanels=
|
||||
[ Panel.filter_events
|
||||
@ -1279,7 +1316,7 @@ module Store = struct
|
||||
(tree : Istore.tree) (sel : Istore.key) =
|
||||
List.iteri
|
||||
(fun _i (step, node) ->
|
||||
Format.pp_open_hovbox pp indent ;
|
||||
Format.pp_open_box pp indent ;
|
||||
if sel = [step] then (
|
||||
Format.pp_open_stag pp
|
||||
Display.(
|
||||
@ -1308,7 +1345,8 @@ module Store = struct
|
||||
Lwt_main.run (Istore.get_tree sv.store sv.view)
|
||||
in
|
||||
draw_levels root sv.selection )
|
||||
; Panel.filter_events
|
||||
; Panel.vbox
|
||||
[ Panel.filter_events
|
||||
(fun ev -> if sv.editmode then ev else [])
|
||||
(Panel.Textedit.panel te)
|
||||
; Panel.prettyprint (fun pp ->
|
||||
@ -1317,7 +1355,7 @@ module Store = struct
|
||||
(Format.get_symbolic_output_buffer
|
||||
(Toplevel.result_sob top) ) ;
|
||||
Format.pp_close_box pp () ;
|
||||
F.flush pp () ) ]
|
||||
F.flush pp () ) ] ]
|
||||
; Panel.Textedit.bindingstate bindstate
|
||||
; Panel.prettyprint (fun pp ->
|
||||
Format.fprintf pp "sv.editmode = %b @." sv.editmode ) ]
|
||||
|
||||
Reference in New Issue
Block a user