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

better keybindings, halfway to store tree navigation

Browse Source
This commit is contained in:
cqc
2021-09-03 08:42:49 -05:00
parent d6b16f2a4e
commit 335d864a8b
1 changed files with 195 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files

273
main.ml
View File

@ -19,7 +19,6 @@ some options:
open Lwt.Infix
module F = Fmt
module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
module Input = struct
open CamomileLibrary
@ -66,39 +65,48 @@ module Input = struct
module Keymod = Set.Make (KeymodSet)
let modset = Keymod.of_list
type key = {mods: Keymod.t; code: code}
module Key = struct
type t = key
let compare (x : t) (y : t) = compare x y
let compare = compare
end
module Bind = struct
(* parts stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *)
module S = Zed_input.Make (Key)
include S
type action = Custom of (unit -> unit) | Zed of Zed_edit.action
type binding = key * action list
type bindings = binding list
(* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *)
type t = action list S.t
type resolver = action list S.resolver
type result = action list S.result
type state =
{ mutable bindings: t
; mutable state: result
; mutable last_keyseq: key list
; mutable last_actions: action list }
let add events action bindings =
let events =
List.map
(fun (m, k) ->
{mods= Keymod.of_list m; code= Char (UChar.of_char k)} )
events in
S.add events action bindings
let default_resolver b =
resolver [pack (fun (x : action list) -> x) b]
let get_resolver result default =
match result with Continue r -> r | _ -> default
let handle_actions actions zectx =
List.iter
(function
| Custom f -> f () | Zed za -> Zed_edit.get_action za zectx
)
actions
let init bindings =
{bindings; state= S.Rejected; last_keyseq= []; last_actions= []}
end
(* stolen from lambda-term/src/lTerm_{edit,key}.ml{,i} *)
@ -340,6 +348,30 @@ module Event = struct
let key_left : Sdl.keycode = 0x40000050
let key_right : Sdl.keycode = 0x4000004f
let handle_keyevents (el : events) f = List.iter f el
let actions_of_events (state : Input.Bind.state) (events : events) =
let open Input.Bind in
List.iter
(function
| `Key_down (k : Input.key) ->
( 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 <- [] ;
[]
| _ -> []
end
module Display = struct
@ -610,9 +642,9 @@ module Panel = struct
open Gg
type t =
{ act: t -> Event.events -> t * Display.pane
; subpanels: t list
; tag: string }
{ mutable act: t -> Event.events -> t * Display.pane
; mutable subpanels: t list
; mutable tag: string }
type actor = Event.events -> Display.pane
@ -671,6 +703,7 @@ module Panel = struct
type Format.stag += Color_bg of Wall.color
type Format.stag += Color_fg of Wall.color
type Format.stag += Cursor of Wall.color
type Format.stag += None_tag
let draw_pp height fpp (s : state) =
let node, sc, box = (ref I.empty, ref s, ref Box2.zero) in
@ -760,7 +793,7 @@ module Panel = struct
let open Zed_edit in
let m = Input.Keymod.of_list in
let b = ref empty in
let add e a = b := Input.Bind.add e a !b in
let add e a = b := Input.Bind.S.add e a !b in
add [{mods= m []; code= Left}] [Zed Prev_char] ;
add [{mods= m []; code= Right}] [Zed Next_char] ;
add [{mods= m []; code= Up}] [Zed Prev_line] ;
@ -834,47 +867,18 @@ module Panel = struct
!b
type textedit =
{ ze: unit Zed_edit.t
; zc: Zed_cursor.t
; mutable bindings: Input.Bind.t
; mutable binding_state: Input.Bind.result
; mutable last_keyseq: Input.key list
; mutable last_actions: Input.Bind.action list }
{ze: unit Zed_edit.t; zc: Zed_cursor.t; keybind: Input.Bind.state}
let make_textedit () =
let make_textedit ?(keybinds = default_bindings) () =
let z = Zed_edit.create () in
{ ze= z
; zc= Zed_edit.new_cursor z
; bindings= default_bindings
; binding_state= Input.Bind.S.Rejected
; last_keyseq= [{mods= Input.Keymod.empty; code= Input.None}]
; last_actions= [] }
(* pane that displays last key binding match state *)
let draw_textedit_input height (te : textedit) =
draw_pp height (fun pp ->
Format.pp_open_hbox pp () ;
F.text pp
(List.fold_right
(fun x s -> Input.to_string_compact x ^ " " ^ s)
te.last_keyseq "" ) ;
F.text pp
(List.fold_right
(fun x s ->
s ^ "-> "
^ Input.Bind.(
match x with
| Zed a -> Zed_edit.name_of_action a
| Custom _ -> "Custom") )
te.last_actions "" ) ;
Format.pp_close_box pp () ;
F.flush pp () )
; keybind= Input.Bind.init keybinds }
let str_of_textedit (te : textedit) =
Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze))
let textedit ?(_keybinds : Input.Bind.bindings = [])
?(_initialstring = "") ?(height = !g_text_height) te =
let textedit ?(_initialstring = "") ?(height = !g_text_height) te =
{ act=
(fun panel events ->
let ctx = Zed_edit.context te.ze te.zc in
@ -883,19 +887,20 @@ module Panel = struct
(function
| `Key_down (k : Input.key) -> (
let open Input.Bind in
( match te.binding_state with
( match te.keybind.state with
| Accepted _ | Rejected ->
te.last_keyseq <- [] ;
te.last_actions <- []
te.keybind.last_keyseq <- [] ;
te.keybind.last_actions <- []
| Continue _ -> () ) ;
te.binding_state <-
te.keybind.state <-
resolve k
(get_resolver te.binding_state
(default_resolver te.bindings) ) ;
te.last_keyseq <- k :: te.last_keyseq ;
match te.binding_state with
(get_resolver te.keybind.state
(default_resolver te.keybind.bindings) ) ;
te.keybind.last_keyseq <-
k :: te.keybind.last_keyseq ;
match te.keybind.state with
| Accepted a ->
te.last_actions <- a ;
te.keybind.last_actions <- a ;
List.iter
(function
| Input.Bind.Custom f -> f ()
@ -931,15 +936,45 @@ module Panel = struct
; subpanels= []
; tag= "textedit" }
(* pane that displays last key binding match state *)
let bindingstate ?(height = !g_text_height) (b : Input.Bind.state) =
{ act=
(fun panel _events ->
( panel
, draw_pp height (fun pp ->
Format.pp_open_hbox pp () ;
F.text pp
(List.fold_left
(fun s x -> Input.to_string_compact x ^ " " ^ s)
"" b.last_keyseq ) ;
F.text pp "-> " ;
F.text pp
( match b.state with
| Accepted a ->
"Accepted "
^ List.fold_right
(fun x s ->
s
^ Input.Bind.(
match x with
| Zed a -> Zed_edit.name_of_action a
| Custom _ -> "Custom")
^ "; " )
a ""
| Rejected -> "Rejected"
| Continue _ -> "Continue" ) ;
Format.pp_close_box pp () ;
F.flush pp () ) ) )
; subpanels= []
; tag= "binding-state" }
let prettyprint ?(height = !g_text_height) fpp =
{ act= (fun panel _events -> (panel, draw_pp height fpp))
; subpanels= []
; tag= "pretty-print" }
let enclosure = ref blank
let actor (panel : t) : Event.events -> Display.pane =
enclosure := panel ;
let enclosure = ref panel in
fun events ->
let panel, pane = panel.act !enclosure events in
enclosure := panel ;
@ -952,39 +987,93 @@ module I = Image
module P = Path
module Text = Wall_text
type storeview = {s: Store.t; path: string list}
module Store = struct
module Istore = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
let make_storeview storepath branch ?(path = []) () =
{ s=
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 }
let make_storeview ?(path = []) storepath branch =
{ store=
Lwt_main.run
(Store.of_branch
(Lwt_main.run (Store.Repo.v (Irmin_git.config storepath)))
(Istore.of_branch
(Lwt_main.run
(Istore.Repo.v (Irmin_git.config storepath)) )
branch )
; path }
; view= path
; selected= [2]
; edit= false }
let draw_storeview (r : storeview) height (s : Display.state) =
let draw_storeview tree selected pp =
let indent = ref 0 in
let rec draw_levels (tree : (string * Store.tree) list) pp =
let rec draw_levels ttree sel =
indent := !indent + 1 ;
List.iter
(fun (step, node) ->
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 (Store.Tree.list node []) in
draw_levels subtree 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 ;
ttree ;
indent := !indent - 1 in
draw_levels tree selected
let navigate sv action =
let _root =
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
let editor ?(branch = "current") storepath : Panel.t =
let sv = make_storeview storepath branch in
let keybinds =
let open CamomileLibrary in
let open Input.Bind in
add [([], 'n')] [Custom (navigate sv `Next)]
@@ add [([], 'p')] [Custom (navigate sv `Prev)] empty in
let bindstate = Input.Bind.init keybinds in
{ act=
(fun panel events ->
List.iter
Input.Bind.(function Custom f -> f () | _ -> ())
(Event.actions_of_events bindstate events) ;
(Panel.vbox panel.subpanels).act panel events )
; subpanels=
[ Panel.prettyprint (fun pp ->
let root =
Lwt_main.run
(Store.get_tree r.s r.path >>= fun n -> Store.Tree.list n [])
in
Panel.draw_pp height (draw_levels root) s
( Istore.get_tree sv.store sv.view
>>= fun n -> Istore.Tree.list n [] ) in
draw_storeview root sv.selected pp )
; Panel.bindingstate bindstate ]
; tag= "store-editor" }
end
let format_symbolic_output_buffer (ppf : Format.formatter) buf =
List.iter
@ -1017,7 +1106,7 @@ type top =
; mutable eval: Topinf.evalenv option
; mutable path: string list
; mutable histpath: string list
; storeview: storeview }
; storeview: Store.storeview }
let make_top storepath ?(branch = "current") () =
let t =
@ -1026,15 +1115,15 @@ let make_top storepath ?(branch = "current") () =
; eval= None
; path= ["init"]
; histpath= ["history"]
; storeview= make_storeview storepath branch () } in
; storeview= Store.make_storeview storepath branch } in
Topinf.ppf := Format.formatter_of_symbolic_output_buffer t.res ;
Format.pp_set_formatter_out_functions Format.std_formatter
(out_funs_of_sob t.res) ;
(* Format.pp_set_formatter_out_functions Format.std_formatter
(out_funs_of_sob t.res) ;*)
let zctx = Zed_edit.context t.te.ze t.te.zc in
Zed_edit.insert zctx
(Zed_rope.of_string
(Zed_string.of_utf8
(Lwt_main.run (Store.get t.storeview.s t.path)) ) ) ;
(Lwt_main.run (Store.Istore.get t.storeview.store t.path)) ) ) ;
t
let top_panel (t : top) =
@ -1055,9 +1144,9 @@ let top_panel (t : top) =
try
ignore
(Lwt_main.run
( Store.tree t.storeview.s
( Store.Istore.tree t.storeview.store
>>= fun tree ->
Store.Tree.add tree
Store.Istore.Tree.add tree
(t.histpath @ ["input"])
(Panel.str_of_textedit t.te) ) ) ;
ignore (Format.flush_symbolic_output_buffer t.res) ;
@ -1069,14 +1158,14 @@ let top_panel (t : top) =
(Format.get_symbolic_output_buffer t.res) ;
ignore
(Lwt_main.run
( Store.tree t.storeview.s
( Store.Istore.tree t.storeview.store
>>= fun tree ->
Store.Tree.add tree
Store.Istore.Tree.add tree
(t.histpath @ ["output"])
(Buffer.contents b) ) ) ;
ignore
(Lwt_main.run
(Store.set_exn t.storeview.s
(Store.Istore.set_exn t.storeview.store
~info:(Irmin_unix.info "history")
t.path
(Panel.str_of_textedit t.te) ) ) ;
@ -1085,12 +1174,12 @@ let top_panel (t : top) =
F.pf ppf "Exception in pane_top//eval@." ;
Location.report_exception ppf e ;
F.epr "Exception in pane_top//eval@." in
t.te.bindings <-
t.te.keybind.bindings <-
Input.(
Bind.add
Bind.S.add
[{mods= Keymod.of_list [Ctrl]; code= Enter}]
Bind.[Custom eval]
t.te.bindings) ;
t.te.keybind.bindings) ;
Panel.(
vbox
[ textedit t.te
@ -1101,7 +1190,7 @@ let top_panel (t : top) =
Format.pp_close_box pp () ;
F.flush pp () ) (*; draw_textedit_input height t.te *) ])
let top_1 = make_top "../rootstore" ()
(*let top_1 = make_top "../rootstore" () *)
let () =
let actor =
@ -1109,7 +1198,7 @@ let () =
(Panel.obox
[ Panel.draw (fun (s : Display.state) ->
(s, Display.fill_box (Display.gray 0.125) s.box) )
; top_panel top_1 ] ) in
; Store.editor "../rootstore" (*top_panel top_1*) ] ) in
Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) actor) ()
(* Implement the "window management" as just toplevel defined functions that manipulate the window tree *)