store editor tree navigation works????
This commit is contained in:
14
irc.ml
14
irc.ml
@ -5,6 +5,10 @@ we need to design this somehow before implementing it
|
|||||||
really the graphical drawing / window management funcitons i think at this point.
|
really the graphical drawing / window management funcitons i think at this point.
|
||||||
|
|
||||||
|
|
||||||
|
features:
|
||||||
|
- message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people.......
|
||||||
|
- i mean really what you want is an editable stream, so you can stage messages for later
|
||||||
|
- because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory.
|
||||||
|
|
||||||
*)
|
*)
|
||||||
|
|
||||||
@ -34,7 +38,8 @@ let callback connection result =
|
|||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
Lwt_io.flush Lwt_io.stdout
|
Lwt_io.flush Lwt_io.stdout
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
C.send_privmsg ~connection ~target:"cqc" ~message:("ack: " ^ data)
|
C.send_privmsg ~connection ~target:"cqc"
|
||||||
|
~message:("ack: " ^ data)
|
||||||
| Result.Ok msg ->
|
| Result.Ok msg ->
|
||||||
Lwt_io.printf "Got message: %s\n" (M.to_string msg)
|
Lwt_io.printf "Got message: %s\n" (M.to_string msg)
|
||||||
>>= fun () -> Lwt_io.flush Lwt_io.stdout
|
>>= fun () -> Lwt_io.flush Lwt_io.stdout
|
||||||
@ -44,15 +49,16 @@ let lwt_main () =
|
|||||||
C.reconnect_loop ~after:30
|
C.reconnect_loop ~after:30
|
||||||
~connect:(fun () ->
|
~connect:(fun () ->
|
||||||
Lwt_io.printl "Connecting..."
|
Lwt_io.printl "Connecting..."
|
||||||
>>= fun () -> C.connect_by_name ~server:!host ~port:!port ~nick:!nick ()
|
>>= fun () ->
|
||||||
)
|
C.connect_by_name ~server:!host ~port:!port ~nick:!nick () )
|
||||||
~f:(fun connection ->
|
~f:(fun connection ->
|
||||||
Lwt_io.printl "Connected"
|
Lwt_io.printl "Connected"
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
Lwt_io.printl "send join msg"
|
Lwt_io.printl "send join msg"
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
C.send_join ~connection ~channel:!channel
|
C.send_join ~connection ~channel:!channel
|
||||||
>>= fun () -> C.send_privmsg ~connection ~target:!channel ~message )
|
>>= fun () ->
|
||||||
|
C.send_privmsg ~connection ~target:!channel ~message )
|
||||||
~callback ()
|
~callback ()
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
|
|||||||
149
main.ml
149
main.ml
@ -346,7 +346,7 @@ module Event = struct
|
|||||||
| `Window_event -> `Unknown "`Window_event "
|
| `Window_event -> `Unknown "`Window_event "
|
||||||
| `Display_event -> `Unknown "`Display_event "
|
| `Display_event -> `Unknown "`Display_event "
|
||||||
| `Sensor_update -> `Unknown "`Sensor_update " in
|
| `Sensor_update -> `Unknown "`Sensor_update " in
|
||||||
(* F.epr "event_of_sdlevent: %s@." (to_string r) ;*)
|
(*F.epr "event_of_sdlevent: %s@." (to_string r) ;*)
|
||||||
r
|
r
|
||||||
|
|
||||||
let key_up : Sdl.keycode = 0x40000052
|
let key_up : Sdl.keycode = 0x40000052
|
||||||
@ -357,9 +357,12 @@ module Event = struct
|
|||||||
|
|
||||||
let actions_of_events (state : Input.Bind.state) (events : events) =
|
let actions_of_events (state : Input.Bind.state) (events : events) =
|
||||||
let open Input.Bind in
|
let open Input.Bind in
|
||||||
List.iter
|
List.flatten
|
||||||
(function
|
(List.filter_map
|
||||||
| `Key_down (k : Input.keystate) ->
|
(fun e ->
|
||||||
|
(*F.epr "action_of_events: %s@." (to_string e) ;*)
|
||||||
|
match e with
|
||||||
|
| `Key_down (k : Input.keystate) -> (
|
||||||
( match state.state with
|
( match state.state with
|
||||||
| Continue _ -> ()
|
| Continue _ -> ()
|
||||||
| _ -> state.last_keyseq <- [] ) ;
|
| _ -> state.last_keyseq <- [] ) ;
|
||||||
@ -367,17 +370,17 @@ module Event = struct
|
|||||||
resolve k
|
resolve k
|
||||||
(get_resolver state.state
|
(get_resolver state.state
|
||||||
(default_resolver state.bindings) ) ;
|
(default_resolver state.bindings) ) ;
|
||||||
state.last_keyseq <- k :: state.last_keyseq
|
state.last_keyseq <- k :: state.last_keyseq ;
|
||||||
| _ -> () )
|
|
||||||
events ;
|
|
||||||
match state.state with
|
match state.state with
|
||||||
| Accepted a ->
|
| Accepted a ->
|
||||||
state.last_actions <- a ;
|
state.last_actions <- a ;
|
||||||
a
|
Some a
|
||||||
| Rejected ->
|
| Rejected ->
|
||||||
state.last_actions <- [] ;
|
state.last_actions <- [] ;
|
||||||
[]
|
None
|
||||||
| _ -> []
|
| _ -> None )
|
||||||
|
| _ -> None )
|
||||||
|
events )
|
||||||
end
|
end
|
||||||
|
|
||||||
module Display = struct
|
module Display = struct
|
||||||
@ -793,7 +796,7 @@ module Panel = struct
|
|||||||
, ( Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box))
|
, ( Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box))
|
||||||
, !node ) )
|
, !node ) )
|
||||||
|
|
||||||
let default_bindings =
|
let textedit_bindings =
|
||||||
let open Input.Bind in
|
let open Input.Bind in
|
||||||
add [([], Code Left)] [Zed Prev_char]
|
add [([], Code Left)] [Zed Prev_char]
|
||||||
@@ add [([], Code Right)] [Zed Next_char]
|
@@ add [([], Code Right)] [Zed Next_char]
|
||||||
@ -837,7 +840,7 @@ module Panel = struct
|
|||||||
type textedit =
|
type textedit =
|
||||||
{ze: unit Zed_edit.t; zc: Zed_cursor.t; keybind: Input.Bind.state}
|
{ze: unit Zed_edit.t; zc: Zed_cursor.t; keybind: Input.Bind.state}
|
||||||
|
|
||||||
let make_textedit ?(keybinds = default_bindings) () =
|
let make_textedit ?(keybinds = textedit_bindings) () =
|
||||||
let z = Zed_edit.create () in
|
let z = Zed_edit.create () in
|
||||||
{ ze= z
|
{ ze= z
|
||||||
; zc= Zed_edit.new_cursor z
|
; zc= Zed_edit.new_cursor z
|
||||||
@ -958,6 +961,8 @@ module Text = Wall_text
|
|||||||
module Store = struct
|
module Store = struct
|
||||||
module Istore = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
|
module Istore = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
|
||||||
|
|
||||||
|
(* storeview shows items of the selected level *)
|
||||||
|
|
||||||
type storeview =
|
type storeview =
|
||||||
{ store: Istore.t
|
{ store: Istore.t
|
||||||
; mutable view: string list
|
; mutable view: string list
|
||||||
@ -973,12 +978,77 @@ module Store = struct
|
|||||||
(Istore.Repo.v (Irmin_git.config storepath)) )
|
(Istore.Repo.v (Irmin_git.config storepath)) )
|
||||||
branch )
|
branch )
|
||||||
; view= path
|
; view= path
|
||||||
; selected= [2]
|
; selected= [1]
|
||||||
; edit= false }
|
; edit= false }
|
||||||
|
|
||||||
let draw_storeview tree selected pp =
|
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
|
||||||
|
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)) )
|
||||||
|
)
|
||||||
|
|
||||||
|
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 [([], Char 'n')] [Custom (navigate sv `Next)]
|
||||||
|
@@ add [([], Char 'p')] [Custom (navigate sv `Prev)]
|
||||||
|
@@ add [([], Char 'd')] [Custom (navigate sv `Sub)]
|
||||||
|
@@ add [([], Char 'u')] [Custom (navigate sv `Sup)] 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 indent = ref 0 in
|
let indent = ref 0 in
|
||||||
let rec draw_levels ttree sel =
|
let rec draw_levels tree sel =
|
||||||
indent := !indent + 1 ;
|
indent := !indent + 1 ;
|
||||||
List.iteri
|
List.iteri
|
||||||
(fun i (step, node) ->
|
(fun i (step, node) ->
|
||||||
@ -990,55 +1060,26 @@ module Store = struct
|
|||||||
if sel = [i] then
|
if sel = [i] then
|
||||||
Format.pp_open_stag pp
|
Format.pp_open_stag pp
|
||||||
Display.(
|
Display.(
|
||||||
Panel.Color_bg (Wall.Color.v 0.99 0.99 0.125 0.3)) ;
|
Panel.Color_bg
|
||||||
|
(Wall.Color.v 0.99 0.99 0.125 0.3)) ;
|
||||||
Format.fprintf pp "%d-%s@." !indent step ;
|
Format.fprintf pp "%d-%s@." !indent step ;
|
||||||
if sel = [i] then Format.pp_close_stag pp () ;
|
if sel = [i] then Format.pp_close_stag pp () ;
|
||||||
Format.pp_close_box pp () ;
|
Format.pp_close_box pp () ;
|
||||||
let subtree = Lwt_main.run (Istore.Tree.list node []) in
|
let subtree =
|
||||||
|
Lwt_main.run (Istore.Tree.list node []) in
|
||||||
let subsel =
|
let subsel =
|
||||||
if List.length sel > 0 && List.hd sel = i then List.tl sel
|
if List.length sel > 0 && List.hd sel = i then
|
||||||
|
List.tl sel
|
||||||
else [] in
|
else [] in
|
||||||
draw_levels subtree subsel ;
|
draw_levels subtree subsel ;
|
||||||
Format.pp_close_box pp () )
|
Format.pp_close_box pp () )
|
||||||
ttree ;
|
tree ;
|
||||||
indent := !indent - 1 in
|
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 [([], Char 'n')] [Custom (navigate sv `Next)]
|
|
||||||
@@ add [([], Char '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 =
|
let root =
|
||||||
Lwt_main.run
|
Lwt_main.run
|
||||||
( Istore.get_tree sv.store sv.view
|
( Istore.get_tree sv.store sv.view
|
||||||
>>= fun n -> Istore.Tree.list n [] ) in
|
>>= fun n -> Istore.Tree.list n [] ) in
|
||||||
draw_storeview root sv.selected pp )
|
draw_levels root sv.selected )
|
||||||
; Panel.bindingstate bindstate ]
|
; Panel.bindingstate bindstate ]
|
||||||
; tag= "store-editor" }
|
; tag= "store-editor" }
|
||||||
end
|
end
|
||||||
@ -1144,8 +1185,8 @@ let top_panel (t : top) =
|
|||||||
F.epr "Exception in pane_top//eval@." in
|
F.epr "Exception in pane_top//eval@." in
|
||||||
t.te.keybind.bindings <-
|
t.te.keybind.bindings <-
|
||||||
Input.(
|
Input.(
|
||||||
Bind.S.add
|
Bind.add
|
||||||
[{mods= Keymod.of_list [Ctrl]; code= Enter}]
|
[([Ctrl], Code Enter)]
|
||||||
Bind.[Custom eval]
|
Bind.[Custom eval]
|
||||||
t.te.keybind.bindings) ;
|
t.te.keybind.bindings) ;
|
||||||
Panel.(
|
Panel.(
|
||||||
|
|||||||
Reference in New Issue
Block a user