console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

i left it like this for a long time whoops

Browse Source
This commit is contained in:
cqc
2022-01-04 04:17:26 -06:00
parent 8ee3789cb9
commit 481870e067
1 changed files with 272 additions and 171 deletions
Download Patch File Download Diff File Expand all files Collapse all files

443
human.ml
View File

@ -42,9 +42,6 @@ module Key = struct
type keystate = type keystate =
{ctrl: bool; meta: bool; shift: bool; super: bool; code: code} {ctrl: bool; meta: bool; shift: bool; super: bool; code: code}
type mods = Ctrl | Meta | Super | Shift
type key = Char of char | Code of code
module KeyS = struct module KeyS = struct
type t = keystate type t = keystate
@ -55,20 +52,18 @@ module Key = struct
(* parts stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *) (* parts stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *)
module S = Zed_input.Make (KeyS) module S = Zed_input.Make (KeyS)
type action = type 'a t = 'a list S.t
| Custom of (unit -> unit) type 'a resolver = 'a list S.resolver
| CustomLwt of (unit -> unit Lwt.t) type 'a result = 'a list S.result
| Zed of Zed_edit.action
type t = action list S.t type 'a state =
type resolver = action list S.resolver { mutable bindings: 'a t
type result = action list S.result ; mutable state: 'a result
type state =
{ mutable bindings: t
; mutable state: result
; mutable last_keyseq: keystate list ; mutable last_keyseq: keystate list
; mutable last_actions: action list } ; mutable last_actions: 'a list }
type mods = Ctrl | Meta | Super | Shift
type key = C of char | U of code
let keystate_of_mods ks m = let keystate_of_mods ks m =
List.fold_left List.fold_left
@ -91,8 +86,8 @@ module Key = struct
; shift= false ; shift= false
; code= ; code=
( match k with ( match k with
| Char c -> `Uchar (Uchar.of_char c) | C c -> `Uchar (Uchar.of_char c)
| Code c -> c ) } | U c -> c ) }
m ) m )
events in events in
S.add events action bindings S.add events action bindings
@ -108,7 +103,37 @@ module Key = struct
let resolve = S.resolve let resolve = S.resolve
let empty = S.empty let empty = S.empty
let actions_of_events (state : state) events = type action =
| Custom of (unit -> unit)
| CustomLwt of (unit -> unit Lwt.t)
| Zed of Zed_edit.action
let resolve_events (state : 'a state) events =
List.flatten
(List.filter_map
(fun e ->
match e with
| `Key (`Press, (k : 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 )
let actions_of_events (state : action state) events =
List.flatten List.flatten
(List.filter_map (List.filter_map
(fun e -> (fun e ->
@ -224,7 +249,7 @@ module Event = struct
| `Release -> "`Release " | `Release -> "`Release "
| `Repeat -> "`Repeat " ) | `Repeat -> "`Repeat " )
^ Key.to_string k ^ Key.to_string k
| `Mouse -> "`Mouse" | `Mouse m -> F.str "`Mouse %a" V2.pp m
| `Quit -> "`Quit" | `Quit -> "`Quit"
| `Fullscreen b -> F.str "`Fullscreen %b" b | `Fullscreen b -> F.str "`Fullscreen %b" b
| `Unknown s -> F.str "`Unknown %s" s | `Unknown s -> F.str "`Unknown %s" s
@ -338,8 +363,7 @@ module Event = struct
| `Mouse_wheel -> Some (`Unknown "`Mouse_wheel ") | `Mouse_wheel -> Some (`Unknown "`Mouse_wheel ")
| `Multi_gesture -> Some (`Unknown "`Multi_gesture") | `Multi_gesture -> Some (`Unknown "`Multi_gesture")
| `Sys_wm_event -> Some (`Unknown "`Sys_wm_event ") | `Sys_wm_event -> Some (`Unknown "`Sys_wm_event ")
| `Unknown e -> | `Unknown e -> Some (`Unknown (Format.sprintf "`Unknown %d" e))
Some (`Unknown (Format.sprintf "Some (`Unknown %d " e))
| `User_event -> Some (`Unknown "`User_event ") | `User_event -> Some (`Unknown "`User_event ")
| `Display_event -> Some (`Unknown "`Display_event ") | `Display_event -> Some (`Unknown "`Display_event ")
| `Sensor_update -> Some (`Unknown "`Sensor_update ") | `Sensor_update -> Some (`Unknown "`Sensor_update ")
@ -855,49 +879,49 @@ module Panel = struct
type t = type t =
{ mutable zed: unit Zed_edit.context { mutable zed: unit Zed_edit.context
; mutable view: Zed_cursor.t ; mutable view: Zed_cursor.t
; mutable keybind: Key.Bind.state } ; mutable keybind: Key.Bind.action Key.Bind.state }
let bindings te = let bindings te =
let open Key.Bind in let open Key.Bind in
add [([], Code (`Arrow `Left))] [Zed Prev_char] add [([], U (`Arrow `Left))] [Zed Prev_char]
@@ add [([], Code (`Arrow `Right))] [Zed Next_char] @@ add [([], U (`Arrow `Right))] [Zed Next_char]
@@ add [([], Code (`Arrow `Up))] [Zed Prev_line] @@ add [([], U (`Arrow `Up))] [Zed Prev_line]
@@ add [([], Code (`Arrow `Down))] [Zed Next_line] @@ add [([], U (`Arrow `Down))] [Zed Next_line]
@@ add [([], Code `Home)] [Zed Goto_bol] @@ add [([], U `Home)] [Zed Goto_bol]
@@ add [([], Code `End)] [Zed Goto_eol] @@ add [([], U `End)] [Zed Goto_eol]
@@ add [([], Code `Insert)] [Zed Switch_erase_mode] @@ add [([], U `Insert)] [Zed Switch_erase_mode]
@@ add [([], Code `Delete)] [Zed Delete_next_char] @@ add [([], U `Delete)] [Zed Delete_next_char]
@@ add [([], Code `Enter)] [Zed Newline] @@ add [([], U `Enter)] [Zed Newline]
@@ add [([Ctrl], Char ' ')] [Zed Set_mark] @@ add [([Ctrl], C ' ')] [Zed Set_mark]
@@ add [([Ctrl], Char 'a')] [Zed Goto_bol] @@ add [([Ctrl], C 'a')] [Zed Goto_bol]
@@ add [([Ctrl], Char 'e')] [Zed Goto_eol] @@ add [([Ctrl], C 'e')] [Zed Goto_eol]
@@ add [([Ctrl], Char 'd')] [Zed Delete_next_char] @@ add [([Ctrl], C 'd')] [Zed Delete_next_char]
@@ add [([Ctrl], Char 'h')] [Zed Delete_prev_char] @@ add [([Ctrl], C 'h')] [Zed Delete_prev_char]
@@ add [([Ctrl], Char 'k')] [Zed Kill_next_line] @@ add [([Ctrl], C 'k')] [Zed Kill_next_line]
@@ add [([Ctrl], Char 'u')] [Zed Kill_prev_line] @@ add [([Ctrl], C 'u')] [Zed Kill_prev_line]
@@ add [([Ctrl], Char 'n')] [Zed Next_line] @@ add [([Ctrl], C 'n')] [Zed Next_line]
@@ add [([Ctrl], Char 'p')] [Zed Prev_line] @@ add [([Ctrl], C 'p')] [Zed Prev_line]
@@ add [([Ctrl], Char 'w')] [Zed Kill] @@ add [([Ctrl], C 'w')] [Zed Kill]
@@ add [([Ctrl], Char 'y')] [Zed Yank] @@ add [([Ctrl], C 'y')] [Zed Yank]
@@ add [([], Code `Backspace)] [Zed Delete_prev_char] @@ add [([], U `Backspace)] [Zed Delete_prev_char]
@@ add [([Meta], Char 'w')] [Zed Copy] @@ add [([Meta], C 'w')] [Zed Copy]
@@ add [([Meta], Char 'c')] [Zed Capitalize_word] @@ add [([Meta], C 'c')] [Zed Capitalize_word]
@@ add [([Meta], Char 'l')] [Zed Lowercase_word] @@ add [([Meta], C 'l')] [Zed Lowercase_word]
@@ add [([Meta], Char 'u')] [Zed Uppercase_word] @@ add [([Meta], C 'u')] [Zed Uppercase_word]
@@ add [([Meta], Char 'b')] [Zed Prev_word] @@ add [([Meta], C 'b')] [Zed Prev_word]
@@ add [([Meta], Char 'f')] [Zed Next_word] @@ add [([Meta], C 'f')] [Zed Next_word]
@@ add [([Meta], Code (`Arrow `Right))] [Zed Next_word] @@ add [([Meta], U (`Arrow `Right))] [Zed Next_word]
@@ add [([Meta], Code (`Arrow `Left))] [Zed Prev_word] @@ add [([Meta], U (`Arrow `Left))] [Zed Prev_word]
@@ add [([Ctrl], Code (`Arrow `Right))] [Zed Next_word] @@ add [([Ctrl], U (`Arrow `Right))] [Zed Next_word]
@@ add [([Ctrl], Code (`Arrow `Left))] [Zed Prev_word] @@ add [([Ctrl], U (`Arrow `Left))] [Zed Prev_word]
@@ add [([Meta], Code `Backspace)] [Zed Kill_prev_word] @@ add [([Meta], U `Backspace)] [Zed Kill_prev_word]
@@ add [([Meta], Code `Delete)] [Zed Kill_prev_word] @@ add [([Meta], U `Delete)] [Zed Kill_prev_word]
@@ add [([Ctrl], Code `Delete)] [Zed Kill_next_word] @@ add [([Ctrl], U `Delete)] [Zed Kill_next_word]
@@ add [([Meta], Char 'd')] [Zed Kill_next_word] @@ add [([Meta], C 'd')] [Zed Kill_next_word]
@@ add [([Ctrl], Char '/')] [Zed Undo] @@ add [([Ctrl], C '/')] [Zed Undo]
@@ add [([Ctrl], Char 'x'); ([], Char 'u')] [Zed Undo] @@ add [([Ctrl], C 'x'); ([], C 'u')] [Zed Undo]
@@ add @@ add
[([Ctrl], Char 'v')] [([Ctrl], C 'v')]
[ Custom [ Custom
(fun () -> (fun () ->
let r = Zed_edit.text (Zed_edit.edit te.zed) in let r = Zed_edit.text (Zed_edit.edit te.zed) in
@ -906,7 +930,7 @@ module Panel = struct
Zed_cursor.goto te.view Zed_cursor.goto te.view
(Zed_lines.line_start l i + 10) ) ] (Zed_lines.line_start l i + 10) ) ]
@@ add @@ add
[([Meta], Char 'v')] [([Meta], C 'v')]
[ Custom [ Custom
(fun () -> (fun () ->
let r = Zed_edit.text (Zed_edit.edit te.zed) in let r = Zed_edit.text (Zed_edit.edit te.zed) in
@ -1012,7 +1036,8 @@ module Panel = struct
; tag= "textedit" } ; tag= "textedit" }
(* pane that displays last key binding match state *) (* pane that displays last key binding match state *)
let bindingstate ?(height = !g_text_height) (b : Key.Bind.state) = let bindingstate ?(height = !g_text_height)
(b : Key.Bind.action Key.Bind.state) =
Lwt.return Lwt.return
{ act= { act=
(fun _panel _events -> (fun _panel _events ->
@ -1065,7 +1090,7 @@ module Panel = struct
let keybinds = let keybinds =
let open Key.Bind in let open Key.Bind in
add add
[([], Code `Enter)] [([], U `Enter)]
[ Custom [ Custom
(fun () -> (fun () ->
(* set input first so a modal can trigger another modal *) (* set input first so a modal can trigger another modal *)
@ -1325,13 +1350,19 @@ module Panel = struct
| Some x -> fold_lwt_opt ~t ~start:c ~f x | Some x -> fold_lwt_opt ~t ~start:c ~f x
| None -> Lwt.return acc ) | None -> Lwt.return acc )
| None -> Lwt.return acc | None -> Lwt.return acc
end end
module Ui = struct module Ui = struct
open Gg open Gg
open Wall open Wall
type t = [`Atom of atom | `Attr of attr | `Region of region] type t = [`Atom of atom | `Attr of (attr * node) | `Region of (dir * region)]
and node = {mutable parent: parent; mutable child: t}
and parent = [ `Atom of atom | `Attr of (attr * node) | `Region of (dir * region * Region.cursor)]
and atom = and atom =
[ `Image of image [ `Image of image
@ -1342,38 +1373,31 @@ module Panel = struct
[ `Style of style [ `Style of style
| `Pad of Pad.t | `Pad of Pad.t
| `Shift of dim | `Shift of dim
| `Focus of focus * Focus.handle | `Focus of handle * Focus.handle
| `Handle of handle ] | `Handle of handle ]
* node
and region = [`X | `Y | `Z] * node Region.t and region = node Region.t
and node = {mutable parent: node; mutable child: t}
and dir = [`X | `Y | `Z]
and image = Wall.image * Size2.t and image = Wall.image * Size2.t
and dim = Gg.size2 and dim = Gg.size2
and text = string
and style = Style.t and style = Style.t
and status = [`Handled | `Event of Event.t] and handle = node -> Event.t -> Event.t option Lwt.t
and event_status =
[ `Handled
| (*`Focus of [`Next | `Prev | `Up | `Down] | *)
`Event of
Event.t ]
and focus = node -> Event.t -> status Lwt.t
and handle = node -> Event.t -> status Lwt.t
let empty_image = (Image.empty, V2.zero) let empty_image = (Image.empty, V2.zero)
let empty_node = let empty_node =
let rec parent = {parent; child= `Atom (`Image empty_image)} in let rec parent = `Atom (`Image empty_image) in
parent
let empty_region dir =
let rec parent =
`Region (dir, Region.create ()) in
parent parent
let set_parent_on_children parent = let set_parent_on_children parent =
@ -1397,7 +1421,7 @@ module Panel = struct
let style (s : Style.t) (n : node) = node (`Attr (`Style s, n)) let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
let focus ((f, h) : focus * Focus.handle) (n : node) = let focus ((f, h) : handle * Focus.handle) (n : node) =
node (`Attr (`Focus (f, h), n)) node (`Attr (`Focus (f, h), n))
let node_func ?(fnode = fun (x : node) -> x) let node_func ?(fnode = fun (x : node) -> x)
@ -1439,6 +1463,36 @@ module Panel = struct
() ) () )
parent parent
let rec search_backward (node : node) (t : [`Atom of atom | `Attr of attr | `Region of dir] ) =
match node.parent.child with
| `Atom a when t <> `Atom a -> search_backward node.parent t
| `Attr (a, n) when t <> `Attr a -> search_backward node.parent t
| `Region (d, r) when t <> `Region d ->
| `Region -> x where x = t -> x
let join_ d (a : node) (b : node) =
let rec parent =
{ parent
; child=
`Region
(d, Region.append (Region.append (Region.create ()) a) b)
} in
set_parent_on_children parent ;
parent
let join_x = join_ `X
let join_y = join_ `Y
let join_z = join_ `Z
let pack_x : node Lwd_utils.monoid = (empty_region `X, join_x)
let pack_y : node Lwd_utils.monoid = (empty_region `Y, join_y)
let pack_z : node Lwd_utils.monoid = (empty_region `Z, join_z)
let ( ^^ ) = join_x
let ( ^/^ ) = join_y
module Text = struct module Text = struct
(* let to_buffer t = (* let to_buffer t =
let b = Buffer.create 0 in let b = Buffer.create 0 in
@ -1543,26 +1597,6 @@ module Panel = struct
let text = Text.text let text = Text.text
let join_ d (a : node) (b : node) =
let rec parent =
{ parent
; child=
`Region
(d, Region.append (Region.append (Region.create ()) a) b)
} in
a.parent <- parent ;
b.parent <- parent ;
parent
let join_x = join_ `X
let join_y = join_ `Y
let join_z = join_ `Z
let pack_x : node Lwd_utils.monoid = (empty_node, join_x)
let pack_y : node Lwd_utils.monoid = (empty_node, join_y)
let pack_z : node Lwd_utils.monoid = (empty_node, join_z)
let ( ^^ ) = join_x
let ( ^/^ ) = join_y
module Draw = struct module Draw = struct
type d = [`X | `Y | `Z] type d = [`X | `Y | `Z]
@ -1647,76 +1681,143 @@ module Panel = struct
| `Region a -> region ~style a | `Region a -> region ~style a
end end
module Action = struct
type segment_type =
[`Char | `Word | `Phrase | `Line | `Page | `Region]
type segment =
[ `Beginning of segment_type
| `Back of segment_type
| `Forward of segment_type
| `End of segment_type ]
type t =
[ `Move of segment
| `Yank of segment
| `Kill of segment
| `Custom of string * (node -> t Key.Bind.t -> unit Lwt.t) ]
type dir =
[ `Next
| `Prev
| `Up
| `Down
| `Left
| `Right
| `Fwd
| `Enter
| `In
| `Out ]
let handle (action : t) (node : node) : node option =
match action with
| `Move (`Beginning `Char) -> Some node
| `Move (`Beginning `Word) ->
Some (search_backward node (`Boundary `Word))
| `Move _ -> None
| `Yank _s -> None
| `Kill _s -> None
| `Custom _s -> None
end
type event_status =
[ `Handled
| (*`Focus of [`Next | `Prev | `Up | `Down] | *)
`Event of
Event.t ]
let rec handle_event (node : node) (ev : Event.t) : let rec handle_event (node : node) (ev : Event.t) :
event_status Lwt.t = event_status Lwt.t =
Lwt.return `Handled match node.child with
| `Atom _ -> Lwt.return (`Event ev)
| `Attr (`Focus (f, _), n) -> (
f n ev
>>= function
| None -> Lwt.return `Handled | Some e -> handle_event n e )
| `Attr (`Handle f, n) -> (
f n ev
>>= function
| None -> Lwt.return `Handled | Some e -> handle_event n e )
| `Attr (_, n) -> handle_event n ev
| `Region (_, r) ->
Region.fold_lwt_opt ~t:r
~f:(fun _ n (es : event_status) ->
match es with
| `Event e -> (
handle_event n e
>>= function
| `Handled -> Lwt.return None
| x -> Lwt.return (Some x) )
| `Handled -> Lwt.return None )
(`Event ev)
(* let textedit_bindings =
match node.child with let open Key.Bind in
| `Atom _ -> Lwt.return (`Event ev) empty
| `Attr (`Focus (f, _), n) -> ( |> add [([Ctrl], C 'f')] [`Move (`Forward `Char)]
f n ev |> add [([Ctrl], C 'b')] [`Move (`Back `Char)]
>>= function |> add [([Ctrl], C 'f')] [`Move (`Forward `Word)]
| `Unhandled -> handle_event n ev |> add [([Meta], C 'b')] [`Move (`Back `Word)]
| `Handled -> Lwt.return `Handled ) |> add
| `Attr (`Handle f, n) -> ( [([Ctrl], C 'c'); ([Ctrl], C 'n')]
f n ev [`Move (`Forward `Phrase)]
>>= function |> add [([Ctrl], C 'c'); ([Ctrl], C 'p')] [`Move (`Back `Phrase)]
| `Handled -> Lwt.return `Handled |> add [([Ctrl], C 'n')] [`Move (`Forward `Line)]
| `Event e -> handle_event n e ) |> add [([Ctrl], C 'p')] [`Move (`Back `Line)]
| `Attr (_, n) -> handle_event n ev |> add [([Meta], C 'v')] [`Move (`Forward `Page)]
| `Region (_, r) -> |> add [([Ctrl], C 'v')] [`Move (`Back `Page)]
Region.fold_lwt_opt ~t:r |> add [([Ctrl], C 'a')] [`Move (`Beginning `Line)]
~f:(fun _ n (es : event_status) -> |> add [([Ctrl], C 'e')] [`Move (`End `Line)]
match es with |> add [([Ctrl], C 'k')] [`Kill (`End `Line)]
| `Event e -> ( |> add [([Ctrl], U `Backspace)] [`Kill (`Back `Word)]
handle_event n e |> add [([Meta], U `Backspace)] [`Kill (`Back `Word)]
>>= function |> add
| `Handled -> Lwt.return None [([Ctrl], C 'x'); ([], U `Backspace)]
| x -> Lwt.return (Some x) ) [`Kill (`Back `Phrase)]
| `Handled -> Lwt.return None )
(`Event ev) *)
(* let textedit_handler ?(bindings = textedit_bindings) n =
let _nav (code, (ctrl, meta, shift, super)) = let bind = Key.Bind.init bindings in
let nomod = (false, false, false, false) in let fq = Stack.create () in
(match code, (ctrl, meta, shift, super) with Stack.push (`Down, node) fq ;
`Enter, x when x = nomod -> (* `Focus `Next *) ()
| `Uchar b when b = (Uchar.of_char 'b') -> )
let navigator n =
focus focus
( (fun (n : node) : (Event.t -> status Lwt.t) -> function ( (fun (_ : node) (e : Event.t) : Event.t option Lwt.t ->
| `Key (`Press, {ctrl; meta; shift; super; code}) -> match Key.Bind.resolve_events bind [e] with
Lwt.return( _nav (code, (ctrl, meta, shift, super))) | x :: _ -> Action.handle x
| x -> Lwt.return (`Event x) ) | [] -> Lwt.return_some e )
, Focus.make () ) , Focus.make () )
n n
*)
let panel (t : node Lwd.t) : (Event.events -> image Lwt.t) Lwt.t = let panel (t : node Lwd.t) : (Event.events -> image Lwt.t) Lwt.t =
let rq = Lwd.make_release_queue () in let rq = Lwd.make_release_queue () in
let root = Lwd.observe t in let root = Lwd.observe t in
Lwt.return (fun ev -> Lwt.return (fun ev ->
let r = Lwd.sample rq root in let r = Lwd.sample rq root in
(*handle_events r ev Lwt_list.iter_s
>>= fun h -> (fun e ->
( match h with handle_event r e
| [] -> () >>= fun h ->
| _ -> F.epr "handle_event: Unhandled event@." ) ;*) ( match h with
Lwt.return (Draw.pane r) ) | `Handled -> ()
| `Event e ->
F.epr "handle_event: Unhandled event: %s@."
(Event.to_string e) ) ;
Lwt.return_unit )
ev
>|= fun () -> Draw.pane r )
let test = let test =
panel panel
(Lwd.pure (Lwd.pure
(style Style.dark (textedit_handler
(join_y (style Style.dark
(join_y (join_y
(Text.of_string (join_y
"-- welcome to the land of idiots ---" ) (Text.of_string
(join_x "-- welcome to the land of idiots ---" )
(Text.of_string "hello bitch") (join_x
(Text.of_string "! sup dude") ) ) (Text.of_string "hello bitch")
(Text.of_string "test 1 2 3 4 5 6") ) ) ) (Text.of_string "!\n sup dude") ) )
(Text.of_string "test 1 2 3 4 5 6") ) ) ) )
end end
end end
@ -1856,7 +1957,7 @@ module Store = struct
let editbinds = let editbinds =
let open Key.Bind in let open Key.Bind in
add add
[([Ctrl], Char 'c')] [([Ctrl], C 'c')]
[ Custom [ Custom
(fun () -> (fun () ->
sv.editmode <- not sv.editmode ; sv.editmode <- not sv.editmode ;
@ -1864,14 +1965,14 @@ module Store = struct
(sv.view @ sv.selection) (sv.view @ sv.selection)
(Panel.Textedit.contents te) ) ] (Panel.Textedit.contents te) ) ]
@@ add @@ add
[([Ctrl], Char 's')] [([Ctrl], C 's')]
[ Custom [ Custom
(fun () -> (fun () ->
save sv.store save sv.store
(sv.view @ sv.selection) (sv.view @ sv.selection)
(Panel.Textedit.contents te) ) ] (Panel.Textedit.contents te) ) ]
@@ add @@ add
[([Ctrl], Char 'x'); ([], Char 'x')] [([Ctrl], C 'x'); ([], C 'x')]
[ Custom [ Custom
(fun () -> (fun () ->
Toplevel.eval top (Panel.Textedit.contents te) ) ] Toplevel.eval top (Panel.Textedit.contents te) ) ]
@ -1948,14 +2049,14 @@ module Store = struct
Istore.set_tree_exn Istore.set_tree_exn
~info:(Irmin_unix.info "new Contents") ~info:(Irmin_unix.info "new Contents")
sv.store sv.view newtree ) in sv.store sv.view newtree ) in
add [([], Char 'n')] [CustomLwt (navigate sv `Next)] add [([], C 'n')] [CustomLwt (navigate sv `Next)]
@@ add [([], Char 'p')] [CustomLwt (navigate sv `Prev)] @@ add [([], C 'p')] [CustomLwt (navigate sv `Prev)]
@@ add [([], Char 'w')] [CustomLwt (navigate sv `Prev)] @@ add [([], C 'w')] [CustomLwt (navigate sv `Prev)]
@@ add [([], Char 's')] [CustomLwt (navigate sv `Next)] @@ add [([], C 's')] [CustomLwt (navigate sv `Next)]
@@ add [([], Char 'd')] [CustomLwt (navigate sv `Sub)] @@ add [([], C 'd')] [CustomLwt (navigate sv `Sub)]
@@ add [([], Char 'a')] [CustomLwt (navigate sv `Sup)] @@ add [([], C 'a')] [CustomLwt (navigate sv `Sup)]
@@ add @@ add
[([], Char 'e')] (* enter edit mode *) [([], C 'e')] (* enter edit mode *)
[ Custom [ Custom
(fun () -> (fun () ->
Lwt.async (fun () -> Lwt.async (fun () ->
@ -1964,17 +2065,17 @@ module Store = struct
if not nb then sv.editmode <- not sv.editmode ; if not nb then sv.editmode <- not sv.editmode ;
Lwt.return_unit ) ) ] Lwt.return_unit ) ) ]
@@ add @@ add
[([], Char 'f')] (* find: enter path in modal *) [([], C 'f')] (* find: enter path in modal *)
[Custom (fun () -> ())] [Custom (fun () -> ())]
@@ add @@ add
[([], Char 'c')] (* contents: create new contents node *) [([], C 'c')] (* contents: create new contents node *)
[ Custom [ Custom
(fun () -> (fun () ->
Panel.Modal.start ~prompt:"Contents name > " Panel.Modal.start ~prompt:"Contents name > "
modalstate "" (fun name -> modalstate "" (fun name ->
new_contents (Istore.Key.v [name]) "" ) ) ] new_contents (Istore.Key.v [name]) "" ) ) ]
@@ add @@ add
[([], Char 't')] (* tree: create new subtree *) [([], C 't')] (* tree: create new subtree *)
[ Custom [ Custom
(fun () -> (fun () ->
Panel.Modal.start ~prompt:"Node name > " modalstate Panel.Modal.start ~prompt:"Node name > " modalstate
@ -1986,7 +2087,7 @@ module Store = struct
(Istore.Key.v [nodename; contentsname]) (Istore.Key.v [nodename; contentsname])
"" ) ) ) ] "" ) ) ) ]
@@ add @@ add
[([], Char 'r')] (* remove contents/node *) [([], C 'r')] (* remove contents/node *)
[ CustomLwt [ CustomLwt
(fun () -> (fun () ->
let selection = sv.selection in let selection = sv.selection in
@ -2000,7 +2101,7 @@ module Store = struct
~info:(Irmin_unix.info "remove Contents/Node") ~info:(Irmin_unix.info "remove Contents/Node")
sv.store sv.view newtree ) ] sv.store sv.view newtree ) ]
@@ add @@ add
[([], Char 'x')] (* execute contents/node *) [([], C 'x')] (* execute contents/node *)
[ Custom [ Custom
(fun () -> (fun () ->
Toplevel.eval top (Panel.Textedit.contents te) ) ] Toplevel.eval top (Panel.Textedit.contents te) ) ]